From 6a45f4b3a6987617b0c834d0e8fb1e3a40cec95f Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Tue, 16 May 2017 13:28:32 +0200 Subject: [PATCH] Add withReorder function --- src/UI/Butcher/Monadic/Command.hs | 1 + src/UI/Butcher/Monadic/Internal/Core.hs | 6 ++++++ 2 files changed, 7 insertions(+) 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 () --