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:
@@ -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",
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user