diff --git a/src/UI/Butcher/Monadic/Command.hs b/src/UI/Butcher/Monadic/Command.hs index a5a0e9a..e94db63 100644 --- a/src/UI/Butcher/Monadic/Command.hs +++ b/src/UI/Butcher/Monadic/Command.hs @@ -59,6 +59,7 @@ module UI.Butcher.Monadic.Command , addCmdHelpStr , reorderStart , reorderStop + , withReorder , peekCmdDesc , peekInput -- * Building CmdParsers - myprog -v --input PATH diff --git a/src/UI/Butcher/Monadic/Internal/Core.hs b/src/UI/Butcher/Monadic/Internal/Core.hs index 6385396..9b03a72 100644 --- a/src/UI/Butcher/Monadic/Internal/Core.hs +++ b/src/UI/Butcher/Monadic/Internal/Core.hs @@ -24,6 +24,7 @@ module UI.Butcher.Monadic.Internal.Core , addCmdImpl , reorderStart , reorderStop + , withReorder , checkCmdParser , runCmdParser , runCmdParserExt @@ -245,6 +246,11 @@ 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 () --