command database in gfcc

src/GF/Command/Interpreter.hs

@@ -1,4 +1,6 @@
-module GF.Command.Interpreter where
+module GF.Command.Interpreter (
+  interpretCommandLine
+  ) where
 
 import GF.Command.AbsGFShell hiding (Tree)
 import GF.Command.PPrTree
@@ -9,6 +11,8 @@ import GF.GFCC.AbsGFCC ----
 
 import GF.Command.ErrM ----
 
+import qualified Data.Map as Map
+
 interpretCommandLine :: MultiGrammar -> String -> IO ()
 interpretCommandLine gr line = case (pCommandLine (myLexer line)) of
   Ok CEmpty -> return ()
@@ -25,22 +29,98 @@ interpretCommandLine gr line = case (pCommandLine (myLexer line)) of
    interc = interpret gr
 
 -- return the trees to be sent in pipe, and the output possibly printed
-interpret :: MultiGrammar -> [Tree] -> Command -> IO ([Tree],String)
-interpret mgr trees0 comm = do
-  tss@(_,s) <- exec co
-  optTrace s
-  return tss
+interpret :: MultiGrammar -> [Tree] -> Command -> IO CommandOutput
+interpret mgr trees0 comm = case lookCommand co commands of
+  Just info -> do
+    checkOpts info
+    tss@(_,s) <- exec info trees
+    optTrace s
+    return tss
+  _ -> do
+    putStrLn $ "command " ++ co ++ " not interpreted"
+    return ([],[])
  where
-   exec co = case co of
-     "l"  -> return $ fromStrings $ map lin $ trees
-     "p"  -> return $ fromTrees   $ concatMap par $ toStrings $ trees
-     "gr" -> do
-       ts <- generateRandom mgr optCat
-       return $ fromTrees $ take optNum ts 
-     _ -> return (trees,"command not interpreted")
-
+   optTrace = if isOpt "tr" opts then putStrLn else const (return ()) 
    (co,opts,trees) = getCommand comm trees0
+   commands = allCommands mgr opts
+   checkOpts info = 
+     case
+       [o | OOpt  (Ident o)   <- opts, notElem o (options info)] ++
+       [o | OFlag (Ident o) _ <- opts, notElem o (flags info)]
+      of
+        []  -> return () 
+        [o] -> putStrLn $ "option not interpreted: " ++ o
+        os  -> putStrLn $ "options not interpreted: " ++ unwords os
 
+type CommandOutput = ([Tree],String) ---- errors, etc
+
+data CommandInfo = CommandInfo {
+  exec     :: [Tree] -> IO CommandOutput,
+  synopsis :: String,
+  explanation :: String,
+  longname :: String,
+  options  :: [String],
+  flags    :: [String]
+  }
+
+emptyCommandInfo :: CommandInfo
+emptyCommandInfo = CommandInfo {
+  exec = \ts -> return (ts,[]), ----
+  synopsis = "synopsis",
+  explanation = "explanation",
+  longname = "longname",
+  options = [],
+  flags = []
+  }
+
+lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
+lookCommand = Map.lookup
+
+commandHelpAll :: MultiGrammar -> [Option] -> String
+commandHelpAll mgr opts = unlines
+  [commandHelp (isOpt "full" opts) (co,info)
+    | (co,info) <- Map.assocs (allCommands mgr opts)]
+
+commandHelp :: Bool -> (String,CommandInfo) -> String
+commandHelp full (co,info) = unlines $ [
+  co ++ ", " ++ longname info,
+  synopsis info] ++ if full then [
+  explanation info,
+  "options: " ++ unwords (options info),
+  "flags: " ++ unwords (flags info)
+  ] else []
+
+allCommands :: MultiGrammar -> [Option] -> Map.Map String CommandInfo
+allCommands mgr opts = Map.fromAscList [
+  ("gr", emptyCommandInfo {
+     longname = "generate_random",
+     synopsis = "generates a list of random trees, by default one tree",
+     flags = ["number"],
+     exec = \_ -> do
+       ts <- generateRandom mgr optCat
+       return $ fromTrees $ take optNum ts
+     }),
+  ("h", emptyCommandInfo {
+     longname = "help",
+     synopsis = "get description of a command, or a the full list of commands",
+     options = ["full"],
+     exec = \ts -> return ([], case ts of
+       [t] -> let co = (showTree t) in 
+              case lookCommand co (allCommands mgr opts) of
+                Just info -> commandHelp True (co,info)
+                _ -> "command not found"
+       _ -> commandHelpAll mgr opts)
+     }),
+  ("l", emptyCommandInfo {
+     exec = return . fromStrings . map lin,
+     flags = ["lang"]
+     }),
+  ("p", emptyCommandInfo {
+     exec = return . fromTrees . concatMap par . toStrings,
+     flags = ["cat","lang"]
+     })
+  ]
+ where
    lin t = unlines [linearize mgr lang t    | lang <- optLangs]
    par s = concat  [parse mgr lang optCat s | lang <- optLangs]
  
@@ -49,7 +129,7 @@ interpret mgr trees0 comm = do
      lang -> [lang] 
    optCat   = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts
    optNum   = valIntOpts "number" 1 opts
-   optTrace = if isOpt "tr" opts then putStrLn else const (return ()) 
+
    gr       = gfcc mgr
 
    fromTrees ts = (ts,unlines (map showTree ts))