import qualified Text.Blaze.Internal as B
import Data.Locale
-import Hdoc.DTC.Anchor (plainifyWords)
-import Hdoc.DTC.Document as DTC hiding (XML)
+import Hdoc.DTC.Analyze.Index (plainifyWords)
+import Hdoc.DTC.Document as DTC
writeXML :: Locales ls => LocaleIn ls -> Document -> XML
writeXML _loc Document{..} = do
XML.atomStylesheet $ "./xsl/document.atom."<>lang<>".xsl"
-}
XML.document $ do
- xmlify head
- xmlify body
+ forM_ document_head xmlify
+ xmlify document_body
-- * Class 'Xmlify'
class Xmlify a where
xmlify = B.toMarkup
instance Xmlify Head where
xmlify Head{..} =
- xmlify about
+ mempty
+ -- TODO: xmlify head_section
instance Xmlify (Tree BodyNode) where
xmlify (Tree n ts) =
case n of
BodyBlock b -> xmlify b
- BodySection{..} ->
- xmlCommonAttrs attrs $
+ BodySection Section{..} ->
+ xmlCommonAttrs section_attrs $
XML.section $ do
- xmlify title
- forM_ aliases xmlify
+ xmlify section_about
xmlify ts
instance Xmlify Block where
xmlify = \case
xmlCommonAttrs attrs $
XML.index $ do
XML.ul $
- forM_ terms $ \aliases ->
+ forM_ index $ \aliases ->
XML.li $
xmlify $
TL.unlines $
xmlify = \case
Judgment{..} ->
XML.judgment
- ! XA.judges (attrify judges)
- ! XA.grades (attrify grades) $
- xmlify question
- -- TODO: xmlify choices
+ ! XA.judges (attrify judgment_judgesId)
+ ! XA.grades (attrify judgment_gradesId) $
+ xmlify judgment_question
+ -- TODO: xmlify judgment_choices
instance Xmlify ListItem where
xmlify ListItem{..} =
XML.li ! XA.name (attrify name) $ xmlify paras
PlainCode -> XML.code $ xmlify ts
PlainDel -> XML.del $ xmlify ts
PlainI -> XML.i $ xmlify ts
- PlainNote{..} -> XML.note $ xmlify note
+ PlainNote{..} -> XML.note $ xmlify note_paras
PlainQ -> XML.q $ xmlify ts
PlainSpan{..} -> xmlCommonAttrs attrs $ XML.span $ xmlify ts
PlainSC -> XML.sc $ xmlify ts
PlainSup -> XML.sup $ xmlify ts
PlainU -> XML.u $ xmlify ts
PlainEref to -> XML.eref ! XA.to (attrify to) $ xmlify ts
- PlainIref{..} -> XML.iref ! XA.term (attrify $ plainifyWords term) $ xmlify ts
- PlainRef to -> XML.ref ! XA.to (attrify $ unIdent to) $ xmlify ts
- PlainRref{..} -> XML.rref ! XA.to (attrify $ unIdent to) $ xmlify ts
+ PlainIref{..} -> XML.iref ! XA.term (attrify $ plainifyWords iref_term) $ xmlify ts
+ PlainAt{..} -> (if at_back then XML.at_back else XML.at)
+ ! XA.to (attrify at_ident) $ xmlify ts
+ PlainTag{..} -> (if tag_back then XML.tag_back else XML.at)
+ ! XA.to (attrify tag_ident) $ xmlify ts
+ PlainRef{..} -> XML.ref ! XA.to (attrify ref_ident) $ xmlify ts
instance Xmlify About where
xmlify About{..} = do
- XML.about
- !?? mayAttr XA.url url
- $ do
- xmlify titles
- xmlify authors
- xmlify editor
- xmlify date
- forM_ tags $ XML.tag . xmlify
- xmlify links
- xmlify includes
+ XML.about $ do
+ xmlify about_titles
+ xmlify about_aliases
+ forM_ about_authors xmlify
+ forM_ about_dates xmlify
+ forM_ about_tags $ XML.tag . xmlify
+ forM_ about_links xmlify
+ xmlify about_description
+ xmlify about_judgments
instance Xmlify Include where
xmlify Include{..} =
XML.include True
- ! XA.href (attrify href)
+ ! XA.href (attrify include_href)
instance Xmlify Date where
xmlify Date{..} =
XML.date
- ! XA.year (attrify year)
- !?? mayAttr XA.month month
- !?? mayAttr XA.day day
+ ! XA.year (attrify date_year)
+ !?? mayAttr XA.rel date_rel
+ !?? mayAttr XA.role date_role
+ !?? mayAttr XA.month date_month
+ !?? mayAttr XA.day date_day
instance Xmlify Link where
xmlify Link{..} =
XML.link
- !?? mayAttr XA.name name
- !?? mayAttr XA.rel rel
- !?? mayAttr XA.href href
- $ xmlify plain
+ !?? mayAttr XA.rel link_rel
+ !?? mayAttr XA.role link_role
+ !?? mayAttr XA.href link_url
+ -- !?? mayAttr XA.type_ link_type
+ $ xmlify link_plain
instance Xmlify Entity where
xmlify Entity{..} =
XML.entity
- !?? mayAttr XA.name name
- !?? mayAttr XA.street street
- !?? mayAttr XA.zipcode zipcode
- !?? mayAttr XA.city city
- !?? mayAttr XA.region region
- !?? mayAttr XA.country country
- !?? mayAttr XA.email email
- !?? mayAttr XA.tel tel
- !?? mayAttr XA.fax fax
+ !?? mayAttr XA.rel entity_rel
+ !?? mayAttr XA.role entity_role
+ !?? mayAttr XA.name entity_name
+ !?? mayAttr XA.street entity_street
+ !?? mayAttr XA.zipcode entity_zipcode
+ !?? mayAttr XA.city entity_city
+ !?? mayAttr XA.region entity_region
+ !?? mayAttr XA.country entity_country
+ !?? mayAttr XA.email entity_email
+ !?? mayAttr XA.tel entity_tel
+ !?? mayAttr XA.fax entity_fax
+ $ xmlify entity_org
instance Xmlify Title where
xmlify (Title t) = XML.title $ xmlify t
instance Xmlify Alias where
- xmlify Alias{..} = XML.alias !?? mayAttr XA.id id
+ xmlify Alias{..} =
+ xmlCommonAttrs alias_attrs $
+ XML.alias $
+ xmlify alias_title
instance Xmlify Reference where
xmlify Reference{..} = XML.reference mempty -- TODO: to be coded
xmlId (Ident i) = XA.id $ attrify i
xmlCommonAttrs :: CommonAttrs -> XML -> XML
-xmlCommonAttrs CommonAttrs{id=ident, ..} =
- (case ident of
+xmlCommonAttrs CommonAttrs{..} =
+ (case attrs_id of
Nothing -> Fun.id
Just (Ident i) ->
B.AddCustomAttribute "id" $
B.String $ TL.unpack i) .
- case classes of
+ case attrs_classes of
[] -> Fun.id
_ ->
B.AddCustomAttribute "class" $
- B.String $ TL.unpack $ TL.unwords classes
+ B.String $ TL.unpack $ TL.unwords attrs_classes
sourcephile / git / doclang.git / blobdiff