]> Git — Sourcephile - doclang.git/blob - Language/DTC/Sym.hs
Remove unused PaddedList.
[doclang.git] / Language / DTC / Sym.hs
1 {-# LANGUAGE NoMonomorphismRestriction #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 module Language.DTC.Sym where
4
5 import Control.Applicative (Applicative(..), (<$>), (<$))
6 import Control.Monad (void)
7 import Data.Default.Class (Default(..))
8 import Data.Foldable (Foldable(..), concat)
9 import Data.Function (($), (.), flip)
10 import Data.Maybe (Maybe(..), maybe)
11 import Data.TreeSeq.Strict (Tree(..), tree0)
12 import qualified Data.Sequence as Seq
13 import qualified Data.Text.Lazy as TL
14
15 import Language.XML
16 import Language.RNC.Sym as RNC
17 import Language.DTC.Anchor (wordify)
18 import qualified Language.DTC.Document as DTC
19 import qualified Language.RNC.Write as RNC
20
21 foldlApp :: (Default a, Foldable t) => t (a -> a) -> a
22 foldlApp = foldl' (flip ($)) def
23 foldrApp :: (Default a, Foldable t) => t (a -> a) -> a
24 foldrApp = foldr ($) def
25
26 -- Class 'Sym_DTC'
27 -- | Use a symantic (tagless final) class to encode
28 -- both the parsing and the schema of DTC,
29 -- when repr is respectively instanciated
30 -- on 'DTC.Parser' or 'RNC.RuleWriter'.
31 class RNC.Sym_RNC repr => Sym_DTC repr where
32 position :: repr DTC.Pos
33 document :: repr DTC.Document
34
35 head :: repr DTC.Head
36 about :: repr DTC.About
37 keyword :: repr TL.Text
38 version :: repr TL.Text
39 author :: repr DTC.Entity
40 editor :: repr DTC.Entity
41 date :: repr DTC.Date
42 entity :: repr DTC.Entity
43 link :: repr DTC.Link
44 serie :: repr DTC.Serie
45 alias :: repr DTC.Alias
46
47 body :: repr DTC.Body
48 include :: repr DTC.Include
49
50 block :: repr DTC.Block
51 blockToC :: repr DTC.Block
52 blockToF :: repr DTC.Block
53 blockIndex :: repr DTC.Block
54 blockFigure :: repr DTC.Block
55 blockReferences :: repr DTC.Block
56 reference :: repr DTC.Reference
57
58 para :: repr DTC.Para
59 paraItem :: repr DTC.ParaItem
60 paraItems :: repr DTC.Para
61
62 plain :: repr DTC.Plain
63 plainNode :: repr (Tree DTC.PlainNode)
64
65 commonAttrs :: repr DTC.CommonAttrs
66 ident :: repr Ident
67 title :: repr DTC.Title
68 name :: repr TL.Text
69 url :: repr URL
70 path :: repr Path
71 to :: repr Ident
72 id :: repr Ident
73
74 commonAttrs =
75 rule "commonAttrs" $
76 interleaved $
77 DTC.CommonAttrs
78 <$?> (def, Just <$> id)
79 <|?> (def, rule "class" $ attribute "class" $ TL.words <$> text)
80
81 document = rule "document" $
82 DTC.Document
83 <$> head
84 <*> body
85 head = rule "head" $
86 maybe def DTC.Head
87 <$> optional (rule "about" $ element "about" about)
88 body =
89 rule "body" $
90 (Seq.fromList <$>) $
91 many $
92 choice
93 [ element "section" $ Tree <$> section <*> body
94 , tree0 . DTC.BodyBlock <$> block
95 ]
96 where
97 section =
98 DTC.BodySection
99 <$> position
100 <*> commonAttrs
101 <*> title
102 <*> many alias
103 title = rule "title" $ DTC.Title <$> element "title" plain
104 name = rule "name" $ attribute "name" text
105 url = rule "url" $ URL <$> text
106 path = rule "path" $ Path <$> text
107 ident = rule "ident" $ Ident <$> text
108 to = rule "to" $ attribute "to" ident
109 id = rule "id" $ attribute "id" ident
110 date = rule "date" $
111 element "date" $
112 interleaved $
113 DTC.Date
114 <$?> (0, attribute "year" int)
115 <|?> (Nothing, Just <$> attribute "month" nat1)
116 <|?> (Nothing, Just <$> attribute "day" nat1)
117 include =
118 rule "include" $
119 element "include" $
120 interleaved $
121 DTC.Include
122 <$?> (def, attribute "href" path)
123 block = rule "block" $
124 choice
125 [ DTC.BlockPara <$> para
126 , blockToC
127 , blockToF
128 , blockIndex
129 , blockFigure
130 , blockReferences
131 {-
132 , anyElem $ \n@XmlName{..} ->
133 case xmlNameSpace of
134 "" -> figure n
135 -}
136 ]
137 blockToC =
138 rule "blockToC" $
139 element "toc" $
140 DTC.BlockToC
141 <$> position
142 <*> commonAttrs
143 <*> optional (attribute "depth" nat)
144 blockToF =
145 rule "blockToF" $
146 element "tof" $
147 DTC.BlockToF
148 <$> position
149 <*> commonAttrs
150 <*> option [] (
151 element "ul" $
152 many $
153 element "li" $
154 element "para" text)
155 blockIndex =
156 rule "blockIndex" $
157 element "index" $
158 DTC.BlockIndex
159 <$> position
160 <*> commonAttrs
161 <*> option [] (
162 element "ul" $
163 many $
164 element "li" $
165 element "para" $
166 (concat <$>) $
167 many $
168 (wordify <$>) . TL.lines <$> text)
169 blockFigure =
170 rule "blockFigure" $
171 element "figure" $
172 DTC.BlockFigure
173 <$> position
174 <*> commonAttrs
175 <*> attribute "type" text
176 <*> optional title
177 <*> many para
178 blockReferences =
179 rule "blockReferences" $
180 element "references" $
181 DTC.BlockReferences
182 <$> position
183 <*> commonAttrs
184 <*> many reference
185
186 para = rule "para" $ paraItems <|> DTC.ParaItem <$> paraItem
187 paraItem =
188 rule "paraItem" $
189 choice
190 [ element "ol" $ DTC.ParaOL <$> many (element "li" $ DTC.ListItem <$> attribute "name" text <*> many para)
191 , element "ul" $ DTC.ParaUL <$> many (element "li" $ many para)
192 , element "artwork" $ DTC.ParaArtwork <$> attribute "type" text <*> text
193 , element "quote" $ DTC.ParaQuote <$> attribute "type" text <*> many para
194 , DTC.ParaPlain . Seq.fromList <$> some plainNode
195 , DTC.ParaComment <$> comment
196 ]
197 paraItems =
198 rule "paraItems" $
199 element "para" $
200 DTC.ParaItems
201 <$> position
202 <*> commonAttrs
203 <*> many paraItem
204 plain = rule "plain" $ (Seq.fromList <$>) $ many plainNode
205 plainNode =
206 rule "plainNode" $
207 choice
208 [ tree0 . DTC.PlainText <$> text
209 , element "br" $ tree0 DTC.PlainBR <$ none
210 , element "b" $ Tree DTC.PlainB <$> plain
211 , element "code" $ Tree DTC.PlainCode <$> plain
212 , element "del" $ Tree DTC.PlainDel <$> plain
213 , element "i" $ Tree DTC.PlainI <$> plain
214 , element "q" $ Tree DTC.PlainQ <$> plain
215 , element "sc" $ Tree DTC.PlainSC <$> plain
216 , element "sub" $ Tree DTC.PlainSub <$> plain
217 , element "sup" $ Tree DTC.PlainSup <$> plain
218 , element "u" $ Tree DTC.PlainU <$> plain
219 , element "note" $ tree0 . DTC.PlainNote Nothing <$> many para
220 , element "iref" $ Tree . DTC.PlainIref Nothing . wordify <$> attribute "to" text <*> plain
221 , element "eref" $ Tree . DTC.PlainEref <$> attribute "to" url <*> plain
222 , element "ref" $ Tree . DTC.PlainRef <$> to <*> plain
223 , element "rref" $ Tree . DTC.PlainRref Nothing <$> to <*> plain
224 ]
225 keyword = rule "keyword" $ element "keyword" text
226 version = rule "version" $ element "version" text
227 about =
228 interleaved $
229 DTC.About
230 <$*> title
231 <|?> (def, Just <$> attribute "url" url)
232 <|*> author
233 <|?> (def, Just <$> editor)
234 <|?> (def, Just <$> date)
235 <|?> (def, Just <$> version)
236 <|*> keyword
237 <|*> link
238 <|*> serie
239 <|*> include
240 author = rule "author" $ element "author" entity
241 editor = rule "editor" $ element "editor" entity
242 entity = rule "entity" $
243 interleaved $
244 DTC.Entity
245 <$?> (def, name)
246 <|?> (def, attribute "street" text)
247 <|?> (def, attribute "zipcode" text)
248 <|?> (def, attribute "city" text)
249 <|?> (def, attribute "region" text)
250 <|?> (def, attribute "country" text)
251 <|?> (def, attribute "email" text)
252 <|?> (def, attribute "tel" text)
253 <|?> (def, attribute "fax" text)
254 <|?> (def, Just <$> attribute "url" url)
255 <|?> (def, Just <$> element "org" entity)
256 serie = rule "serie" $
257 element "serie" $
258 interleaved $
259 DTC.Serie
260 <$?> (def, name)
261 <|?> (def, attribute "id" text)
262 link = rule "link" $
263 element "link" $
264 interleaved $
265 (\n u t p -> DTC.Link n u t (Seq.fromList p))
266 <$?> (def, name)
267 <|?> (def, attribute "href" url)
268 <|?> (def, attribute "rel" text)
269 <|*> plainNode
270 alias = rule "alias" $
271 element "alias" $
272 interleaved $
273 DTC.Alias
274 <$?> (def, id)
275 reference = rule "reference" $
276 element "reference" $
277 DTC.Reference
278 <$> id
279 <*> about
280
281 instance Sym_DTC RNC.Writer where
282 position = RNC.writeText ""
283 instance Sym_DTC RNC.RuleWriter where
284 position = RNC.RuleWriter position
285
286 -- | RNC schema for DTC
287 schema :: [RNC.RuleWriter ()]
288 schema =
289 [ void $ document
290
291 , void $ head
292 , void $ rule "about" $ element "about" about
293 , void $ keyword
294 , void $ version
295 , void $ author
296 , void $ editor
297 , void $ date
298 , void $ entity
299 , void $ link
300 , void $ serie
301 , void $ alias
302
303 , void $ body
304 , void $ include
305
306 , void $ block
307 , void $ blockToC
308 , void $ blockToF
309 , void $ blockIndex
310 , void $ blockFigure
311 , void $ blockReferences
312 , void $ reference
313
314 , void $ para
315 , void $ paraItem
316 , void $ paraItems
317
318 , void $ plain
319 , void $ plainNode
320
321 , void $ commonAttrs
322 , void $ ident
323 , void $ title
324 , void $ name
325 , void $ url
326 , void $ path
327 , void $ to
328 , void $ id
329 ]