forked from GitHub/gf-core
82 lines
2.5 KiB
Haskell
82 lines
2.5 KiB
Haskell
module GF.Command.CommandInfo where
|
|
import GF.Command.Abstract(Option,Expr,Term)
|
|
import GF.Text.Pretty(render)
|
|
import GF.Grammar.Grammar(Term(K))
|
|
import GF.Grammar.Printer() -- instance Pretty Term
|
|
import PGF2(mkStr,unStr,showExpr)
|
|
|
|
data CommandInfo m = CommandInfo {
|
|
exec :: [Option] -> CommandArguments -> m CommandOutput,
|
|
synopsis :: String,
|
|
syntax :: String,
|
|
explanation :: String,
|
|
longname :: String,
|
|
options :: [(String,String)],
|
|
flags :: [(String,String)],
|
|
examples :: [(String,String)],
|
|
needsTypeCheck :: Bool
|
|
}
|
|
|
|
mapCommandExec f c = c { exec = \ opts ts -> f (exec c opts ts) }
|
|
|
|
--emptyCommandInfo :: CommandInfo env
|
|
emptyCommandInfo = CommandInfo {
|
|
exec = error "command not implemented",
|
|
synopsis = "",
|
|
syntax = "",
|
|
explanation = "",
|
|
longname = "",
|
|
options = [],
|
|
flags = [],
|
|
examples = [],
|
|
needsTypeCheck = True
|
|
}
|
|
--------------------------------------------------------------------------------
|
|
|
|
class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data CommandArguments = Exprs [(Expr,Float)] | Strings [String] | Term Term
|
|
|
|
newtype CommandOutput = Piped (CommandArguments,String) ---- errors, etc
|
|
|
|
-- ** Converting command output
|
|
fromStrings ss = Piped (Strings ss, unlines ss)
|
|
fromExprs show_p es = Piped (Exprs es,unlines (map (\(e,p) -> (if show_p then (++) ("["++show p++"] ") else id) (showExpr [] e)) es))
|
|
fromString s = Piped (Strings [s], s)
|
|
pipeWithMessage es msg = Piped (Exprs es,msg)
|
|
pipeMessage msg = Piped (Exprs [],msg)
|
|
pipeExprs es = Piped (Exprs es,[]) -- only used in emptyCommandInfo
|
|
void = Piped (Exprs [],"")
|
|
|
|
-- ** Converting command input
|
|
|
|
toStrings args =
|
|
case args of
|
|
Strings ss -> ss
|
|
Exprs es -> zipWith showAsString (True:repeat False) es
|
|
Term t -> [render t]
|
|
where
|
|
showAsString first (e,p) =
|
|
case unStr e of
|
|
Just s -> s
|
|
Nothing -> ['\n'|not first] ++
|
|
showExpr [] e ---newline needed in other cases than the first
|
|
|
|
toExprs args =
|
|
case args of
|
|
Exprs es -> map fst es
|
|
Strings ss -> map mkStr ss
|
|
Term t -> [mkStr (render t)]
|
|
|
|
toTerm args =
|
|
case args of
|
|
Term t -> t
|
|
Strings ss -> K $ unwords ss -- hmm
|
|
Exprs es -> K $ unwords $ map (showExpr [] . fst) es -- hmm
|
|
|
|
-- ** Creating documentation
|
|
|
|
mkEx s = let (command,expl) = break (=="--") (words s) in (unwords command, unwords (drop 1 expl))
|