module UI.Butcher.Monadic
(
Input (..)
, CmdParser
, ParsingError (..)
, CommandDesc(_cmd_out)
, cmd_out
,
runCmdParserSimple
, runCmdParser
, runCmdParserExt
, runCmdParserA
, runCmdParserAExt
, runCmdParserWithHelpDesc
, checkCmdParser
,
module UI.Butcher.Monadic.Command
, module UI.Butcher.Monadic.Pretty
, module UI.Butcher.Monadic.IO
, module UI.Butcher.Monadic.Interactive
, addHelpCommand
, addHelpCommand2
, addHelpCommandWith
, addButcherDebugCommand
, addShellCompletionCommand
, addShellCompletionCommand'
, 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
runCmdParserWithHelpDesc
:: Maybe String
-> Input
-> (CommandDesc () -> CmdParser Identity out ())
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserWithHelpDesc :: forall out.
Maybe String
-> Input
-> (CommandDesc () -> CmdParser Identity out ())
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserWithHelpDesc Maybe String
mProgName Input
input CommandDesc () -> CmdParser Identity out ()
cmdF =
let (Either String (CommandDesc ())
checkResult, CommandDesc ()
fullDesc)
= ( 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)
runCmdParserSimple :: String -> CmdParser Identity out () -> Either String out
runCmdParserSimple :: forall out.
String -> CmdParser Identity out () -> Either String out
runCmdParserSimple String
s 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 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 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 String
"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
_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 String
"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 String
"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" (String -> Param String
forall p. String -> Param p
paramHelpStr String
"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 String
"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 String
"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 String
"" [String
"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 String
"NAME" (String -> Param String
forall p. String -> Param p
paramHelpStr String
"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 String
"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
$ String
"hi, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!"
else String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"hello, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", welcome from butcher!"
String
-> CmdParser Identity (IO ()) () -> CmdParser Identity (IO ()) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmd String
"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 String
"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 String
"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 String
"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
_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 String
"butcher") CmdParser Identity (IO ()) ()
_cmds of
Left String
e -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"LEFT: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
Right 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 [String
"hello"] CommandDesc ()
desc
_test3 :: String -> IO ()
_test3 :: String -> IO ()
_test3 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 String
"butcher") (String -> Input
InputString String
s) CmdParser Identity (IO ()) ()
_cmds of
(CommandDesc ()
desc, Left 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_` \(Maybe String
_, 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
(CommandDesc ()
desc, Right CommandDesc (IO ())
out) -> do
case CommandDesc (IO ()) -> Maybe (IO ())
forall out. CommandDesc out -> Maybe out
_cmd_out CommandDesc (IO ())
out of
Maybe (IO ())
Nothing -> do
String -> IO ()
putStrLn String
"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 IO ()
f -> IO ()
f