    -- | Turn your CmdParser into an IO () to be used as your program @main@.
    module UI.Butcher.Monadic.IO
      ( mainFromCmdParser
      , mainFromCmdParserWithHelpDesc
      )
    where

    #include "prelude.inc"
    import           Control.Monad.Free
    import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
    import qualified Control.Monad.Trans.MultiState.Strict as MultiStateS

    import qualified Text.PrettyPrint as PP

    import           Data.HList.ContainsType

    import           UI.Butcher.Monadic.Internal.Types
    import           UI.Butcher.Monadic.Internal.Core
    import           UI.Butcher.Monadic.Pretty
    import           UI.Butcher.Monadic.Param

    import           System.IO

    -- | Utility method that allows using a 'CmdParser' as your @main@ function:
    --
    -- > main = mainFromCmdParser $ do
    -- >   addCmdImpl $ putStrLn "This is a fairly boring program."
    --
    -- Uses @System.Environment.getProgName@ as program name and
    -- @System.Environment.getArgs@ as the input to be parsed. Prints some
    -- appropriate messages if parsing fails or if the command has no
    -- implementation; if all is well executes the \'out\' action (the IO ()).
    mainFromCmdParser :: CmdParser Identity (IO ()) () -> IO ()
    mainFromCmdParser :: CmdParser Identity (IO ()) () -> IO ()
    mainFromCmdParser cmd :: CmdParser Identity (IO ()) ()
    cmd = do
      String
    progName <- IO String
    System.Environment.getProgName
      case Maybe String
    -> CmdParser Identity (IO ()) () -> Either String (CommandDesc ())
    forall (f :: * -> *) out.
    Maybe String
    -> CmdParser f out () -> Either String (CommandDesc ())
    checkCmdParser (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    progName) CmdParser Identity (IO ()) ()
    cmd of
        Left  e :: String
    e -> do
          String -> IO ()
    putStrErrLn
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    progName
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": internal error: failed sanity check for butcher main command parser!"
          String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
          String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "aborting."
        Right _ -> do
          [String]
    args <- IO [String]
    System.Environment.getArgs
          case Maybe String
    -> Input
    -> CmdParser Identity (IO ()) ()
    -> (CommandDesc (), Either ParsingError (CommandDesc (IO ())))
    forall out.
    Maybe String
    -> Input
    -> CmdParser Identity out ()
    -> (CommandDesc (), Either ParsingError (CommandDesc out))
    runCmdParser (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    progName) ([String] -> Input
    InputArgs [String]
    args) CmdParser Identity (IO ()) ()
    cmd of
            (desc :: CommandDesc ()
    desc, Left (ParsingError mess :: [String]
    mess remaining :: Input
    remaining)) -> do
              String -> IO ()
    putStrErrLn
                (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $  String
    progName
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": error parsing arguments: "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ case [String]
    mess of
                     []    -> ""
                     (m :: String
    m:_) -> String
    m
              String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case Input
    remaining of
                InputString ""  -> "at the end of input."
                InputString str :: String
    str -> case String -> String
    forall a. Show a => a -> String
    show String
    str of
                  s :: String
    s | String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 42 -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "."
                  s :: String
    s                 -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take 40 String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "..\"."
                InputArgs   []  -> "at the end of input"
                InputArgs   xs :: [String]
    xs  -> case [String] -> String
    List.unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. Show a => a -> String
    show (String -> String) -> [String] -> [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    xs of
                  s :: String
    s | String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 42 -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "."
                  s :: String
    s                 -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take 40 String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "..\"."
              String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "usage:"
              Doc -> IO ()
    forall a. Show a => a -> IO ()
    printErr (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDesc () -> Doc
    forall a. CommandDesc a -> Doc
    ppUsage CommandDesc ()
    desc
            (desc :: CommandDesc ()
    desc, Right out :: CommandDesc (IO ())
    out                         ) -> case CommandDesc (IO ()) -> Maybe (IO ())
    forall out. CommandDesc out -> Maybe out
    _cmd_out CommandDesc (IO ())
    out of
              Nothing -> do
                String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "usage:"
                Doc -> IO ()
    forall a. Show a => a -> IO ()
    printErr (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDesc () -> Doc
    forall a. CommandDesc a -> Doc
    ppUsage CommandDesc ()
    desc
              Just a :: IO ()
    a  -> IO ()
    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 :: (CommandDesc () -> CmdParser Identity (IO ()) ()) -> IO ()
    mainFromCmdParserWithHelpDesc cmdF :: CommandDesc () -> CmdParser Identity (IO ()) ()
    cmdF = do
      String
    progName <- IO String
    System.Environment.getProgName
      let (checkResult :: Either String (CommandDesc ())
    checkResult, fullDesc :: CommandDesc ()
    fullDesc)
            -- knot-tying at its finest..
            = ( Maybe String
    -> CmdParser Identity (IO ()) () -> Either String (CommandDesc ())
    forall (f :: * -> *) out.
    Maybe String
    -> CmdParser f out () -> Either String (CommandDesc ())
    checkCmdParser (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    progName) (CommandDesc () -> CmdParser Identity (IO ()) ()
    cmdF CommandDesc ()
    fullDesc)
              , (String -> CommandDesc ())
    -> (CommandDesc () -> CommandDesc ())
    -> Either String (CommandDesc ())
    -> CommandDesc ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (CommandDesc () -> String -> CommandDesc ()
    forall a b. a -> b -> a
    const CommandDesc ()
    forall out. CommandDesc out
    emptyCommandDesc) CommandDesc () -> CommandDesc ()
    forall a. a -> a
    id (Either String (CommandDesc ()) -> CommandDesc ())
    -> Either String (CommandDesc ()) -> CommandDesc ()
    forall a b. (a -> b) -> a -> b
    $ Either String (CommandDesc ())
    checkResult
              )
      case Either String (CommandDesc ())
    checkResult of
        Left e :: String
    e -> do
          String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    progName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": internal error: failed sanity check for butcher main command parser!"
          String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
          String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "aborting."
        Right _ -> do
          [String]
    args <- IO [String]
    System.Environment.getArgs
          case Maybe String
    -> Input
    -> CmdParser Identity (IO ()) ()
    -> (CommandDesc (), Either ParsingError (CommandDesc (IO ())))
    forall out.
    Maybe String
    -> Input
    -> CmdParser Identity out ()
    -> (CommandDesc (), Either ParsingError (CommandDesc out))
    runCmdParser (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    progName) ([String] -> Input
    InputArgs [String]
    args) (CommandDesc () -> CmdParser Identity (IO ()) ()
    cmdF CommandDesc ()
    fullDesc) of
            (desc :: CommandDesc ()
    desc, Left (ParsingError mess :: [String]
    mess remaining :: Input
    remaining)) -> do
              String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    progName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": error parsing arguments: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. [a] -> a
    head [String]
    mess
              String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case Input
    remaining of
                InputString "" -> "at the end of input."
                InputString str :: String
    str -> case String -> String
    forall a. Show a => a -> String
    show String
    str of
                  s :: String
    s | String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 42 -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "."
                  s :: String
    s -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take 40 String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "..\"."
                InputArgs [] -> "at the end of input"
                InputArgs xs :: [String]
    xs -> case [String] -> String
    List.unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. Show a => a -> String
    show (String -> String) -> [String] -> [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    xs of
                  s :: String
    s | String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 42 -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "."
                  s :: String
    s -> "at: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take 40 String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "..\"."
              String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "usage:"
              Doc -> IO ()
    forall a. Show a => a -> IO ()
    printErr (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDesc () -> Doc
    forall a. CommandDesc a -> Doc
    ppUsage CommandDesc ()
    desc
            (desc :: CommandDesc ()
    desc, Right out :: CommandDesc (IO ())
    out) -> case CommandDesc (IO ()) -> Maybe (IO ())
    forall out. CommandDesc out -> Maybe out
    _cmd_out CommandDesc (IO ())
    out of
              Nothing -> do
                String -> IO ()
    putStrErrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "usage:"
                Doc -> IO ()
    forall a. Show a => a -> IO ()
    printErr (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDesc () -> Doc
    forall a. CommandDesc a -> Doc
    ppUsage CommandDesc ()
    desc
              Just a :: IO ()
    a -> IO ()
    a

    putStrErrLn :: String -> IO ()
    putStrErrLn :: String -> IO ()
    putStrErrLn s :: String
    s = Handle -> String -> IO ()
    hPutStrLn Handle
    stderr String
    s

    printErr :: Show a => a -> IO ()
    printErr :: a -> IO ()
    printErr = String -> IO ()
    putStrErrLn (String -> IO ()) -> (a -> String) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show