module GF.Command.CommandInfo where
import GF.Command.Abstract(Option,Expr,Term)
import GF.Text.Pretty(render)
import GF.Grammar.Printer() -- instance Pretty Term
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 env
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) ---- errors, etc

-- ** Converting command output
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,[]) -- only used in emptyCommandInfo
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 -- should be a pattern macro

-- ** Converting command input

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 ---newline needed in other cases than the first

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 -- hmm
    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 -- hmm

-- ** Creating documentation

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))