{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE PatternGuards      #-}
{-# LANGUAGE RankNTypes         #-}
-- | DOM-based parsing and rendering.
--
-- This module requires that all entities be resolved at parsing. If you need
-- to interact with unresolved entities, please use "Text.XML.Unresolved". This
-- is the recommended module for most uses cases.
--
-- While many of the datatypes in this module are simply re-exported from
-- @Data.XML.Types@, 'Document', 'Node' and 'Element' are all redefined here to
-- disallow the possibility of unresolved entities. Conversion functions are
-- provided to switch between the two sets of datatypes.
--
-- For simpler, bidirectional traversal of the DOM tree, see the
-- "Text.XML.Cursor" module.
module Text.XML
    ( -- * Data types
      Document (..)
    , Prologue (..)
    , Instruction (..)
    , Miscellaneous (..)
    , Node (..)
    , Element (..)
    , Name (..)
    , Doctype (..)
    , ExternalID (..)
      -- * Parsing
      -- ** Files
    , readFile
      -- ** Bytes
    , parseLBS
    , parseLBS_
    , sinkDoc
      -- ** Text
    , parseText
    , parseText_
    , sinkTextDoc
      -- ** Other
    , fromEvents
    , UnresolvedEntityException (..)
    , XMLException (..)
      -- * Rendering
    , writeFile
    , renderLBS
    , renderText
    , renderBytes
      -- * Settings
    , def
      -- ** Parsing
    , ParseSettings
    , psDecodeEntities
    , P.psRetainNamespaces
      -- *** Entity decoding
    , P.decodeXmlEntities
    , P.decodeHtmlEntities
      -- ** Rendering
    , R.RenderSettings
    , R.rsPretty
    , R.rsNamespaces
    , R.rsAttrOrder
    , R.rsUseCDATA
    , R.rsXMLDeclaration
    , R.orderAttrs
      -- * Conversion
    , toXMLDocument
    , fromXMLDocument
    , toXMLNode
    , fromXMLNode
    , toXMLElement
    , fromXMLElement
    ) where

import           Conduit
import           Control.Applicative          ((<$>))
import           Control.DeepSeq              (NFData (rnf))
import           Control.Exception            (Exception, SomeException, handle,
                                               throw, throwIO)
import           Control.Monad.Trans.Resource (MonadThrow, throwM)
import           Data.ByteString              (ByteString)
import qualified Data.ByteString.Lazy         as L
import           Data.Data                    (Data)
import           Data.Either                  (partitionEithers)
import qualified Data.Map                     as Map
import           Data.Set                     (Set)
import qualified Data.Set                     as Set
import           Data.Text                    (Text)
import qualified Data.Text                    as T
import           Data.Typeable                (Typeable)
import           Data.XML.Types               (Doctype (..), ExternalID (..),
                                               Instruction (..),
                                               Miscellaneous (..), Name (..),
                                               Prologue (..))
import qualified Data.XML.Types               as X
import           Prelude                      hiding (readFile, writeFile)
import           Text.XML.Stream.Parse        (ParseSettings, def,
                                               psDecodeEntities)
import qualified Text.XML.Stream.Parse        as P
import qualified Text.XML.Stream.Render       as R
import qualified Text.XML.Unresolved          as D

import           Control.Monad.Trans.Class    (lift)
import qualified Data.Conduit.Binary          as CB
import           Data.Conduit.Lazy            (lazyConsume)
import qualified Data.Conduit.List            as CL
import qualified Data.Text.Lazy               as TL
import qualified Data.Text.Lazy.Encoding      as TLE
import           System.IO.Unsafe             (unsafePerformIO)

import           Control.Arrow                (first)
import           Data.List                    (foldl')
import           Data.Monoid                  (mappend, mempty)
import           Data.String                  (fromString)
import qualified Text.Blaze                   as B
import qualified Text.Blaze.Html              as B
import qualified Text.Blaze.Html5             as B5
import qualified Text.Blaze.Internal          as BI

data Document = Document
    { Document -> Prologue
documentPrologue :: Prologue
    , Document -> Element
documentRoot     :: Element
    , Document -> [Miscellaneous]
documentEpilogue :: [Miscellaneous]
    }
  deriving (Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> String
$cshow :: Document -> String
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Show, Document -> Document -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c== :: Document -> Document -> Bool
Eq, Typeable, Typeable Document
Document -> DataType
Document -> Constr
(forall b. Data b => b -> b) -> Document -> Document
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
forall u. (forall d. Data d => d -> u) -> Document -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Document -> m Document
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Document
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Document)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Document -> m Document
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Document -> m Document
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Document -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Document -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
gmapT :: (forall b. Data b => b -> b) -> Document -> Document
$cgmapT :: (forall b. Data b => b -> b) -> Document -> Document
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Document)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Document)
dataTypeOf :: Document -> DataType
$cdataTypeOf :: Document -> DataType
toConstr :: Document -> Constr
$ctoConstr :: Document -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Document
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Document
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
Data)

#if MIN_VERSION_containers(0, 4, 2)
instance NFData Document where
  rnf :: Document -> ()
rnf (Document Prologue
a Element
b [Miscellaneous]
c) = forall a. NFData a => a -> ()
rnf Prologue
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Element
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Miscellaneous]
c seq :: forall a b. a -> b -> b
`seq` ()
#endif

data Node
    = NodeElement Element
    | NodeInstruction Instruction
    | NodeContent Text
    | NodeComment Text
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Eq Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmax :: Node -> Node -> Node
>= :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c< :: Node -> Node -> Bool
compare :: Node -> Node -> Ordering
$ccompare :: Node -> Node -> Ordering
Ord, Typeable, Typeable Node
Node -> DataType
Node -> Constr
(forall b. Data b => b -> b) -> Node -> Node
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
forall u. (forall d. Data d => d -> u) -> Node -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapT :: (forall b. Data b => b -> b) -> Node -> Node
$cgmapT :: (forall b. Data b => b -> b) -> Node -> Node
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
dataTypeOf :: Node -> DataType
$cdataTypeOf :: Node -> DataType
toConstr :: Node -> Constr
$ctoConstr :: Node -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
Data)

#if MIN_VERSION_containers(0, 4, 2)
instance NFData Node where
  rnf :: Node -> ()
rnf (NodeElement Element
e)     = forall a. NFData a => a -> ()
rnf Element
e seq :: forall a b. a -> b -> b
`seq` ()
  rnf (NodeInstruction Instruction
i) = forall a. NFData a => a -> ()
rnf Instruction
i seq :: forall a b. a -> b -> b
`seq` ()
  rnf (NodeContent Text
t)     = forall a. NFData a => a -> ()
rnf Text
t seq :: forall a b. a -> b -> b
`seq` ()
  rnf (NodeComment Text
t)     = forall a. NFData a => a -> ()
rnf Text
t seq :: forall a b. a -> b -> b
`seq` ()
#endif

data Element = Element
    { Element -> Name
elementName       :: Name
    , Element -> Map Name Text
elementAttributes :: Map.Map Name Text
    , Element -> [Node]
elementNodes      :: [Node]
    }
  deriving (Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show, Element -> Element -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Eq Element
Element -> Element -> Bool
Element -> Element -> Ordering
Element -> Element -> Element
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Element -> Element -> Element
$cmin :: Element -> Element -> Element
max :: Element -> Element -> Element
$cmax :: Element -> Element -> Element
>= :: Element -> Element -> Bool
$c>= :: Element -> Element -> Bool
> :: Element -> Element -> Bool
$c> :: Element -> Element -> Bool
<= :: Element -> Element -> Bool
$c<= :: Element -> Element -> Bool
< :: Element -> Element -> Bool
$c< :: Element -> Element -> Bool
compare :: Element -> Element -> Ordering
$ccompare :: Element -> Element -> Ordering
Ord, Typeable, Typeable Element
Element -> DataType
Element -> Constr
(forall b. Data b => b -> b) -> Element -> Element
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
forall u. (forall d. Data d => d -> u) -> Element -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Element -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Element -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
gmapT :: (forall b. Data b => b -> b) -> Element -> Element
$cgmapT :: (forall b. Data b => b -> b) -> Element -> Element
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
dataTypeOf :: Element -> DataType
$cdataTypeOf :: Element -> DataType
toConstr :: Element -> Constr
$ctoConstr :: Element -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
Data)

#if MIN_VERSION_containers(0, 4, 2)
instance NFData Element where
  rnf :: Element -> ()
rnf (Element Name
a Map Name Text
b [Node]
c) = forall a. NFData a => a -> ()
rnf Name
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Map Name Text
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Node]
c seq :: forall a b. a -> b -> b
`seq` ()
#endif

{-
readFile :: FilePath -> ParseSettings -> IO (Either SomeException Document)
readFile_ :: FIlePath -> ParseSettings -> IO Document
-}

toXMLDocument :: Document -> X.Document
toXMLDocument :: Document -> Document
toXMLDocument = RenderSettings -> Document -> Document
toXMLDocument' forall a. Default a => a
def

toXMLDocument' :: R.RenderSettings -> Document -> X.Document
toXMLDocument' :: RenderSettings -> Document -> Document
toXMLDocument' RenderSettings
rs (Document Prologue
a Element
b [Miscellaneous]
c) = Prologue -> Element -> [Miscellaneous] -> Document
X.Document Prologue
a (RenderSettings -> Element -> Element
toXMLElement' RenderSettings
rs Element
b) [Miscellaneous]
c

toXMLElement :: Element -> X.Element
toXMLElement :: Element -> Element
toXMLElement = RenderSettings -> Element -> Element
toXMLElement' forall a. Default a => a
def

toXMLElement' :: R.RenderSettings -> Element -> X.Element
toXMLElement' :: RenderSettings -> Element -> Element
toXMLElement' RenderSettings
rs (Element Name
name Map Name Text
as [Node]
nodes) =
    Name -> [(Name, [Content])] -> [Node] -> Element
X.Element Name
name [(Name, [Content])]
as' [Node]
nodes'
  where
    as' :: [(Name, [Content])]
as' = forall a b. (a -> b) -> [a] -> [b]
map (\(Name
x, Text
y) -> (Name
x, [Text -> Content
X.ContentText Text
y])) forall a b. (a -> b) -> a -> b
$ RenderSettings -> Name -> Map Name Text -> [(Name, Text)]
R.rsAttrOrder RenderSettings
rs Name
name Map Name Text
as
    nodes' :: [Node]
nodes' = forall a b. (a -> b) -> [a] -> [b]
map (RenderSettings -> Node -> Node
toXMLNode' RenderSettings
rs) [Node]
nodes

toXMLNode :: Node -> X.Node
toXMLNode :: Node -> Node
toXMLNode = RenderSettings -> Node -> Node
toXMLNode' forall a. Default a => a
def

toXMLNode' :: R.RenderSettings -> Node -> X.Node
toXMLNode' :: RenderSettings -> Node -> Node
toXMLNode' RenderSettings
rs (NodeElement Element
e)    = Element -> Node
X.NodeElement forall a b. (a -> b) -> a -> b
$ RenderSettings -> Element -> Element
toXMLElement' RenderSettings
rs Element
e
toXMLNode' RenderSettings
_ (NodeContent Text
t)     = Content -> Node
X.NodeContent forall a b. (a -> b) -> a -> b
$ Text -> Content
X.ContentText Text
t
toXMLNode' RenderSettings
_ (NodeComment Text
c)     = Text -> Node
X.NodeComment Text
c
toXMLNode' RenderSettings
_ (NodeInstruction Instruction
i) = Instruction -> Node
X.NodeInstruction Instruction
i

fromXMLDocument :: X.Document -> Either (Set Text) Document
fromXMLDocument :: Document -> Either (Set Text) Document
fromXMLDocument (X.Document Prologue
a Element
b [Miscellaneous]
c) =
    case Element -> Either (Set Text) Element
fromXMLElement Element
b of
        Left Set Text
es  -> forall a b. a -> Either a b
Left Set Text
es
        Right Element
b' -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
Document Prologue
a Element
b' [Miscellaneous]
c

fromXMLElement :: X.Element -> Either (Set Text) Element
fromXMLElement :: Element -> Either (Set Text) Element
fromXMLElement (X.Element Name
name [(Name, [Content])]
as [Node]
nodes) =
    case ([Set Text]
lnodes, [Set Text]
las) of
        ([], []) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
Element Name
name Map Name Text
ras [Node]
rnodes
        ([Set Text]
x, [])  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
x
        ([], [Set Text]
y)  -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
y
        ([Set Text]
x, [Set Text]
y)   -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
x forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
y
  where
    enodes :: [Either (Set Text) Node]
enodes = forall a b. (a -> b) -> [a] -> [b]
map Node -> Either (Set Text) Node
fromXMLNode [Node]
nodes
    ([Set Text]
lnodes, [Node]
rnodes) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Set Text) Node]
enodes
    eas :: [Either (Set Text) (Name, Text)]
eas = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, [Content]) -> Either (Set Text) (a, Text)
go [(Name, [Content])]
as
    ([Set Text]
las, [(Name, Text)]
ras') = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Set Text) (Name, Text)]
eas
    ras :: Map Name Text
ras = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, Text)]
ras'
    go :: (a, [Content]) -> Either (Set Text) (a, Text)
go (a
x, [Content]
y) =
        case [Text] -> ([Text] -> [Text]) -> [Content] -> Either (Set Text) Text
go' [] forall a. a -> a
id [Content]
y of
            Left Set Text
es  -> forall a b. a -> Either a b
Left Set Text
es
            Right Text
y' -> forall a b. b -> Either a b
Right (a
x, Text
y')
    go' :: [Text] -> ([Text] -> [Text]) -> [Content] -> Either (Set Text) Text
go' [] [Text] -> [Text]
front []                       = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
front []
    go' [Text]
errs [Text] -> [Text]
_ []                         = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [Text]
errs
    go' [Text]
errs [Text] -> [Text]
front (X.ContentText Text
t:[Content]
ys)   = [Text] -> ([Text] -> [Text]) -> [Content] -> Either (Set Text) Text
go' [Text]
errs ([Text] -> [Text]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Text
t) [Content]
ys
    go' [Text]
errs [Text] -> [Text]
front (X.ContentEntity Text
t:[Content]
ys) = [Text] -> ([Text] -> [Text]) -> [Content] -> Either (Set Text) Text
go' (Text
t forall a. a -> [a] -> [a]
: [Text]
errs) [Text] -> [Text]
front [Content]
ys

fromXMLNode :: X.Node -> Either (Set Text) Node
fromXMLNode :: Node -> Either (Set Text) Node
fromXMLNode (X.NodeElement Element
e) = Element -> Node
NodeElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> Either (Set Text) Element
fromXMLElement Element
e
fromXMLNode (X.NodeContent (X.ContentText Text
t)) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Node
NodeContent Text
t
fromXMLNode (X.NodeContent (X.ContentEntity Text
t)) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton Text
t
fromXMLNode (X.NodeComment Text
c) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Node
NodeComment Text
c
fromXMLNode (X.NodeInstruction Instruction
i) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Instruction -> Node
NodeInstruction Instruction
i

readFile :: ParseSettings -> FilePath -> IO Document
readFile :: ParseSettings -> String -> IO Document
readFile ParseSettings
ps String
fp = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
    (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SomeException -> XMLException
InvalidXMLFile String
fp)
    (forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
CB.sourceFile String
fp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps)

data XMLException = InvalidXMLFile FilePath SomeException
    deriving Typeable

instance Show XMLException where
    show :: XMLException -> String
show (InvalidXMLFile String
fp SomeException
e) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Error parsing XML file "
        , String
fp
        , String
": "
        , forall a. Show a => a -> String
show SomeException
e
        ]
instance Exception XMLException

parseLBS :: ParseSettings -> L.ByteString -> Either SomeException Document
parseLBS :: ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
ps ByteString
lbs
  = forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (ByteString -> [ByteString]
L.toChunks ByteString
lbs)
 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps

parseLBS_ :: ParseSettings -> L.ByteString -> Document
parseLBS_ :: ParseSettings -> ByteString -> Document
parseLBS_ ParseSettings
ps = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
ps

sinkDoc :: MonadThrow m
        => ParseSettings
        -> ConduitT ByteString o m Document
sinkDoc :: forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps = forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString EventPos m ()
P.parseBytesPos ParseSettings
ps forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents

parseText :: ParseSettings -> TL.Text -> Either SomeException Document
parseText :: ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
ps Text
tl
  = forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (Text -> [Text]
TL.toChunks Text
tl)
 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT Text o m Document
sinkTextDoc ParseSettings
ps

parseText_ :: ParseSettings -> TL.Text -> Document
parseText_ :: ParseSettings -> Text -> Document
parseText_ ParseSettings
ps = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
ps

sinkTextDoc :: MonadThrow m
            => ParseSettings
            -> ConduitT Text o m Document
sinkTextDoc :: forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT Text o m Document
sinkTextDoc ParseSettings
ps = forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text EventPos m ()
P.parseTextPos ParseSettings
ps forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents

fromEvents :: MonadThrow m => ConduitT P.EventPos o m Document
fromEvents :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents = do
    Document
d <- forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
D.fromEvents
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Text -> UnresolvedEntityException
UnresolvedEntityException) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Document -> Either (Set Text) Document
fromXMLDocument Document
d

data UnresolvedEntityException = UnresolvedEntityException (Set Text)
    deriving (Int -> UnresolvedEntityException -> ShowS
[UnresolvedEntityException] -> ShowS
UnresolvedEntityException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnresolvedEntityException] -> ShowS
$cshowList :: [UnresolvedEntityException] -> ShowS
show :: UnresolvedEntityException -> String
$cshow :: UnresolvedEntityException -> String
showsPrec :: Int -> UnresolvedEntityException -> ShowS
$cshowsPrec :: Int -> UnresolvedEntityException -> ShowS
Show, Typeable)
instance Exception UnresolvedEntityException

renderBytes :: PrimMonad m => D.RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes :: forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc = forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
D.renderBytes RenderSettings
rs forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> Document
toXMLDocument' RenderSettings
rs Document
doc

writeFile :: R.RenderSettings -> FilePath -> Document -> IO ()
writeFile :: RenderSettings -> String -> Document -> IO ()
writeFile RenderSettings
rs String
fp Document
doc =
    forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitT ByteString o m ()
CB.sinkFile String
fp

renderLBS :: R.RenderSettings -> Document -> L.ByteString
renderLBS :: RenderSettings -> Document -> ByteString
renderLBS RenderSettings
rs Document
doc =
    [ByteString] -> ByteString
L.fromChunks forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO
                 -- not generally safe, but we know that runResourceT
                 -- will not deallocate any of the resources being used
                 -- by the process
                 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadActive m) =>
Source m a -> m [a]
lazyConsume
                 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc

renderText :: R.RenderSettings -> Document -> TL.Text
renderText :: RenderSettings -> Document -> Text
renderText RenderSettings
rs = ByteString -> Text
TLE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> ByteString
renderLBS RenderSettings
rs

instance B.ToMarkup Document where
    toMarkup :: Document -> Markup
toMarkup (Document Prologue
_ Element
root [Miscellaneous]
_) = Markup
B5.docType forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ToMarkup a => a -> Markup
B.toMarkup Element
root

-- | Note that the special element name
-- @{http://www.snoyman.com/xml2html}ie-cond@ with the single attribute @cond@
-- is used to indicate an IE conditional comment.
instance B.ToMarkup Element where
    toMarkup :: Element -> Markup
toMarkup (Element Name
"{http://www.snoyman.com/xml2html}ie-cond" Map Name Text
attrs [Node]
children)
      | [(Name
"cond", Text
cond)] <- forall k a. Map k a -> [(k, a)]
Map.toList Map Name Text
attrs =
        forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup (Text
"<!--[if " :: T.Text)
        forall a. Monoid a => a -> a -> a
`mappend` forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup Text
cond
        forall a. Monoid a => a -> a -> a
`mappend` forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup (Text
"]>" :: T.Text)
        forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. ToMarkup a => a -> Markup
B.toMarkup [Node]
children
        forall a. Monoid a => a -> a -> a
`mappend` forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup (Text
"<![endif]-->" :: T.Text)

    toMarkup (Element Name
name' Map Name Text
attrs [Node]
children) =
        if Bool
isVoid
            then forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall h. Attributable h => h -> Attribute -> h
(B.!) Markup
leaf [Attribute]
attrs'
            else forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall h. Attributable h => h -> Attribute -> h
(B.!) Markup -> Markup
parent [Attribute]
attrs' Markup
childrenHtml
      where
        childrenHtml :: B.Html
        childrenHtml :: Markup
childrenHtml =
            case (String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"style", String
"script"], [Node]
children) of
                (Bool
True, [NodeContent Text
t]) -> forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup Text
t
                (Bool, [Node])
_                       -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. ToMarkup a => a -> Markup
B.toMarkup [Node]
children

        isVoid :: Bool
isVoid = Name -> Text
nameLocalName Name
name' forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
voidElems

        parent :: B.Html -> B.Html
        parent :: Markup -> Markup
parent = forall a.
StaticString
-> StaticString -> StaticString -> MarkupM a -> MarkupM a
BI.Parent StaticString
tag StaticString
open StaticString
close
        leaf :: B.Html
#if MIN_VERSION_blaze_markup(0,8,0)
        leaf :: Markup
leaf = forall a.
StaticString -> StaticString -> StaticString -> a -> MarkupM a
BI.Leaf StaticString
tag StaticString
open (forall a. IsString a => String -> a
fromString String
" />") ()
#else
        leaf = BI.Leaf tag open (fromString " />")
#endif

        name :: String
name = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Name -> Text
nameLocalName Name
name'
        tag :: StaticString
tag = forall a. IsString a => String -> a
fromString String
name
        open :: StaticString
open = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Char
'<' forall a. a -> [a] -> [a]
: String
name
        close :: StaticString
close = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"</", String
name, String
">"]

        attrs' :: [B.Attribute]
        attrs' :: [Attribute]
attrs' = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. ToValue a => (Text, a) -> Attribute
goAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> Text
nameLocalName) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map Name Text
attrs
        goAttr :: (Text, a) -> Attribute
goAttr (Text
key, a
value) = Tag -> AttributeValue -> Attribute
B.customAttribute (Text -> Tag
B.textTag Text
key) forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
B.toValue a
value

instance B.ToMarkup Node where
    toMarkup :: Node -> Markup
toMarkup (NodeElement Element
e) = forall a. ToMarkup a => a -> Markup
B.toMarkup Element
e
    toMarkup (NodeContent Text
t) = forall a. ToMarkup a => a -> Markup
B.toMarkup Text
t
    toMarkup Node
_               = forall a. Monoid a => a
mempty

voidElems :: Set.Set T.Text
voidElems :: Set Text
voidElems = forall a. Eq a => [a] -> Set a
Set.fromAscList forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"area base br col command embed hr img input keygen link meta param source track wbr"