added needsTypeCheck parameter to CommandInfo. The argument to the command is typechecked only if needsTypeCheck=True

This commit is contained in:
krasimir
2009-09-13 15:39:11 +00:00
parent 352a640e64
commit d67f2ad970
2 changed files with 32 additions and 19 deletions

View File

@@ -5,6 +5,7 @@ module GF.Command.Commands (
isOpt,
options,
flags,
needsTypeCheck,
CommandInfo,
CommandOutput
) where
@@ -49,7 +50,8 @@ data CommandInfo = CommandInfo {
longname :: String,
options :: [(String,String)],
flags :: [(String,String)],
examples :: [String]
examples :: [String],
needsTypeCheck :: Bool
}
emptyCommandInfo :: CommandInfo
@@ -61,7 +63,8 @@ emptyCommandInfo = CommandInfo {
longname = "",
options = [],
flags = [],
examples = []
examples = [],
needsTypeCheck = True
}
lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
@@ -117,14 +120,16 @@ allCommands cod env@(pgf, mos) = Map.fromList [
syntax = "! SYSTEMCOMMAND",
examples = [
"! ls *.gf -- list all GF files in the working directory"
]
],
needsTypeCheck = False
}),
("?", emptyCommandInfo {
synopsis = "system pipe: send value from previous command to a system command",
syntax = "? SYSTEMCOMMAND",
examples = [
"gt | l | ? wc -- generate, linearize, word-count"
]
],
needsTypeCheck = False
}),
("aw", emptyCommandInfo {
@@ -179,7 +184,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
("all","pick all strings (forms and variants) from records and tables"),
("table","show all strings labelled by parameters"),
("unqual","hide qualifying module names")
]
],
needsTypeCheck = False
}),
("dc", emptyCommandInfo {
longname = "define_command",
@@ -192,7 +198,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
"trees can be arguments. Currently at most one argument is possible.",
"This command must be a line of its own, and thus cannot be a part",
"of a pipe."
]
],
needsTypeCheck = False
}),
("dt", emptyCommandInfo {
longname = "define_tree",
@@ -211,7 +218,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
("dt ex UseN man_N -- define ex as string"),
("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"),
("l -lang=LangSwe %ex | ps -to_utf8 -- linearize the tree ex")
]
],
needsTypeCheck = False
}),
("e", emptyCommandInfo {
longname = "empty",
@@ -287,7 +295,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
Just info -> commandHelp True (co,info)
_ -> "command not found"
_ -> commandHelpAll cod env opts
in return (fromString msg)
in return (fromString msg),
needsTypeCheck = False
}),
("i", emptyCommandInfo {
longname = "import",
@@ -306,7 +315,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
("retain","retain operations (used for cc command)"),
("src", "force compilation from source"),
("v", "be verbose - show intermediate status information")
]
],
needsTypeCheck = False
}),
("l", emptyCommandInfo {
longname = "linearize",
@@ -367,7 +377,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [
("lang","language of the quiz"),
("cat","category of the quiz"),
("number","maximum number of questions")
]
]
}),
("p", emptyCommandInfo {
@@ -520,7 +530,8 @@ allCommands cod env@(pgf, mos) = Map.fromList [
examples = [
"se cp1251 -- set encoding to cp1521",
"se utf8 -- set encoding to utf8 (default)"
]
],
needsTypeCheck = False
}),
("sp", emptyCommandInfo {
longname = "system_pipe",

View File

@@ -56,7 +56,7 @@ interpretPipe enc env cs = do
interc es comm@(Command co opts arg) = case co of
'%':f -> case Map.lookup f (commandmacros env) of
Just css ->
case getCommandTrees env arg es of
case getCommandTrees env False arg es of
Right es -> do mapM_ (interpretPipe enc env) (appLine es css)
return ([],[])
Left msg -> do putStrLn ('\n':msg)
@@ -98,7 +98,7 @@ getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo,[Opt
getCommand env es co@(Command c opts arg) = do
info <- getCommandInfo env c
checkOpts info opts
es <- getCommandTrees env arg es
es <- getCommandTrees env (needsTypeCheck info) arg es
return (info,opts,es)
getCommandInfo :: CommandEnv -> String -> Either String CommandInfo
@@ -117,14 +117,16 @@ checkOpts info opts =
[o] -> fail $ "option not interpreted: " ++ o
os -> fail $ "options not interpreted: " ++ unwords os
getCommandTrees :: CommandEnv -> Argument -> [Expr] -> Either String [Expr]
getCommandTrees env a es =
getCommandTrees :: CommandEnv -> Bool -> Argument -> [Expr] -> Either String [Expr]
getCommandTrees env needsTypeCheck a es =
case a of
AMacro m -> case Map.lookup m (expmacros env) of
Just e -> return [e]
_ -> return []
AExpr e -> case inferExpr (multigrammar env) e of
Left tcErr -> fail $ render (ppTcError tcErr)
Right (e,ty) -> return [e] -- ignore piped
AExpr e -> if needsTypeCheck
then case inferExpr (multigrammar env) e of
Left tcErr -> fail $ render (ppTcError tcErr)
Right (e,ty) -> return [e] -- ignore piped
else return [e]
ANoArg -> return es -- use piped