]> Git — Sourcephile - doclang.git/blob - Language/DTC/Sym.hs
Add Html5ify for TCT.
[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 <*> 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 choice
199 [ element "b" $ TreeN DTC.B <$> para
200 , element "code" $ TreeN DTC.Code <$> para
201 , element "del" $ TreeN DTC.Del <$> para
202 , element "i" $ TreeN DTC.I <$> para
203 , element "note" $ TreeN DTC.Note <$> para
204 , element "q" $ TreeN DTC.Q <$> para
205 , element "sc" $ TreeN DTC.SC <$> para
206 , element "sub" $ TreeN DTC.Sub <$> para
207 , element "sup" $ TreeN DTC.Sup <$> para
208 , element "u" $ TreeN DTC.U <$> para
209 , element "eref" $ TreeN . DTC.Eref <$> attribute "to" url <*> para
210 , element "iref" $ TreeN . DTC.Iref Nothing . wordify <$> attribute "to" text <*> para
211 , element "ref" $ TreeN . DTC.Ref <$> to <*> para
212 , element "rref" $ TreeN . DTC.Rref Nothing <$> to <*> para
213 , element "br" $ Tree0 DTC.BR <$ none
214 , Tree0 . DTC.Plain <$> text
215 ]
216 keyword = rule "keyword" $
217 element "keyword" text
218 version = rule "version" $
219 MayText <$>
220 element "version" text
221 about =
222 interleaved $
223 DTC.About
224 <$*> title
225 <|?> (def, Just <$> attribute "url" url)
226 <|*> author
227 <|?> (Nothing, Just <$> editor)
228 <|?> (Nothing, Just <$> date)
229 <|?> (def, version)
230 <|*> keyword
231 <|*> link
232 <|*> serie
233 <|*> include
234 author = rule "author" $ element "author" entity
235 editor = rule "editor" $ element "editor" entity
236 entity = rule "entity" $
237 interleaved $
238 DTC.Entity
239 <$?> (def, attribute "name" text)
240 <|?> (def, attribute "street" text)
241 <|?> (def, attribute "zipcode" text)
242 <|?> (def, attribute "city" text)
243 <|?> (def, attribute "region" text)
244 <|?> (def, attribute "country" text)
245 <|?> (def, attribute "email" text)
246 <|?> (def, attribute "tel" text)
247 <|?> (def, attribute "fax" text)
248 <|?> (def, Just <$> attribute "url" url)
249 serie = rule "serie" $
250 element "serie" $
251 interleaved $
252 DTC.Serie
253 <$?> (def, attribute "name" text)
254 <|?> (def, attribute "key" text)
255 link = rule "link" $
256 element "link" $
257 interleaved $
258 (\n h r ls -> DTC.Link n h r (Seq.fromList ls))
259 <$?> (def, attribute "name" text)
260 <|?> (def, attribute "href" url)
261 <|?> (def, attribute "rel" text)
262 <|*> lines
263 alias = rule "alias" $
264 element "alias" $
265 interleaved $
266 DTC.Alias
267 <$?> (def, id)
268 reference = rule "reference" $
269 element "reference" $
270 DTC.Reference
271 <$> id
272 <*> about
273
274 instance Sym_DTC RNC.Writer where
275 position = RNC.writeText ""
276 deriving instance Sym_DTC RNC.RuleWriter
277
278 dtcRNC :: [RNC.RuleWriter ()]
279 dtcRNC =
280 [ void $ document
281
282 , void $ head
283 , void $ rule "about" $ element "about" about
284 , void $ keyword
285 , void $ version
286 , void $ author
287 , void $ editor
288 , void $ date
289 , void $ entity
290 , void $ link
291 , void $ serie
292 , void $ alias
293
294 , void $ body
295 , void $ bodyValue
296 , void $ toc
297 , void $ tof
298 , void $ index
299 , void $ figure
300 , void $ references
301 , void $ reference
302 , void $ include
303
304 , void $ block
305 , void $ para
306 , void $ lines
307
308 , void $ commonAttrs
309 , void $ ident
310 , void $ title
311 , void $ name
312 , void $ url
313 , void $ path
314 , void $ to
315 , void $ id
316 ]