]> Git — Sourcephile - doclang.git/blob - Language/DTC/Document.hs
Add golden tests.
[doclang.git] / Language / DTC / Document.hs
1 {-# LANGUAGE DisambiguateRecordFields #-}
2 {-# LANGUAGE DuplicateRecordFields #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 module Language.DTC.Document
6 ( module Language.DTC.Document
7 , module Language.XML
8 ) where
9
10 import Data.Default.Class (Default(..))
11 import Data.Default.Instances.Containers ()
12 import Data.Eq (Eq)
13 import Data.Function (on)
14 import Data.Int (Int)
15 import Data.Map.Strict (Map)
16 import Data.Maybe (Maybe(..))
17 import Data.Monoid (Monoid(..))
18 import Data.Ord (Ord(..))
19 import Data.Semigroup (Semigroup(..))
20 import Data.Sequence (Seq)
21 import Data.Text (Text)
22 import Data.TreeSeq.Strict (Tree(..), Trees)
23 import Text.Show (Show)
24
25 import Language.XML
26
27 -- * Type 'Document'
28 data Document
29 = Document
30 { head :: Head
31 , body :: Body
32 } deriving (Eq,Show)
33 instance Default Document where
34 def = Document
35 { head = def
36 , body = mempty
37 }
38
39 -- * Type 'Head'
40 data Head
41 = Head
42 { about :: About
43 } deriving (Eq,Show)
44 instance Default Head where
45 def = Head
46 { about = def
47 }
48
49 -- ** Type 'About'
50 data About
51 = About
52 { titles :: [Title]
53 , url :: Maybe URL
54 , authors :: [Entity]
55 , editor :: Maybe Entity
56 , date :: Maybe Date
57 , version :: MayText
58 , keywords :: [Text]
59 , links :: [Link]
60 , series :: [Serie]
61 , includes :: [Include]
62 } deriving (Eq,Show)
63 instance Default About where
64 def = About
65 { includes = def
66 , titles = def
67 , url = def
68 , date = def
69 , version = def
70 , editor = def
71 , authors = def
72 , keywords = def
73 , links = def
74 , series = def
75 }
76 instance Semigroup About where
77 x <> y = About
78 { titles = titles x <> titles y
79 , url = url (x::About) <> url (y::About)
80 , authors = authors x <> authors y
81 , editor = editor x <> editor y
82 , date = date x <> date y
83 , version = version x <> version y
84 , keywords = keywords x <> keywords y
85 , links = links x <> links y
86 , series = series x <> series y
87 , includes = includes x <> includes y
88 }
89
90 -- * Type 'Body'
91 type Body = Trees BodyKey BodyValue
92
93 -- ** Type 'BodyKey'
94 data BodyKey
95 = Section { pos :: Pos
96 , attrs :: CommonAttrs
97 , title :: Title
98 , aliases :: [Alias]
99 }
100 deriving (Eq,Show)
101
102 -- ** Type 'BodyValue'
103 data BodyValue
104 = ToC { pos :: Pos
105 , attrs :: CommonAttrs
106 , depth :: Maybe Nat
107 }
108 | ToF { pos :: Pos
109 , attrs :: CommonAttrs
110 , types :: [Text]
111 }
112 | Figure { pos :: Pos
113 , attrs :: CommonAttrs
114 , type_ :: Text
115 , title :: Maybe Title
116 , blocks :: Blocks
117 }
118 | Index { pos :: Pos
119 , attrs :: CommonAttrs
120 , terms :: Terms
121 }
122 | References { pos :: Pos
123 , attrs :: CommonAttrs
124 , refs :: [Reference]
125 }
126 | Block Block
127 deriving (Eq,Show)
128
129 -- ** Type 'Pos'
130 data Pos
131 = Pos
132 { posAncestors :: PosPath
133 , posAncestorsWithFigureNames :: PosPath
134 , posPrecedingsSiblings :: Map XmlName Rank
135 } deriving (Eq,Show)
136 instance Ord Pos where
137 compare = compare `on` posAncestors
138 instance Default Pos where
139 def = Pos mempty mempty mempty
140
141 -- *** Type 'PosPath'
142 type PosPath = Seq (XmlName,Rank)
143
144 -- ** Type 'Word'
145 type Word = Text
146
147 -- *** Type 'Words'
148 type Words = [WordOrSpace]
149
150 -- **** Type 'WordOrSpace'
151 data WordOrSpace
152 = Word Word
153 | Space
154 deriving (Eq,Ord,Show)
155
156 -- ** Type 'Aliases'
157 type Aliases = [Words]
158
159 -- ** Type 'Terms'
160 type Terms = [Aliases]
161
162 -- * Type 'Count'
163 type Count = Int
164
165 -- * Type 'Block'
166 data Block
167 = Para { pos :: Pos
168 , attrs :: CommonAttrs
169 , para :: Para
170 }
171 | OL { pos :: Pos
172 , attrs :: CommonAttrs
173 , items :: [Blocks]
174 }
175 | UL { pos :: Pos
176 , attrs :: CommonAttrs
177 , items :: [Blocks]
178 }
179 | Artwork { pos :: Pos
180 , attrs :: CommonAttrs
181 , art :: Artwork
182 }
183 | Comment Text
184 deriving (Eq,Show)
185
186 -- * Type 'CommonAttrs'
187 data CommonAttrs
188 = CommonAttrs
189 { id :: Maybe Ident
190 , classes :: [Text]
191 } deriving (Eq,Show)
192
193 -- * Type 'Blocks'
194 type Blocks = [Block]
195
196 -- * Type 'Artwork'
197 data Artwork
198 = Raw Text
199 deriving (Eq,Show)
200
201 -- * Type 'Para'
202 type Para = Seq Lines
203
204 -- * Type 'Lines'
205 type Lines = Tree LineKey LineValue
206
207 -- ** Type 'LineKey'
208 data LineKey
209 = B
210 | Code
211 | Del
212 | I
213 | Note {number :: Maybe Nat1}
214 | Q
215 | SC
216 | Sub
217 | Sup
218 | U
219 | Eref {href :: URL}
220 | Iref {anchor :: Maybe Anchor, term :: Words}
221 | Ref {to :: Ident}
222 | Rref {anchor :: Maybe Anchor, to :: Ident}
223 deriving (Eq,Show)
224
225 -- ** Type 'Anchor'
226 data Anchor
227 = Anchor
228 { section :: Pos
229 , count :: Nat1
230 } deriving (Eq,Ord,Show)
231
232 -- ** Type 'LineValue'
233 data LineValue
234 = BR
235 | Plain Text
236 deriving (Eq,Show)
237
238 -- * Type 'Title'
239 newtype Title = Title { unTitle :: Para }
240 deriving (Eq,Show,Semigroup,Monoid,Default)
241
242 -- ** Type 'Entity'
243 data Entity
244 = Entity
245 { name :: Text
246 , street :: Text
247 , zipcode :: Text
248 , city :: Text
249 , region :: Text
250 , country :: Text
251 , email :: Text
252 , tel :: Text
253 , fax :: Text
254 , url :: Maybe URL
255 , org :: Maybe Entity
256 } deriving (Eq,Show)
257 instance Default Entity where
258 def = Entity
259 { name = def
260 , street = def
261 , zipcode = def
262 , city = def
263 , region = def
264 , country = def
265 , email = def
266 , tel = def
267 , fax = def
268 , url = def
269 , org = def
270 }
271 instance Semigroup Entity where
272 _x <> y = y
273
274 -- * Type 'Include'
275 data Include
276 = Include
277 { href :: Path
278 } deriving (Eq,Show)
279 instance Default Include where
280 def = Include
281 { href = def
282 }
283
284 -- * Type 'Reference'
285 data Reference
286 = Reference
287 { id :: Ident
288 , about :: About
289 } deriving (Eq,Show)
290 reference :: Ident -> Reference
291 reference id =
292 Reference
293 { id
294 , about = def
295 }
296 instance Default Reference where
297 def = reference def
298
299 -- * Type 'Date'
300 data Date
301 = Date
302 { year :: Int
303 , month :: Maybe Nat1
304 , day :: Maybe Nat1
305 } deriving (Eq,Show)
306 instance Default Date where
307 def = Date
308 { year = 1970
309 , month = Just (Nat1 01)
310 , day = Just (Nat1 01)
311 }
312 instance Semigroup Date where
313 _x <> y = y
314
315 -- * Type 'Link'
316 data Link
317 = Link
318 { name :: Text
319 , href :: URL
320 , rel :: Text
321 , para :: Para
322 } deriving (Eq,Show)
323 instance Default Link where
324 def = Link
325 { name = def
326 , href = def
327 , rel = def
328 , para = def
329 }
330
331 -- * Type 'Alias'
332 data Alias
333 = Alias
334 { id :: Ident
335 } deriving (Eq,Show)
336 instance Default Alias where
337 def = Alias
338 { id = def
339 }
340
341 -- * Type 'Serie'
342 data Serie
343 = Serie
344 { name :: Text
345 , key :: Text
346 } deriving (Eq,Show)
347 instance Default Serie where
348 def = Serie
349 { name = def
350 , key = def
351 }