diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs index 51b434395..177bfb833 100644 --- a/src/GF/Command/Interpreter.hs +++ b/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))