Fix addFlagReadParamAll for InputArgs case

src/UI/Butcher/Monadic/Flag.hs

@@ -143,7 +143,7 @@ addFlagReadParamAll
   -> Flag p
   -> (p -> f ())
   -> CmdParser f out [p]
-addFlagReadParamAll shorts longs name flag act = addCmdPartManyA desc parseF act
+addFlagReadParamAll shorts longs name flag act = addCmdPartManyInpA desc parseF act
   where
     allStrs = fmap (\c -> "-"++[c]) shorts
            ++ fmap (\s -> "--"++s)  longs
@@ -153,15 +153,23 @@ addFlagReadParamAll shorts longs name flag act = addCmdPartManyA desc parseF act
     desc1 = PartAlts $ PartLiteral <$> allStrs
     desc2 = (maybe id (PartDefault . show) $ _flag_default flag)
           $ PartVariable name
-    parseF :: String -> Maybe (p, String)
+    parseF :: Input -> Maybe (p, Input)
-    parseF str = flip firstJust allStrs
+    parseF inp = case inp of
-               $ \s -> [ t
+      InputString str -> flip firstJust allStrs $ \s ->
+        [ t
         | (s ++ " ") `isPrefixOf` str
-                       , t <- case Text.Read.reads $ drop (length s + 1) str of
+        , let rest = drop (length s + 1) str
-                          ((x, ' ':r):_) -> Just (x, dropWhile Char.isSpace r)
+        , t <- case Text.Read.reads rest of
-                          ((x, []):_)    -> Just (x, [])
+           ((x, ' ':r):_) -> Just (x, InputString $ dropWhile Char.isSpace r)
-                          _ -> _flag_default flag <&> \x -> (x, s)
+           ((x, ""):_)    -> Just (x, InputString $ "")
+           _ -> _flag_default flag <&> \x -> (x, InputString rest)
         ]
+      InputArgs (arg1:argR) | any (==arg1) allStrs -> case argR of
+        [] -> _flag_default flag <&> \d -> (d, InputArgs argR)
+        (arg2:rest) -> case readMaybe arg2 of
+          Just x -> Just (x, InputArgs rest)
+          Nothing -> _flag_default flag <&> \d -> (d, InputArgs argR)
+      InputArgs _ -> Nothing
 
 addFlagStringParam
   :: forall f out