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 ed7bc81442f0fee1ce0ae0f5ae901309c88f0b6a..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
@@ -27,17 +23,18 @@ import qualified Text.Blaze.DTC.Attributes as XA
 import qualified Text.Blaze.Internal as B
 
 import Data.Locale
-import Language.DTC.Document (MayText(..), whenMayText)
 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
@@ -50,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
@@ -64,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
@@ -109,13 +109,16 @@ instance Xmlify ParaItem where
                XML.quote
                 ! XA.type_ (attrify type_) $ do
                        xmlify paras
-        ParaOL items -> XML.ol $ forM_ items $ XML.li . xmlify
+        ParaOL items -> XML.ol $ forM_ items xmlify
         ParaUL items -> XML.ul $ forM_ items $ XML.li . xmlify
+instance Xmlify ListItem where
+       xmlify ListItem{..} =
+               XML.li ! XA.name (attrify name) $ xmlify paras
 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
@@ -123,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
@@ -134,14 +138,16 @@ instance Xmlify (Tree PlainNode) where
 
 instance Xmlify About where
        xmlify About{..} = do
-               xmlify titles
-               xmlify authors
-               xmlify editor
-               xmlify date
-               whenMayText 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
@@ -178,8 +184,6 @@ instance Xmlify Alias where
 instance Xmlify Reference where
        xmlify Reference{..} = XML.reference mempty -- TODO: to be coded
 
-instance Xmlify MayText where
-       xmlify (MayText t) = xmlify t
 instance Xmlify a => Xmlify (Maybe a) where
        xmlify = foldMap xmlify
 instance Xmlify a => Xmlify [a] where