Supporting unset values

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:args)
-runParser (OptParser opt next) (identifier:arg:args)
     | optionMatch opt identifier = do
-        ret <- parser opt arg
+        (ret, lo) <- getArg opt args
-        return (fmap ret next, args)
+        return (fmap ret next, lo)
-    | otherwise                  = do
+    | otherwise = do
-        (nextP, newArgs) <- runParser next (identifier:arg:args)
+        (nextP, newArgs) <- runParser next (identifier:args)
-        return (OptParser opt nextP, newArgs)
+        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)

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

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

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"