made command table independent of options

src/GF/Command/Commands.hs

@@ -5,6 +5,7 @@ module GF.Command.Commands (
   isOpt,
   options,
   flags,
+  CommandInfo,
   CommandOutput
   ) where
 
@@ -22,7 +23,7 @@ import qualified Data.Map as Map
 type CommandOutput = ([Tree],String) ---- errors, etc
 
 data CommandInfo = CommandInfo {
-  exec     :: [Tree] -> IO CommandOutput,
+  exec     :: [Option] -> [Tree] -> IO CommandOutput,
   synopsis :: String,
   explanation :: String,
   longname :: String,
@@ -32,7 +33,7 @@ data CommandInfo = CommandInfo {
 
 emptyCommandInfo :: CommandInfo
 emptyCommandInfo = CommandInfo {
-  exec = \ts -> return (ts,[]), ----
+  exec = \_ ts -> return (ts,[]), ----
   synopsis = "synopsis",
   explanation = "explanation",
   longname = "longname",
@@ -46,7 +47,7 @@ lookCommand = Map.lookup
 commandHelpAll :: MultiGrammar -> [Option] -> String
 commandHelpAll mgr opts = unlines
   [commandHelp (isOpt "full" opts) (co,info)
-    | (co,info) <- Map.assocs (allCommands mgr opts)]
+    | (co,info) <- Map.assocs (allCommands mgr)]
 
 commandHelp :: Bool -> (String,CommandInfo) -> String
 commandHelp full (co,info) = unlines $ [
@@ -78,45 +79,45 @@ isOpt :: String -> [Option] -> Bool
 isOpt o opts = elem o [x | OOpt (Ident x) <- opts]
 
 
-allCommands :: MultiGrammar -> [Option] -> Map.Map String CommandInfo
-allCommands mgr opts = Map.fromAscList [
+allCommands :: MultiGrammar -> Map.Map String CommandInfo
+allCommands mgr = 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
+     flags = ["cat","number"],
+     exec = \opts _ -> do
+       ts <- generateRandom mgr (optCat opts)
+       return $ fromTrees $ take (optNum opts) 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
+     exec = \opts ts -> return ([], case ts of
        [t] -> let co = (showTree t) in 
-              case lookCommand co (allCommands mgr opts) of
+              case lookCommand co (allCommands mgr) of   ---- new map ??!!
                 Just info -> commandHelp True (co,info)
                 _ -> "command not found"
        _ -> commandHelpAll mgr opts)
      }),
   ("l", emptyCommandInfo {
-     exec = return . fromStrings . map lin,
+     exec = \opts -> return . fromStrings . map (lin opts),
      flags = ["lang"]
      }),
   ("p", emptyCommandInfo {
-     exec = return . fromTrees . concatMap par . toStrings,
+     exec = \opts -> return . fromTrees . concatMap (par opts). toStrings,
      flags = ["cat","lang"]
      })
   ]
  where
-   lin t = unlines [linearize mgr lang t    | lang <- optLangs]
-   par s = concat  [parse mgr lang optCat s | lang <- optLangs]
+   lin opts t = unlines [linearize mgr lang t    | lang <- optLangs opts]
+   par opts s = concat  [parse mgr lang (optCat opts) s | lang <- optLangs opts]
  
-   optLangs = case valIdOpts "lang" "" opts of
+   optLangs opts = case valIdOpts "lang" "" opts of
      "" -> languages mgr
      lang -> [lang] 
-   optCat   = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts
-   optNum   = valIntOpts "number" 1 opts
+   optCat opts = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts
+   optNum opts = valIntOpts "number" 1 opts
 
    gr       = gfcc mgr
 

src/GF/Command/Interpreter.hs

@@ -1,4 +1,5 @@
 module GF.Command.Interpreter (
+  CommandEnv (..),
   interpretCommandLine
   ) where
 
@@ -14,8 +15,13 @@ import GF.Command.ErrM ----
 
 import qualified Data.Map as Map
 
-interpretCommandLine :: MultiGrammar -> String -> IO ()
-interpretCommandLine gr line = case (pCommandLine (myLexer line)) of
+data CommandEnv = CommandEnv {
+  multigrammar :: MultiGrammar,
+  commands     :: Map.Map String CommandInfo
+  }
+
+interpretCommandLine :: CommandEnv -> String -> IO ()
+interpretCommandLine env line = case (pCommandLine (myLexer line)) of
   Ok CEmpty -> return ()
   Ok (CLine pipes) -> mapM_ interPipe pipes
   _ -> putStrLn "command not parsed"
@@ -27,14 +33,14 @@ interpretCommandLine gr line = case (pCommandLine (myLexer line)) of
    intercs (trees,_) (c:cs) = do
      treess2 <- interc trees c
      intercs treess2 cs
-   interc = interpret gr
+   interc = interpret env
 
 -- return the trees to be sent in pipe, and the output possibly printed
-interpret :: MultiGrammar -> [Tree] -> Command -> IO CommandOutput
-interpret mgr trees0 comm = case lookCommand co commands of
+interpret :: CommandEnv -> [Tree] -> Command -> IO CommandOutput
+interpret env trees0 comm = case lookCommand co comms of
   Just info -> do
     checkOpts info
-    tss@(_,s) <- exec info trees
+    tss@(_,s) <- exec info opts trees
     optTrace s
     return tss
   _ -> do
@@ -43,7 +49,7 @@ interpret mgr trees0 comm = case lookCommand co commands of
  where
    optTrace = if isOpt "tr" opts then putStrLn else const (return ()) 
    (co,opts,trees) = getCommand comm trees0
-   commands = allCommands mgr opts
+   comms = commands env
    checkOpts info = 
      case
        [o | OOpt  (Ident o)   <- opts, notElem o (options info)] ++

src/GF/Devel/Shell.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import GF.Command.Interpreter
+import GF.Command.Commands
 import GF.GFCC.API
 import System (getArgs)
 import Data.Char (isDigit)
@@ -11,15 +12,16 @@ main :: IO ()
 main = do
   file:_  <- getArgs
   grammar <- file2grammar file
+  let env = CommandEnv grammar (allCommands grammar)
   printHelp grammar
-  loop grammar
+  loop env
 
-loop :: MultiGrammar -> IO ()
-loop grammar = do
+loop :: CommandEnv -> IO ()
+loop env = do
   s <- getLine
   if s == "q" then return () else do
-    interpretCommandLine grammar s
-    loop grammar
+    interpretCommandLine env s
+    loop env
 
 printHelp grammar = do
   putStrLn $ "languages:  " ++ unwords (languages grammar)