]> Git — Sourcephile - doclang.git/blob - Language/DTC/Sym.hs
Automatize localesOf.
[doclang.git] / Language / DTC / Sym.hs
1 {-# LANGUAGE NamedFieldPuns #-}
2 {-# LANGUAGE NoMonomorphismRestriction #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE RecordWildCards #-}
5 module Language.DTC.Sym where
6
7 import Control.Applicative (Applicative(..), (<$>), (<$))
8 import Control.Monad (void)
9 import Data.Default.Class (Default(..))
10 import Data.Foldable (Foldable, foldl', foldr)
11 import Data.Function (($), (.), flip)
12 import Data.Maybe (Maybe(..), maybe)
13 import Data.Text (Text)
14 import Data.TreeSeq.Strict (Tree(..))
15 import qualified Data.Sequence as Seq
16 import qualified Data.Text as Text
17
18 import Language.XML
19 import Language.RNC.Sym as RNC
20 import qualified Language.DTC.Document as DTC
21 import qualified Language.RNC.Write as RNC
22
23 foldlApp :: (Default a, Foldable t) => t (a -> a) -> a
24 foldlApp = foldl' (flip ($)) def
25 foldrApp :: (Default a, Foldable t) => t (a -> a) -> a
26 foldrApp = foldr ($) def
27
28 class RNC.Sym_RNC repr => Sym_DTC repr where
29 title :: repr DTC.Title
30 name :: repr Text
31 url :: repr URL
32 path :: repr Path
33 ident :: repr Ident
34 to :: repr Ident
35 id :: repr Ident
36 date :: repr DTC.Date
37 include :: repr DTC.Include
38 horizontals :: repr DTC.Horizontals
39 horizontal :: repr DTC.Horizontal
40 vertical :: repr DTC.Vertical
41 reference :: repr DTC.Reference
42 document :: repr DTC.Document
43 head :: repr DTC.Head
44 body :: repr DTC.Body
45 bodyKey :: repr DTC.BodyKey
46 bodyValue :: repr DTC.BodyValue
47 figure :: repr DTC.BodyValue
48 about :: repr DTC.About
49 keyword :: repr Text
50 version :: repr MayText
51 author :: repr DTC.Entity
52 editor :: repr DTC.Entity
53 entity :: repr DTC.Entity
54 address :: repr DTC.Address
55 link :: repr DTC.Link
56 serie :: repr DTC.Serie
57 alias :: repr DTC.Alias
58 commonAttrs :: repr DTC.CommonAttrs
59 commonAttrs =
60 rule "commonAttrs" $
61 interleaved $
62 DTC.CommonAttrs
63 <$?> (def, Just <$> id)
64 <|?> (def, rule "class" $ attribute "class" $ Text.words <$> text)
65
66 document = rule "document" $
67 DTC.Document
68 <$> head
69 <*> body
70 head = rule "head" $
71 maybe def DTC.Head
72 <$> optional (rule "about" $ element "about" about)
73 body =
74 rule "body" $
75 (Seq.fromList <$>) $
76 many $
77 choice
78 [ rule "section" $ element "section" $ TreeN <$> bodyKey <*> body
79 , Tree0 . Seq.fromList <$> some bodyValue
80 ]
81 bodyKey =
82 position $
83 DTC.Section
84 <$> commonAttrs
85 <*> title
86 <*> many alias
87 bodyValue =
88 choice
89 [ element "toc" $
90 position $
91 DTC.ToC
92 <$> commonAttrs
93 <*> optional (attribute "depth" nat)
94 , element "tof" $
95 position $
96 DTC.ToF
97 <$> commonAttrs
98 <*> optional (attribute "depth" nat)
99 , element "index" $
100 position $
101 DTC.Index
102 <$> commonAttrs
103 <* any
104 , figure
105 , DTC.Vertical
106 <$> vertical
107 ]
108 title = rule "title" $ DTC.Title <$> element "title" horizontals
109 name = rule "name" $ attribute "name" text
110 url = rule "url" $ URL <$> text
111 path = rule "path" $ Path <$> text
112 ident = rule "ident" $ Ident <$> text
113 to = rule "to" $ attribute "to" ident
114 id = rule "id" $ attribute "id" ident
115 date = rule "date" $
116 element "date" $
117 interleaved $
118 DTC.Date
119 <$?> (0, attribute "year" int)
120 <|?> (Nothing, Just <$> attribute "month" nat1)
121 <|?> (Nothing, Just <$> attribute "day" nat1)
122 include = rule "include" $
123 element "include" $
124 interleaved $
125 DTC.Include
126 <$?> (def, attribute "href" path)
127 vertical = rule "vertical" $
128 choice
129 [ DTC.Comment <$> comment
130 , element "para" $
131 position $
132 DTC.Para
133 <$> commonAttrs
134 <*> horizontals
135 , element "ol" $
136 position $
137 DTC.OL
138 <$> commonAttrs
139 <*> many (element "li" $ many vertical)
140 , element "ul" $
141 position $
142 DTC.UL
143 <$> commonAttrs
144 <*> many (element "li" $ many vertical)
145 , element "rl" $
146 position $
147 DTC.RL
148 <$> commonAttrs
149 <*> many reference
150 {-
151 , anyElem $ \n@XmlName{..} ->
152 case xmlNameSpace of
153 "" -> figure n
154 -}
155 ]
156 figure =
157 rule "figure" $
158 element "figure" $
159 position $
160 DTC.Figure
161 <$> attribute "type" text
162 <*> commonAttrs
163 <*> title
164 <*> many vertical
165 horizontals = many horizontal
166 horizontal = rule "horizontal" $
167 choice
168 [ DTC.BR <$ element "br" none
169 , DTC.B <$> element "b" horizontals
170 , DTC.Code <$> element "code" horizontals
171 , DTC.Del <$> element "del" horizontals
172 , DTC.I <$> element "i" horizontals
173 , DTC.Note <$> element "note" horizontals
174 , DTC.Q <$> element "q" horizontals
175 , DTC.SC <$> element "sc" horizontals
176 , DTC.Sub <$> element "sub" horizontals
177 , DTC.Sup <$> element "sup" horizontals
178 , DTC.U <$> element "u" horizontals
179 , element "eref" $ DTC.Eref
180 <$> attribute "to" url
181 <*> horizontals
182 , element "iref" $ DTC.Iref <$> to <*> horizontals
183 , element "ref" $ DTC.Ref <$> to <*> horizontals
184 , element "rref" $ DTC.Rref <$> to <*> horizontals
185 , DTC.Plain <$> text
186 ]
187 keyword = rule "keyword" $
188 element "keyword" text
189 version = rule "version" $
190 MayText <$>
191 element "version" text
192 about =
193 interleaved $
194 DTC.About
195 <$*> title
196 <|*> author
197 <|?> (Nothing, Just <$> editor)
198 <|?> (Nothing, Just <$> date)
199 <|?> (def, version)
200 <|*> keyword
201 <|*> link
202 <|*> serie
203 <|*> include
204 author = rule "author" $ element "author" entity
205 editor = rule "editor" $ element "editor" entity
206 entity = rule "entity" $
207 DTC.Entity
208 <$> name
209 <*> address
210 address = rule "address" $
211 element "address" $
212 interleaved $
213 DTC.Address
214 <$?> (def, attribute "street" text)
215 <|?> (def, attribute "zipcode" text)
216 <|?> (def, attribute "city" text)
217 <|?> (def, attribute "region" text)
218 <|?> (def, attribute "country" text)
219 <|?> (def, attribute "email" text)
220 <|?> (def, attribute "tel" text)
221 <|?> (def, attribute "fax" text)
222 serie = rule "serie" $
223 element "serie" $
224 interleaved $
225 DTC.Serie
226 <$?> (def, attribute "name" text)
227 <|?> (def, attribute "key" text)
228 link = rule "link" $
229 element "link" $
230 interleaved $
231 DTC.Link
232 <$?> (def, attribute "name" text)
233 <|?> (def, attribute "href" url)
234 <|?> (def, attribute "rel" text)
235 <|*> horizontal
236 alias = rule "alias" $
237 element "alias" $
238 interleaved $
239 DTC.Alias
240 <$?> (def, id)
241 reference = rule "reference" $
242 element "reference" $
243 DTC.Reference
244 <$> id
245 <*> optional (attribute "to" url)
246 <*> about
247
248 instance Sym_DTC RNC.Writer
249 instance Sym_DTC RNC.RuleWriter
250 dtcRNC :: [RNC.RuleWriter ()]
251 dtcRNC =
252 [ void document
253 , void head
254 , void body
255
256 , void vertical
257 , void horizontal
258 , void $ rule "horizontals" horizontals
259
260 , void title
261 , void name
262 , void url
263 , void path
264 , void ident
265
266 , void commonAttrs
267 , void to
268 , void id
269
270 , void $ rule "about" $ element "about" about
271 , void address
272 , void author
273 , void date
274 , void editor
275 , void entity
276 , void keyword
277 , void link
278 , void serie
279 , void version
280
281 , void alias
282 , void reference
283
284 , void include
285 , void figure
286 ]