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