    {-# LANGUAGE CPP #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE FlexibleInstances #-}
    -- | This module provides combinators for generating XML documents.
    --
    -- As an example, suppose you want to generate the following XML document:
    --
    -- > <?xml version="1.0"?>
    -- > <people>
    -- >   <person age="32">Stefan</person>
    -- >   <person age="4">Judith</person>
    -- > </people>
    --
    -- Then you could use the following Haskell code:
    --
    --
    -- @
    -- let people = [(\"Stefan\", \"32\"), (\"Judith\", \"4\")]
    -- in 'doc' 'defaultDocInfo' $
    --      'xelem' \"people\" $
    --        'xelems' $ map (\(name, age) -> 'xelem' \"person\" ('xattr' \"age\" age '<#>' 'xtext' name)) people
    -- @

    module Text.XML.Generator (

      -- * General
        Xml
      -- * Documents
      , Doc, DocInfo(..), doc, defaultDocInfo
      -- * Namespaces
      , Namespace, Prefix, Uri, Name
      , namespace, noNamespace, defaultNamespace
      -- * Elements
      , Elem, xelem, xelemQ, xelemEmpty, xelemQEmpty, AddChildren
      , xelems, noElems, xelemWithText, (<>), (<#>)
      -- * Attributes
      , Attr, xattr, xattrQ, xattrQRaw
      , xattrs, noAttrs
      -- * Text
      , TextContent
      , xtext, xtextRaw, xentityRef
      -- * Other
      , xempty , Misc(xprocessingInstruction, xcomment)
      -- * Rendering
      , xrender
      , XmlOutput(fromBuilder), Renderable
      -- * XHTML documents
      , xhtmlFramesetDocInfo, xhtmlStrictDocInfo, xhtmlTransitionalDocInfo
      , xhtmlRootElem

    ) where

    import Prelude hiding (elem)
    import Control.Monad.Reader (Reader(..), ask, asks, runReader)
    import qualified Data.Map as Map
    import qualified Data.ByteString.Lazy as BSL
    import qualified Data.Monoid as M

    import Blaze.ByteString.Builder
    import qualified Blaze.ByteString.Builder as Blaze
    import Blaze.ByteString.Builder.Char.Utf8

    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Lazy as BSL

    import Data.Char (isPrint, ord)
    import qualified Data.String as S

    #if MIN_VERSION_base(4,9,0)
    import Data.Semigroup
    import Data.Monoid hiding (mconcat, (<>))
    #else
    -- for ghc 7.10
    import Data.Monoid hiding (mconcat)
    #endif

    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL

    #ifdef MIN_VERSION_base

    #if MIN_VERSION_base(4,5,0)
    #define BASE_AT_LEAST_4_5_0_0
    #endif

    #else

    -- Fallback for ghci
    #if __GLASGOW_HASKELL__ >= 704
    #define BASE_AT_LEAST_4_5_0_0
    #endif

    #endif

    --
    -- Basic definitions
    --

    -- | A piece of XML at the element level.
    newtype Elem = Elem { Elem -> Builder
    unElem :: Builder }

    -- | A piece of XML at the attribute level.
    newtype Attr = Attr { Attr -> Builder
    unAttr :: Builder }

    -- | A piece of XML at the document level.
    newtype Doc = Doc { Doc -> Builder
    unDoc :: Builder }

    -- | Namespace prefix.
    type Prefix = T.Text

    -- | Namespace URI.
    type Uri = T.Text -- must not be empty

    -- | A type for names
    type Name = T.Text

    nameBuilder :: Name -> Builder
    nameBuilder :: Text -> Builder
    nameBuilder = Text -> Builder
    fromText

    -- | Type for representing presence or absence of an XML namespace.
    data Namespace
        = NoNamespace
        | DefaultNamespace
        | QualifiedNamespace Prefix Uri
        deriving (Int -> Namespace -> ShowS
    [Namespace] -> ShowS
    Namespace -> String
    (Int -> Namespace -> ShowS)
    -> (Namespace -> String)
    -> ([Namespace] -> ShowS)
    -> Show Namespace
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Namespace -> ShowS
    showsPrec :: Int -> Namespace -> ShowS
    $cshow :: Namespace -> String
    show :: Namespace -> String
    $cshowList :: [Namespace] -> ShowS
    showList :: [Namespace] -> ShowS
    Show, Namespace -> Namespace -> Bool
    (Namespace -> Namespace -> Bool)
    -> (Namespace -> Namespace -> Bool) -> Eq Namespace
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Namespace -> Namespace -> Bool
    == :: Namespace -> Namespace -> Bool
    $c/= :: Namespace -> Namespace -> Bool
    /= :: Namespace -> Namespace -> Bool
    Eq)

    -- | Constructs a qualified XML namespace.
    --   The given URI must not be the empty string.
    namespace :: Prefix -> Uri -> Namespace
    namespace :: Text -> Text -> Namespace
    namespace Text
    p Text
    u = if Text -> Bool
    T.null Text
    u
                    then String -> Namespace
    forall a. HasCallStack => String -> a
    error String
    "Text.XML.Generator.ns: namespace URI must not be empty"
                    else Text -> Text -> Namespace
    QualifiedNamespace Text
    p Text
    u

    -- | A 'Namespace' value denoting the absence of any XML namespace information.
    noNamespace :: Namespace
    noNamespace :: Namespace
    noNamespace = Namespace
    NoNamespace

    -- | A 'Namespace' value denoting the default namespace.
    --
    -- * For elements, this is the namespace currently mapped to the empty prefix.
    --
    -- * For attributes, the default namespace does not carry any namespace information.
    defaultNamespace :: Namespace
    defaultNamespace :: Namespace
    defaultNamespace = Namespace
    DefaultNamespace

    data NsEnv = NsEnv { NsEnv -> Map Text Text
    ne_namespaceMap :: Map.Map Prefix Uri
                       , NsEnv -> Bool
    ne_noNamespaceInUse :: Bool }

    emptyNsEnv :: NsEnv
    emptyNsEnv :: NsEnv
    emptyNsEnv = Map Text Text -> Bool -> NsEnv
    NsEnv Map Text Text
    forall k a. Map k a
    Map.empty Bool
    False

    -- | The type @Xml t@ represent a piece of XML of type @t@, where @t@
    --   is usually one of 'Elem', 'Attr', or 'Doc'.
    newtype Xml t = Xml { forall t. Xml t -> Reader NsEnv (t, NsEnv)
    unXml :: Reader NsEnv (t, NsEnv) }

    runXml :: NsEnv -> Xml t -> (t, NsEnv)
    runXml :: forall t. NsEnv -> Xml t -> (t, NsEnv)
    runXml NsEnv
    nsEnv (Xml Reader NsEnv (t, NsEnv)
    x) = Reader NsEnv (t, NsEnv) -> NsEnv -> (t, NsEnv)
    forall r a. Reader r a -> r -> a
    runReader Reader NsEnv (t, NsEnv)
    x NsEnv
    nsEnv

    -- | An empty, polymorphic piece of XML.
    xempty :: Renderable t => Xml t
    xempty :: forall t. Renderable t => Xml t
    xempty = Reader NsEnv (t, NsEnv) -> Xml t
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (t, NsEnv) -> Xml t)
    -> Reader NsEnv (t, NsEnv) -> Xml t
    forall a b. (a -> b) -> a -> b
    $
        do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           return (mkRenderable mempty, env)

    --
    -- Document
    --

    -- | The 'DocInfo' type contains all information of an XML document except the root element.
    data DocInfo
        = DocInfo
          { DocInfo -> Bool
    docInfo_standalone :: Bool          -- ^ Value of the @standalone@ attribute in the @\<?xml ... ?\>@ header
          , DocInfo -> Maybe String
    docInfo_docType    :: Maybe String  -- ^ Document type (N.B.: rendering does not escape this value)
          , DocInfo -> Xml Doc
    docInfo_preMisc    :: Xml Doc       -- ^ Content before the root element
          , DocInfo -> Xml Doc
    docInfo_postMisc   :: Xml Doc       -- ^ Content after the root element
          }

    -- | The default document info (standalone, without document type, without content before/after the root element).
    defaultDocInfo :: DocInfo
    defaultDocInfo :: DocInfo
    defaultDocInfo = DocInfo { docInfo_standalone :: Bool
    docInfo_standalone = Bool
    True
                             , docInfo_docType :: Maybe String
    docInfo_docType    = Maybe String
    forall a. Maybe a
    Nothing
                             , docInfo_preMisc :: Xml Doc
    docInfo_preMisc    = Xml Doc
    forall t. Renderable t => Xml t
    xempty
                             , docInfo_postMisc :: Xml Doc
    docInfo_postMisc   = Xml Doc
    forall t. Renderable t => Xml t
    xempty }

    -- | Constructs an XML document from a 'DocInfo' value and the root element.
    doc :: DocInfo -> Xml Elem -> Xml Doc
    doc :: DocInfo -> Xml Elem -> Xml Doc
    doc DocInfo
    di Xml Elem
    rootElem = Reader NsEnv (Doc, NsEnv) -> Xml Doc
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Doc, NsEnv) -> Xml Doc)
    -> Reader NsEnv (Doc, NsEnv) -> Xml Doc
    forall a b. (a -> b) -> a -> b
    $
        do let prologBuf :: Builder
    prologBuf = String -> Builder
    fromString String
    "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                           String -> Builder
    fromString (if Bool
    standalone then String
    "yes" else String
    "no") Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                           String -> Builder
    fromString String
    "\"?>\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                           case Maybe String
    mDocType of
                             Maybe String
    Nothing -> Builder
    forall a. Monoid a => a
    mempty
                             Just String
    s -> String -> Builder
    fromString String
    s Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    fromString String
    "\n"
           env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           let Doc preBuf = fst $ runXml env preMisc
               Elem elemBuf = fst $ runXml env rootElem
               Doc postBuf = fst $ runXml env postMisc
           return $ (Doc $ prologBuf `mappend` preBuf `mappend` elemBuf `mappend` postBuf, env)
        where
           standalone :: Bool
    standalone = DocInfo -> Bool
    docInfo_standalone DocInfo
    di
           mDocType :: Maybe String
    mDocType = DocInfo -> Maybe String
    docInfo_docType DocInfo
    di
           preMisc :: Xml Doc
    preMisc = DocInfo -> Xml Doc
    docInfo_preMisc DocInfo
    di
           postMisc :: Xml Doc
    postMisc = DocInfo -> Xml Doc
    docInfo_postMisc DocInfo
    di

    --
    -- Text content
    --

    -- | Text content subject to escaping.
    type TextContent = T.Text

    textBuilder :: TextContent -> Builder
    textBuilder :: Text -> Builder
    textBuilder = Text -> Builder
    fromText (Text -> Builder) -> (Text -> Text) -> Text -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    escapeText

    -- | Constructs a text node by escaping the given argument.
    xtext :: TextContent -> Xml Elem
    xtext :: Text -> Xml Elem
    xtext Text
    content = Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Elem, NsEnv) -> Xml Elem)
    -> Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall a b. (a -> b) -> a -> b
    $
        do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           return (Elem $ textBuilder content, env)

    -- | Constructs a text node /without/ escaping the given argument.
    xtextRaw :: Builder -> Xml Elem
    xtextRaw :: Builder -> Xml Elem
    xtextRaw Builder
    content = Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Elem, NsEnv) -> Xml Elem)
    -> Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall a b. (a -> b) -> a -> b
    $
        do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           return (Elem content, env)

    -- | Constructs a reference to the named entity.
    -- /Note:/ no escaping is performed on the name of the entity
    xentityRef :: Name -> Xml Elem
    xentityRef :: Text -> Xml Elem
    xentityRef Text
    name = Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Elem, NsEnv) -> Xml Elem)
    -> Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall a b. (a -> b) -> a -> b
    $
        do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           return (Elem $ fromChar '&' <> fromText name <> fromChar ';', env)

    --
    -- Attributes
    --

    -- | Construct a simple-named attribute by escaping its value.
    xattr :: Name -> TextContent -> Xml Attr
    xattr :: Text -> Text -> Xml Attr
    xattr = Namespace -> Text -> Text -> Xml Attr
    xattrQ Namespace
    DefaultNamespace

    -- | Construct an attribute by escaping its value.
    xattrQ :: Namespace -> Name -> TextContent -> Xml Attr
    xattrQ :: Namespace -> Text -> Text -> Xml Attr
    xattrQ Namespace
    ns Text
    key Text
    value = Namespace -> Builder -> Builder -> Xml Attr
    xattrQRaw' Namespace
    ns (Text -> Builder
    nameBuilder Text
    key) (Text -> Builder
    textBuilder Text
    value)

    -- | Construct an attribute without escaping its value.
    -- /Note:/ attribute values are quoted with double quotes.
    xattrQRaw :: Namespace -> Name -> Builder -> Xml Attr
    xattrQRaw :: Namespace -> Text -> Builder -> Xml Attr
    xattrQRaw Namespace
    ns Text
    key Builder
    value = Namespace -> Builder -> Builder -> Xml Attr
    xattrQRaw' Namespace
    ns (Text -> Builder
    nameBuilder Text
    key) Builder
    value

    xattrQRaw' :: Namespace -> Builder -> Builder -> Xml Attr
    xattrQRaw' :: Namespace -> Builder -> Builder -> Xml Attr
    xattrQRaw' Namespace
    ns' Builder
    key Builder
    valueBuilder = Reader NsEnv (Attr, NsEnv) -> Xml Attr
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Attr, NsEnv) -> Xml Attr)
    -> Reader NsEnv (Attr, NsEnv) -> Xml Attr
    forall a b. (a -> b) -> a -> b
    $
        do uriMap' <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           let (mDecl, prefix, uriMap) = extendNsEnv True uriMap' ns'
               nsDeclBuilder =
                   case Maybe (Text, Text)
    mDecl of
                     Maybe (Text, Text)
    Nothing -> Builder
    forall a. Monoid a => a
    mempty
                     Just (Text
    p, Text
    u) ->
                         let uriBuilder :: Builder
    uriBuilder = Text -> Builder
    fromText Text
    u
                             prefixBuilder :: Builder
    prefixBuilder =
                                 if Text -> Bool
    T.null Text
    p then Builder
    forall a. Monoid a => a
    mempty else Builder
    colonBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Text -> Builder
    fromText Text
    p
                         in Builder
    spaceBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    nsDeclStartBuilder
                            Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    prefixBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    startBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    uriBuilder
                            Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    endBuilder
               prefixBuilder =
                   if Text -> Bool
    T.null Text
    prefix
                      then Builder
    spaceBuilder
                      else Builder
    spaceBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Text -> Builder
    fromText Text
    prefix Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    colonBuilder
               builder = Builder
    nsDeclBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    prefixBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                         Builder
    key Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    startBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend`
                         Builder
    valueBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    endBuilder
           return $ (Attr builder, uriMap)
        where
          spaceBuilder :: Builder
    spaceBuilder = String -> Builder
    fromString String
    " "
          startBuilder :: Builder
    startBuilder = String -> Builder
    fromString String
    "=\""
          endBuilder :: Builder
    endBuilder = String -> Builder
    fromString String
    "\""
          nsDeclStartBuilder :: Builder
    nsDeclStartBuilder = String -> Builder
    fromString String
    "xmlns"
          colonBuilder :: Builder
    colonBuilder = String -> Builder
    fromString String
    ":"

    -- |  Merge a list of attributes into a single piece of XML at the attribute level.
    xattrs :: [Xml Attr] -> Xml Attr
    xattrs :: [Xml Attr] -> Xml Attr
    xattrs = [Xml Attr] -> Xml Attr
    forall a. Monoid a => [a] -> a
    M.mconcat

    -- | The empty attribute list.
    noAttrs :: Xml Attr
    noAttrs :: Xml Attr
    noAttrs = Xml Attr
    forall t. Renderable t => Xml t
    xempty

    {-# INLINE mappendAttr #-}
    mappendAttr :: Xml Attr -> Xml Attr -> Xml Attr
    mappendAttr :: Xml Attr -> Xml Attr -> Xml Attr
    mappendAttr Xml Attr
    x1 Xml Attr
    x2 = Reader NsEnv (Attr, NsEnv) -> Xml Attr
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Attr, NsEnv) -> Xml Attr)
    -> Reader NsEnv (Attr, NsEnv) -> Xml Attr
    forall a b. (a -> b) -> a -> b
    $
        do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           let (Attr b1, env') = runXml env x1
           let (Attr b2, env'') = runXml env' x2
           return $ (Attr $ b1 `mappend` b2, env'')

    #if MIN_VERSION_base(4,9,0)
    instance Semigroup (Xml Attr) where
        <> :: Xml Attr -> Xml Attr -> Xml Attr
    (<>) = Xml Attr -> Xml Attr -> Xml Attr
    mappendAttr

    instance Monoid (Xml Attr) where
        mempty :: Xml Attr
    mempty = Xml Attr
    noAttrs
    #if !(MIN_VERSION_base(4,11,0))
        -- this is redundant starting with base-4.11 / GHC 8.4
        mappend = (<>)
    #endif
    #else
    -- for ghc 7.10
    instance Monoid (Xml Attr) where
        mempty = noAttrs
        mappend = mappendAttr
    #endif

    --
    -- Elements
    --

    -- | Class for adding children to an element.
    --
    -- The various instances of this class allow the addition of different kinds
    -- of children.
    class AddChildren c where
        addChildren :: c -> NsEnv -> Builder

    instance AddChildren (Xml Attr) where
        addChildren :: Xml Attr -> NsEnv -> Builder
    addChildren Xml Attr
    attrs NsEnv
    uriMap =
           let (Attr Builder
    builder', NsEnv
    _) = NsEnv -> Xml Attr -> (Attr, NsEnv)
    forall t. NsEnv -> Xml t -> (t, NsEnv)
    runXml NsEnv
    uriMap Xml Attr
    attrs
           in Builder
    builder' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    fromString String
    "\n>"

    instance AddChildren (Xml Elem) where
        addChildren :: Xml Elem -> NsEnv -> Builder
    addChildren Xml Elem
    elems NsEnv
    uriMap =
           let (Elem Builder
    builder', NsEnv
    _) = NsEnv -> Xml Elem -> (Elem, NsEnv)
    forall t. NsEnv -> Xml t -> (t, NsEnv)
    runXml NsEnv
    uriMap Xml Elem
    elems
           in String -> Builder
    fromString String
    "\n>" Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    builder'

    instance AddChildren (Xml Attr, Xml Elem) where
        addChildren :: (Xml Attr, Xml Elem) -> NsEnv -> Builder
    addChildren (Xml Attr
    attrs, Xml Elem
    elems) NsEnv
    uriMap =
            let (Attr Builder
    builder, NsEnv
    uriMap') = NsEnv -> Xml Attr -> (Attr, NsEnv)
    forall t. NsEnv -> Xml t -> (t, NsEnv)
    runXml NsEnv
    uriMap Xml Attr
    attrs
                (Elem Builder
    builder', NsEnv
    _) = NsEnv -> Xml Elem -> (Elem, NsEnv)
    forall t. NsEnv -> Xml t -> (t, NsEnv)
    runXml NsEnv
    uriMap' Xml Elem
    elems
            in Builder
    builder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    fromString String
    "\n>" Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    builder'

    instance AddChildren (Xml Attr, [Xml Elem]) where
        addChildren :: (Xml Attr, [Xml Elem]) -> NsEnv -> Builder
    addChildren (Xml Attr
    attrs, [Xml Elem]
    elems) NsEnv
    uriMap = (Xml Attr, Xml Elem) -> NsEnv -> Builder
    forall c. AddChildren c => c -> NsEnv -> Builder
    addChildren (Xml Attr
    attrs, [Xml Elem] -> Xml Elem
    xelems [Xml Elem]
    elems) NsEnv
    uriMap

    instance AddChildren TextContent where
        addChildren :: Text -> NsEnv -> Builder
    addChildren Text
    t NsEnv
    _ = Char -> Builder
    fromChar Char
    '>' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    textBuilder Text
    t

    instance AddChildren String where
        addChildren :: String -> NsEnv -> Builder
    addChildren String
    t NsEnv
    _ = Char -> Builder
    fromChar Char
    '>' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    fromString String
    t

    instance AddChildren () where
        addChildren :: () -> NsEnv -> Builder
    addChildren ()
    _ NsEnv
    _ = Char -> Builder
    fromChar Char
    '>'

    -- | Construct a simple-named element with the given children.
    xelem :: (AddChildren c) => Name -> c -> Xml Elem
    xelem :: forall c. AddChildren c => Text -> c -> Xml Elem
    xelem = Namespace -> Text -> c -> Xml Elem
    forall c. AddChildren c => Namespace -> Text -> c -> Xml Elem
    xelemQ Namespace
    DefaultNamespace

    -- | Construct a simple-named element without any children.
    xelemEmpty :: Name -> Xml Elem
    xelemEmpty :: Text -> Xml Elem
    xelemEmpty Text
    name = Namespace -> Text -> Xml Elem -> Xml Elem
    forall c. AddChildren c => Namespace -> Text -> c -> Xml Elem
    xelemQ Namespace
    DefaultNamespace Text
    name (Xml Elem
    forall a. Monoid a => a
    mempty :: Xml Elem)

    -- | Construct an element with the given children.
    xelemQ :: (AddChildren c) => Namespace -> Name -> c -> Xml Elem
    xelemQ :: forall c. AddChildren c => Namespace -> Text -> c -> Xml Elem
    xelemQ Namespace
    ns' Text
    name c
    children = Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Elem, NsEnv) -> Xml Elem)
    -> Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall a b. (a -> b) -> a -> b
    $
        do oldUriMap <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           let (mDecl, prefix,!uriMap) = oldUriMap `seq` extendNsEnv False oldUriMap ns'
           let elemNameBuilder =
                   if Text -> Bool
    T.null Text
    prefix
                      then Text -> Builder
    nameBuilder Text
    name
                      else Text -> Builder
    fromText Text
    prefix Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    fromString String
    ":" Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Text -> Builder
    nameBuilder Text
    name
           let nsDeclBuilder =
                   case Maybe (Text, Text)
    mDecl of
                     Maybe (Text, Text)
    Nothing -> Builder
    forall a. Monoid a => a
    mempty
                     Just (Text
    p, Text
    u) ->
                         let prefixBuilder :: Builder
    prefixBuilder =
                                 if Text -> Bool
    T.null Text
    p then Builder
    forall a. Monoid a => a
    mempty else Char -> Builder
    fromChar Char
    ':' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Text -> Builder
    fromText Text
    p
                         in String -> Builder
    fromString String
    " xmlns" Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    prefixBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    fromString String
    "=\""
                            Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Text -> Builder
    fromText Text
    u Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    fromString String
    "\""
           let b1 = String -> Builder
    fromString String
    "<"
           let b2 = Builder
    b1 Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    elemNameBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    nsDeclBuilder
           let b3 = Builder
    b2 Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` c -> NsEnv -> Builder
    forall c. AddChildren c => c -> NsEnv -> Builder
    addChildren c
    children NsEnv
    uriMap
           let builderOut = Builder -> Elem
    Elem (Builder
    b3 Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    fromString String
    "</" Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Builder
    elemNameBuilder Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` String -> Builder
    fromString String
    "\n>")
           return (builderOut, oldUriMap)

    -- | Construct an element without any children.
    xelemQEmpty :: Namespace -> Name -> Xml Elem
    xelemQEmpty :: Namespace -> Text -> Xml Elem
    xelemQEmpty Namespace
    ns Text
    name = Namespace -> Text -> Xml Elem -> Xml Elem
    forall c. AddChildren c => Namespace -> Text -> c -> Xml Elem
    xelemQ Namespace
    ns Text
    name (Xml Elem
    forall a. Monoid a => a
    mempty :: Xml Elem)

    -- |  Merges a list of elements into a single piece of XML at the element level.
    xelems :: [Xml Elem] -> Xml Elem
    xelems :: [Xml Elem] -> Xml Elem
    xelems = [Xml Elem] -> Xml Elem
    forall a. Monoid a => [a] -> a
    M.mconcat

    -- | No elements at all.
    noElems :: Xml Elem
    noElems :: Xml Elem
    noElems = Xml Elem
    forall t. Renderable t => Xml t
    xempty

    -- | The expression @xelemWithText n t@ constructs an XML element with name @n@ and text content @t@.
    xelemWithText :: Name -> TextContent -> Xml Elem
    xelemWithText :: Text -> Text -> Xml Elem
    xelemWithText Text
    n Text
    t = Text -> Xml Elem -> Xml Elem
    forall c. AddChildren c => Text -> c -> Xml Elem
    xelem Text
    n (Text -> Xml Elem
    xtext Text
    t)

    {-# INLINE mappendElem #-}
    mappendElem :: Xml Elem -> Xml Elem -> Xml Elem
    mappendElem :: Xml Elem -> Xml Elem -> Xml Elem
    mappendElem Xml Elem
    x1 Xml Elem
    x2 = Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (Elem, NsEnv) -> Xml Elem)
    -> Reader NsEnv (Elem, NsEnv) -> Xml Elem
    forall a b. (a -> b) -> a -> b
    $
        do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
           let (Elem b1, env') = runXml env x1
               (Elem b2, env'') = runXml env' x2
           return (Elem $ b1 `mappend` b2, env'')

    #if MIN_VERSION_base(4,9,0)
    instance Semigroup (Xml Elem) where
        <> :: Xml Elem -> Xml Elem -> Xml Elem
    (<>) = Xml Elem -> Xml Elem -> Xml Elem
    mappendElem

    instance Monoid (Xml Elem) where
        mempty :: Xml Elem
    mempty = Xml Elem
    noElems
    #if !(MIN_VERSION_base(4,11,0))
        -- this is redundant starting with base-4.11 / GHC 8.4
        mappend = (<>)
    #endif
    #else
    -- for ghc 7.10
    instance Monoid (Xml Elem) where
        mempty = noElems
        mappend = mappendElem
    #endif
    --
    -- Other XML constructs
    --

    -- | Class providing methods for adding processing instructions and comments.
    class Renderable t => Misc t where
        -- | Constructs a processing instruction with the given target and content.
        -- /Note:/ Rendering does not perform escaping on the target and the content.
        xprocessingInstruction :: String -> String -> Xml t
        xprocessingInstruction String
    target String
    content = Reader NsEnv (t, NsEnv) -> Xml t
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (t, NsEnv) -> Xml t)
    -> Reader NsEnv (t, NsEnv) -> Xml t
    forall a b. (a -> b) -> a -> b
    $
            do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
               return (mkRenderable $
                       fromString "<?" <>
                       fromString target <>
                       fromChar ' ' <>
                       fromString content <>
                       fromString "?>",
                       env)
        -- | Constructs an XML comment.
        -- /Note:/ No escaping is performed on the text of the comment.
        xcomment :: String -> Xml t
        xcomment String
    content = Reader NsEnv (t, NsEnv) -> Xml t
    forall t. Reader NsEnv (t, NsEnv) -> Xml t
    Xml (Reader NsEnv (t, NsEnv) -> Xml t)
    -> Reader NsEnv (t, NsEnv) -> Xml t
    forall a b. (a -> b) -> a -> b
    $
            do env <- ReaderT NsEnv Identity NsEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
               return (mkRenderable $
                       fromString "<!--" <>
                       fromString content <>
                       fromString "-->",
                       env)

    instance Misc Elem
    instance Misc Doc

    --
    -- Operators
    --

    -- Note: (<>) is defined in Data.Monoid starting with base 4.5.0.0
    #ifndef BASE_AT_LEAST_4_5_0_0
    infixl 6 <>
    -- | Shortcut for the 'mappend' functions of monoids. Used to concatenate elements, attributes
    --   and text nodes.
    (<>) :: Monoid t => t -> t -> t
    (<>) = mappend
    #endif

    infixl 5 <#>
    -- | Shortcut for constructing pairs. Used in combination with 'xelem' for separating child-attributes
    --   from child-elements.
    (<#>) :: a -> b -> (a, b)
    <#> :: forall a b. a -> b -> (a, b)
    (<#>) a
    x b
    y = (a
    x, b
    y)

    --
    -- Rendering
    --

    -- | Instances of the @XmlOutput@ class may serve as target of serializing an XML document.
    class XmlOutput t where
        -- | Creates the target type from a 'Builder'.
        fromBuilder :: Builder -> t

    instance XmlOutput Builder where
        fromBuilder :: Builder -> Builder
    fromBuilder Builder
    b = Builder
    b

    instance XmlOutput BS.ByteString where
        fromBuilder :: Builder -> ByteString
    fromBuilder = Builder -> ByteString
    toByteString

    instance XmlOutput BSL.ByteString where
        fromBuilder :: Builder -> ByteString
    fromBuilder = Builder -> ByteString
    toLazyByteString

    -- | Any type subject to rendering must implement this type class.
    class Renderable t where
        builder :: t -> Builder
        mkRenderable :: Builder -> t

    instance Renderable Elem where
        builder :: Elem -> Builder
    builder (Elem Builder
    b) = Builder
    b
        mkRenderable :: Builder -> Elem
    mkRenderable = Builder -> Elem
    Elem

    instance Renderable Attr where
        builder :: Attr -> Builder
    builder (Attr Builder
    b) = Builder
    b
        mkRenderable :: Builder -> Attr
    mkRenderable = Builder -> Attr
    Attr

    instance Renderable Doc where
        builder :: Doc -> Builder
    builder (Doc Builder
    b) = Builder
    b
        mkRenderable :: Builder -> Doc
    mkRenderable = Builder -> Doc
    Doc

    -- | Renders a given piece of XML.
    xrender :: (Renderable r, XmlOutput t) => Xml r -> t
    xrender :: forall r t. (Renderable r, XmlOutput t) => Xml r -> t
    xrender Xml r
    r = Builder -> t
    forall t. XmlOutput t => Builder -> t
    fromBuilder (Builder -> t) -> Builder -> t
    forall a b. (a -> b) -> a -> b
    $ r -> Builder
    forall t. Renderable t => t -> Builder
    builder r
    r'
        where
          r' :: r
    r' = (r, NsEnv) -> r
    forall a b. (a, b) -> a
    fst ((r, NsEnv) -> r) -> (r, NsEnv) -> r
    forall a b. (a -> b) -> a -> b
    $ NsEnv -> Xml r -> (r, NsEnv)
    forall t. NsEnv -> Xml t -> (t, NsEnv)
    runXml NsEnv
    emptyNsEnv Xml r
    r

    --
    -- Utilities
    --

    extendNsEnv :: Bool -> NsEnv -> Namespace -> (Maybe (Prefix, Uri), Prefix, NsEnv)
    extendNsEnv :: Bool -> NsEnv -> Namespace -> (Maybe (Text, Text), Text, NsEnv)
    extendNsEnv Bool
    isAttr NsEnv
    env Namespace
    ns =
        case Namespace
    ns of
          Namespace
    NoNamespace
              | Bool
    isAttr -> (Maybe (Text, Text)
    forall a. Maybe a
    Nothing, Text
    T.empty, NsEnv
    env)
              | Bool
    otherwise ->
                  case Text -> Map Text Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    T.empty (NsEnv -> Map Text Text
    ne_namespaceMap NsEnv
    env) of
                    Maybe Text
    Nothing ->  -- empty prefix not in use
                      (Maybe (Text, Text)
    forall a. Maybe a
    Nothing, Text
    T.empty, NsEnv
    env { ne_noNamespaceInUse = True })
                    Just Text
    uri -> -- empty prefix mapped to uri
                      ((Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    T.empty, Text
    T.empty), Text
    T.empty, NsEnv
    env { ne_namespaceMap = Map.delete T.empty (ne_namespaceMap env)
                                              , ne_noNamespaceInUse = True })
          Namespace
    DefaultNamespace ->
              (Maybe (Text, Text)
    forall a. Maybe a
    Nothing, Text
    T.empty, NsEnv
    env)
          QualifiedNamespace Text
    p' Text
    u ->
              let p :: Text
    p = if Text -> Bool
    T.null Text
    p' Bool -> Bool -> Bool
    && (Bool
    isAttr Bool -> Bool -> Bool
    || NsEnv -> Bool
    ne_noNamespaceInUse NsEnv
    env) then String -> Text
    T.pack String
    "_" else Text
    p'
                  (Maybe (Text, Text)
    mDecl, Text
    prefix, Map Text Text
    newMap) = Map Text Text
    -> Text -> Text -> (Maybe (Text, Text), Text, Map Text Text)
    forall {t}.
    Eq t =>
    Map Text t -> Text -> t -> (Maybe (Text, t), Text, Map Text t)
    genValidPrefix (NsEnv -> Map Text Text
    ne_namespaceMap NsEnv
    env) Text
    p Text
    u
              in (Maybe (Text, Text)
    mDecl, Text
    prefix, NsEnv
    env { ne_namespaceMap = newMap })
        where
          genValidPrefix :: Map Text t -> Text -> t -> (Maybe (Text, t), Text, Map Text t)
    genValidPrefix Map Text t
    map Text
    prefix t
    uri =
            case Text -> Map Text t -> Maybe t
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    prefix Map Text t
    map of
              Maybe t
    Nothing -> ((Text, t) -> Maybe (Text, t)
    forall a. a -> Maybe a
    Just (Text
    prefix, t
    uri), Text
    prefix, Text -> t -> Map Text t -> Map Text t
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Text
    prefix t
    uri Map Text t
    map)
              Just t
    foundUri ->
                  if t
    foundUri t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    uri
                     then (Maybe (Text, t)
    forall a. Maybe a
    Nothing, Text
    prefix, Map Text t
    map)
                     else Map Text t -> Text -> t -> (Maybe (Text, t), Text, Map Text t)
    genValidPrefix Map Text t
    map (Char -> Text -> Text
    T.cons Char
    '_' Text
    prefix) t
    uri

    escapeText :: T.Text -> T.Text
    escapeText :: Text -> Text
    escapeText = (Char -> Text -> Text) -> Text -> Text -> Text
    forall a. (Char -> a -> a) -> a -> Text -> a
    T.foldr Char -> Text -> Text
    escChar Text
    T.empty
        where
          -- copied from xml-light
          escChar :: Char -> Text -> Text
    escChar Char
    c = case Char
    c of
            Char
    '<'   -> Text -> Text -> Text
    T.append (String -> Text
    T.pack String
    "&lt;")
            Char
    '>'   -> Text -> Text -> Text
    T.append (String -> Text
    T.pack String
    "&gt;")
            Char
    '&'   -> Text -> Text -> Text
    T.append (String -> Text
    T.pack String
    "&amp;")
            Char
    '"'   -> Text -> Text -> Text
    T.append (String -> Text
    T.pack String
    "&quot;")
            -- we use &#39 instead of &apos; because IE apparently has difficulties
            -- rendering &apos; in xhtml.
            -- Reported by Rohan Drape <rohan.drape@gmail.com>.
            Char
    '\''  -> Text -> Text -> Text
    T.append (String -> Text
    T.pack String
    "&#39;")
            -- XXX: Is this really wortherd?
            -- We could deal with these issues when we convert characters to bytes.
            Char
    _ | (Int
    oc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0x7f Bool -> Bool -> Bool
    && Char -> Bool
    isPrint Char
    c) Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\r' -> Char -> Text -> Text
    T.cons Char
    c
              | Bool
    otherwise -> Text -> Text -> Text
    T.append (String -> Text
    T.pack String
    "&#") (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text -> Text
    T.append (String -> Text
    T.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    oc)) (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Text -> Text
    T.cons Char
    ';'
                where oc :: Int
    oc = Char -> Int
    ord Char
    c

    --
    -- XHTML
    --

    -- | Document type for XHTML 1.0 strict.
    xhtmlDoctypeStrict :: String
    xhtmlDoctypeStrict :: String
    xhtmlDoctypeStrict =
        String
    "<!DOCTYPE html\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        String
    "    PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        String
    "    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"

    -- | Document info for XHTML 1.0 strict.
    xhtmlStrictDocInfo :: DocInfo
    xhtmlStrictDocInfo :: DocInfo
    xhtmlStrictDocInfo = DocInfo
    defaultDocInfo { docInfo_docType = Just xhtmlDoctypeStrict }

    -- | Document type for XHTML 1.0 transitional.
    xhtmlDoctypeTransitional :: String
    xhtmlDoctypeTransitional :: String
    xhtmlDoctypeTransitional =
        String
    "<!DOCTYPE html\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        String
    "    PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        String
    "    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"

    -- | Document info for XHTML 1.0 transitional.
    xhtmlTransitionalDocInfo :: DocInfo
    xhtmlTransitionalDocInfo :: DocInfo
    xhtmlTransitionalDocInfo = DocInfo
    defaultDocInfo { docInfo_docType = Just xhtmlDoctypeTransitional }

    -- | Document type for XHTML 1.0 frameset.
    xhtmlDoctypeFrameset :: String
    xhtmlDoctypeFrameset :: String
    xhtmlDoctypeFrameset =
        String
    "<!DOCTYPE html\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        String
    "    PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        String
    "    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">"

    -- | Document info for XHTML 1.0 frameset.
    xhtmlFramesetDocInfo :: DocInfo
    xhtmlFramesetDocInfo :: DocInfo
    xhtmlFramesetDocInfo = DocInfo
    defaultDocInfo { docInfo_docType = Just xhtmlDoctypeFrameset }

    -- | Constructs the root element of an XHTML document.
    xhtmlRootElem :: T.Text -> Xml Elem -> Xml Elem
    xhtmlRootElem :: Text -> Xml Elem -> Xml Elem
    xhtmlRootElem Text
    lang Xml Elem
    children =
        Namespace -> Text -> (Xml Attr, Xml Elem) -> Xml Elem
    forall c. AddChildren c => Namespace -> Text -> c -> Xml Elem
    xelemQ (Text -> Text -> Namespace
    namespace (String -> Text
    T.pack String
    "") (String -> Text
    T.pack String
    "http://www.w3.org/1999/xhtml")) (String -> Text
    T.pack String
    "html")
               (Text -> Text -> Xml Attr
    xattr (String -> Text
    T.pack String
    "xml:lang") Text
    lang Xml Attr -> Xml Attr -> Xml Attr
    forall a. Semigroup a => a -> a -> a
    <>
                Text -> Text -> Xml Attr
    xattr (String -> Text
    T.pack String
    "lang") Text
    lang Xml Attr -> Xml Elem -> (Xml Attr, Xml Elem)
    forall a b. a -> b -> (a, b)
    <#>
                Xml Elem
    children)