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