Fix CSS titles and pages.

[doclang.git] / Language / DTC / Write / XML.hs

diff --git a/Language/DTC/Write/XML.hs b/Language/DTC/Write/XML.hs
index 8dcbacf6572e3314fd0278c472da5a31487e3d72..f755708b82928fe57357aa396c16e5a1e5d5c679 100644 (file)
--- a/Language/DTC/Write/XML.hs
+++ b/Language/DTC/Write/XML.hs
@@ -10,16 +10,12 @@ import Data.Function (($), (.))
 import Data.Functor ((<$>))
 import Data.Maybe (Maybe(..))
 import Data.Monoid (Monoid(..))
-import Data.Semigroup (Semigroup(..))
 import Data.Sequence (Seq)
 import Data.TreeSeq.Strict (Tree(..))
 import Text.Blaze ((!))
 import Text.Blaze.Utils
 import Text.Blaze.XML (XML)
-import qualified Data.Char as Char
 import qualified Data.Function as Fun
-import qualified Data.Map.Strict as Map
-import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 import qualified Text.Blaze as B
 import qualified Text.Blaze.DTC as XML
@@ -30,13 +26,15 @@ import Data.Locale
 import Language.DTC.Anchor (plainifyWords)
 import Language.DTC.Document as DTC hiding (XML)
 
-document :: Locales ls => LocaleIn ls -> Document -> XML
-document loc Document{..} = do
-       let lang = Text.takeWhile Char.isAlphaNum $ textLocales Map.! loc
+writeXML :: Locales ls => LocaleIn ls -> Document -> XML
+writeXML _loc Document{..} = do
        XML.xmlModel "./schema/dtc.rnc"
+       {-
+       let lang = Text.takeWhile Char.isAlphaNum $ textLocales Map.! loc
        XML.xmlStylesheet   $ "./xsl/document.html5."<>lang<>".xsl"
        XML.html5Stylesheet $ "./xsl/document.html5."<>lang<>".xsl"
        XML.atomStylesheet  $ "./xsl/document.atom."<>lang<>".xsl"
+       -}
        XML.document $ do
                xmlify head
                xmlify body
@@ -49,7 +47,7 @@ instance Xmlify TL.Text where
        xmlify = B.toMarkup
 instance Xmlify Head where
        xmlify Head{..} =
-               XML.about $ xmlify about
+               xmlify about
 instance Xmlify (Tree BodyNode) where
        xmlify (Tree n ts) =
                case n of
@@ -63,6 +61,9 @@ instance Xmlify (Tree BodyNode) where
 instance Xmlify Block where
        xmlify = \case
         BlockPara para -> xmlify para
+        BlockBreak{..} ->
+               xmlCommonAttrs attrs $
+               XML.break
         BlockToC{..} ->
                xmlCommonAttrs attrs $
                XML.toc
@@ -117,7 +118,7 @@ instance Xmlify (Tree PlainNode) where
        xmlify (Tree n ts) =
                case n of
                 PlainText t   -> xmlify t
-                PlainBR       -> XML.br
+                PlainBreak    -> XML.br
                 PlainGroup    -> xmlify ts
                 PlainB        -> XML.b    $ xmlify ts
                 PlainCode     -> XML.code $ xmlify ts
@@ -125,6 +126,7 @@ instance Xmlify (Tree PlainNode) where
                 PlainI        -> XML.i    $ xmlify ts
                 PlainNote{..} -> XML.note $ xmlify note
                 PlainQ        -> XML.q    $ xmlify ts
+                PlainSpan{..} -> xmlCommonAttrs attrs $ XML.span $ xmlify ts
                 PlainSC       -> XML.sc   $ xmlify ts
                 PlainSub      -> XML.sub  $ xmlify ts
                 PlainSup      -> XML.sup  $ xmlify ts
@@ -136,14 +138,16 @@ instance Xmlify (Tree PlainNode) where
 
 instance Xmlify About where
        xmlify About{..} = do
-               xmlify titles
-               xmlify authors
-               xmlify editor
-               xmlify date
-               forM_ version  $ XML.version . xmlify
-               forM_ keywords $ XML.keyword . xmlify
-               xmlify links
-               xmlify includes
+               XML.about
+                !?? mayAttr XA.url url
+                $ do
+                       xmlify titles
+                       xmlify authors
+                       xmlify editor
+                       xmlify date
+                       forM_ tags $ XML.tag . xmlify
+                       xmlify links
+                       xmlify includes
 instance Xmlify Include where
        xmlify Include{..} =
                XML.include True