diff --git a/GetOpt.hs b/GetOpt.hs index a0cd77d..5c381eb 100644 --- a/GetOpt.hs +++ b/GetOpt.hs @@ -7,6 +7,7 @@ module GetOpt ( GetOpt.Options.short, GetOpt.Options.value, GetOpt.Options.meta, + GetOpt.Options.unset, GetOpt.Options.option, GetOpt.Options.auto, ) where @@ -26,11 +27,23 @@ runParser p@(DefParser _) args = Nothing runParser (OptParser opt next) [] = do def <- defaultValue opt return (fmap def next, []) -runParser (OptParser _ _) [_] = Nothing -- TODO remove this and support default values -runParser (OptParser opt next) (identifier:arg:args) +runParser (OptParser opt next) (identifier:args) | optionMatch opt identifier = do - ret <- parser opt arg - return (fmap ret next, args) - | otherwise = do - (nextP, newArgs) <- runParser next (identifier:arg:args) - return (OptParser opt nextP, newArgs) \ No newline at end of file + (ret, lo) <- getArg opt args + return (fmap ret next, lo) + | otherwise = do + (nextP, newArgs) <- runParser next (identifier:args) + return (OptParser opt nextP, newArgs) + + where + getArg :: Option a -> [String] -> Maybe (a, [String]) + getArg opt (arg:args) + | head arg /= '-' = do + ret <- parser opt arg + return (ret, args) + | otherwise = do + ret <- unsetValue opt + return (ret, arg:args) + getArg opt args = do + ret <- unsetValue opt + return (ret, args) diff --git a/GetOpt/Data.hs b/GetOpt/Data.hs index 0d45b6f..ddd89aa 100644 --- a/GetOpt/Data.hs +++ b/GetOpt/Data.hs @@ -11,9 +11,11 @@ data Option a = Option { shortName :: Char, defaultValue :: Maybe a, helpMessage :: String, + unsetValue :: Maybe a, parser :: OptionParser a } instance Functor Option where -- fmap :: (a -> b) -> f a -> f b - fmap f (Option mv l s dv hm p) = Option mv l s (fmap f dv) hm (fmap f . p) \ No newline at end of file + fmap f (Option mv l s dv hm sv p) + = Option mv l s (fmap f dv) hm (fmap f sv) (fmap f . p) \ No newline at end of file diff --git a/GetOpt/Options.hs b/GetOpt/Options.hs index 767aa8e..3bf994a 100644 --- a/GetOpt/Options.hs +++ b/GetOpt/Options.hs @@ -18,6 +18,9 @@ value v = Mod $ \x -> x { defaultValue = Just v } help :: String -> Mod a help v = Mod $ \x -> x { helpMessage = v } +unset :: a -> Mod a +unset v = Mod $ \x -> x { unsetValue = Just v } + newtype Mod a = Mod (Option a -> Option a) @@ -28,7 +31,7 @@ instance Semigroup (Mod a) where option :: OptionParser a -> Mod a -> Parser a option p (Mod m) = OptParser (fmap const (m $ def p)) (DefParser ()) where - def = Option "VAR" "" ' ' Nothing "No help message set." + def = Option "VAR" "" ' ' Nothing "No help message set." Nothing optionMatch :: Option a -> String -> Bool optionMatch opt [d, s] = d == '-' && s == shortName opt diff --git a/Main.hs b/Main.hs index 06f6561..7016320 100644 --- a/Main.hs +++ b/Main.hs @@ -15,7 +15,8 @@ getParser = Configuration long "rule" <> short 'r' <> meta "RULE" - <> help "The rulset used." + <> help "The rulset used." + <> unset 30 ) <*> option auto ( long "start"