diff options
| author | aarne <aarne@cs.chalmers.se> | 2007-11-06 10:43:19 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2007-11-06 10:43:19 +0000 |
| commit | db399191d926209d36c8496ba65d53dcaeb7855b (patch) | |
| tree | 00eb094f1395ab5563ab7c47908df7591b0c95e2 /src/GF/Command/Interpreter.hs | |
| parent | 5e87b6ef983a11257eafec7fa1d8216bbe9a300e (diff) | |
factored out commands from interpreter in gfcc
Diffstat (limited to 'src/GF/Command/Interpreter.hs')
| -rw-r--r-- | src/GF/Command/Interpreter.hs | 106 |
1 files changed, 1 insertions, 105 deletions
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 |
