module GF.Command.CommandInfo where
import GF.Command.Abstract(Option,Expr,Term)
import GF.Text.Pretty(render)
import GF.Grammar.Printer()
import GF.Grammar.Macros(string2term)
import qualified PGF as H(showExpr)
import qualified PGF.Internal as H(Literal(LStr),Expr(ELit))
data CommandInfo m = CommandInfo {
CommandInfo m -> [Option] -> CommandArguments -> m CommandOutput
exec :: [Option] -> CommandArguments -> m CommandOutput,
CommandInfo m -> String
synopsis :: String,
CommandInfo m -> String
syntax :: String,
CommandInfo m -> String
explanation :: String,
CommandInfo m -> String
longname :: String,
CommandInfo m -> [(String, String)]
options :: [(String,String)],
CommandInfo m -> [(String, String)]
flags :: [(String,String)],
CommandInfo m -> [(String, String)]
examples :: [(String,String)],
CommandInfo m -> Bool
needsTypeCheck :: Bool
}
mapCommandExec :: (m CommandOutput -> m CommandOutput)
-> CommandInfo m -> CommandInfo m
mapCommandExec m CommandOutput -> m CommandOutput
f CommandInfo m
c = CommandInfo m
c { exec :: [Option] -> CommandArguments -> m CommandOutput
exec = \ [Option]
opts CommandArguments
ts -> m CommandOutput -> m CommandOutput
f (CommandInfo m -> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *).
CommandInfo m -> [Option] -> CommandArguments -> m CommandOutput
exec CommandInfo m
c [Option]
opts CommandArguments
ts) }
emptyCommandInfo :: CommandInfo m
emptyCommandInfo = CommandInfo :: forall (m :: * -> *).
([Option] -> CommandArguments -> m CommandOutput)
-> String
-> String
-> String
-> String
-> [(String, String)]
-> [(String, String)]
-> [(String, String)]
-> Bool
-> CommandInfo m
CommandInfo {
exec :: [Option] -> CommandArguments -> m CommandOutput
exec = String -> [Option] -> CommandArguments -> m CommandOutput
forall a. HasCallStack => String -> a
error String
"command not implemented",
synopsis :: String
synopsis = String
"",
syntax :: String
syntax = String
"",
explanation :: String
explanation = String
"",
longname :: String
longname = String
"",
options :: [(String, String)]
options = [],
flags :: [(String, String)]
flags = [],
examples :: [(String, String)]
examples = [],
needsTypeCheck :: Bool
needsTypeCheck = Bool
True
}
class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr
data CommandArguments = Exprs [Expr] | Strings [String] | Term Term
newtype CommandOutput = Piped (CommandArguments,String)
fromStrings :: [String] -> CommandOutput
fromStrings [String]
ss = (CommandArguments, String) -> CommandOutput
Piped ([String] -> CommandArguments
Strings [String]
ss, [String] -> String
unlines [String]
ss)
fromExprs :: [Expr] -> CommandOutput
fromExprs [Expr]
es = (CommandArguments, String) -> CommandOutput
Piped ([Expr] -> CommandArguments
Exprs [Expr]
es,[String] -> String
unlines ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([CId] -> Expr -> String
H.showExpr []) [Expr]
es))
fromString :: String -> CommandOutput
fromString String
s = (CommandArguments, String) -> CommandOutput
Piped ([String] -> CommandArguments
Strings [String
s], String
s)
pipeWithMessage :: [Expr] -> String -> CommandOutput
pipeWithMessage [Expr]
es String
msg = (CommandArguments, String) -> CommandOutput
Piped ([Expr] -> CommandArguments
Exprs [Expr]
es,String
msg)
pipeMessage :: String -> CommandOutput
pipeMessage String
msg = (CommandArguments, String) -> CommandOutput
Piped ([Expr] -> CommandArguments
Exprs [],String
msg)
pipeExprs :: [Expr] -> CommandOutput
pipeExprs [Expr]
es = (CommandArguments, String) -> CommandOutput
Piped ([Expr] -> CommandArguments
Exprs [Expr]
es,[])
void :: CommandOutput
void = (CommandArguments, String) -> CommandOutput
Piped ([Expr] -> CommandArguments
Exprs [],String
"")
stringAsExpr :: String -> Expr
stringAsExpr = Literal -> Expr
H.ELit (Literal -> Expr) -> (String -> Literal) -> String -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
H.LStr
toStrings :: CommandArguments -> [String]
toStrings CommandArguments
args =
case CommandArguments
args of
Strings [String]
ss -> [String]
ss
Exprs [Expr]
es -> (Bool -> Expr -> String) -> [Bool] -> [Expr] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Expr -> String
showAsString (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [Expr]
es
Term Term
t -> [Term -> String
forall a. Pretty a => a -> String
render Term
t]
where
showAsString :: Bool -> Expr -> String
showAsString Bool
first Expr
t =
case Expr
t of
H.ELit (H.LStr String
s) -> String
s
Expr
_ -> [Char
'\n'|Bool -> Bool
not Bool
first] String -> String -> String
forall a. [a] -> [a] -> [a]
++
[CId] -> Expr -> String
H.showExpr [] Expr
t
toExprs :: CommandArguments -> [Expr]
toExprs CommandArguments
args =
case CommandArguments
args of
Exprs [Expr]
es -> [Expr]
es
Strings [String]
ss -> (String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
stringAsExpr [String]
ss
Term Term
t -> [String -> Expr
stringAsExpr (Term -> String
forall a. Pretty a => a -> String
render Term
t)]
toTerm :: CommandArguments -> Term
toTerm CommandArguments
args =
case CommandArguments
args of
Term Term
t -> Term
t
Strings [String]
ss -> String -> Term
string2term (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
ss
Exprs [Expr]
es -> String -> Term
string2term (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([CId] -> Expr -> String
H.showExpr []) [Expr]
es
mkEx :: String -> (String, String)
mkEx String
s = let ([String]
command,[String]
expl) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"--") (String -> [String]
words String
s) in ([String] -> String
unwords [String]
command, [String] -> String
unwords (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
expl))