diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 1d9da6558..79e28865f 100644 --- a/src/GF/Command/Commands.hs +++ b/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 diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs index fb2158d1d..fce0014db 100644 --- a/src/GF/Command/Interpreter.hs +++ b/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)] ++ diff --git a/src/GF/Devel/Shell.hs b/src/GF/Devel/Shell.hs index 9e6536087..1d88a24a0 100644 --- a/src/GF/Devel/Shell.hs +++ b/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)