diff --git a/src/UI/Butcher/Monadic.hs b/src/UI/Butcher/Monadic.hs index 16928ae..1ddad25 100644 --- a/src/UI/Butcher/Monadic.hs +++ b/src/UI/Butcher/Monadic.hs @@ -8,7 +8,8 @@ module UI.Butcher.Monadic , CommandDesc(_cmd_out) , cmd_out , -- * Run or Check CmdParsers - runCmdParser + runCmdParserSimple + , runCmdParser , runCmdParserExt , runCmdParserA , runCmdParserAExt @@ -77,6 +78,16 @@ runCmdParserWithHelpDesc mProgName input cmdF = in runCmdParser mProgName input (cmdF fullDesc) +-- | Wrapper around 'runCmdParser' for very simple usage: Accept a @String@ +-- input and return only the output from the parser, returning @Nothing@ in +-- any error case. +runCmdParserSimple :: String -> CmdParser Identity out () -> Either String out +runCmdParserSimple s p = case snd $ runCmdParser Nothing (InputString s) p of + Left e -> Left $ show e + Right desc -> + maybe (Left "command has no implementation") Right $ _cmd_out desc + + -------------------------------------- -- all below is for testing purposes -------------------------------------- diff --git a/src/UI/Butcher/Monadic/Command.hs b/src/UI/Butcher/Monadic/Command.hs index e94db63..4d0ed91 100644 --- a/src/UI/Butcher/Monadic/Command.hs +++ b/src/UI/Butcher/Monadic/Command.hs @@ -85,3 +85,11 @@ import UI.Butcher.Monadic.Internal.Types import UI.Butcher.Monadic.Internal.Core import UI.Butcher.Monadic.Flag import UI.Butcher.Monadic.Param + + + +-- | Safe wrapper around 'reorderStart'/'reorderStop' for cases where reducing +-- to a single binding is possible/preferable. +withReorder :: CmdParser f out a -> CmdParser f out a +withReorder x = reorderStart *> x <* reorderStop + diff --git a/src/UI/Butcher/Monadic/Internal/Core.hs b/src/UI/Butcher/Monadic/Internal/Core.hs index 9b03a72..6385396 100644 --- a/src/UI/Butcher/Monadic/Internal/Core.hs +++ b/src/UI/Butcher/Monadic/Internal/Core.hs @@ -24,7 +24,6 @@ module UI.Butcher.Monadic.Internal.Core , addCmdImpl , reorderStart , reorderStop - , withReorder , checkCmdParser , runCmdParser , runCmdParserExt @@ -246,11 +245,6 @@ reorderStart = liftF $ CmdParserReorderStart () reorderStop :: CmdParser f out () reorderStop = liftF $ CmdParserReorderStop () --- | Safe wrapper around 'reorderStart'/'reorderStop' for cases where reducing --- to a single binding is possible/preferable. -withReorder :: CmdParser f out a -> CmdParser f out a -withReorder x = reorderStart *> x <* reorderStop - -- addPartHelp :: String -> CmdPartParser () -- addPartHelp s = liftF $ CmdPartParserHelp s () --