1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
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
|
