From 8793adcc7d62d620da8fc8f0864e0f248228d728 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <lsp@informatik.uni-kiel.de>
Date: Tue, 16 May 2017 21:42:28 +0200
Subject: [PATCH] Add function runCmdParserSimple

---
 src/UI/Butcher/Monadic.hs               | 13 ++++++++++++-
 src/UI/Butcher/Monadic/Command.hs       |  8 ++++++++
 src/UI/Butcher/Monadic/Internal/Core.hs |  6 ------
 3 files changed, 20 insertions(+), 7 deletions(-)

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 ()
 --