1
0
forked from GitHub/gf-core

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

View File

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