-- | Reexports of everything that is exposed in the submodules.
module UI.Butcher.Monadic
  ( -- * Types
    Input (..)
  , CmdParser
  , ParsingError (..)
  , CommandDesc(_cmd_out)
  , cmd_out
  , -- * Run or Check CmdParsers
    runCmdParserSimple
  , runCmdParser
  , runCmdParserExt
  , runCmdParserA
  , runCmdParserAExt
  , runCmdParserWithHelpDesc
  , checkCmdParser
  , -- * Building CmdParsers
    module UI.Butcher.Monadic.Command
    -- * PrettyPrinting CommandDescs (usage/help)
  , module UI.Butcher.Monadic.Pretty
    -- * Wrapper around System.Environment.getArgs
  , module UI.Butcher.Monadic.IO
    -- * Utilities for interactive feedback of commandlines (completions etc.)
  , module UI.Butcher.Monadic.Interactive
  -- , cmds
  -- , sample
  -- , test
  -- , test2
  -- , test3
    -- * Builtin commands
  , addHelpCommand
  , addHelpCommand2
  , addHelpCommandWith
  , addButcherDebugCommand
  , addShellCompletionCommand
  , addShellCompletionCommand'
    -- * Advanced usage
  , mapOut
  , emptyCommandDesc
  , Visibility (..)
  )
where



#include "prelude.inc"

import UI.Butcher.Monadic.Types
import UI.Butcher.Monadic.Internal.Types
import UI.Butcher.Monadic.Command
import UI.Butcher.Monadic.BuiltinCommands
import UI.Butcher.Monadic.Internal.Core
import UI.Butcher.Monadic.Pretty
import UI.Butcher.Monadic.IO
import UI.Butcher.Monadic.Interactive

import qualified Text.PrettyPrint as PP



#ifdef HLINT
{-# ANN module "HLint: ignore Use import/export shortcut" #-}
#endif



-- | Like 'runCmdParser', 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'.
--
-- Note that the @CommandDesc ()@ in the output is _not_ the same value as the
-- parameter passed to the parser function: The output value contains a more
-- "shallow" description. This is more efficient for complex CmdParsers when
-- used interactively, because non-relevant parts of the CmdParser are not
-- traversed unless the parser function argument is forced.
runCmdParserWithHelpDesc
  :: Maybe String -- ^ program name to be used for the top-level @CommandDesc@
  -> Input -- ^ input to be processed
  -> (CommandDesc () -> CmdParser Identity out ()) -- ^ parser to use
  -> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserWithHelpDesc :: Maybe String
-> Input
-> (CommandDesc () -> CmdParser Identity out ())
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserWithHelpDesc mProgName :: Maybe String
mProgName input :: Input
input cmdF :: CommandDesc () -> CmdParser Identity out ()
cmdF =
  let (checkResult :: Either String (CommandDesc ())
checkResult, fullDesc :: CommandDesc ()
fullDesc)
        -- knot-tying at its finest..
        = ( Maybe String
-> CmdParser Identity out () -> Either String (CommandDesc ())
forall (f :: * -> *) out.
Maybe String
-> CmdParser f out () -> Either String (CommandDesc ())
checkCmdParser Maybe String
mProgName (CommandDesc () -> CmdParser Identity out ()
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
          )
  in Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
forall out.
Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParser Maybe String
mProgName Input
input (CommandDesc () -> CmdParser Identity out ()
cmdF CommandDesc ()
fullDesc)


-- | Wrapper around 'runCmdParser' for very simple usage: Accept a @String@
-- input and return only the output from the parser, or a plain error string
-- on failure.
runCmdParserSimple :: String -> CmdParser Identity out () -> Either String out
runCmdParserSimple :: String -> CmdParser Identity out () -> Either String out
runCmdParserSimple s :: String
s p :: CmdParser Identity out ()
p = case (CommandDesc (), Either ParsingError (CommandDesc out))
-> Either ParsingError (CommandDesc out)
forall a b. (a, b) -> b
snd ((CommandDesc (), Either ParsingError (CommandDesc out))
 -> Either ParsingError (CommandDesc out))
-> (CommandDesc (), Either ParsingError (CommandDesc out))
-> Either ParsingError (CommandDesc out)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
forall out.
Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParser Maybe String
forall a. Maybe a
Nothing (String -> Input
InputString String
s) CmdParser Identity out ()
p of
  Left e :: ParsingError
e -> String -> Either String out
forall a b. a -> Either a b
Left (String -> Either String out) -> String -> Either String out
forall a b. (a -> b) -> a -> b
$ ParsingError -> String
parsingErrorString ParsingError
e
  Right desc :: CommandDesc out
desc ->
    Either String out
-> (out -> Either String out) -> Maybe out -> Either String out
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String out
forall a b. a -> Either a b
Left "command has no implementation") out -> Either String out
forall a b. b -> Either a b
Right (Maybe out -> Either String out) -> Maybe out -> Either String out
forall a b. (a -> b) -> a -> b
$ CommandDesc out -> Maybe out
forall out. CommandDesc out -> Maybe out
_cmd_out CommandDesc out
desc


--------------------------------------
-- all below is for testing purposes
--------------------------------------


_cmds :: CmdParser Identity (IO ()) ()
_cmds :: CmdParser Identity (IO ()) ()
_cmds = do
  String
-> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmd "echo" (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 ()
addCmdHelpStr "print its parameter to output"
    String
str <- String -> Param String -> CmdParser Identity (IO ()) String
forall (f :: * -> *) out a.
(Applicative f, Typeable a, Show a, Read a) =>
String -> Param a -> CmdParser f out a
addParamRead "STRING" (String -> Param String
forall p. String -> Param p
paramHelpStr "the string to print")
    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 ()
putStrLn String
str
  String
-> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmd "hello" (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 ()
addCmdHelpStr "greet the user"
    CmdParser Identity (IO ()) ()
forall (f :: * -> *) out. CmdParser f out ()
reorderStart
    Bool
short <- String -> [String] -> Flag Void -> CmdParser Identity (IO ()) Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag "" ["short"] Flag Void
forall a. Monoid a => a
mempty
    String
name <- String -> Param String -> CmdParser Identity (IO ()) String
forall (f :: * -> *) out a.
(Applicative f, Typeable a, Show a, Read a) =>
String -> Param a -> CmdParser f out a
addParamRead "NAME" (String -> Param String
forall p. String -> Param p
paramHelpStr "your name, so you can be greeted properly"
                              Param String -> Param String -> Param String
forall a. Semigroup a => a -> a -> a
<> String -> Param String
forall p. p -> Param p
paramDefault "user")
    CmdParser Identity (IO ()) ()
forall (f :: * -> *) out. CmdParser f out ()
reorderStop
    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
      if Bool
short
        then String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "hi, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "!"
        else String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "hello, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", welcome from butcher!"
  String
-> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmd "foo" (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 ()
addCmdHelpStr "foo"
    CommandDesc ()
desc <- CmdParser Identity (IO ()) (CommandDesc ())
forall (f :: * -> *) out. CmdParser f out (CommandDesc ())
peekCmdDesc
    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 ()
putStrLn "foo"
      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 ()
desc
  String
-> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmd "help" (CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ())
-> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
forall a b. (a -> b) -> a -> b
$ do
    CommandDesc ()
desc <- CmdParser Identity (IO ()) (CommandDesc ())
forall (f :: * -> *) out. CmdParser f out (CommandDesc ())
peekCmdDesc
    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
      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 ()
-> ((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)

data Sample = Sample
  { Sample -> Int
_hello :: Int
  , Sample -> String
_s1   :: String
  , Sample -> String
_s2   :: String
  , Sample -> Bool
_quiet :: Bool
  }
  deriving Int -> Sample -> String -> String
[Sample] -> String -> String
Sample -> String
(Int -> Sample -> String -> String)
-> (Sample -> String)
-> ([Sample] -> String -> String)
-> Show Sample
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Sample] -> String -> String
$cshowList :: [Sample] -> String -> String
show :: Sample -> String
$cshow :: Sample -> String
showsPrec :: Int -> Sample -> String -> String
$cshowsPrec :: Int -> Sample -> String -> String
Show

-- sample :: OPA.Parser Sample
-- sample = Sample
--      <$> OPA.option OPA.auto
--          ( OPA.long "hello"
--         <> OPA.metavar "TARGET"
--         <> OPA.help "Target for the greeting" )
--      <*> OPA.strArgument (OPA.metavar "S1")
--      <*> OPA.strArgument (OPA.metavar "S2")
--      <*> OPA.switch
--          ( OPA.long "quiet"
--         <> OPA.help "Whether to be quiet" )
-- 
-- test :: String -> OPA.ParserResult Sample
-- test s = OPA.execParserPure OPA.defaultPrefs (OPA.ParserInfo sample True mempty mempty mempty (-13) True) (List.words s)

_test2 :: IO ()
_test2 :: IO ()
_test2 = 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 "butcher") CmdParser Identity (IO ()) ()
_cmds of
  Left e :: String
e -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "LEFT: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
  Right desc :: CommandDesc ()
desc -> do
    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
ppUsage CommandDesc ()
desc
    Doc -> IO ()
forall a. Show a => a -> IO ()
print (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. HasCallStack => a
undefined Doc -> Doc
forall a. a -> a
id (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [String] -> CommandDesc () -> Maybe Doc
forall a. [String] -> CommandDesc a -> Maybe Doc
ppUsageAt ["hello"] CommandDesc ()
desc

_test3 :: String -> IO ()
_test3 :: String -> IO ()
_test3 s :: String
s = 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 "butcher") (String -> Input
InputString String
s) CmdParser Identity (IO ()) ()
_cmds of
  (desc :: CommandDesc ()
desc, Left e :: ParsingError
e) -> do
    ParsingError -> IO ()
forall a. Show a => a -> IO ()
print ParsingError
e
    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 ()
desc
    CommandDesc () -> Maybe (Maybe String, CommandDesc ())
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc ()
desc Maybe (Maybe String, CommandDesc ())
-> ((Maybe String, CommandDesc ()) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \(_, d :: CommandDesc ()
d) -> do
      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
ppUsage CommandDesc ()
d
  (desc :: CommandDesc ()
desc, Right out :: CommandDesc (IO ())
out) -> do
    case CommandDesc (IO ()) -> Maybe (IO ())
forall out. CommandDesc out -> Maybe out
_cmd_out CommandDesc (IO ())
out of
      Nothing -> do
        String -> IO ()
putStrLn "command is missing implementation!"
        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 ()
desc
      Just f :: IO ()
f -> IO ()
f