module Text.HTML.WraXML.Document (
   XmlDoc.T(..), XmlDoc.lift,
   decodeAdaptive, format,
   ) where

import qualified Text.HTML.WraXML.Tree    as HtmlTree
import qualified Text.XML.WraXML.Document as XmlDoc
import qualified Text.XML.WraXML.String  as XmlString
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.Format as Format
import qualified Text.HTML.Basic.String as HtmlStringB
import qualified Text.HTML.Basic.Character as HtmlChar

import Control.Monad.Trans.State (State, put, get, )

import Control.Applicative (liftA2, )
import Data.Traversable (traverse, )


format ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   XmlDoc.T i name string -> ShowS
format :: forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> ShowS
format (XmlDoc.Cons Maybe [T name string]
xml Maybe String
dtd [T i name string]
trees) =
   let ([T i name string] -> ShowS
formatHTML, ShowS
formatXMLDecl) =
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (forall name string i.
(Tag name, Attribute name, C string) =>
[T i name string] -> ShowS
HtmlTree.formatMany, forall a. a -> a
id)
             (\[T name string]
xmlDecl ->
                 (forall name string i.
(Tag name, Attribute name, C string) =>
[T i name string] -> ShowS
HtmlTree.formatManyXHTML,
                  forall name string.
(Tag name, Attribute name, C string) =>
[T name string] -> ShowS
XmlDoc.formatXMLDeclaration [T name string]
xmlDecl)) Maybe [T name string]
xml
   in  ShowS
formatXMLDecl forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id String -> ShowS
XmlDoc.formatDocType Maybe String
dtd forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall {i}. [T i name string] -> ShowS
formatHTML [T i name string]
trees


decodeAdaptive ::
   (Name.Attribute name, Name.Tag name) =>
   (XmlString.Encoding -> XmlString.Encoded -> String) ->
   XmlDoc.T i name [HtmlChar.T] ->
   State (XmlString.Encoded -> String) (XmlDoc.T i name String)
decodeAdaptive :: forall name i.
(Attribute name, Tag name) =>
(String -> ShowS) -> T i name [T] -> State ShowS (T i name String)
decodeAdaptive String -> ShowS
getDecoder (XmlDoc.Cons Maybe [T name [T]]
xml0 Maybe String
dtd [T i name [T]]
trees0) =
   forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
      (\Maybe [T name String]
xml1 [T i name String]
trees1 -> forall i name str.
Maybe [T name str]
-> Maybe String -> [T i name str] -> T i name str
XmlDoc.Cons Maybe [T name String]
xml1 Maybe String
dtd [T i name String]
trees1)
      (do ShowS
decoder <- forall (m :: * -> *) s. Monad m => StateT s m s
get
          let xml1 :: Maybe [T name String]
xml1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> [T] -> String
HtmlStringB.decode ShowS
decoder))) Maybe [T name [T]]
xml0
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (forall (m :: * -> *) a. Monad m => a -> m a
return ())
             (forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
getDecoder) forall a b. (a -> b) -> a -> b
$
             forall name string.
Attribute name =>
Name name -> [T name string] -> Maybe string
Attr.lookup forall name. Attribute name => Name name
Attr.encodingName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [T name String]
xml1
          forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [T name String]
xml1)
      (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall name i.
(Attribute name, Tag name) =>
(String -> ShowS) -> T i name [T] -> State ShowS (T i name String)
HtmlTree.decodeAdaptive String -> ShowS
getDecoder) [T i name [T]]
trees0)