structured-cli 2.4.0.1 → 2.5.0.0

raw patch · 3 files changed

+52/−3 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• example/Main.hs +7/−0
• src/System/Console/StructuredCLI.hs +44/−2
• structured-cli.cabal +1/−1

@@ -16,6 +16,7 @@ root = do   basic   foo+  grob  basic :: CommandsT StateM () basic = do@@ -53,6 +54,12 @@          n <- gets bars          liftIO . putStrLn $ "frobbing " ++ show n ++ " bars"          return NoAction++grob :: CommandsT StateM ()+grob = custom "grob" "grob something" (parseOneOf options "what to grob") always $+         const (return NoAction)+           where options = ["fee", "fa", "fo", "fum"]+                 always  = return True  parseBars :: Validator StateM Int parseBars = return . readMaybe

@@ -100,6 +100,8 @@                                      noAction,                                      param,                                      param',+                                     paramParser,+                                     parseOneOf,                                      runCLI,                                      top) where @@ -434,9 +436,50 @@ (-.-) :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c (-.-) = (.).(.) +-- | A utility parser that reads an input and parses any of the provided possibilities+-- as a parameter for the command node using this parser (see provided example.hs)+parseOneOf :: (Monad m) => [String] -> String-> Node m -> String -> m (ParseResult String)+parseOneOf possibilities hint = parseOneOf' -.- labelParser+    where parseOneOf' = (=<<) parseOneOf''+          parseOneOf'' :: (Monad m) => ParseResult String -> m (ParseResult String)+          parseOneOf'' (Done _ _ rest) =+              case nextWord rest of+                ("?", _) ->+                    return $ Fail hint rest+                ("", remaining) ->+                    return $ Partial (zip possibilities $ repeat "") remaining+                (word, _) -> do+                  results <- mapM (parseOne word) (zip possibilities $ repeat "")+                  case filter isDone results of+                    (result:_) -> return result+                    _          ->+                      case filter isPartial results of+                        []       ->+                          case results of+                            (result':_) -> return result'+                            _           -> return NoMatch+                        partials ->+                          return $ foldl merge (Partial [] "") partials+          parseOneOf'' (Fail hint' rest) = return $ Fail hint' rest+          parseOneOf'' (Partial xs rest) = return $ Partial xs rest+          parseOneOf'' NoMatch           = return NoMatch+          merge (Partial ps _) (Partial ps' rest') = Partial (ps ++ ps') rest'+          merge _  _ = error "Internal inconsistency merging partial results from parseOneOf"+          isDone (Done _ _ _)     = True+          isDone _                = False+          isPartial (Partial _ _) = True+          isPartial _             = False+          parseOne input (str, hint') = labelParser Node { getLabel    = str,+                                                           getHint     = hint',+                                                           getBranches = [],+                                                           isEnabled   = return True,+                                                           runParser   = error "dummy parser",+                                                           handle      = const $ return NoAction+                                                         } input+ paramParser :: Monad m => String -> (String -> m (Maybe a)) -> Node m -> String -> m (ParseResult a) paramParser hint validator = parseParam -.- labelParser-    where parseParam  = flip (>>=) parseParam'+    where parseParam  = (=<<) parseParam'           parseParam' (Done _ matched rest) =               case nextWord rest of                 ("?", _) ->@@ -627,7 +670,6 @@               enabled <- lift isEnabled               if enabled then do                   result <- lift $ runParser node input-                  debugM $ "ran " ++ getLabel ++ " parser on " ++ show input ++ ": "  -- ++ show result                   case result of                     Done output matched rest ->                         return Completed { completedNode      = node,

@@ -1,5 +1,5 @@ name:                structured-cli-version:             2.4.0.1+version:             2.5.0.0 synopsis:            Application library for building interactive console CLIs description:         This module provides the tools to build a complete "structured" CLI application, similar to those found in systems like Cisco IOS or console configuration utilities etc. It aims to be easy for implementors to use. homepage:            https://gitlab.com/codemonkeylabs/structured-cli#readme