From 071eacccfcf63ed7ef497e8139aae0ae9833c9a2 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sun, 20 Sep 2020 14:18:53 +0200
Subject: [PATCH] Clean up existing examples, Remove redundant function

mainFromCmdParserWithHelpDesc is no longer required, because
peekCmdDesc can be used at the top-level to access the full
CmdDesc value. The knot-tying implementation is no longer
required either.
---
 examples/HelloWorld.hs                  |  4 ++-
 examples/InteractiveConcurrentOutput.hs |  3 --
 src/UI/Butcher/Applicative/IO.hs        | 25 --------------
 src/UI/Butcher/Monadic/IO.hs            | 43 -------------------------
 4 files changed, 3 insertions(+), 72 deletions(-)

diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs
index c638af9..c8bf618 100644
--- a/examples/HelloWorld.hs
+++ b/examples/HelloWorld.hs
@@ -5,7 +5,9 @@ import           UI.Butcher.Monadic
 
 
 main :: IO ()
-main = mainFromCmdParserWithHelpDesc $ \helpDesc -> do
+main = mainFromCmdParser $ do
+
+  helpDesc <- peekCmdDesc
 
   addCmdSynopsis "a simple butcher example program"
   addCmdHelpStr "a very long help document"
diff --git a/examples/InteractiveConcurrentOutput.hs b/examples/InteractiveConcurrentOutput.hs
index 4a773b4..eb973c5 100644
--- a/examples/InteractiveConcurrentOutput.hs
+++ b/examples/InteractiveConcurrentOutput.hs
@@ -38,9 +38,6 @@ parser = do
     putStrLn $ "bar = " ++ show bar
     putStrLn $ "x = " ++ show x
 
-leftToMaybe :: Either a b -> Maybe a
-leftToMaybe = either Just (const Nothing)
-
 main :: IO ()
 main = displayConsoleRegions $ do
   withReg $ \reg1 -> withReg $ \reg2 -> withReg $ \reg3 -> do
diff --git a/src/UI/Butcher/Applicative/IO.hs b/src/UI/Butcher/Applicative/IO.hs
index af5da1d..c46fdb2 100644
--- a/src/UI/Butcher/Applicative/IO.hs
+++ b/src/UI/Butcher/Applicative/IO.hs
@@ -62,31 +62,6 @@ mainFromCmdParser cmd = do
       printErr $ ppUsage desc
     (_desc, _remaining, Right out) -> out
 
--- | Same as mainFromCmdParser, but with one additional twist: You get access
--- to a knot-tied complete CommandDesc for this full command. Useful in
--- combination with 'UI.Butcher.Monadic.BuiltinCommands.addHelpCommand'
--- mainFromCmdParserWithHelpDesc
---   :: (CommandDesc -> CmdParser (IO ()) (IO ())) -> IO ()
--- mainFromCmdParserWithHelpDesc cmdF = do
---   progName <- System.Environment.getProgName
---   args     <- System.Environment.getArgs
---   case runCmdParserWithHelpDesc (InputArgs args) cmdF of
---     (desc, Left err) -> do
---       putStrErrLn $ progName ++ ": error parsing arguments: " ++ head
---         (_pe_messages err)
---       putStrErrLn $ case _pe_remaining err of
---         InputString ""  -> "at the end of input."
---         InputString str -> case show str of
---           s | length s < 42 -> "at: " ++ s ++ "."
---           s                 -> "at: " ++ take 40 s ++ "..\"."
---         InputArgs [] -> "at the end of input"
---         InputArgs xs -> case List.unwords $ show <$> xs of
---           s | length s < 42 -> "at: " ++ s ++ "."
---           s                 -> "at: " ++ take 40 s ++ "..\"."
---       putStrErrLn $ "usage:"
---       printErr $ ppUsage desc
---     (_desc, Right out) -> out
-
 putStrErrLn :: String -> IO ()
 putStrErrLn s = hPutStrLn stderr s
 
diff --git a/src/UI/Butcher/Monadic/IO.hs b/src/UI/Butcher/Monadic/IO.hs
index 0fe123e..9b3038e 100644
--- a/src/UI/Butcher/Monadic/IO.hs
+++ b/src/UI/Butcher/Monadic/IO.hs
@@ -1,7 +1,6 @@
 -- | Turn your CmdParser into an IO () to be used as your program @main@.
 module UI.Butcher.Monadic.IO
   ( mainFromCmdParser
-  , mainFromCmdParserWithHelpDesc
   )
 where
 
@@ -73,48 +72,6 @@ mainFromCmdParser cmd = do
             printErr $ ppUsage desc
           Just a -> a
 
--- | Same as mainFromCmdParser, but with one additional twist: You get access
--- to a knot-tied complete CommandDesc for this full command. Useful in
--- combination with 'UI.Butcher.Monadic.BuiltinCommands.addHelpCommand'
-mainFromCmdParserWithHelpDesc
-  :: (CommandDesc -> CmdParser Identity (IO ()) ()) -> IO ()
-mainFromCmdParserWithHelpDesc cmdF = do
-  progName <- System.Environment.getProgName
-  let (checkResult, optimisticFullDesc) =
-        ( toCmdDesc (Just progName) (cmdF optimisticFullDesc)
-        , either (const emptyCommandDesc) id $ checkResult
-        )
-        -- knot-tying at its finest..
-  case checkResult of
-    Left e -> do
-      putStrErrLn
-        $ progName
-        ++ ": internal error: failed sanity check for butcher main command parser!"
-      putStrErrLn $ "(" ++ e ++ ")"
-      putStrErrLn $ "aborting."
-    Right fullDesc -> do
-      args <- System.Environment.getArgs
-      case runCmdParserCoreFromDesc fullDesc (InputArgs args) (cmdF fullDesc) of
-        (desc, _, Left err) -> do
-          putStrErrLn $ progName ++ ": error parsing arguments: " ++ head
-            (_pe_messages err)
-          putStrErrLn $ case _pe_remaining err of
-            InputString ""  -> "at the end of input."
-            InputString str -> case show str of
-              s | length s < 42 -> "at: " ++ s ++ "."
-              s                 -> "at: " ++ take 40 s ++ "..\"."
-            InputArgs [] -> "at the end of input"
-            InputArgs xs -> case List.unwords $ show <$> xs of
-              s | length s < 42 -> "at: " ++ s ++ "."
-              s                 -> "at: " ++ take 40 s ++ "..\"."
-          putStrErrLn $ "usage:"
-          printErr $ ppUsage desc
-        (desc, _, Right out) -> case out of
-          Nothing -> do
-            putStrErrLn $ "usage:"
-            printErr $ ppUsage desc
-          Just a -> a
-
 putStrErrLn :: String -> IO ()
 putStrErrLn s = hPutStrLn stderr s