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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
|
import System
import Char
import List
type Cats = [(String,String,String)]
type Rules = [(String,String,String)]
main = do
xx <- getArgs
let isLatex = case xx of
"-tex":_ -> True
_ -> False
cs1 <- getCats commonAPI
cs2 <- getCats catAPI
let cs = sortCats (cs1 ++ cs2)
writeFile synopsis "GF Resource Grammar Library: Synopsis"
append "B. Bringert and A. Ranta"
space
append "%!postproc(html): '(SRC=\"categories.png\")' '\\1 USEMAP=\"#categories\"'"
append "%!postproc(html): '#LParadigms' '<a name=\"RParadigms\"></a>'"
append "%!postproc(tex): '#LParadigms' ''"
delimit $ addToolTips cs
include "synopsis-intro.txt"
title "Categories"
space
link "Source 1:" commonAPI
space
link "Source 2:" catAPI
space
append "==A hierarchic view==\n"
include "categories-intro.txt"
append "==Explanations==\n"
delimit $ mkCatTable isLatex cs
space
title "Syntax Rules and Structural Words"
space
link "Source 1:" syntaxAPI
space
link "Source 2:" structuralAPI
space
rs <- getRules syntaxAPI
rs2 <- getRules structuralAPI
delimit $ mkSplitTables True isLatex cs $ rs ++ rs2
space
-- title "Structural Words"
-- space
-- link "Source:" structuralAPI
-- space
-- rs <- rulesTable False isLatex cs structuralAPI
-- delimit rs
space
title "Lexical Paradigms"
mapM_ (putParadigms isLatex cs) paradigmFiles
space
include "synopsis-browse.txt"
space
title "An Example of Usage"
space
include "synopsis-example.txt"
space
let format = if isLatex then "tex" else "html"
system $ "txt2tags -t" ++ format ++ " --toc " ++ synopsis
if isLatex then (system $ "pdflatex synopsis.tex") >> return () else return ()
addToolTips :: Cats -> [String]
addToolTips = map f
where f (n,e,_) = "%!postproc(html): '(?i)(HREF=\"#" ++ n ++ "\")( TITLE=\"[^\"]*\")?' '\\1 TITLE=\"" ++ e' ++ "\"'"
where e' = n ++ if null e then "" else " - " ++ e
getCats :: FilePath -> IO Cats
getCats file = do
ss <- readFile file >>= return . lines
return $ getrs [] ss
where
getrs rs ss = case ss of
('-':'-':'.':_):_ -> reverse rs
[] -> reverse rs
('-':'-':_):ss2 -> getrs rs ss2
s:ss2 -> case words s of
cat:";":"--":exp -> getrs ((cat,unwords expl, unwords (tail ex)):rs) ss2 where
(expl,ex) = span (/="e.g.") exp
_ -> getrs rs ss2
rulesTable :: Bool -> Bool -> Cats -> FilePath -> IO [String]
rulesTable hasEx isLatex cs file = do
rs <- getRules file
return $ mkTable hasEx isLatex cs rs
getRules :: FilePath -> IO Rules
getRules file = do
ss <- readFile file >>= return . lines
return $ getrs [] ss
where
getrs rs ss = case ss of
('-':'-':'.':_):_ -> reverse rs
[] -> reverse rs
('-':'-':_):ss2 -> getrs rs ss2
s:ss2 -> case words s of
_:_:"overload":_ -> getrs rs ss2
_:":":_ -> getrs (rule s:rs) ss2
_ -> getrs rs ss2
rule s = (name, typ, ex)
where
ws = words s
name = head ws
(t,e) = span (/="--") (tail ws)
typ = unwords $ filtype (drop 1 t)
filtype = filter (/=";")
ex = if null e then "" else unwords $ unnumber $ drop 1 e
unnumber e = case e of
n:ws | last n == '.' && not (null (init n)) && all isDigit (init n) -> ws
_ -> e
putParadigms :: Bool -> Cats -> (String, FilePath) -> IO ()
putParadigms isLatex cs (lang,file) = do
stitle ("Paradigms for " ++ lang)
append "#LParadigms"
space
link "source" file
space
rs <- rulesTable False isLatex cs file
space
delimit rs
space
inChunks :: Int -> ([a] -> [String]) -> [a] -> [String]
inChunks i f = concat . intersperse ["\n\n"] . map f . chunks i where
chunks _ [] = []
chunks i xs = x : chunks i y where (x,y) = splitAt i xs
-- Makes one table per result category.
-- Adds a subsection header for each table.
mkSplitTables :: Bool -> Bool -> Cats -> Rules -> [String]
mkSplitTables hasEx isLatex cs = concatMap t . addLexicalCats cs . sortRules
where t (c, xs) = [subtitle c expl] ++ tableOrLink
where
expl = case [e | (n,e,_) <- cs, n == c] of
[] -> ""
e:_ -> e
tableOrLink = if null xs then parad else mkTable hasEx isLatex cs xs
parad = [
"Lexical category, constructors given in",
"[lexical paradigms #RParadigms]."
]
mkTable :: Bool -> Bool -> Cats -> Rules -> [String]
mkTable hasEx isLatex cs = inChunks chsize (\rs -> header : map (unwords . row) rs)
where
chsize = if isLatex then 40 else 1000
header = if hasEx then "|| Function | Type | Example ||"
else "|| Function | Type ||"
row (name,typ,ex)
= if hasEx then ["|", name', "|", typ', "|", ex', "|"]
else ["|", name', "|", typ', "|"]
where
name' = ttf name
typ' = showTyp cs typ
ex' = if null ex then itf (takeWhile (/='_') name) else itf ex
mkCatTable :: Bool -> Cats -> [String]
mkCatTable isLatex cs = inChunks chsize (\rs -> header ++ map mk1 rs) cs
where
header = ["|| Category | Explanation | Example ||"]
chsize = if isLatex then 40 else 1000
mk1 (name,expl,ex) = unwords ["|", showCat cs name, "|", expl, "|", typo ex, "|"]
typo ex = if take 1 ex == "\"" then itf (init (tail ex)) else ex
synopsis = "synopsis.txt"
commonAPI = "../abstract/Common.gf"
catAPI = "../abstract/Cat.gf"
syntaxAPI = "../api/Constructors.gf"
structuralAPI = "../abstract/Structural.gf"
paradigmFiles = [
("Bulgarian", "../bulgarian/ParadigmsBul.gf"),
("Danish", "../danish/ParadigmsDan.gf"),
("English", "../english/ParadigmsEng.gf"),
("Finnish", "../finnish/ParadigmsFin.gf"),
("French", "../french/ParadigmsFre.gf"),
("German", "../german/ParadigmsGer.gf"),
-- ("Interlingua", "../interlingua/ParadigmsIna.gf"),
("Italian", "../italian/ParadigmsIta.gf"),
("Norwegian", "../norwegian/ParadigmsNor.gf"),
("Russian", "../russian/ParadigmsRus.gf"),
("Spanish", "../spanish/ParadigmsSpa.gf"),
("Swedish", "../swedish/ParadigmsSwe.gf")
]
append s = appendFile synopsis ('\n':s)
title s = append $ "=" ++ s ++ "="
stitle s = append $ "==" ++ s ++ "=="
include s = append $ "%!include: " ++ s
space = append "\n"
delimit ss = mapM_ append ss
link s f = append $ s ++ " [``" ++ fa ++ "`` " ++ f ++ "]" where
fa = "http://www.cs.chalmers.se/~aarne/GF/lib/resource" ++ dropWhile (=='.') f
ttf s = "``" ++ s ++ "``"
itf s = "//" ++ s ++ "//"
-----------------
-- sort category synopsis by category, retain one table
sortCats :: Cats -> Cats
sortCats = sortBy compareCat
where compareCat (n1,_,_) (n2,_,_) = compare n1 n2
-- sort function synopsis by category, into separate tables
sortRules :: Rules -> [Rules]
sortRules = groupBy sameCat . sortBy compareRules
where sameCat r1 r2 = resultCat r1 == resultCat r2
compareRules r1@(n1,_,_) r2@(n2,_,_)
= compare (resultCat r1,n1) (resultCat r2,n2)
addLexicalCats :: Cats -> [Rules] -> [(String,Rules)]
addLexicalCats cs rss =
map head $ groupBy fstEq $ sortBy (\x y -> compare (fst x) (fst y)) $
[ (resultCat r, rs) | rs@(r:_) <- rss] ++ [(n,[]) | (n,_,_) <- cs]
where fstEq p1 p2 = fst p1 == fst p2
resultCat :: (String,String,String) -> String
resultCat (_,t,_) = last (words t)
subtitle cat expl = "==" ++ cat ++ e ++ "==" ++ "[" ++ cat ++ "]"
where e = if null expl then "" else " - " ++ expl
showCat :: Cats -> String -> String
showCat cs cat = "[" ++ cat ++ " #" ++ cat ++ "]"
showTyp :: Cats -> String -> String
showTyp cs = unwords . map f . words
where f s | head s == '(' && last s == ')' && isCat c
= "(" ++ showCat cs c ++ ")"
| isCat s = showCat cs s
| otherwise = ttf s
where c = init (tail s)
isCat cat = cat `notElem` ["Str","Int"]
&& all (\c -> isAlphaNum c || c == '\'') cat
&& isUpper (head cat)
|
