command option check

src/GF.hs

@@ -7,6 +7,7 @@ import IOGrammar
 import ShellState
 import Shell
 import SubShell
+import ShellCommands
 import PShell
 import JGF
 import UTF8

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

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
 

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"

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 moved to ShellCommands. AR 27/5/2004
-
-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
 
 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

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)

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 = ([],[])

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:
+  options:
-      -nometas don't return trees that include metavariables
+      -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)

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  options:" ++
-  "\n      -nometas don't return trees that include metavariables" ++
+  "\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)" ++

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"