]> Git — Sourcephile - doclang.git/blob - Text/Blaze/DTC.hs
Fix <name> DTC writing.
[doclang.git] / Text / Blaze / DTC.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RecordWildCards #-}
3 module Text.Blaze.DTC where
4
5 import Data.Bool
6 import Data.Eq (Eq)
7 import Data.Function (($), (.))
8 import Data.Int (Int)
9 import Data.Maybe (Maybe(..))
10 import Data.Text (Text)
11 import Text.Blaze
12 import Text.Blaze.Internal
13 import Text.Show (Show(..))
14
15 import Text.Blaze.Utils
16 import Text.Blaze.DTC.Attributes
17
18 -- * Type 'DTC'
19 type DTC = Markup
20
21 xmlModel :: Text -> DTC
22 xmlModel rnc =
23 Leaf "xml-model" "<?xml-model" "?>\n" ()
24 ! attribute "type" " type=\"" "application/relax-ng-compact-syntax"
25 ! attribute "href" " href=\"" (attrValue rnc)
26
27 xmlStylesheet :: Text -> DTC
28 xmlStylesheet xsl =
29 Leaf "xml-stylesheet" "<?xml-stylesheet" "?>\n" ()
30 ! attribute "type" " type=\"" "text/xsl"
31 ! attribute "href" " href=\"" (attrValue xsl)
32
33 html5Stylesheet :: Text -> DTC
34 html5Stylesheet xsl =
35 Leaf "html5-stylesheet" "<?html5-stylesheet" "?>\n" ()
36 ! attribute "type" " type=\"" "text/xsl"
37 ! attribute "href" " href=\"" (attrValue xsl)
38
39 atomStylesheet :: Text -> DTC
40 atomStylesheet xsl =
41 Leaf "atom-stylesheet" "<?atom-stylesheet" "?>\n" ()
42 ! attribute "type" " type=\"" "text/xsl"
43 ! attribute "href" " href=\"" (attrValue xsl)
44
45 about :: DTC -> DTC
46 about = Parent "about" "<about" "</about>"
47 address :: DTC -> DTC
48 address = Parent "address" "<address" "</address>"
49 artwork :: DTC -> DTC
50 artwork = Parent "artwork" "<artwork" "</artwork>"
51 author :: DTC -> DTC
52 author = Parent "author" "<author" "</author>"
53 b :: DTC -> DTC
54 b = Parent "b" "<b" "</b>"
55 br :: DTC
56 br = Leaf "br" "<br" " />" ()
57 call :: DTC -> DTC
58 call = Parent "call" "<call" "</call>"
59 code :: DTC -> DTC
60 code = Parent "code" "<code" "</code>"
61
62 -- * Type 'Date'
63 data Date
64 = Date
65 { date_year :: Int
66 , date_month :: Maybe Int
67 , date_day :: Maybe Int
68 } deriving (Eq,Show)
69 date :: Date -> DTC
70 date Date{..} =
71 Leaf "date" "<date" "/>" ()
72 ! attribute "year" " year=\"" (attrValue date_year)
73 !?? (date_month, attribute "month" " month=\"" . attrValue)
74 !?? (date_day, attribute "day" " day=\"" . attrValue)
75
76 define :: DTC -> DTC
77 define = Parent "define" "<define" "</define>"
78 document :: DTC -> DTC
79 document = Parent "document" "<document" "</document>"
80 editor :: DTC -> DTC
81 editor = Parent "editor" "<editor" "</editor>"
82 email :: DTC -> DTC
83 email = Parent "email" "<email" "</email>"
84 eref :: DTC -> DTC
85 eref (Empty a) = Leaf "eref" "<eref" "/>" a
86 eref x = Parent "eref" "<eref" "</eref>" x
87 figure :: DTC -> DTC
88 figure = Parent "figure" "<figure" "</figure>"
89 i :: DTC -> DTC
90 i = Parent "i" "<i" "</i>"
91 include :: Bool -> AttributeValue -> DTC
92 include inc h =
93 Leaf "include" "<include" "/>" ()
94 !? (not inc, attribute "include" " include=\"" "no")
95 ! href h
96 keyword :: DTC -> DTC
97 keyword = Parent "keyword" "<keyword" "</keyword>"
98 li :: DTC -> DTC
99 li = Parent "li" "<li" "</li>"
100 link :: DTC -> DTC
101 link = Parent "link" "<link" "</link>"
102 macro :: DTC -> DTC
103 macro = Parent "macro" "<macro" "</macro>"
104 name :: DTC -> DTC
105 name = Parent "name" "<name" "</name>"
106 note :: DTC -> DTC
107 note = Parent "note" "<note" "</note>"
108 ol :: DTC -> DTC
109 ol = Parent "ol" "<ol" "</ol>"
110 organization :: DTC -> DTC
111 organization = Parent "organization" "<organization" "</organization>"
112 para :: DTC -> DTC
113 para = Parent "para" "<para" "</para>"
114 q :: DTC -> DTC
115 q = Parent "q" "<q" "</q>"
116 quote :: DTC -> DTC
117 quote = Parent "quote" "<quote" "</quote>"
118 ref :: DTC -> DTC
119 ref (Empty a) = Leaf "ref" "<ref" "/>" a
120 ref x = Parent "ref" "<ref" "</ref>" x
121 reference :: DTC -> DTC
122 reference = Parent "reference" "<reference" "</reference>"
123 references :: DTC -> DTC
124 references = Parent "references" "<references" "</references>"
125 rref :: DTC -> DTC
126 rref (Empty a) = Leaf "rref" "<rref" "/>" a
127 rref x = Parent "rref" "<rref" "</rref>" x
128 section :: DTC -> DTC
129 section = Parent "section" "<section" "</section>"
130 ul :: DTC -> DTC
131 ul = Parent "ul" "<ul" "</ul>"
132
133 -- * Type 'Postal'
134 data Postal
135 = Postal
136 { postal_street :: Text
137 , postal_zipcode :: Text
138 , postal_city :: Text
139 , postal_region :: Text
140 , postal_country :: Text
141 } deriving (Eq,Show)
142 postal :: Postal -> DTC
143 postal Postal{..} =
144 Parent "postal" "<postal" "</postal>" $ do
145 Parent "street" "<street" "</street>" $ toMarkup postal_street
146 Parent "zipcode" "<zipcode" "</zipcode>" $ toMarkup postal_zipcode
147 Parent "city" "<city" "</city>" $ toMarkup postal_city
148 Parent "region" "<region" "</region>" $ toMarkup postal_region
149 Parent "country" "<country" "</country>" $ toMarkup postal_country
150
151 indentTag :: Text -> IndentTag
152 indentTag t =
153 case t of
154 "about" -> IndentTagChildren
155 "address" -> IndentTagChildren
156 "author" -> IndentTagChildren
157 "document" -> IndentTagChildren
158 "editor" -> IndentTagChildren
159 "figure" -> IndentTagChildren
160 "ol" -> IndentTagChildren
161 "postal" -> IndentTagChildren
162 "reference" -> IndentTagChildren
163 "references" -> IndentTagChildren
164 "section" -> IndentTagChildren
165 "ul" -> IndentTagChildren
166 "a" -> IndentTagText
167 "b" -> IndentTagText
168 "i" -> IndentTagText
169 "li" -> IndentTagText
170 "para" -> IndentTagText
171 "q" -> IndentTagText
172 "quote" -> IndentTagText
173 "note" -> IndentTagText
174 _ -> IndentTagPreserve
175
176 elems :: [Text]
177 elems =
178 [ "about"
179 , "abstract"
180 , "address"
181 , "alias"
182 , "annotation"
183 , "area"
184 , "artwork"
185 , "aside"
186 , "audio"
187 , "author"
188 , "authors"
189 , "bcp14"
190 , "br"
191 , "call"
192 , "city"
193 , "code"
194 , "comment"
195 , "comments"
196 , "country"
197 , "date"
198 , "dd"
199 , "define"
200 , "del"
201 , "div"
202 , "dl"
203 , "document"
204 , "dt"
205 , "editor"
206 , "email"
207 , "embed"
208 , "eref"
209 , "fax"
210 , "feed"
211 , "feedback"
212 , "figure"
213 , "filter"
214 , "format"
215 , "from"
216 , "h"
217 , "hi"
218 , "html5"
219 , "i"
220 , "index"
221 , "iref"
222 , "keyword"
223 , "li"
224 , "link"
225 , "note"
226 , "ol"
227 , "organization"
228 , "para"
229 , "postamble"
230 , "preamble"
231 , "q"
232 , "quote"
233 , "ref"
234 , "reference"
235 , "references"
236 , "region"
237 , "rref"
238 , "sc"
239 , "section"
240 , "serie"
241 , "source"
242 , "span"
243 , "street"
244 , "style"
245 , "sub"
246 , "sup"
247 , "table"
248 , "tbody"
249 , "td"
250 , "tel"
251 , "tfoot"
252 , "th"
253 , "thead"
254 , "toc"
255 , "tof"
256 , "tr"
257 , "tt"
258 , "ul"
259 , "uri"
260 , "video"
261 , "workgroup"
262 , "xml"
263 , "zipcode"
264 ]