]> Git — Sourcephile - doclang.git/blob - Language/DTC/Document.hs
Fix XML rendition of PairFrenchquote.
[doclang.git] / Language / DTC / Document.hs
1 {-# LANGUAGE DisambiguateRecordFields #-}
2 {-# LANGUAGE DuplicateRecordFields #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 {-# LANGUAGE OverloadedStrings #-}
6 module Language.DTC.Document
7 ( module Language.DTC.Document
8 , module Language.XML
9 ) where
10
11 import Data.Default.Class (Default(..))
12 import Data.Default.Instances.Containers ()
13 import Data.Eq (Eq)
14 import Data.Function (on, ($))
15 import Data.Int (Int)
16 import Data.Map.Strict (Map)
17 import Data.Maybe (Maybe(..))
18 import Data.Monoid (Monoid(..))
19 import Data.Ord (Ord(..))
20 import Data.Semigroup (Semigroup(..))
21 import Data.Sequence (Seq, ViewR(..), viewr)
22 import Data.TreeSeq.Strict (Trees)
23 import Text.Show (Show)
24 import qualified Data.Char as Char
25 import qualified Data.Text.Lazy as TL
26
27 import Language.XML
28
29 -- * Type 'Document'
30 data Document
31 = Document
32 { head :: Head
33 , body :: Body
34 } deriving (Eq,Show)
35 instance Default Document where
36 def = Document
37 { head = def
38 , body = mempty
39 }
40
41 -- * Type 'Head'
42 data Head
43 = Head
44 { about :: About
45 } deriving (Eq,Show)
46 instance Default Head where
47 def = Head
48 { about = def
49 }
50
51 -- ** Type 'About'
52 data About
53 = About
54 { headers :: [Header]
55 , titles :: [Title]
56 , url :: Maybe URL
57 , authors :: [Entity]
58 , editor :: Maybe Entity
59 , date :: Maybe Date
60 , tags :: [TL.Text]
61 , links :: [Link]
62 , series :: [Serie]
63 , includes :: [Include]
64 } deriving (Eq,Show)
65 instance Default About where
66 def = About
67 { headers = def
68 , includes = def
69 , titles = def
70 , url = def
71 , date = def
72 , editor = def
73 , authors = def
74 , tags = def
75 , links = def
76 , series = def
77 }
78 instance Semigroup About where
79 x <> y = About
80 { headers = headers x <> headers y
81 , titles = titles x <> titles y
82 , url = url (x::About) <> url (y::About)
83 , authors = authors x <> authors y
84 , editor = editor x <> editor y
85 , date = date x <> date y
86 , tags = tags x <> tags y
87 , links = links x <> links y
88 , series = series x <> series y
89 , includes = includes x <> includes y
90 }
91
92 -- * Type 'Header'
93 data Header
94 = Header
95 { name :: TL.Text
96 , value :: Plain
97 } deriving (Eq,Show)
98
99 -- * Type 'Body'
100 type Body = Trees BodyNode
101
102 -- ** Type 'BodyNode'
103 data BodyNode
104 = BodySection { pos :: Pos
105 , attrs :: CommonAttrs
106 , title :: Title
107 , aliases :: [Alias]
108 }
109 | BodyBlock Block -- ^ leaf
110 deriving (Eq,Show)
111
112 -- * Type 'Block'
113 data Block
114 = BlockPara Para
115 | BlockToC { pos :: Pos
116 , attrs :: CommonAttrs
117 , depth :: Maybe Nat
118 }
119 | BlockToF { pos :: Pos
120 , attrs :: CommonAttrs
121 , types :: [TL.Text]
122 }
123 | BlockFigure { pos :: Pos
124 , attrs :: CommonAttrs
125 , type_ :: TL.Text
126 , mayTitle :: Maybe Title
127 , paras :: [Para]
128 }
129 | BlockIndex { pos :: Pos
130 , attrs :: CommonAttrs
131 , terms :: Terms
132 }
133 | BlockReferences { pos :: Pos
134 , attrs :: CommonAttrs
135 , refs :: [Reference]
136 }
137 deriving (Eq,Show)
138
139 -- * Type 'Para'
140 data Para
141 = ParaItem { item :: ParaItem }
142 | ParaItems { pos :: Pos
143 , attrs :: CommonAttrs
144 , items :: [ParaItem]
145 }
146 deriving (Eq,Show)
147
148 -- ** Type 'ParaItem'
149 data ParaItem
150 = ParaPlain Plain
151 | ParaComment TL.Text
152 | ParaOL [ListItem]
153 | ParaUL [[Para]]
154 | ParaQuote { type_ :: TL.Text
155 , paras :: [Para]
156 }
157 | ParaArtwork { type_ :: TL.Text
158 , text :: TL.Text
159 }
160 deriving (Eq,Show)
161
162 -- *** Type 'ListItem'
163 data ListItem
164 = ListItem { name :: TL.Text
165 , paras :: [Para]
166 }
167 deriving (Eq,Show)
168
169 -- * Type 'Plain'
170 type Plain = Trees PlainNode
171
172 -- ** Type 'PlainNode'
173 data PlainNode
174 -- Nodes
175 = PlainB -- ^ Bold
176 | PlainCode -- ^ Code (monospaced)
177 | PlainDel -- ^ Deleted (crossed-over)
178 | PlainI -- ^ Italic
179 | PlainGroup -- ^ Group subTrees (neutral)
180 | PlainQ -- ^ Quoted
181 | PlainSC -- ^ Small Caps
182 | PlainSub -- ^ Subscript
183 | PlainSup -- ^ Superscript
184 | PlainU -- ^ Underlined
185 | PlainEref { href :: URL } -- ^ External reference
186 | PlainIref { anchor :: Maybe Anchor
187 , term :: Words
188 } -- ^ Index reference
189 | PlainRef { to :: Ident }
190 -- ^ Reference
191 | PlainRref { anchor :: Maybe Anchor
192 , to :: Ident
193 } -- ^ Reference reference
194 -- Leafs
195 | PlainBR -- ^ Line break (\n)
196 | PlainText TL.Text
197 | PlainNote { number :: Maybe Nat1
198 , note :: [Para]
199 } -- ^ Footnote
200 deriving (Eq,Show)
201
202 -- * Type 'Pos'
203 data Pos
204 = Pos
205 { posAncestors :: PosPath
206 , posAncestorsWithFigureNames :: PosPath
207 , posPrecedingsSiblings :: Map XmlName Rank
208 } deriving (Eq,Show)
209 instance Ord Pos where
210 compare = compare `on` posAncestors
211 instance Default Pos where
212 def = Pos mempty mempty mempty
213
214 -- *** Type 'PosPath'
215 type PosPath = Seq (XmlName,Rank)
216
217 posParent :: PosPath -> Maybe PosPath
218 posParent p =
219 case viewr p of
220 EmptyR -> Nothing
221 ls :> _ -> Just ls
222
223 -- * Type 'CommonAttrs'
224 data CommonAttrs
225 = CommonAttrs
226 { id :: Maybe Ident
227 , classes :: [TL.Text]
228 } deriving (Eq,Show)
229 instance Default CommonAttrs where
230 def = CommonAttrs
231 { id = def
232 , classes = def
233 }
234
235 -- ** Type 'Anchor'
236 data Anchor
237 = Anchor
238 { section :: Pos
239 , count :: Nat1
240 } deriving (Eq,Ord,Show)
241
242 -- * Type 'Title'
243 newtype Title = Title { unTitle :: Plain }
244 deriving (Eq,Show,Semigroup,Monoid,Default)
245
246 -- ** Type 'Entity'
247 data Entity
248 = Entity
249 { name :: TL.Text
250 , street :: TL.Text
251 , zipcode :: TL.Text
252 , city :: TL.Text
253 , region :: TL.Text
254 , country :: TL.Text
255 , email :: TL.Text
256 , tel :: TL.Text
257 , fax :: TL.Text
258 , url :: Maybe URL
259 , org :: Maybe Entity
260 } deriving (Eq,Show)
261 instance Default Entity where
262 def = Entity
263 { name = def
264 , street = def
265 , zipcode = def
266 , city = def
267 , region = def
268 , country = def
269 , email = def
270 , tel = def
271 , fax = def
272 , url = def
273 , org = def
274 }
275 instance Semigroup Entity where
276 _x <> y = y
277
278 -- * Type 'Include'
279 data Include
280 = Include
281 { href :: Path
282 } deriving (Eq,Show)
283 instance Default Include where
284 def = Include
285 { href = def
286 }
287
288 -- * Type 'Reference'
289 data Reference
290 = Reference
291 { id :: Ident
292 , about :: About
293 } deriving (Eq,Show)
294 reference :: Ident -> Reference
295 reference id =
296 Reference
297 { id
298 , about = def
299 }
300 instance Default Reference where
301 def = reference def
302
303 -- * Type 'Date'
304 data Date
305 = Date
306 { year :: Int
307 , month :: Maybe Nat1
308 , day :: Maybe Nat1
309 } deriving (Eq,Show)
310 instance Default Date where
311 def = Date
312 { year = 1970
313 , month = Just (Nat1 01)
314 , day = Just (Nat1 01)
315 }
316 instance Semigroup Date where
317 _x <> y = y
318
319 -- * Type 'Link'
320 data Link
321 = Link
322 { name :: TL.Text
323 , href :: URL
324 , rel :: TL.Text
325 , type_ :: Maybe TL.Text
326 , plain :: Plain
327 } deriving (Eq,Show)
328 instance Default Link where
329 def = Link
330 { name = def
331 , href = def
332 , rel = def
333 , type_ = def
334 , plain = def
335 }
336
337 -- * Type 'Alias'
338 data Alias
339 = Alias
340 { id :: Ident
341 } deriving (Eq,Show)
342 instance Default Alias where
343 def = Alias
344 { id = def
345 }
346
347 -- * Type 'Serie'
348 data Serie
349 = Serie
350 { name :: TL.Text
351 , id :: TL.Text
352 } deriving (Eq,Show)
353 instance Default Serie where
354 def = Serie
355 { name = def
356 , id = def
357 }
358
359 -- | Builtins 'URL' recognized from |Serie|'s 'name'.
360 urlSerie :: Serie -> Maybe URL
361 urlSerie Serie{id=id_, name} =
362 case name of
363 "RFC" | TL.all Char.isDigit id_ ->
364 Just $ URL $ "https://tools.ietf.org/html/rfc"<>id_
365 "DOI" -> Just $ URL $ "https://dx.doi.org/"<>id_
366 _ -> Nothing
367
368 -- * Type 'Word'
369 type Word = TL.Text
370
371 -- ** Type 'Words'
372 type Words = [WordOrSpace]
373
374 -- *** Type 'WordOrSpace'
375 data WordOrSpace
376 = Word Word
377 | Space
378 deriving (Eq,Ord,Show)
379
380 -- ** Type 'Aliases'
381 type Aliases = [Words]
382
383 -- ** Type 'Terms'
384 type Terms = [Aliases]
385
386 -- * Type 'Count'
387 type Count = Int