mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
removed src for 2.9
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user