Commit be58bfe2 authored by Erick Gonzalez's avatar Erick Gonzalez

add parseOneOf utility parser

parent f58d66e7
......@@ -16,6 +16,7 @@ root :: CommandsT StateM ()
root = do
basic
foo
grob
basic :: CommandsT StateM ()
basic = do
......@@ -54,6 +55,12 @@ frob = command "frob" "frob this level" $ do
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 @@ module System.Console.StructuredCLI (
noAction,
param,
param',
paramParser,
parseOneOf,
runCLI,
top) where
......@@ -434,9 +436,50 @@ infixr 9 -.-
(-.-) :: (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 @@ findNext root input = do
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,
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment