1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 module Language.DTC.Write.XML where
6 import Control.Monad (forM_)
8 import Data.Foldable (Foldable(..))
9 import Data.Function (($), (.))
10 import Data.Functor ((<$>))
11 import Data.Maybe (Maybe(..))
12 import Data.Monoid (Monoid(..))
13 import Data.Semigroup (Semigroup(..))
14 import Data.Sequence (Seq)
15 import Data.TreeSeq.Strict (Tree(..))
16 import Text.Blaze ((!))
17 import Text.Blaze.Utils
18 import Text.Blaze.XML (XML)
19 import qualified Data.Char as Char
20 import qualified Data.Function as Fun
21 import qualified Data.Map.Strict as Map
22 import qualified Data.Text as Text
23 import qualified Data.Text.Lazy as TL
24 import qualified Text.Blaze as B
25 import qualified Text.Blaze.DTC as XML
26 import qualified Text.Blaze.DTC.Attributes as XA
27 import qualified Text.Blaze.Internal as B
30 import Language.DTC.Document (MayText(..), whenMayText)
31 import Language.DTC.Anchor (plainifyWords)
32 import Language.DTC.Document as DTC hiding (XML)
34 document :: Locales ls => LocaleIn ls -> Document -> XML
35 document loc Document{..} = do
36 let lang = Text.takeWhile Char.isAlphaNum $ textLocales Map.! loc
37 XML.xmlModel "./schema/dtc.rnc"
38 XML.xmlStylesheet $ "./xsl/document.html5."<>lang<>".xsl"
39 XML.html5Stylesheet $ "./xsl/document.html5."<>lang<>".xsl"
40 XML.atomStylesheet $ "./xsl/document.atom."<>lang<>".xsl"
49 instance Xmlify TL.Text where
51 instance Xmlify Head where
53 XML.about $ xmlify about
54 instance Xmlify (Tree BodyNode) where
57 BodyBlock b -> xmlify b
59 xmlCommonAttrs attrs $
64 instance Xmlify Block where
66 BlockPara para -> xmlify para
68 xmlCommonAttrs attrs $
70 !?? mayAttr XA.depth depth
72 xmlCommonAttrs attrs $
78 xmlCommonAttrs attrs $
81 forM_ terms $ \aliases ->
85 plainifyWords <$> aliases
87 xmlCommonAttrs attrs $
89 ! XA.type_ (attrify type_) $ do
92 BlockReferences{..} ->
93 xmlCommonAttrs attrs $
94 XML.references $ xmlify refs
95 instance Xmlify Para where
97 ParaItem{..} -> xmlify item
98 ParaItems{..} -> xmlCommonAttrs attrs $ XML.para $ xmlify items
99 instance Xmlify ParaItem where
101 ParaPlain p -> XML.p $ xmlify p
103 XML.comment $ TL.toStrict c
106 ! XA.type_ (attrify type_) $ do
110 ! XA.type_ (attrify type_) $ do
112 ParaOL items -> XML.ol $ forM_ items $ XML.li . xmlify
113 ParaUL items -> XML.ul $ forM_ items $ XML.li . xmlify
114 instance Xmlify (Tree PlainNode) where
117 PlainText t -> xmlify t
119 PlainGroup -> xmlify ts
120 PlainB -> XML.b $ xmlify ts
121 PlainCode -> XML.code $ xmlify ts
122 PlainDel -> XML.del $ xmlify ts
123 PlainI -> XML.i $ xmlify ts
124 PlainNote{..} -> XML.note $ xmlify note
125 PlainQ -> XML.q $ xmlify ts
126 PlainSC -> XML.sc $ xmlify ts
127 PlainSub -> XML.sub $ xmlify ts
128 PlainSup -> XML.sup $ xmlify ts
129 PlainU -> XML.u $ xmlify ts
130 PlainEref to -> XML.eref ! XA.to (attrify to) $ xmlify ts
131 PlainIref{..} -> XML.iref ! XA.term (attrify $ plainifyWords term) $ xmlify ts
132 PlainRef to -> XML.ref ! XA.to (attrify to) $ xmlify ts
133 PlainRref{..} -> XML.rref ! XA.to (attrify to) $ xmlify ts
135 instance Xmlify About where
136 xmlify About{..} = do
141 whenMayText version $ XML.version . xmlify
142 forM_ keywords $ XML.keyword . xmlify
145 instance Xmlify Include where
148 ! XA.href (attrify href)
149 instance Xmlify Date where
152 ! XA.year (attrify year)
153 !?? mayAttr XA.month month
154 !?? mayAttr XA.day day
155 instance Xmlify Link where
158 !?? mayAttr XA.name name
159 !?? mayAttr XA.rel rel
160 !?? mayAttr XA.href href
162 instance Xmlify Entity where
165 !?? mayAttr XA.name name
166 !?? mayAttr XA.street street
167 !?? mayAttr XA.zipcode zipcode
168 !?? mayAttr XA.city city
169 !?? mayAttr XA.region region
170 !?? mayAttr XA.country country
171 !?? mayAttr XA.email email
172 !?? mayAttr XA.tel tel
173 !?? mayAttr XA.fax fax
174 instance Xmlify Title where
175 xmlify (Title t) = XML.title $ xmlify t
176 instance Xmlify Alias where
177 xmlify Alias{..} = XML.alias !?? mayAttr XA.id id
178 instance Xmlify Reference where
179 xmlify Reference{..} = XML.reference mempty -- TODO: to be coded
181 instance Xmlify MayText where
182 xmlify (MayText t) = xmlify t
183 instance Xmlify a => Xmlify (Maybe a) where
184 xmlify = foldMap xmlify
185 instance Xmlify a => Xmlify [a] where
186 xmlify = foldMap xmlify
187 instance Xmlify a => Xmlify (Seq a) where
188 xmlify = foldMap xmlify
190 xmlId :: Ident -> B.Attribute
191 xmlId (Ident i) = XA.id $ attrify i
193 xmlCommonAttrs :: CommonAttrs -> XML -> XML
194 xmlCommonAttrs CommonAttrs{id=ident, ..} =
198 B.AddCustomAttribute "id" $
199 B.String $ TL.unpack i) .
203 B.AddCustomAttribute "class" $
204 B.String $ TL.unpack $ TL.unwords classes