{-# 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
(Int -> Document -> ShowS)
-> (Document -> String) -> ([Document] -> ShowS) -> Show Document
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
(Document -> Document -> Bool)
-> (Document -> Document -> Bool) -> Eq Document
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
DataType
Constr
Typeable Document
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Document -> c Document)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Document)
-> (Document -> Constr)
-> (Document -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Document -> Document)
-> (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 u. (forall d. Data d => d -> u) -> Document -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Document -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Document -> m Document)
-> Data Document
Document -> DataType
Document -> Constr
(forall b. Data b => b -> b) -> Document -> Document
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cDocument :: Constr
$tDocument :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Document -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
gmapQ :: (forall d. Data d => d -> u) -> Document -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Document -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Document
Data)

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

data Node
    = NodeElement Element
    | NodeInstruction Instruction
    | NodeContent Text
    | NodeComment Text
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
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
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
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
Eq Node
-> (Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord 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
$cp1Ord :: Eq Node
Ord, Typeable, Typeable Node
DataType
Constr
Typeable Node
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Node -> c Node)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Node)
-> (Node -> Constr)
-> (Node -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Node -> Node)
-> (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 u. (forall d. Data d => d -> u) -> Node -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Node -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Node -> m Node)
-> Data Node
Node -> DataType
Node -> Constr
(forall b. Data b => b -> b) -> Node -> Node
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cNodeComment :: Constr
$cNodeContent :: Constr
$cNodeInstruction :: Constr
$cNodeElement :: Constr
$tNode :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Node -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
gmapQ :: (forall d. Data d => d -> u) -> Node -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Node
Data)

#if MIN_VERSION_containers(0, 4, 2)
instance NFData Node where
  rnf :: Node -> ()
rnf (NodeElement Element
e)     = Element -> ()
forall a. NFData a => a -> ()
rnf Element
e () -> () -> ()
`seq` ()
  rnf (NodeInstruction Instruction
i) = Instruction -> ()
forall a. NFData a => a -> ()
rnf Instruction
i () -> () -> ()
`seq` ()
  rnf (NodeContent Text
t)     = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t () -> () -> ()
`seq` ()
  rnf (NodeComment Text
t)     = Text -> ()
forall a. NFData a => a -> ()
rnf Text
t () -> () -> ()
`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
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
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
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
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
Eq Element
-> (Element -> Element -> Ordering)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Bool)
-> (Element -> Element -> Element)
-> (Element -> Element -> Element)
-> Ord 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
$cp1Ord :: Eq Element
Ord, Typeable, Typeable Element
DataType
Constr
Typeable Element
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Element -> c Element)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Element)
-> (Element -> Constr)
-> (Element -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Element -> Element)
-> (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 u. (forall d. Data d => d -> u) -> Element -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Element -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Element -> m Element)
-> Data Element
Element -> DataType
Element -> Constr
(forall b. Data b => b -> b) -> Element -> Element
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cElement :: Constr
$tElement :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Element -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
gmapQ :: (forall d. Data d => d -> u) -> Element -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Element -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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) = Name -> ()
forall a. NFData a => a -> ()
rnf Name
a () -> () -> ()
`seq` Map Name Text -> ()
forall a. NFData a => a -> ()
rnf Map Name Text
b () -> () -> ()
`seq` [Node] -> ()
forall a. NFData a => a -> ()
rnf [Node]
c () -> () -> ()
`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' RenderSettings
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' RenderSettings
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' = ((Name, Text) -> (Name, [Content]))
-> [(Name, Text)] -> [(Name, [Content])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
x, Text
y) -> (Name
x, [Text -> Content
X.ContentText Text
y])) ([(Name, Text)] -> [(Name, [Content])])
-> [(Name, Text)] -> [(Name, [Content])]
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' = (Node -> Node) -> [Node] -> [Node]
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' RenderSettings
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 (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Element -> Element
toXMLElement' RenderSettings
rs Element
e
toXMLNode' RenderSettings
_ (NodeContent Text
t)     = Content -> Node
X.NodeContent (Content -> Node) -> Content -> Node
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  -> Set Text -> Either (Set Text) Document
forall a b. a -> Either a b
Left Set Text
es
        Right Element
b' -> Document -> Either (Set Text) Document
forall a b. b -> Either a b
Right (Document -> Either (Set Text) Document)
-> Document -> Either (Set Text) Document
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
        ([], []) -> Element -> Either (Set Text) Element
forall a b. b -> Either a b
Right (Element -> Either (Set Text) Element)
-> Element -> Either (Set Text) Element
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, [])  -> Set Text -> Either (Set Text) Element
forall a b. a -> Either a b
Left (Set Text -> Either (Set Text) Element)
-> Set Text -> Either (Set Text) Element
forall a b. (a -> b) -> a -> b
$ [Set Text] -> Set Text
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
x
        ([], [Set Text]
y)  -> Set Text -> Either (Set Text) Element
forall a b. a -> Either a b
Left (Set Text -> Either (Set Text) Element)
-> Set Text -> Either (Set Text) Element
forall a b. (a -> b) -> a -> b
$ [Set Text] -> Set Text
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
y
        ([Set Text]
x, [Set Text]
y)   -> Set Text -> Either (Set Text) Element
forall a b. a -> Either a b
Left (Set Text -> Either (Set Text) Element)
-> Set Text -> Either (Set Text) Element
forall a b. (a -> b) -> a -> b
$ [Set Text] -> Set Text
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
x Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` [Set Text] -> Set Text
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Text]
y
  where
    enodes :: [Either (Set Text) Node]
enodes = (Node -> Either (Set Text) Node)
-> [Node] -> [Either (Set Text) Node]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Either (Set Text) Node
fromXMLNode [Node]
nodes
    ([Set Text]
lnodes, [Node]
rnodes) = [Either (Set Text) Node] -> ([Set Text], [Node])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Set Text) Node]
enodes
    eas :: [Either (Set Text) (Name, Text)]
eas = ((Name, [Content]) -> Either (Set Text) (Name, Text))
-> [(Name, [Content])] -> [Either (Set Text) (Name, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [Content]) -> Either (Set Text) (Name, Text)
forall a. (a, [Content]) -> Either (Set Text) (a, Text)
go [(Name, [Content])]
as
    ([Set Text]
las, [(Name, Text)]
ras') = [Either (Set Text) (Name, Text)] -> ([Set Text], [(Name, Text)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Set Text) (Name, Text)]
eas
    ras :: Map Name Text
ras = [(Name, Text)] -> Map Name Text
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' [] [Text] -> [Text]
forall a. a -> a
id [Content]
y of
            Left Set Text
es  -> Set Text -> Either (Set Text) (a, Text)
forall a b. a -> Either a b
Left Set Text
es
            Right Text
y' -> (a, Text) -> Either (Set Text) (a, Text)
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 []                       = Text -> Either (Set Text) Text
forall a b. b -> Either a b
Right (Text -> Either (Set Text) Text) -> Text -> Either (Set Text) Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
front []
    go' [Text]
errs [Text] -> [Text]
_ []                         = Set Text -> Either (Set Text) Text
forall a b. a -> Either a b
Left (Set Text -> Either (Set Text) Text)
-> Set Text -> Either (Set Text) Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
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 ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
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 Text -> [Text] -> [Text]
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 (Element -> Node)
-> Either (Set Text) Element -> Either (Set Text) Node
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)) = Node -> Either (Set Text) Node
forall a b. b -> Either a b
Right (Node -> Either (Set Text) Node) -> Node -> Either (Set Text) Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
NodeContent Text
t
fromXMLNode (X.NodeContent (X.ContentEntity Text
t)) = Set Text -> Either (Set Text) Node
forall a b. a -> Either a b
Left (Set Text -> Either (Set Text) Node)
-> Set Text -> Either (Set Text) Node
forall a b. (a -> b) -> a -> b
$ Text -> Set Text
forall a. a -> Set a
Set.singleton Text
t
fromXMLNode (X.NodeComment Text
c) = Node -> Either (Set Text) Node
forall a b. b -> Either a b
Right (Node -> Either (Set Text) Node) -> Node -> Either (Set Text) Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
NodeComment Text
c
fromXMLNode (X.NodeInstruction Instruction
i) = Node -> Either (Set Text) Node
forall a b. b -> Either a b
Right (Node -> Either (Set Text) Node) -> Node -> Either (Set Text) Node
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 = (SomeException -> IO Document) -> IO Document -> IO Document
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
    (XMLException -> IO Document
forall e a. Exception e => e -> IO a
throwIO (XMLException -> IO Document)
-> (SomeException -> XMLException) -> SomeException -> IO Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SomeException -> XMLException
InvalidXMLFile String
fp)
    (ConduitT () Void (ResourceT IO) Document -> IO Document
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) Document -> IO Document)
-> ConduitT () Void (ResourceT IO) Document -> IO Document
forall a b. (a -> b) -> a -> b
$ String -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
CB.sourceFile String
fp ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) Document
-> ConduitT () Void (ResourceT IO) Document
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ParseSettings -> ConduitM ByteString Void (ResourceT IO) Document
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) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Error parsing XML file "
        , String
fp
        , String
": "
        , SomeException -> 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
  = ConduitT () Void (Either SomeException) Document
-> Either SomeException Document
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
  (ConduitT () Void (Either SomeException) Document
 -> Either SomeException Document)
-> ConduitT () Void (Either SomeException) Document
-> Either SomeException Document
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ConduitT () ByteString (Either SomeException) ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (ByteString -> [ByteString]
L.toChunks ByteString
lbs)
 ConduitT () ByteString (Either SomeException) ()
-> ConduitM ByteString Void (Either SomeException) Document
-> ConduitT () Void (Either SomeException) Document
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ParseSettings
-> ConduitM ByteString Void (Either SomeException) Document
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 = (SomeException -> Document)
-> (Document -> Document)
-> Either SomeException Document
-> Document
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Document
forall a e. Exception e => e -> a
throw Document -> Document
forall a. a -> a
id (Either SomeException Document -> Document)
-> (ByteString -> Either SomeException Document)
-> ByteString
-> Document
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 :: ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps = ParseSettings -> ConduitT ByteString EventPos m ()
forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString EventPos m ()
P.parseBytesPos ParseSettings
ps ConduitT ByteString EventPos m ()
-> ConduitM EventPos o m Document
-> ConduitT ByteString o m Document
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM EventPos o m Document
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
  = ConduitT () Void (Either SomeException) Document
-> Either SomeException Document
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
  (ConduitT () Void (Either SomeException) Document
 -> Either SomeException Document)
-> ConduitT () Void (Either SomeException) Document
-> Either SomeException Document
forall a b. (a -> b) -> a -> b
$ [Text] -> ConduitT () Text (Either SomeException) ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (Text -> [Text]
TL.toChunks Text
tl)
 ConduitT () Text (Either SomeException) ()
-> ConduitM Text Void (Either SomeException) Document
-> ConduitT () Void (Either SomeException) Document
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ParseSettings -> ConduitM Text Void (Either SomeException) Document
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 = (SomeException -> Document)
-> (Document -> Document)
-> Either SomeException Document
-> Document
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Document
forall a e. Exception e => e -> a
throw Document -> Document
forall a. a -> a
id (Either SomeException Document -> Document)
-> (Text -> Either SomeException Document) -> Text -> Document
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 :: ParseSettings -> ConduitT Text o m Document
sinkTextDoc ParseSettings
ps = ParseSettings -> ConduitT Text EventPos m ()
forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text EventPos m ()
P.parseTextPos ParseSettings
ps ConduitT Text EventPos m ()
-> ConduitM EventPos o m Document -> ConduitT Text o m Document
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM EventPos o m Document
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents

fromEvents :: MonadThrow m => ConduitT P.EventPos o m Document
fromEvents :: ConduitT EventPos o m Document
fromEvents = do
    Document
d <- ConduitT EventPos o m Document
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
D.fromEvents
    (Set Text -> ConduitT EventPos o m Document)
-> (Document -> ConduitT EventPos o m Document)
-> Either (Set Text) Document
-> ConduitT EventPos o m Document
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m Document -> ConduitT EventPos o m Document
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Document -> ConduitT EventPos o m Document)
-> (Set Text -> m Document)
-> Set Text
-> ConduitT EventPos o m Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedEntityException -> m Document
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnresolvedEntityException -> m Document)
-> (Set Text -> UnresolvedEntityException)
-> Set Text
-> m Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Text -> UnresolvedEntityException
UnresolvedEntityException) Document -> ConduitT EventPos o m Document
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Set Text) Document -> ConduitT EventPos o m Document)
-> Either (Set Text) Document -> ConduitT EventPos o m Document
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
(Int -> UnresolvedEntityException -> ShowS)
-> (UnresolvedEntityException -> String)
-> ([UnresolvedEntityException] -> ShowS)
-> Show UnresolvedEntityException
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 :: RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc = RenderSettings -> Document -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
D.renderBytes RenderSettings
rs (Document -> ConduitT i ByteString m ())
-> Document -> ConduitT i ByteString m ()
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 =
    ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ RenderSettings
-> Document -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| String -> ConduitM ByteString Void (ResourceT IO) ()
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 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ IO [ByteString] -> [ByteString]
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
                 (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Source IO ByteString -> IO [ByteString]
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadActive m) =>
Source m a -> m [a]
lazyConsume
                 (Source IO ByteString -> IO [ByteString])
-> Source IO ByteString -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> Source IO ByteString
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 (ByteString -> Text)
-> (Document -> ByteString) -> Document -> Text
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 Markup -> Markup -> Markup
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> Markup
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)] <- Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name Text
attrs =
        Text -> Markup
forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup (Text
"<!--[if " :: T.Text)
        Markup -> Markup -> Markup
forall a. Monoid a => a -> a -> a
`mappend` Text -> Markup
forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup Text
cond
        Markup -> Markup -> Markup
forall a. Monoid a => a -> a -> a
`mappend` Text -> Markup
forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup (Text
"]>" :: T.Text)
        Markup -> Markup -> Markup
forall a. Monoid a => a -> a -> a
`mappend` (Node -> Markup) -> [Node] -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node -> Markup
forall a. ToMarkup a => a -> Markup
B.toMarkup [Node]
children
        Markup -> Markup -> Markup
forall a. Monoid a => a -> a -> a
`mappend` Text -> Markup
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 (Markup -> Attribute -> Markup) -> Markup -> [Attribute] -> Markup
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
(B.!) Markup
leaf [Attribute]
attrs'
            else ((Markup -> Markup) -> Attribute -> Markup -> Markup)
-> (Markup -> Markup) -> [Attribute] -> Markup -> Markup
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Markup -> Markup) -> Attribute -> Markup -> Markup
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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"style", String
"script"], [Node]
children) of
                (Bool
True, [NodeContent Text
t]) -> Text -> Markup
forall a. ToMarkup a => a -> Markup
B.preEscapedToMarkup Text
t
                (Bool, [Node])
_                       -> (Node -> Markup) -> [Node] -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node -> Markup
forall a. ToMarkup a => a -> Markup
B.toMarkup [Node]
children

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

        parent :: B.Html -> B.Html
        parent :: Markup -> Markup
parent = StaticString -> StaticString -> StaticString -> Markup -> Markup
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 = StaticString -> StaticString -> StaticString -> () -> Markup
forall a.
StaticString -> StaticString -> StaticString -> a -> MarkupM a
BI.Leaf StaticString
tag StaticString
open (String -> StaticString
forall a. IsString a => String -> a
fromString String
" />") ()
#else
        leaf = BI.Leaf tag open (fromString " />")
#endif

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

        attrs' :: [B.Attribute]
        attrs' :: [Attribute]
attrs' = ((Name, Text) -> Attribute) -> [(Name, Text)] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Attribute
forall a. ToValue a => (Text, a) -> Attribute
goAttr ((Text, Text) -> Attribute)
-> ((Name, Text) -> (Text, Text)) -> (Name, Text) -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> (Name, Text) -> (Text, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> Text
nameLocalName) ([(Name, Text)] -> [Attribute]) -> [(Name, Text)] -> [Attribute]
forall a b. (a -> b) -> a -> b
$ Map Name Text -> [(Name, Text)]
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) (AttributeValue -> Attribute) -> AttributeValue -> Attribute
forall a b. (a -> b) -> a -> b
$ a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
B.toValue a
value

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

voidElems :: Set.Set T.Text
voidElems :: Set Text
voidElems = [Text] -> Set Text
forall a. Eq a => [a] -> Set a
Set.fromAscList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
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"