factored out commands from interpreter in gfcc

2 files changed, 128 insertions, 105 deletions

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
new file mode 100644
index 000000000..1d9da6558
--- /dev/null
+++ b/src/GF/Command/Commands.hs
@@ -0,0 +1,127 @@
+module GF.Command.Commands (
+  allCommands,
+  lookCommand,
+  exec,
+  isOpt,
+  options,
+  flags,
+  CommandOutput
+  ) where
+
+import GF.Command.AbsGFShell hiding (Tree)
+import GF.Command.PPrTree
+import GF.Command.ParGFShell
+import GF.GFCC.API
+import GF.GFCC.Macros
+import GF.GFCC.AbsGFCC ----
+
+import GF.Command.ErrM ----
+
+import qualified Data.Map as Map
+
+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 []
+
+valIdOpts :: String -> String -> [Option] -> String
+valIdOpts flag def opts = case valOpts flag (VId (Ident def)) opts of
+  VId (Ident v) -> v
+  _ -> def
+
+valIntOpts :: String -> Integer -> [Option] -> Int
+valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
+  VInt v -> v
+  _ -> def
+
+valOpts :: String -> Value -> [Option] -> Value
+valOpts flag def opts = case lookup flag flags of
+  Just v -> v
+  _ -> def
+ where
+   flags = [(f,v) | OFlag (Ident f) v <- opts]
+
+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 [
+  ("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]
+ 
+   optLangs = case valIdOpts "lang" "" opts of
+     "" -> languages mgr
+     lang -> [lang] 
+   optCat   = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts
+   optNum   = valIntOpts "number" 1 opts
+
+   gr       = gfcc mgr
+
+   fromTrees ts = (ts,unlines (map showTree ts))
+   fromStrings ss = (map tStr ss, unlines ss)
+   toStrings ts = [s | DTr [] (AS s) [] <- ts] 
+   tStr s = DTr [] (AS s) []
+
diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs
index 177bfb833..fb2158d1d 100644
--- a/src/GF/Command/Interpreter.hs
+++ b/src/GF/Command/Interpreter.hs
@@ -2,6 +2,7 @@ module GF.Command.Interpreter (
   interpretCommandLine
   ) where
 
+import GF.Command.Commands
 import GF.Command.AbsGFShell hiding (Tree)
 import GF.Command.PPrTree
 import GF.Command.ParGFShell
@@ -52,111 +53,6 @@ interpret mgr trees0 comm = case lookCommand co commands of
         [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]
- 
-   optLangs = case valIdOpts "lang" "" opts of
-     "" -> languages mgr
-     lang -> [lang] 
-   optCat   = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts
-   optNum   = valIntOpts "number" 1 opts
-
-   gr       = gfcc mgr
-
-   fromTrees ts = (ts,unlines (map showTree ts))
-   fromStrings ss = (map tStr ss, unlines ss)
-   toStrings ts = [s | DTr [] (AS s) [] <- ts] 
-   tStr s = DTr [] (AS s) []
-
-valIdOpts :: String -> String -> [Option] -> String
-valIdOpts flag def opts = case valOpts flag (VId (Ident def)) opts of
-  VId (Ident v) -> v
-  _ -> def
-
-valIntOpts :: String -> Integer -> [Option] -> Int
-valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
-  VInt v -> v
-  _ -> def
-
-valOpts :: String -> Value -> [Option] -> Value
-valOpts flag def opts = case lookup flag flags of
-  Just v -> v
-  _ -> def
- where
-   flags = [(f,v) | OFlag (Ident f) v <- opts]
-
-isOpt :: String -> [Option] -> Bool
-isOpt o opts = elem o [x | OOpt (Ident x) <- opts]
-
 -- analyse command parse tree to a uniform datastructure, normalizing comm name
 getCommand :: Command -> [Tree] -> (String,[Option],[Tree])
 getCommand co ts = case co of