Supporting unset values

This commit is contained in:
Zoe Roux
2021-03-11 16:12:37 +01:00
parent 450d292e96
commit e0de414346
4 changed files with 29 additions and 10 deletions

View File

@@ -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)
(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)

View File

@@ -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)
fmap f (Option mv l s dv hm sv p)
= Option mv l s (fmap f dv) hm (fmap f sv) (fmap f . p)

View File

@@ -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

View File

@@ -16,6 +16,7 @@ getParser = Configuration
<> short 'r'
<> meta "RULE"
<> help "The rulset used."
<> unset 30
)
<*> option auto (
long "start"