Add 'suggestion' functionality

i.e. possible additional input that could make the input valid
(or at least less invalid).

src/UI/Butcher/Monadic/Core.hs

@@ -876,6 +876,7 @@ cmdRunParserAExt mTopLevel inputInitial cmdParser
       PartAlts alts    -> f $ head alts -- this is not optimal, but probably
                                      -- does not matter.
       PartDefault  _ d -> f d
+      PartSuggestion _ d -> f d
       PartRedirect s _ -> s
       PartMany      ds -> f ds
       PartWithHelp _ d -> f d

src/UI/Butcher/Monadic/Param.hs

@@ -3,10 +3,12 @@ module UI.Butcher.Monadic.Param
   , paramHelp
   , paramHelpStr
   , paramDefault
+  , paramSuggestions
   , addReadParam
   , addReadParamOpt
   , addStringParam
   , addStringParamOpt
+  , addRestOfInputStringParam
   )
 where
 
@@ -29,11 +31,17 @@ import           UI.Butcher.Monadic.Core
 data Param p = Param
   { _param_default :: Maybe p
   , _param_help :: Maybe PP.Doc
+  , _param_suggestions :: Maybe [p]
   }
 
 instance Monoid (Param p) where
-  mempty = Param Nothing Nothing
+  mempty = Param Nothing Nothing Nothing
-  Param a1 b1 `mappend` Param a2 b2 = Param (a1 `f` a2) (b1 `mappend` b2)
+  mappend (Param a1 b1 c1)
+          (Param a2 b2 c2)
+    = Param
+          (a1 `f` a2)
+          (b1 `mappend` b2)
+          (c1 `mappend` c2)
     where
       f Nothing x = x
       f x       _ = x
@@ -47,6 +55,9 @@ paramHelp h = mempty { _param_help = Just h }
 paramDefault :: p -> Param p
 paramDefault d = mempty { _param_default = Just d }
 
+paramSuggestions :: [p] -> Param p
+paramSuggestions ss = mempty { _param_suggestions = Just ss }
+
 addReadParam :: forall f out a
               . (Applicative f, Typeable a, Show a, Text.Read.Read a)
              => String
@@ -89,7 +100,7 @@ addStringParam
 addStringParam name par = addCmdPartInp desc parseF
   where
     desc :: PartDesc
-    desc = PartOptional
+    desc = addSuggestion (_param_suggestions par)
          $ (maybe id PartWithHelp $ _param_help par)
          $ PartVariable name
     parseF :: Input -> Maybe (String, Input)

src/UI/Butcher/Monadic/Pretty.hs

@@ -107,6 +107,7 @@ ppHelpShallow desc@(CommandDesc mParent syn help parts _out _children) =
           PartAlts ps -> ps >>= go
           PartSeq  ps -> ps >>= go
           PartDefault _ p -> go p
+          PartSuggestion _ p -> go p
           PartRedirect s p -> [PP.text s $$ PP.nest 20 (ppPartDescUsage p)]
                            ++ (PP.nest 2 <$> go p)
           PartReorder ps -> ps >>= go
@@ -116,34 +117,41 @@ ppHelpShallow desc@(CommandDesc mParent syn help parts _out _children) =
 
 ppPartDescUsage :: PartDesc -> PP.Doc
 ppPartDescUsage = \case
-    PartLiteral s    -> PP.text s
+  PartLiteral  s  -> PP.text s
-    PartVariable s   -> PP.text s
+  PartVariable s  -> PP.text s
-    PartOptional p   -> PP.brackets $ rec p
+  PartOptional p  -> PP.brackets $ rec p
-    PartAlts ps      -> PP.fcat $ PP.punctuate (PP.text ",") $ rec <$> ps
+  PartAlts     ps -> PP.fcat $ PP.punctuate (PP.text ",") $ rec <$> ps
-    PartSeq ps       -> PP.fsep $ rec <$> ps
+  PartSeq      ps -> PP.fsep $ rec <$> ps
-    PartDefault _ p  -> PP.brackets $ rec p
+  PartDefault _ p -> PP.brackets $ rec p
-    PartRedirect s _ -> PP.text s
+  PartSuggestion s p ->
-    PartMany p       -> rec p <> PP.text "+"
+    PP.parens $ PP.fcat $ PP.punctuate (PP.text "|") $ fmap PP.text s ++ [rec p]
-    PartWithHelp _ p -> rec p
+  PartRedirect s _ -> PP.text s
-    PartReorder ps   ->
+  PartMany p       -> rec p <> PP.text "+"
-      let flags = [d | PartMany d <- ps]
+  PartWithHelp _ p -> rec p
-          params = filter (\case PartMany{} -> False; _ -> True) ps
+  PartReorder ps ->
-      in     PP.brackets (PP.fsep $ rec <$> flags)
+    let flags  = [ d | PartMany d <- ps ]
-         <+> PP.fsep (rec <$> params)
+        params = filter ( \case
-  where
+                          PartMany{} -> False
-    rec = ppPartDescUsage
+                          _          -> True
+                        )
+                        ps
+    in  PP.brackets (PP.fsep $ rec <$> flags) <+> PP.fsep (rec <$> params)
+ where
+  rec = ppPartDescUsage
 
 ppPartDescHeader :: PartDesc -> PP.Doc
 ppPartDescHeader = \case
-    PartLiteral    s -> PP.text s
+  PartLiteral  s     -> PP.text s
-    PartVariable   s -> PP.text s
+  PartVariable s     -> PP.text s
-    PartOptional ds' -> rec ds'
+  PartOptional ds'   -> rec ds'
-    PartAlts alts    -> PP.hcat $ List.intersperse (PP.text ",") $ rec <$> alts
+  PartAlts     alts  -> PP.hcat $ List.intersperse (PP.text ",") $ rec <$> alts
-    PartDefault  _ d -> rec d
+  PartDefault    _ d -> rec d
-    PartRedirect s _ -> PP.text s
+  PartSuggestion _ d -> rec d
-    PartMany      ds -> rec ds
+  PartRedirect   s _ -> PP.text s
-    PartWithHelp _ d -> rec d
+  PartMany ds        -> rec ds
-    PartSeq       ds -> PP.hsep $ rec <$> ds
+  PartWithHelp _ d   -> rec d
-    PartReorder   ds -> PP.vcat $ rec <$> ds
+  PartSeq     ds     -> PP.hsep $ rec <$> ds
-  where
+  PartReorder ds     -> PP.vcat $ rec <$> ds
-    rec = ppPartDescHeader
+ where
+  rec = ppPartDescHeader
+

src/UI/Butcher/Monadic/Types.hs

@@ -22,6 +22,7 @@ module UI.Butcher.Monadic.Types
   , PartDesc(..)
   , Input (..)
   , ParsingError (..)
+  , addSuggestion
   )
 where
 
@@ -109,6 +110,7 @@ data PartDesc
   | PartSeq [PartDesc]
   | PartDefault String -- default representation
                 PartDesc
+  | PartSuggestion [String] PartDesc
   | PartRedirect String -- name for the redirection
                  PartDesc
   | PartReorder [PartDesc]
@@ -116,6 +118,10 @@ data PartDesc
   | PartWithHelp PP.Doc PartDesc
   deriving Show
 
+addSuggestion :: Maybe [String] -> PartDesc -> PartDesc
+addSuggestion Nothing     = id
+addSuggestion (Just sugs) = PartSuggestion sugs
+
 {-
 command documentation structure
 1. terminals. e.g. "--dry-run"