diff --git a/src/GF.hs b/src/GF.hs index c1fb35fa8..b29a3c797 100644 --- a/src/GF.hs +++ b/src/GF.hs @@ -7,6 +7,7 @@ import IOGrammar import ShellState import Shell import SubShell +import ShellCommands import PShell import JGF import UTF8 diff --git a/src/GF/API.hs b/src/GF/API.hs index 42101706d..d92f85e26 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -167,7 +167,7 @@ generateTrees opts gr mt = cat = firstAbsCat opts gr dpt = maybe 3 id $ getOptInt opts flagDepth mn = getOptInt opts flagAlts - ifm = not $ oElem noMetas opts + ifm = oElem withMetas opts speechGenerate :: Options -> String -> IO () speechGenerate opts str = do diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index a9cc3bf7a..3a7151ad8 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -287,6 +287,7 @@ stateAbstractGrammar st = StGr { -- analysing shell state into parts globalOptions = gloptions allLanguages = map (fst . fst) . concretes +allCategories = map fst . allCatsOf . canModules allStateGrammars = map snd . allStateGrammarsWithNames diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index b2a5902cc..c04d40244 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -25,6 +25,7 @@ eqOpt s (Opt (o, [])) = s == o eqOpt s _ = False type OptFun = String -> Option +type OptFunId = String getOptVal :: Options -> OptFun -> Maybe String getOptVal (Opts os) fopt = @@ -140,7 +141,7 @@ tableLin = iOpt "table" defaultLinOpts = [firstLin] useUTF8 = iOpt "utf8" showLang = iOpt "lang" -noMetas = iOpt "nometas" +withMetas = iOpt "metas" -- other beVerbose = iOpt "v" diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index f5692a398..ebfa332b0 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -9,6 +9,8 @@ import qualified GFC import Values import GetTree +import ShellCommands + import API import IOGrammar import Compile @@ -40,66 +42,11 @@ import UTF8 (encodeUTF8) -- AR 18/4/2000 - 7/11/2001 -type SrcTerm = G.Term -- term as returned by the command parser - -data Command = - CImport FilePath - | CRemoveLanguage Language - | CEmptyState - | CStripState - | CTransformGrammar FilePath - | CConvertLatex FilePath - - | CLinearize [()] ---- parameters - | CParse - | CTranslate Language Language - | CGenerateRandom - | CGenerateTrees - | CPutTerm - | CWrapTerm Ident - | CMorphoAnalyse - | CTestTokenizer - | CComputeConcrete String - - | CTranslationQuiz Language Language - | CTranslationList Language Language Int - | CMorphoQuiz - | CMorphoList Int - - | CReadFile FilePath - | CWriteFile FilePath - | CAppendFile FilePath - | CSpeakAloud - | CPutString - | CShowTerm - | CSystemCommand String - - | CSetFlag - | CSetLocalFlag Language - - | CPrintGrammar - | CPrintGlobalOptions - | CPrintLanguages - | CPrintInformation I.Ident - | CPrintMultiGrammar - | CPrintGramlet - | CPrintCanonXML - | CPrintCanonXMLStruct - | CPrintHistory - | CHelp (Maybe String) - - | CImpure ImpureCommand - - | CVoid - --- to isolate the commands that are executed on top level -data ImpureCommand = - ICQuit | ICExecuteHistory FilePath | ICEarlierCommand Int - | ICEditSession | ICTranslateSession +-- data Command moved to ShellCommands. AR 27/5/2004 type CommandLine = (CommandOpt, CommandArg, [CommandOpt]) -type CommandOpt = (Command, Options) +type SrcTerm = G.Term -- term as returned by the command parser type HState = (ShellState,([String],Integer)) -- history & CPU @@ -144,7 +91,7 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do -- individual commands possibly piped: value returned; this is not a state monad execC :: CommandOpt -> ShellIO -execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of +execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of CImport file -> useIOE sa $ do st1 <- shellStateFromFiles opts st file diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index 7a7f1e702..d58b18c16 100644 --- a/src/GF/Shell/PShell.hs +++ b/src/GF/Shell/PShell.hs @@ -3,6 +3,7 @@ module PShell where import Operations import UseIO import ShellState +import ShellCommands import Shell import Option import PGrammar (pzIdent, pTrm) --- (string2formsAndTerm) diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs new file mode 100644 index 000000000..a0c40f3a6 --- /dev/null +++ b/src/GF/Shell/ShellCommands.hs @@ -0,0 +1,186 @@ +module ShellCommands where + +import qualified Ident as I +import ShellState +import Custom +import PrGrammar + +import Option +import Operations + +import Char (isDigit) + +-- shell commands and their options +-- moved to separate module and added option check: AR 27/5/2004 +--- TODO: single source for +--- (1) command interpreter (2) option check (3) help file + +data Command = + CImport FilePath + | CRemoveLanguage Language + | CEmptyState + | CStripState + | CTransformGrammar FilePath + | CConvertLatex FilePath + + | CLinearize [()] ---- parameters + | CParse + | CTranslate Language Language + | CGenerateRandom + | CGenerateTrees + | CPutTerm + | CWrapTerm I.Ident + | CMorphoAnalyse + | CTestTokenizer + | CComputeConcrete String + + | CTranslationQuiz Language Language + | CTranslationList Language Language Int + | CMorphoQuiz + | CMorphoList Int + + | CReadFile FilePath + | CWriteFile FilePath + | CAppendFile FilePath + | CSpeakAloud + | CPutString + | CShowTerm + | CSystemCommand String + + | CSetFlag + | CSetLocalFlag Language + + | CPrintGrammar + | CPrintGlobalOptions + | CPrintLanguages + | CPrintInformation I.Ident + | CPrintMultiGrammar + | CPrintGramlet + | CPrintCanonXML + | CPrintCanonXMLStruct + | CPrintHistory + | CHelp (Maybe String) + + | CImpure ImpureCommand + + | CVoid + +-- to isolate the commands that are executed on top level +data ImpureCommand = + ICQuit | ICExecuteHistory FilePath | ICEarlierCommand Int + | ICEditSession | ICTranslateSession + +type CommandOpt = (Command, Options) + +-- the top-level option warning action + +checkOptions :: ShellState -> (Command,Options) -> IO () +checkOptions sh (co, Opts opts) = do + let (_,s) = errVal ([],"option check failed") $ mapErr check opts + if (null s) then return () + else putStr "WARNING: " >> putStrLn s + where + check = isValidOption sh co + +isValidOption :: ShellState -> Command -> Option -> Err () +isValidOption st co op = case op of + Opt (o,[]) -> + testErr (elem o $ optsOf co) ("invalid option:" +++ prOpt op) + Opt (o,[x]) -> do + testErr (elem o (flagsOf co)) ("invalid flag:" +++ o) + testValidFlag st o x + _ -> Bad $ "impossible option" +++ prOpt op + where + optsOf co = fst $ optionsOfCommand co + flagsOf co = snd $ optionsOfCommand co + +testValidFlag :: ShellState -> OptFunId -> String -> Err () +testValidFlag st f x = case f of + "cat" -> testIn (map prQIdent_ (allCategories st)) + "lang" -> testIn (map prt (allLanguages st)) + "number" -> testN + "printer" -> testInc customGrammarPrinter + "lexer" -> testInc customTokenizer + "unlexer" -> testInc customUntokenizer + "depth" -> testN + "parser" -> testInc customParser + "alts" -> testN + "transform" -> testInc customTermCommand + "filter" -> testInc customStringCommand + "length" -> testN + _ -> return () + where + testInc ci = + let vs = snd (customInfo ci) in testIn vs + testIn vs = + if elem x vs + then return () + else Bad ("flag:" +++ f +++ "invalid value:" +++ x ++++ + "possible values:" +++ unwords vs) + testN = + if all isDigit x + then return () + else Bad ("flag:" +++ f +++ "invalid value:" +++ x ++++ + "expected integer") + + +optionsOfCommand :: Command -> ([String],[String]) +optionsOfCommand co = case co of + CImport _ -> both "old v s opt src retain nocf nocheckcirc cflexer" + "abs cnc res" + CRemoveLanguage _ -> none + CEmptyState -> none + CStripState -> none + CTransformGrammar _ -> flags "printer" + CConvertLatex _ -> none + CLinearize _ -> both "table struct record" "lang number unlexer" + CParse -> both "n ign raw v" "cat lang lexer parser number" + CTranslate _ _ -> opts "cat lexer parser" + CGenerateRandom -> flags "cat lang number depth" + CGenerateTrees -> both "metas" "depth alts cat lang number" + CPutTerm -> flags "transform number" + CWrapTerm _ -> none + CMorphoAnalyse -> both "short" "lang" + CTestTokenizer -> flags "lexer" + CComputeConcrete _ -> flags "res" + + CTranslationQuiz _ _ -> flags "cat" + CTranslationList _ _ _ -> flags "cat" + CMorphoQuiz -> flags "cat lang" + CMorphoList _ -> flags "cat lang" + + CReadFile _ -> none + CWriteFile _ -> none + CAppendFile _ -> none + CSpeakAloud -> flags "language" + CPutString -> flags "filter length" + CShowTerm -> flags "printer" + CSystemCommand _ -> none + + CPrintGrammar -> flags "printer" + + CHelp _ -> opts "all" + + CImpure ICEditSession -> opts "f" + CImpure ICTranslateSession -> both "f" "cat" + + _ -> none + +{- + CSetFlag + CSetLocalFlag Language + CPrintGlobalOptions + CPrintLanguages + CPrintInformation I.Ident + CPrintMultiGrammar + CPrintGramlet + CPrintCanonXML + CPrintCanonXMLStruct + CPrintHistory + CVoid +-} + where + flags fs = ([],words fs) + opts fs = (words fs,[]) + both os fs = (words os,words fs) + none = ([],[]) diff --git a/src/HelpFile b/src/HelpFile index 8184b4603..833d0c1f4 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -167,8 +167,8 @@ gt, generate_trees: gt Tree? a small -alts is recommended. If a Tree argument is given, the command completes the Tree with values to the metavariables in the tree. - flags: - -nometas don't return trees that include metavariables + options: + -metas also return trees that include metavariables flags: -depth generate to this depth (default 3) -alts take this number of alternatives at each branch (default unlimited) diff --git a/src/HelpFile.hs b/src/HelpFile.hs index 1dda915d7..59f2702b9 100644 --- a/src/HelpFile.hs +++ b/src/HelpFile.hs @@ -180,8 +180,8 @@ txtHelpFile = "\n a small -alts is recommended. If a Tree argument is given, the" ++ "\n command completes the Tree with values to the metavariables in" ++ "\n the tree." ++ - "\n flags:" ++ - "\n -nometas don't return trees that include metavariables" ++ + "\n options:" ++ + "\n -metas also return trees that include metavariables" ++ "\n flags:" ++ "\n -depth generate to this depth (default 3)" ++ "\n -alts take this number of alternatives at each branch (default unlimited)" ++ diff --git a/src/Today.hs b/src/Today.hs index f3613eba0..01505fac0 100644 --- a/src/Today.hs +++ b/src/Today.hs @@ -1 +1 @@ -module Today where today = "Thu May 27 11:01:26 CEST 2004" +module Today where today = "Thu May 27 17:23:01 CEST 2004"