    -- | Some CmdParser actions that add predefined commands.
    module UI.Butcher.Monadic.BuiltinCommands
      ( addHelpCommand
      , addHelpCommand2
      , addHelpCommandWith
      , addHelpCommandShallow
      , addButcherDebugCommand
      , addShellCompletionCommand
      , addShellCompletionCommand'
      )
    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           UI.Butcher.Monadic.Interactive

    import           System.IO

    -- | Adds a proper full help command. To obtain the 'CommandDesc' value, see
    -- 'UI.Butcher.Monadic.cmdRunParserWithHelpDesc' or
    -- 'UI.Butcher.Monadic.IO.mainFromCmdParserWithHelpDesc'.
    --
    -- > addHelpCommand = addHelpCommandWith
    -- >   (pure . PP.renderStyle PP.style { PP.ribbonsPerLine = 1.0 } . ppHelpShallow)
    addHelpCommand :: Applicative f => CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommand :: CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommand = (CommandDesc a -> IO String)
    -> CommandDesc a -> CmdParser f (IO ()) ()
    forall (f :: * -> *) a.
    Applicative f =>
    (CommandDesc a -> IO String)
    -> CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommandWith
      (String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String)
    -> (CommandDesc a -> String) -> CommandDesc a -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style -> Doc -> String
    PP.renderStyle Style
    PP.style { ribbonsPerLine :: Float
    PP.ribbonsPerLine = 1.0 } (Doc -> String)
    -> (CommandDesc a -> Doc) -> CommandDesc a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDesc a -> Doc
    forall a. CommandDesc a -> Doc
    ppHelpShallow)

    -- | Adds a proper full help command. In contrast to 'addHelpCommand',
    -- this version is a bit more verbose about available subcommands as it
    -- includes their synopses.
    --
    -- To obtain the 'CommandDesc' value, see
    -- 'UI.Butcher.Monadic.cmdRunParserWithHelpDesc' or
    -- 'UI.Butcher.Monadic.IO.mainFromCmdParserWithHelpDesc'.
    --
    -- > addHelpCommand2 = addHelpCommandWith
    -- >   (pure . PP.renderStyle PP.style { PP.ribbonsPerLine = 1.0 } . ppHelpDepthOne)
    addHelpCommand2 :: Applicative f => CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommand2 :: CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommand2 = (CommandDesc a -> IO String)
    -> CommandDesc a -> CmdParser f (IO ()) ()
    forall (f :: * -> *) a.
    Applicative f =>
    (CommandDesc a -> IO String)
    -> CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommandWith
      (String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String)
    -> (CommandDesc a -> String) -> CommandDesc a -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Style -> Doc -> String
    PP.renderStyle Style
    PP.style { ribbonsPerLine :: Float
    PP.ribbonsPerLine = 1.0 } (Doc -> String)
    -> (CommandDesc a -> Doc) -> CommandDesc a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandDesc a -> Doc
    forall a. CommandDesc a -> Doc
    ppHelpDepthOne)

    -- | Adds a proper full help command, using the specified function to turn
    -- the relevant subcommand's 'CommandDesc' into a String.
    addHelpCommandWith
      :: Applicative f
      => (CommandDesc a -> IO String)
      -> CommandDesc a
      -> CmdParser f (IO ()) ()
    addHelpCommandWith :: (CommandDesc a -> IO String)
    -> CommandDesc a -> CmdParser f (IO ()) ()
    addHelpCommandWith f :: CommandDesc a -> IO String
    f desc :: CommandDesc a
    desc = String -> CmdParser f (IO ()) () -> CmdParser f (IO ()) ()
    forall (f :: * -> *) out.
    Applicative f =>
    String -> CmdParser f out () -> CmdParser f out ()
    addCmd "help" (CmdParser f (IO ()) () -> CmdParser f (IO ()) ())
    -> CmdParser f (IO ()) () -> CmdParser f (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
      String -> CmdParser f (IO ()) ()
    forall (f :: * -> *) out. String -> CmdParser f out ()
    addCmdSynopsis "print help about this command"
      String
    rest <- String -> Param Void -> CmdParser f (IO ()) String
    forall (f :: * -> *) out.
    Applicative f =>
    String -> Param Void -> CmdParser f out String
    addParamRestOfInput "SUBCOMMAND(s)" Param Void
    forall a. Monoid a => a
    mempty
      IO () -> CmdParser f (IO ()) ()
    forall out (f :: * -> *). out -> CmdParser f out ()
    addCmdImpl (IO () -> CmdParser f (IO ()) ())
    -> IO () -> CmdParser f (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
        let restWords :: [String]
    restWords = String -> [String]
    List.words String
    rest
        let
          descent :: [String] -> CommandDesc a -> CommandDesc a
          descent :: [String] -> CommandDesc a -> CommandDesc a
    descent [] curDesc :: CommandDesc a
    curDesc = CommandDesc a
    curDesc
          descent (w :: String
    w:wr :: [String]
    wr) curDesc :: CommandDesc a
    curDesc =
            case
                Maybe String
    -> [(Maybe String, CommandDesc a)] -> Maybe (CommandDesc a)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    List.lookup (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    w) ([(Maybe String, CommandDesc a)] -> Maybe (CommandDesc a))
    -> [(Maybe String, CommandDesc a)] -> Maybe (CommandDesc a)
    forall a b. (a -> b) -> a -> b
    $ Deque (Maybe String, CommandDesc a)
    -> [(Maybe String, CommandDesc a)]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Data.Foldable.toList (Deque (Maybe String, CommandDesc a)
     -> [(Maybe String, CommandDesc a)])
    -> Deque (Maybe String, CommandDesc a)
    -> [(Maybe String, CommandDesc a)]
    forall a b. (a -> b) -> a -> b
    $ CommandDesc a -> Deque (Maybe String, CommandDesc a)
    forall out.
    CommandDesc out -> Deque (Maybe String, CommandDesc out)
    _cmd_children CommandDesc a
    curDesc
              of
                Nothing    -> CommandDesc a
    curDesc
                Just child :: CommandDesc a
    child -> [String] -> CommandDesc a -> CommandDesc a
    forall a. [String] -> CommandDesc a -> CommandDesc a
    descent [String]
    wr CommandDesc a
    child
        String
    s <- CommandDesc a -> IO String
    f (CommandDesc a -> IO String) -> CommandDesc a -> IO String
    forall a b. (a -> b) -> a -> b
    $ [String] -> CommandDesc a -> CommandDesc a
    forall a. [String] -> CommandDesc a -> CommandDesc a
    descent [String]
    restWords CommandDesc a
    desc
        String -> IO ()
    putStrLn String
    s

    -- | Adds a help command that prints help for the command currently in context.
    --
    -- This version does _not_ include further childcommands, i.e. "help foo" will
    -- not print the help for subcommand "foo".
    --
    -- This also yields slightly different output depending on if it is used
    -- before or after adding other subcommands. In general 'addHelpCommand'
    -- should be preferred.
    addHelpCommandShallow :: Applicative f => CmdParser f (IO ()) ()
    addHelpCommandShallow :: CmdParser f (IO ()) ()
    addHelpCommandShallow = String -> CmdParser f (IO ()) () -> CmdParser f (IO ()) ()
    forall (f :: * -> *) out.
    Applicative f =>
    String -> CmdParser f out () -> CmdParser f out ()
    addCmd "help" (CmdParser f (IO ()) () -> CmdParser f (IO ()) ())
    -> CmdParser f (IO ()) () -> CmdParser f (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
      CommandDesc ()
    desc <- CmdParser f (IO ()) (CommandDesc ())
    forall (f :: * -> *) out. CmdParser f out (CommandDesc ())
    peekCmdDesc
      String
    _rest <- String -> Param Void -> CmdParser f (IO ()) String
    forall (f :: * -> *) out.
    Applicative f =>
    String -> Param Void -> CmdParser f out String
    addParamRestOfInput "SUBCOMMAND(s)" Param Void
    forall a. Monoid a => a
    mempty
      IO () -> CmdParser f (IO ()) ()
    forall out (f :: * -> *). out -> CmdParser f out ()
    addCmdImpl (IO () -> CmdParser f (IO ()) ())
    -> IO () -> CmdParser f (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
        let parentDesc :: CommandDesc ()
    parentDesc = CommandDesc ()
    -> ((Maybe String, CommandDesc ()) -> CommandDesc ())
    -> Maybe (Maybe String, CommandDesc ())
    -> CommandDesc ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe CommandDesc ()
    forall a. HasCallStack => a
    undefined (Maybe String, CommandDesc ()) -> CommandDesc ()
    forall a b. (a, b) -> b
    snd (CommandDesc () -> Maybe (Maybe String, CommandDesc ())
    forall out.
    CommandDesc out -> Maybe (Maybe String, CommandDesc out)
    _cmd_mParent CommandDesc ()
    desc)
        Doc -> IO ()
    forall a. Show a => a -> IO ()
    print (Doc -> IO ()) -> Doc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDesc () -> Doc
    forall a. CommandDesc a -> Doc
    ppHelpShallow (CommandDesc () -> Doc) -> CommandDesc () -> Doc
    forall a b. (a -> b) -> a -> b
    $ CommandDesc ()
    parentDesc

    -- | Prints the raw CommandDesc structure.
    addButcherDebugCommand :: Applicative f => CmdParser f (IO ()) ()
    addButcherDebugCommand :: CmdParser f (IO ()) ()
    addButcherDebugCommand = String -> CmdParser f (IO ()) () -> CmdParser f (IO ()) ()
    forall (f :: * -> *) out.
    Applicative f =>
    String -> CmdParser f out () -> CmdParser f out ()
    addCmd "butcherdebug" (CmdParser f (IO ()) () -> CmdParser f (IO ()) ())
    -> CmdParser f (IO ()) () -> CmdParser f (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
      CommandDesc ()
    desc <- CmdParser f (IO ()) (CommandDesc ())
    forall (f :: * -> *) out. CmdParser f out (CommandDesc ())
    peekCmdDesc
      IO () -> CmdParser f (IO ()) ()
    forall out (f :: * -> *). out -> CmdParser f out ()
    addCmdImpl (IO () -> CmdParser f (IO ()) ())
    -> IO () -> CmdParser f (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
        CommandDesc () -> IO ()
    forall a. Show a => a -> IO ()
    print (CommandDesc () -> IO ()) -> CommandDesc () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CommandDesc ()
    -> ((Maybe String, CommandDesc ()) -> CommandDesc ())
    -> Maybe (Maybe String, CommandDesc ())
    -> CommandDesc ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe CommandDesc ()
    forall a. HasCallStack => a
    undefined (Maybe String, CommandDesc ()) -> CommandDesc ()
    forall a b. (a, b) -> b
    snd (CommandDesc () -> Maybe (Maybe String, CommandDesc ())
    forall out.
    CommandDesc out -> Maybe (Maybe String, CommandDesc out)
    _cmd_mParent CommandDesc ()
    desc)

    -- | Adds the "completion" command and several subcommands.
    --
    -- This command can be used in the following manner:
    --
    -- > $ source <(foo completion bash-script foo)
    addShellCompletionCommand
      :: CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    addShellCompletionCommand :: CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    addShellCompletionCommand mainCmdParser :: CmdParser Identity (IO ()) ()
    mainCmdParser = do
      String
    -> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    forall (f :: * -> *) out.
    Applicative f =>
    String -> CmdParser f out () -> CmdParser f out ()
    addCmdHidden "completion" (CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ())
    -> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
        String -> CmdParser Identity (IO ()) ()
    forall (f :: * -> *) out. String -> CmdParser f out ()
    addCmdSynopsis "utilites to enable bash-completion"
        String
    -> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    forall (f :: * -> *) out.
    Applicative f =>
    String -> CmdParser f out () -> CmdParser f out ()
    addCmd "bash-script" (CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ())
    -> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
          String -> CmdParser Identity (IO ()) ()
    forall (f :: * -> *) out. String -> CmdParser f out ()
    addCmdSynopsis "generate a bash script for completion functionality"
          String
    exeName <- String -> Param String -> CmdParser Identity (IO ()) String
    forall (f :: * -> *) out.
    Applicative f =>
    String -> Param String -> CmdParser f out String
    addParamString "EXENAME" Param String
    forall a. Monoid a => a
    mempty
          IO () -> CmdParser Identity (IO ()) ()
    forall out (f :: * -> *). out -> CmdParser f out ()
    addCmdImpl (IO () -> CmdParser Identity (IO ()) ())
    -> IO () -> CmdParser Identity (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
            String -> IO ()
    putStr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    completionScriptBash String
    exeName
        String
    -> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    forall (f :: * -> *) out.
    Applicative f =>
    String -> CmdParser f out () -> CmdParser f out ()
    addCmd "bash-gen" (CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ())
    -> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
          String -> CmdParser Identity (IO ()) ()
    forall (f :: * -> *) out. String -> CmdParser f out ()
    addCmdSynopsis
            "generate possible completions for given input arguments"
          Input
    rest <- String -> Param Void -> CmdParser Identity (IO ()) Input
    forall (f :: * -> *) out.
    Applicative f =>
    String -> Param Void -> CmdParser f out Input
    addParamRestOfInputRaw "REALCOMMAND" Param Void
    forall a. Monoid a => a
    mempty
          IO () -> CmdParser Identity (IO ()) ()
    forall out (f :: * -> *). out -> CmdParser f out ()
    addCmdImpl (IO () -> CmdParser Identity (IO ()) ())
    -> IO () -> CmdParser Identity (IO ()) ()
    forall a b. (a -> b) -> a -> b
    $ do
            let (cdesc :: CommandDesc ()
    cdesc, remaining :: Input
    remaining, _result :: Either ParsingError (CommandDesc (IO ()))
    _result) =
                  Maybe String
    -> Input
    -> CmdParser Identity (IO ()) ()
    -> (CommandDesc (), Input,
        Either ParsingError (CommandDesc (IO ())))
    forall out.
    Maybe String
    -> Input
    -> CmdParser Identity out ()
    -> (CommandDesc (), Input, Either ParsingError (CommandDesc out))
    runCmdParserExt Maybe String
    forall a. Maybe a
    Nothing Input
    rest CmdParser Identity (IO ()) ()
    mainCmdParser
            let
              compls :: [CompletionItem]
    compls = String -> CommandDesc () -> String -> [CompletionItem]
    shellCompletionWords (Input -> String
    inputString Input
    rest)
                                            CommandDesc ()
    cdesc
                                            (Input -> String
    inputString Input
    remaining)
            let lastWord :: String
    lastWord =
                  String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    Char.isSpace) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Input -> String
    inputString
                    Input
    rest
            String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    List.unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [CompletionItem]
    compls [CompletionItem] -> (CompletionItem -> String) -> [String]
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> \case
              CompletionString s :: String
    s  -> String
    s
              CompletionFile      -> "$(compgen -f -- " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lastWord String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
              CompletionDirectory -> "$(compgen -d -- " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lastWord String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
     where
      inputString :: Input -> String
    inputString (InputString s :: String
    s ) = String
    s
      inputString (InputArgs   as :: [String]
    as) = [String] -> String
    List.unwords [String]
    as

    -- | Adds the "completion" command and several subcommands
    --
    -- This command can be used in the following manner:
    --
    -- > $ source <(foo completion bash-script foo)
    addShellCompletionCommand'
      :: (CommandDesc out -> CmdParser Identity (IO ()) ())
      -> CmdParser Identity (IO ()) ()
    addShellCompletionCommand' :: (CommandDesc out -> CmdParser Identity (IO ()) ())
    -> CmdParser Identity (IO ()) ()
    addShellCompletionCommand' f :: CommandDesc out -> CmdParser Identity (IO ()) ()
    f = CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
    addShellCompletionCommand (CommandDesc out -> CmdParser Identity (IO ()) ()
    f CommandDesc out
    forall out. CommandDesc out
    emptyCommandDesc)

    completionScriptBash :: String -> String
    completionScriptBash :: String -> String
    completionScriptBash exeName :: String
    exeName =
      [String] -> String
    List.unlines
        ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [ "function _" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    exeName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "()"
          , "{"
          , "  local IFS=$'\\n'"
          , "  COMPREPLY=()"
          , "  local result=$("
          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    exeName
          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " completion bash-gen \"${COMP_WORDS[@]:1}\")"
          , "  for r in ${result[@]}; do"
          , "    local IFS=$'\\n '"
          , "    for s in $(eval echo ${r}); do"
          , "      COMPREPLY+=(${s})"
          , "    done"
          , "  done"
          , "}"
          , "complete -F _" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    exeName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    exeName
          ]