Document.hs

module Text.XML.WraXML.Document where

import qualified Text.XML.WraXML.Tree as XmlTree
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.Format as Format



data T i name str = Cons {
   xmlDeclaration :: Maybe [Attr.T name str],
   docType :: Maybe String,
   content :: [XmlTree.T i name str]}
     deriving Show

instance
   (Name.Tag name, Name.Attribute name) =>
      Functor (T i name) where
   fmap f = lift f (map (fmap f))

lift ::
   (Name.Tag name, Name.Attribute name) =>
   (str0 -> str1) ->
   ([XmlTree.T i name str0] -> [XmlTree.T i name str1]) ->
   T i name str0 -> T i name str1
lift g f (Cons xml dtd trees) =
   Cons (fmap (map (fmap g)) xml) dtd $ f trees


formatXMLDeclaration ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   [Attr.T name string] -> ShowS
formatXMLDeclaration attrs =
   showString "<?xml" . Attr.formatListBlankHead attrs . showString "?>" .
   Format.nl

formatDocType :: String -> ShowS
formatDocType dtdStr =
   Format.angle (showString "!DOCTYPE " . showString dtdStr) .
   Format.nl

format ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   T i name string -> ShowS
format (Cons xml dtd trees) =
   maybe id formatXMLDeclaration xml .
   maybe id formatDocType dtd .
   XmlTree.formatMany trees

instance
   (Name.Tag name, Name.Attribute name, Format.C string) =>
      Format.C (T i name string) where
   run = format