{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
module Text.XML
(
Document (..)
, Prologue (..)
, Instruction (..)
, Miscellaneous (..)
, Node (..)
, Element (..)
, Name (..)
, Doctype (..)
, ExternalID (..)
, readFile
, parseLBS
, parseLBS_
, sinkDoc
, parseText
, parseText_
, sinkTextDoc
, fromEvents
, UnresolvedEntityException (..)
, XMLException (..)
, writeFile
, renderLBS
, renderText
, renderBytes
, def
, ParseSettings
, psDecodeEntities
, P.psRetainNamespaces
, P.decodeXmlEntities
, P.decodeHtmlEntities
, R.RenderSettings
, R.rsPretty
, R.rsNamespaces
, R.rsAttrOrder
, R.rsUseCDATA
, R.rsXMLDeclaration
, R.orderAttrs
, 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
| 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
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
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
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"