diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
| commit | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch) | |
| tree | 0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Command/Commands.hs | |
| parent | fe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff) | |
removed src for 2.9
Diffstat (limited to 'src/GF/Command/Commands.hs')
| -rw-r--r-- | src/GF/Command/Commands.hs | 159 |
1 files changed, 0 insertions, 159 deletions
diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs deleted file mode 100644 index d5b5a8768..000000000 --- a/src/GF/Command/Commands.hs +++ /dev/null @@ -1,159 +0,0 @@ -module GF.Command.Commands ( - allCommands, - lookCommand, - exec, - isOpt, - options, - flags, - CommandInfo, - CommandOutput - ) where - -import GF.Command.AbsGFShell hiding (Tree) -import GF.Command.PPrTree -import GF.Command.ParGFShell -import GF.GFCC.ShowLinearize -import GF.GFCC.API -import GF.GFCC.Macros -import GF.Devel.PrintGFCC -import GF.GFCC.DataGFCC ---- - -import GF.Data.ErrM ---- - -import qualified Data.Map as Map - -type CommandOutput = ([Tree],String) ---- errors, etc - -data CommandInfo = CommandInfo { - exec :: [Option] -> [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)] - -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] - --- this list must be kept sorted by the command name! -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 = ["cat","number"], - exec = \opts _ -> do - ts <- generateRandom mgr (optCat opts) - return $ fromTrees $ take (optNum opts) ts - }), - ("gt", emptyCommandInfo { - longname = "generate_trees", - synopsis = "generates a list of trees, by default exhaustive", - flags = ["cat","depth","number"], - exec = \opts _ -> do - let dp = return $ valIntOpts "depth" 4 opts - let ts = generateAllDepth mgr (optCat opts) dp - return $ fromTrees $ take (optNumInf opts) ts - }), - ("h", emptyCommandInfo { - longname = "help", - synopsis = "get description of a command, or a the full list of commands", - options = ["full"], - exec = \opts ts -> return ([], case ts of - [t] -> let co = (showTree t) in - case lookCommand co (allCommands mgr) of ---- new map ??!! - Just info -> commandHelp True (co,info) - _ -> "command not found" - _ -> commandHelpAll mgr opts) - }), - ("l", emptyCommandInfo { - exec = \opts -> return . fromStrings . map (optLin opts), - options = ["all","record","table","term"], - flags = ["lang"] - }), - ("p", emptyCommandInfo { - exec = \opts -> return . fromTrees . concatMap (par opts). toStrings, - flags = ["cat","lang"] - }), - ("pg", emptyCommandInfo { - exec = \opts _ -> return $ fromString $ prGrammar opts, - flags = ["cat","lang","printer"] - }) - ] - where - lin opts t = unlines [linearize mgr lang t | lang <- optLangs opts] - par opts s = concat [parse mgr lang (optCat opts) s | lang <- optLangs opts] - - optLin opts t = unlines [linea lang t | lang <- optLangs opts] where - linea lang = case opts of - _ | isOpt "all" opts -> allLinearize gr (cid lang) - _ | isOpt "table" opts -> tableLinearize gr (cid lang) - _ | isOpt "term" opts -> termLinearize gr (cid lang) - _ | isOpt "record" opts -> recordLinearize gr (cid lang) - _ -> linearize mgr lang - - - optLangs opts = case valIdOpts "lang" "" opts of - "" -> languages mgr - lang -> [lang] - optCat opts = valIdOpts "cat" (lookStartCat gr) opts - optNum opts = valIntOpts "number" 1 opts - optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9 - - gr = gfcc mgr - - fromTrees ts = (ts,unlines (map showTree ts)) - fromStrings ss = (map tStr ss, unlines ss) - fromString s = ([tStr s], s) - toStrings ts = [s | DTr [] (AS s) [] <- ts] - tStr s = DTr [] (AS s) [] - - prGrammar opts = case valIdOpts "printer" "" opts of - "cats" -> unwords $ categories mgr - v -> prGFCC v gr - |
