]> Git — Sourcephile - doclang.git/blob - Text/Blaze/DTC.hs
Update to megaparsec-7 and new symantic-xml
[doclang.git] / Text / Blaze / DTC.hs
1 {-# LANGUAGE OverloadedLists #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 module Text.Blaze.DTC where
5
6 import Data.Bool
7 import Data.Text (Text)
8 import Text.Blaze
9 import Text.Blaze.Internal
10 import qualified Language.Symantic.XML as XML
11 import qualified Data.Text.Lazy as TL
12
13 import Text.Blaze.Utils
14 import Text.Blaze.XML (XML)
15
16 import Hdoc.DTC.Document
17
18 -- * Type 'DTC'
19 type DTC = XML
20
21 xmlns_dtc :: XML.Namespace
22 xmlns_dtc = XML.Namespace (TL.pack "http://commonsoft.org/xml/2018/dtc.rnc")
23
24 xmlModel :: Text -> DTC
25 xmlModel rnc =
26 Leaf "xml-model" "<?xml-model" "?>\n" ()
27 ! attribute "type" " type=\"" "application/relax-ng-compact-syntax"
28 ! attribute "href" " href=\"" (attrify rnc)
29
30 xmlStylesheet :: Text -> DTC
31 xmlStylesheet xsl =
32 Leaf "xml-stylesheet" "<?xml-stylesheet" "?>\n" ()
33 ! attribute "type" " type=\"" "text/xsl"
34 ! attribute "href" " href=\"" (attrify xsl)
35
36 html5Stylesheet :: Text -> DTC
37 html5Stylesheet xsl =
38 Leaf "html5-stylesheet" "<?html5-stylesheet" "?>\n" ()
39 ! attribute "type" " type=\"" "text/xsl"
40 ! attribute "href" " href=\"" (attrify xsl)
41
42 atomStylesheet :: Text -> DTC
43 atomStylesheet xsl =
44 Leaf "atom-stylesheet" "<?atom-stylesheet" "?>\n" ()
45 ! attribute "type" " type=\"" "text/xsl"
46 ! attribute "href" " href=\"" (attrify xsl)
47
48 about :: DTC -> DTC
49 about = Parent "about" "<about" "</about>"
50 alias :: DTC -> DTC
51 alias = Parent "alias" "<alias" "</alias>"
52 at :: DTC -> DTC
53 at = Parent "at" "<at" "</at>"
54 at_back :: DTC -> DTC
55 at_back = Parent "at-back" "<at-back" "</at-back>"
56 artwork :: DTC -> DTC
57 artwork = Parent "artwork" "<artwork" "</artwork>"
58 aside :: DTC -> DTC
59 aside = Parent "aside" "<aside" "</aside>"
60 author :: DTC -> DTC
61 author = Parent "author" "<author" "</author>"
62 b :: DTC -> DTC
63 b = Parent "b" "<b" "</b>"
64 br :: DTC
65 br = Leaf "br" "<br" " />" ()
66 break :: DTC
67 break = Leaf "break" "<break" " />" ()
68 call :: DTC -> DTC
69 call = Parent "call" "<call" "</call>"
70 code :: DTC -> DTC
71 code = Parent "code" "<code" "</code>"
72 comment :: Text -> DTC
73 comment t = Comment (Text t) ()
74 date :: DTC
75 date = Leaf "date" "<date" "/>" ()
76 define :: DTC -> DTC
77 define = Parent "define" "<define" "</define>"
78 del :: DTC -> DTC
79 del = Parent "del" "<del" "</del>"
80 document :: DTC -> DTC
81 document = Parent "document" "<document" "</document>"
82 editor :: DTC -> DTC
83 editor = Parent "editor" "<editor" "</editor>"
84 email :: DTC -> DTC
85 email = Parent "email" "<email" "</email>"
86 entity :: DTC -> DTC
87 entity = Parent "entity" "<entity" "</entity>"
88 eref :: DTC -> DTC
89 -- eref (Empty a) = Leaf "eref" "<eref" "/>" a
90 eref = Parent "eref" "<eref" "</eref>"
91 figure :: DTC -> DTC
92 figure = Parent "figure" "<figure" "</figure>"
93 grades :: DTC -> DTC
94 grades = Parent "grades" "<grades" "</grades>"
95 head :: DTC -> DTC
96 head = Parent "head" "<head" "</head>"
97 i :: DTC -> DTC
98 i = Parent "i" "<i" "</i>"
99 include :: Bool -> DTC
100 include inc =
101 Leaf "include" "<include" "/>" ()
102 !? (not inc, attribute "include" " include=\"" "no")
103 index :: DTC -> DTC
104 index = Parent "index" "<index" "</index>"
105 iref :: DTC -> DTC
106 -- iref (Empty a) = Leaf "iref" "<iref" "/>" a
107 iref = Parent "iref" "<iref" "</iref>"
108 judges :: DTC -> DTC
109 judges = Parent "judges" "<judges" "</judges>"
110 judgment :: DTC -> DTC
111 judgment = Parent "judgment" "<judgment" "</judgment>"
112 li :: DTC -> DTC
113 li = Parent "li" "<li" "</li>"
114 link :: DTC -> DTC
115 link = Parent "link" "<link" "</link>"
116 macro :: DTC -> DTC
117 macro = Parent "macro" "<macro" "</macro>"
118 note :: DTC -> DTC
119 note = Parent "note" "<note" "</note>"
120 ol :: DTC -> DTC
121 ol = Parent "ol" "<ol" "</ol>"
122 org :: DTC -> DTC
123 org = Parent "org" "<org" "</org>"
124 p :: DTC -> DTC
125 p = Parent "p" "<p" "</p>"
126 page_ref :: DTC -> DTC
127 page_ref = Parent "page-ref" "<page-ref" "</page-ref>"
128 para :: DTC -> DTC
129 para = Parent "para" "<para" "</para>"
130 q :: DTC -> DTC
131 q = Parent "q" "<q" "</q>"
132 quote :: DTC -> DTC
133 quote = Parent "quote" "<quote" "</quote>"
134 ref :: DTC -> DTC
135 -- ref (Empty a) = Leaf "ref" "<ref" "/>" a
136 ref x = Parent "ref" "<ref" "</ref>" x
137 reference :: DTC -> DTC
138 reference = Parent "reference" "<reference" "</reference>"
139 references :: DTC -> DTC
140 references = Parent "references" "<references" "</references>"
141 refs :: DTC -> DTC
142 refs = Parent "refs" "<refs" "</refs>"
143 sc :: DTC -> DTC
144 sc = Parent "sc" "<sc" "</sc>"
145 section :: DTC -> DTC
146 section = Parent "section" "<section" "</section>"
147 span :: DTC -> DTC
148 span = Parent "span" "<span" "</span>"
149 sub :: DTC -> DTC
150 sub = Parent "sub" "<sub" "</sub>"
151 sup :: DTC -> DTC
152 sup = Parent "sup" "<sup" "</sup>"
153 tag :: DTC -> DTC
154 -- tag (Empty a) = Leaf "tag" "<tag" "/>" a
155 tag = Parent "tag" "<tag" "</tag>"
156 tag_back :: DTC -> DTC
157 tag_back = Parent "tag-back" "<tag-back" "</tag-back>"
158 title :: DTC -> DTC
159 title = Parent "title" "<title" "</title>"
160 toc :: DTC
161 toc = Leaf "toc" "<toc" "/>" ()
162 tof :: DTC -> DTC
163 tof = Parent "tof" "<tof" "</tof>"
164 u :: DTC -> DTC
165 u = Parent "u" "<u" "</u>"
166 ul :: DTC -> DTC
167 ul = Parent "ul" "<ul" "</ul>"
168 version :: DTC -> DTC
169 version = Parent "version" "<version" "</version>"
170
171 isInlinedElement :: Text -> Bool
172 isInlinedElement = \case
173 "a" -> True
174 "b" -> True
175 "br" -> True
176 "code" -> True
177 "em" -> True
178 "i" -> True
179 "note" -> True
180 "q" -> True
181 "u" -> True
182 "sup" -> True
183 "sub" -> True
184 _ -> False
185
186 instance Attrify Name where
187 attrify (Name a) = attrify a
188 instance MayAttr Name where
189 mayAttr a (Name t) = mayAttr a t