-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.Arrow.Edit
   Copyright  : Copyright (C) 2011 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   common edit arrows

-}

-- ------------------------------------------------------------

module Text.XML.HXT.Arrow.Edit
    ( canonicalizeAllNodes
    , canonicalizeForXPath
    , canonicalizeContents
    , collapseAllXText
    , collapseXText

    , xshowEscapeXml

    , escapeXmlRefs
    , escapeHtmlRefs

    , haskellRepOfXmlDoc
    , treeRepOfXmlDoc
    , addHeadlineToXmlDoc

    , indentDoc
    , numberLinesInXmlDoc
    , preventEmptyElements

    , removeComment
    , removeAllComment
    , removeWhiteSpace
    , removeAllWhiteSpace
    , removeDocWhiteSpace

    , transfCdata
    , transfAllCdata
    , transfCharRef
    , transfAllCharRef

    , substAllXHTMLEntityRefs
    , substXHTMLEntityRef

    , rememberDTDAttrl
    , addDefaultDTDecl

    , hasXmlPi
    , addXmlPi
    , addXmlPiEncoding

    , addDoctypeDecl
    , addXHtmlDoctypeStrict
    , addXHtmlDoctypeTransitional
    , addXHtmlDoctypeFrameset
    )
where

import           Control.Arrow
import           Control.Arrow.ArrowIf
import           Control.Arrow.ArrowList
import           Control.Arrow.ArrowTree
import           Control.Arrow.ListArrow
import           Control.Arrow.NTreeEdit

import           Data.Char.Properties.XMLCharProps (isXmlSpaceChar)

import           Text.XML.HXT.Arrow.XmlArrow
import           Text.XML.HXT.DOM.FormatXmlTree    (formatXmlTree)
import           Text.XML.HXT.DOM.Interface
import qualified Text.XML.HXT.DOM.ShowXml          as XS
import qualified Text.XML.HXT.DOM.XmlNode          as XN
import           Text.XML.HXT.Parser.HtmlParsec    (emptyHtmlTags)
import           Text.XML.HXT.Parser.XhtmlEntities (xhtmlEntities)
import           Text.XML.HXT.Parser.XmlEntities   (xmlEntities)

import           Data.List                         (isPrefixOf)
import qualified Data.Map                          as M
import           Data.Maybe

-- ------------------------------------------------------------

-- |
-- Applies some "Canonical XML" rules to a document tree.
--
-- The rules differ slightly for canonical XML and XPath in handling of comments
--
-- Note: This is not the whole canonicalization as it is specified by the W3C
-- Recommendation. Adding attribute defaults or sorting attributes in lexicographic
-- order is done by the @transform@ function of module @Text.XML.HXT.Validator.Validation@.
-- Replacing entities or line feed normalization is done by the parser.
--
--
-- Not implemented yet:
--
--  - Whitespace within start and end tags is normalized
--
--  - Special characters in attribute values and character content are replaced by character references
--
-- see 'canonicalizeAllNodes' and 'canonicalizeForXPath'

canonicalizeTree'       :: LA XmlTree XmlTree -> LA XmlTree XmlTree
canonicalizeTree' :: LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' LA (NTree XNode) (NTree XNode)
toBeRemoved
    = ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
        ( (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` (forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isXmlPi))    -- remove XML PI and all text around XML root element
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD)              -- remove DTD parts, except PIs whithin DTD
        )
        forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
      )
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes LA (NTree XNode) (NTree XNode)
toBeRemoved

canonicalizeNodes       :: LA XmlTree XmlTree -> LA XmlTree XmlTree
canonicalizeNodes :: LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes LA (NTree XNode) (NTree XNode)
toBeRemoved
    = forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA forall a b. (a -> b) -> a -> b
$
      [ LA (NTree XNode) (NTree XNode)
toBeRemoved     forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      , ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef )   -- canonicalize attribute list
                        forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
processAttrl
                              ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCharRef
                                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                LA (NTree XNode) (NTree XNode)
collapseXText'                  -- combine text in attribute values
                              )
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              ( LA (NTree XNode) (NTree XNode)
collapseXText'                  -- and combine text in content
                                forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                                (forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. XmlTrees -> XmlTrees
has2XText)
                              )
                            )
      , ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. XmlTrees -> XmlTrees
has2XText) )
                        forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
collapseXText'                      -- combine text in content

      , forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef       forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [forall a. Enum a => Int -> a
toEnum Int
i])
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
                            )
      , forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata         forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
                            )
      ]

-- |
-- Applies some "Canonical XML" rules to a document tree.
--
-- The rule differ slightly for canonical XML and XPath in handling of comments
--
-- Note: This is not the whole canonicalization as it is specified by the W3C
-- Recommendation. Adding attribute defaults or sorting attributes in lexicographic
-- order is done by the @transform@ function of module @Text.XML.HXT.Validator.Validation@.
-- Replacing entities or line feed normalization is done by the parser.
--
-- Rules: remove DTD parts, processing instructions, comments and substitute char refs in attribute
-- values and text
--
-- Not implemented yet:
--
--  - Whitespace within start and end tags is normalized
--
--  - Special characters in attribute values and character content are replaced by character references

canonicalizeAllNodes    :: ArrowList a => a XmlTree XmlTree
canonicalizeAllNodes :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
canonicalizeAllNodes    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
                          LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt                       -- remove comment
{-# INLINE canonicalizeAllNodes #-}

-- |
-- Canonicalize a tree for XPath
-- Like 'canonicalizeAllNodes' but comment nodes are not removed
--
-- see 'canonicalizeAllNodes'

canonicalizeForXPath    :: ArrowList a => a XmlTree XmlTree
canonicalizeForXPath :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
canonicalizeForXPath    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' forall (a :: * -> * -> *) b c. ArrowList a => a b c
none               -- comment remains there
{-# INLINE canonicalizeForXPath #-}

-- |
-- Canonicalize the contents of a document
--
-- substitutes all char refs in text and attribute values,
-- removes CDATA section and combines all sequences of resulting text
-- nodes into a single text node
--
-- see 'canonicalizeAllNodes'

canonicalizeContents    :: ArrowList a => a XmlTree XmlTree
canonicalizeContents :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
canonicalizeContents    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
                          LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
{-# INLINE canonicalizeContents #-}

-- ------------------------------------------------------------

has2XText               :: XmlTrees -> XmlTrees
has2XText :: XmlTrees -> XmlTrees
has2XText ts0 :: XmlTrees
ts0@(NTree XNode
t1 : ts1 :: XmlTrees
ts1@(NTree XNode
t2 : XmlTrees
ts2))
    | forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t1      = if forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t2
                          then XmlTrees
ts0
                          else XmlTrees -> XmlTrees
has2XText XmlTrees
ts2
    | Bool
otherwise         = XmlTrees -> XmlTrees
has2XText XmlTrees
ts1
has2XText XmlTrees
_             = []

collapseXText'          :: LA XmlTree XmlTree
collapseXText' :: LA (NTree XNode) (NTree XNode)
collapseXText'
    = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NTree XNode -> XmlTrees -> XmlTrees
mergeText' []) )
    where
    mergeText'  :: XmlTree -> XmlTrees -> XmlTrees
    mergeText' :: NTree XNode -> XmlTrees -> XmlTrees
mergeText' NTree XNode
t1 (NTree XNode
t2 : XmlTrees
ts2)
        | forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t1 Bool -> Bool -> Bool
&& forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t2
            = let
              s1 :: String
s1 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe String
XN.getText forall a b. (a -> b) -> a -> b
$ NTree XNode
t1
              s2 :: String
s2 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe String
XN.getText forall a b. (a -> b) -> a -> b
$ NTree XNode
t2
              t :: NTree XNode
t  = forall a. XmlNode a => String -> a
XN.mkText (String
s1 forall a. [a] -> [a] -> [a]
++ String
s2)
              in
              NTree XNode
t forall a. a -> [a] -> [a]
: XmlTrees
ts2
    mergeText' NTree XNode
t1 XmlTrees
ts
        = NTree XNode
t1 forall a. a -> [a] -> [a]
: XmlTrees
ts

-- |
-- Collects sequences of text nodes in the list of children of a node into one single text node.
-- This is useful, e.g. after char and entity reference substitution

collapseXText           :: ArrowList a => a XmlTree XmlTree
collapseXText :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
collapseXText           = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA LA (NTree XNode) (NTree XNode)
collapseXText'

-- |
-- Applies collapseXText recursively.
--
--
-- see also : 'collapseXText'

collapseAllXText        :: ArrowList a => a XmlTree XmlTree
collapseAllXText :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
collapseAllXText        = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processBottomUp LA (NTree XNode) (NTree XNode)
collapseXText'

-- ------------------------------------------------------------

-- | apply an arrow to the input and convert the resulting XML trees into an XML escaped string
--
-- This is a save variant for converting a tree into an XML string representation
-- that is parsable with 'Text.XML.HXT.Arrow.ReadDocument'.
-- It is implemented with 'Text.XML.HXT.Arrow.XmlArrow.xshow',
-- but xshow does no XML escaping. The XML escaping is done with
-- 'Text.XML.HXT.Arrow.Edit.escapeXmlDoc' before xshow is applied.
--
-- So the following law holds
--
-- > xshowEscapeXml f >>> xread == f

xshowEscapeXml          :: ArrowXml a => a n XmlTree -> a n String
xshowEscapeXml :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n (NTree XNode) -> a n String
xshowEscapeXml a n (NTree XNode)
f        = a n (NTree XNode)
f forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> String
XS.xshow'' (Char -> StringFct, Char -> StringFct)
escapeXmlRefs)

-- ------------------------------------------------------------

-- |
-- escape XmlText,
-- transform all special XML chars into char- or entity- refs

type EntityRefTable     = M.Map Int String

xmlEntityRefTable
 , xhtmlEntityRefTable  :: EntityRefTable

xmlEntityRefTable :: EntityRefTable
xmlEntityRefTable       = [(String, Int)] -> EntityRefTable
buildEntityRefTable forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xmlEntities
xhtmlEntityRefTable :: EntityRefTable
xhtmlEntityRefTable     = [(String, Int)] -> EntityRefTable
buildEntityRefTable forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xhtmlEntities

buildEntityRefTable     :: [(String, Int)] -> EntityRefTable
buildEntityRefTable :: [(String, Int)] -> EntityRefTable
buildEntityRefTable     = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ (String
x,Int
y) -> (Int
y,String
x) )

type EntitySubstTable   = M.Map String String

xhtmlEntitySubstTable   :: EntitySubstTable
xhtmlEntitySubstTable :: EntitySubstTable
xhtmlEntitySubstTable   = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum) forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xhtmlEntities

-- ------------------------------------------------------------

substXHTMLEntityRef     :: LA XmlTree XmlTree
substXHTMLEntityRef :: LA (NTree XNode) (NTree XNode)
substXHTMLEntityRef
    = ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getEntityRef
        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL String -> [String]
subst
        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
      )
      forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    where
      subst :: String -> [String]
subst String
name
          = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name EntitySubstTable
xhtmlEntitySubstTable

substAllXHTMLEntityRefs :: ArrowXml a => a XmlTree XmlTree
substAllXHTMLEntityRefs :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
substAllXHTMLEntityRefs
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processBottomUp LA (NTree XNode) (NTree XNode)
substXHTMLEntityRef

-- ------------------------------------------------------------

escapeXmlRefs           :: (Char -> String -> String, Char -> String -> String)
escapeXmlRefs :: (Char -> StringFct, Char -> StringFct)
escapeXmlRefs           = (Char -> StringFct
cquote, Char -> StringFct
aquote)
    where
    cquote :: Char -> StringFct
cquote Char
c
        | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<&" = (Char
'&' forall a. a -> [a] -> [a]
:)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
        | Bool
otherwise     = (Char
c forall a. a -> [a] -> [a]
:)
    aquote :: Char -> StringFct
aquote Char
c
        | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>\"\'&\n\r\t"
                        = (Char
'&' forall a. a -> [a] -> [a]
:)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
        | Bool
otherwise     = (Char
c forall a. a -> [a] -> [a]
:)

escapeHtmlRefs          :: (Char -> String -> String, Char -> String -> String)
escapeHtmlRefs :: (Char -> StringFct, Char -> StringFct)
escapeHtmlRefs          = (Char -> StringFct
cquote, Char -> StringFct
aquote)
    where
    cquote :: Char -> StringFct
cquote Char
c
        | Char -> Bool
isHtmlTextEsc Char
c
                        = (Char
'&' forall a. a -> [a] -> [a]
:)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xhtmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
        | Bool
otherwise     = (Char
c forall a. a -> [a] -> [a]
:)
    aquote :: Char -> StringFct
aquote Char
c
        | Char -> Bool
isHtmlAttrEsc Char
c
                        = (Char
'&' forall a. a -> [a] -> [a]
:)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xhtmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
        | Bool
otherwise     = (Char
c forall a. a -> [a] -> [a]
:)

    isHtmlTextEsc :: Char -> Bool
isHtmlTextEsc Char
c     = Char
c forall a. Ord a => a -> a -> Bool
>= forall a. Enum a => Int -> a
toEnum(Int
128) Bool -> Bool -> Bool
|| ( Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<&" )
    isHtmlAttrEsc :: Char -> Bool
isHtmlAttrEsc Char
c     = Char
c forall a. Ord a => a -> a -> Bool
>= forall a. Enum a => Int -> a
toEnum(Int
128) Bool -> Bool -> Bool
|| ( Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>\"\'&\n\r\t" )

lookupRef               :: Char -> EntityRefTable -> String
lookupRef :: Char -> EntityRefTable -> String
lookupRef Char
c             = forall a. a -> Maybe a -> a
fromMaybe (Char
'#' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum Char
c))
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. Enum a => a -> Int
fromEnum Char
c)
{-# INLINE lookupRef #-}

-- ------------------------------------------------------------

preventEmptyElements    :: ArrowList a => [String] -> Bool -> a XmlTree XmlTree
preventEmptyElements :: forall (a :: * -> * -> *).
ArrowList a =>
[String] -> Bool -> a (NTree XNode) (NTree XNode)
preventEmptyElements [String]
ns Bool
isHtml
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [ ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem
                     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                     LA (NTree XNode) (NTree XNode)
isNoneEmpty
                     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                     forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                   )
                   forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"")
                 ]
    where
    isNoneEmpty :: LA (NTree XNode) (NTree XNode)
isNoneEmpty
        | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ns) = forall (a :: * -> * -> *).
ArrowXml a =>
(QName -> Bool) -> a (NTree XNode) (NTree XNode)
hasNameWith (QName -> String
localPart forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ns))
        | Bool
isHtml        = forall (a :: * -> * -> *).
ArrowXml a =>
(QName -> Bool) -> a (NTree XNode) (NTree XNode)
hasNameWith (QName -> String
localPart forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
emptyHtmlTags))
        | Bool
otherwise     = forall (a :: * -> * -> *) b. ArrowList a => a b b
this

-- ------------------------------------------------------------

-- |
-- convert a document into a Haskell representation (with show).
--
-- Useful for debugging and trace output.
-- see also : 'treeRepOfXmlDoc', 'numberLinesInXmlDoc'

haskellRepOfXmlDoc      :: ArrowList a => a XmlTree XmlTree
haskellRepOfXmlDoc :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
haskellRepOfXmlDoc
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl] [forall a. Show a => a -> String
show forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText]

-- |
-- convert a document into a text and add line numbers to the text representation.
--
-- Result is a root node with a single text node as child.
-- Useful for debugging and trace output.
-- see also : 'haskellRepOfXmlDoc', 'treeRepOfXmlDoc'

numberLinesInXmlDoc     :: ArrowList a => a XmlTree XmlTree
numberLinesInXmlDoc :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
numberLinesInXmlDoc
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (forall (a :: * -> * -> *).
ArrowXml a =>
StringFct -> a (NTree XNode) (NTree XNode)
changeText StringFct
numberLines)
    where
    numberLines :: String -> String
    numberLines :: StringFct
numberLines String
str
        = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
          forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
n String
l -> Int -> String
lineNr Int
n forall a. [a] -> [a] -> [a]
++ String
l forall a. [a] -> [a] -> [a]
++ String
"\n") [Int
1..] (String -> [String]
lines String
str)
        where
        lineNr   :: Int -> String
        lineNr :: Int -> String
lineNr Int
n = (forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take Int
6 (forall a. [a] -> [a]
reverse (forall a. Show a => a -> String
show Int
n) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
6 Char
' '))) forall a. [a] -> [a] -> [a]
++ String
"  "

-- |
-- convert a document into a text representation in tree form.
--
-- Useful for debugging and trace output.
-- see also : 'haskellRepOfXmlDoc', 'numberLinesInXmlDoc'

treeRepOfXmlDoc :: ArrowList a => a XmlTree XmlTree
treeRepOfXmlDoc :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
treeRepOfXmlDoc
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl] [NTree XNode -> String
formatXmlTree forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText]

addHeadlineToXmlDoc     :: ArrowXml a => a XmlTree XmlTree
addHeadlineToXmlDoc :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addHeadlineToXmlDoc
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ ( forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
addTitle forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
a_source forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ StringFct
formatTitle) )
    where
    addTitle :: String -> a (NTree XNode) (NTree XNode)
addTitle String
str
        = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
str forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n" )
    formatTitle :: StringFct
formatTitle String
str
        = String
"\n" forall a. [a] -> [a] -> [a]
++ String
headline forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
underline forall a. [a] -> [a] -> [a]
++ String
"\n\n"
        where
        headline :: String
headline  = String
"content of: " forall a. [a] -> [a] -> [a]
++ String
str
        underline :: String
underline = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Char
'=') String
headline

-- ------------------------------------------------------------

-- |
-- remove a Comment node

removeComment           :: ArrowXml a => a XmlTree XmlTree
removeComment :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeComment           = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt

-- |
-- remove all comments in a tree recursively

removeAllComment        :: ArrowXml a => a XmlTree XmlTree
removeAllComment :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeAllComment        = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none]

-- ------------------------------------------------------------

-- |
-- simple filter for removing whitespace.
--
-- no check on sigificant whitespace, e.g. in HTML \<pre\>-elements, is done.
--
--
-- see also : 'removeAllWhiteSpace', 'removeDocWhiteSpace'

removeWhiteSpace        :: ArrowXml a => a XmlTree XmlTree
removeWhiteSpace :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeWhiteSpace        = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace

-- |
-- simple recursive filter for removing all whitespace.
--
-- removes all text nodes in a tree that consist only of whitespace.
--
--
-- see also : 'removeWhiteSpace', 'removeDocWhiteSpace'

removeAllWhiteSpace     :: ArrowXml a => a XmlTree XmlTree
removeAllWhiteSpace :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeAllWhiteSpace     = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none]
                       -- fromLA $ processBottomUp removeWhiteSpace'    -- less efficient

-- ------------------------------------------------------------

-- |
-- filter for removing all not significant whitespace.
--
-- the tree traversed for removing whitespace between elements,
-- that was inserted for indentation and readability.
-- whitespace is only removed at places, where it's not significat
-- preserving whitespace may be controlled in a document tree
-- by a tag attribute @xml:space@
--
-- allowed values for this attribute are @default | preserve@
--
-- input is root node of the document to be cleaned up,
-- output the semantically equivalent simplified tree
--
--
-- see also : 'indentDoc', 'removeAllWhiteSpace'

removeDocWhiteSpace     :: ArrowXml a => a XmlTree XmlTree
removeDocWhiteSpace :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeDocWhiteSpace     = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode)
removeRootWhiteSpace


removeRootWhiteSpace    :: LA XmlTree XmlTree
removeRootWhiteSpace :: LA (NTree XNode) (NTree XNode)
removeRootWhiteSpace
    =  forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren LA (NTree XNode) (NTree XNode)
processRootElement
       forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
       forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
    where
    processRootElement  :: LA XmlTree XmlTree
    processRootElement :: LA (NTree XNode) (NTree XNode)
processRootElement
        = forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeWhiteSpace forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
processChild
        where
        processChild :: LA (NTree XNode) (NTree XNode)
processChild
            = forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD
                        forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeAllWhiteSpace                 -- whitespace in DTD is redundant
                      , forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                        forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                              forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees forall a. Int -> LA a (NTree XNode)
insertNothing Bool
False Int
1
                                            )
                      ]

-- ------------------------------------------------------------

-- |
-- filter for indenting a document tree for pretty printing.
--
-- the tree is traversed for inserting whitespace for tag indentation.
--
-- whitespace is only inserted or changed at places, where it isn't significant,
-- is's not inserted between tags and text containing non whitespace chars.
--
-- whitespace is only inserted or changed at places, where it's not significant.
-- preserving whitespace may be controlled in a document tree
-- by a tag attribute @xml:space@
--
-- allowed values for this attribute are @default | preserve@.
--
-- input is a complete document tree or a document fragment
-- result is the semantically equivalent formatted tree.
--
--
-- see also : 'removeDocWhiteSpace'

indentDoc               :: ArrowXml a => a XmlTree XmlTree
indentDoc :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
indentDoc               = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
                          ( ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` LA (NTree XNode) (NTree XNode)
indentRoot )
                            forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                            (forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [] [forall (a :: * -> * -> *) b. ArrowList a => a b b
this] forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
indentRoot forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
                          )

-- ------------------------------------------------------------

indentRoot              :: LA XmlTree XmlTree
indentRoot :: LA (NTree XNode) (NTree XNode)
indentRoot              = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren LA (NTree XNode) (NTree XNode)
indentRootChildren
    where
    indentRootChildren :: LA (NTree XNode) (NTree XNode)
indentRootChildren
        = LA (NTree XNode) (NTree XNode)
removeText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
indentChild forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
insertNL
        where
        removeText :: LA (NTree XNode) (NTree XNode)
removeText      = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText
        insertNL :: LA (NTree XNode) (NTree XNode)
insertNL        = forall (a :: * -> * -> *) b. ArrowList a => a b b
this forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
        indentChild :: LA (NTree XNode) (NTree XNode)
indentChild     = ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
                            ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                              forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
                              (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees (forall a. Int -> Int -> LA a (NTree XNode)
insertIndentation Int
2) Bool
False Int
1
                            )
                            forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD
                          )

-- ------------------------------------------------------------
--
-- copied from EditFilter and rewritten for arrows
-- to remove dependency to the filter module

indentTrees     :: (Int -> LA XmlTree XmlTree) -> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees :: (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees Int -> LA (NTree XNode) (NTree XNode)
_ Bool
_ Int
_ []
    = []
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace Int
level XmlTrees
ts
    = forall {b} {b}. LA b b -> [b] -> [b]
runLAs LA (NTree XNode) (NTree XNode)
lsf XmlTrees
ls
      forall a. [a] -> [a] -> [a]
++
      XmlTrees -> XmlTrees
indentRest XmlTrees
rs
      where
      runLAs :: LA b b -> [b] -> [b]
runLAs LA b b
f [b]
l
          = forall a b. LA a b -> a -> [b]
runLA (forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL [b]
l forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA b b
f) forall a. HasCallStack => a
undefined

      (XmlTrees
ls, XmlTrees
rs)
          = forall a. (a -> Bool) -> [a] -> ([a], [a])
break forall a. XmlNode a => a -> Bool
XN.isElem XmlTrees
ts

      isSignificant     :: Bool
      isSignificant :: Bool
isSignificant
          = Bool
preserveSpace
            Bool -> Bool -> Bool
||
            (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {b}. LA b b -> [b] -> [b]
runLAs LA (NTree XNode) (NTree XNode)
isSignificantPart) XmlTrees
ls

      isSignificantPart :: LA XmlTree XmlTree
      isSignificantPart :: LA (NTree XNode) (NTree XNode)
isSignificantPart
          = forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA
            [ forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace
            , forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata
            , forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef
            , forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isEntityRef
            ]

      lsf       :: LA XmlTree XmlTree
      lsf :: LA (NTree XNode) (NTree XNode)
lsf
          | Bool
isSignificant
              = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          | Bool
otherwise
              = (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace)
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (Int -> LA (NTree XNode) (NTree XNode)
indentFilter Int
level forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) b. ArrowList a => a b b
this)

      indentRest        :: XmlTrees -> XmlTrees
      indentRest :: XmlTrees -> XmlTrees
indentRest []
          | Bool
isSignificant
              = []
          | Bool
otherwise
              = forall a b. LA a b -> a -> [b]
runLA (Int -> LA (NTree XNode) (NTree XNode)
indentFilter (Int
level forall a. Num a => a -> a -> a
- Int
1)) forall a. HasCallStack => a
undefined

      indentRest (NTree XNode
t':XmlTrees
ts')
          = forall a b. LA a b -> a -> [b]
runLA ( ( LA (NTree XNode) (NTree XNode)
indentElem
                      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                      LA (NTree XNode) (NTree XNode)
lsf
                    )
                    forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem
                  ) NTree XNode
t'
            forall a. [a] -> [a] -> [a]
++
            ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
ts'
              then XmlTrees -> XmlTrees
indentRest
              else (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace Int
level
            ) XmlTrees
ts'
          where
          indentElem :: LA (NTree XNode) (NTree XNode)
indentElem
              = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                  forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
                                  XmlTrees -> XmlTrees
indentChildren
                                )

          xmlSpaceAttrValue     :: String
          xmlSpaceAttrValue :: String
xmlSpaceAttrValue
              = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. LA a b -> a -> [b]
runLA (forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"xml:space") forall a b. (a -> b) -> a -> b
$ NTree XNode
t'

          preserveSpace'        :: Bool
          preserveSpace' :: Bool
preserveSpace'
              = ( forall a. a -> Maybe a -> a
fromMaybe Bool
preserveSpace
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
xmlSpaceAttrValue
                ) [ (String
"preserve", Bool
True)
                  , (String
"default",  Bool
False)
                  ]

          indentChildren        :: XmlTrees -> XmlTrees
          indentChildren :: XmlTrees -> XmlTrees
indentChildren XmlTrees
cs'
              | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isXmlSpaceChar) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe String
XN.getText) XmlTrees
cs'
                  = []
              | Bool
otherwise
                  = (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace' (Int
level forall a. Num a => a -> a -> a
+ Int
1) XmlTrees
cs'


-- filter for indenting elements

insertIndentation       :: Int -> Int -> LA a XmlTree
insertIndentation :: forall a. Int -> Int -> LA a (NTree XNode)
insertIndentation Int
indentWidth Int
level
    = forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt (Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
level forall a. Num a => a -> a -> a
* Int
indentWidth) Char
' ')

-- filter for removing all whitespace

insertNothing           :: Int -> LA a XmlTree
insertNothing :: forall a. Int -> LA a (NTree XNode)
insertNothing Int
_         = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

-- ------------------------------------------------------------

-- |
-- converts a CDATA section into normal text nodes

transfCdata             :: ArrowXml a => a XmlTree XmlTree
transfCdata :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCdata             = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
                          (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText) forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata

-- |
-- converts CDATA sections in whole document tree into normal text nodes

transfAllCdata          :: ArrowXml a => a XmlTree XmlTree
transfAllCdata :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfAllCdata          = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata forall a b. a -> b -> IfThen a b
:-> (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText)]

-- |
-- converts a character reference to normal text

transfCharRef           :: ArrowXml a => a XmlTree XmlTree
transfCharRef :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCharRef           = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
                          ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [forall a. Enum a => Int -> a
toEnum Int
i]) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText )
                          forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                          forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef

-- |
-- recursively converts all character references to normal text

transfAllCharRef        :: ArrowXml a => a XmlTree XmlTree
transfAllCharRef :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfAllCharRef        = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef forall a b. a -> b -> IfThen a b
:-> (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [forall a. Enum a => Int -> a
toEnum Int
i]) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText)]

-- ------------------------------------------------------------

rememberDTDAttrl        :: ArrowList a => a XmlTree XmlTree
rememberDTDAttrl :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
rememberDTDAttrl
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      ( ( forall {a :: * -> * -> *}.
ArrowXml a =>
[(String, String)] -> a (NTree XNode) (NTree XNode)
addDTDAttrl forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowDTD a =>
a (NTree XNode) (NTree XNode)
isDTDDoctype forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) [(String, String)]
getDTDAttrl ) )
        forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
        forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      )
    where
    addDTDAttrl :: [(String, String)] -> a (NTree XNode) (NTree XNode)
addDTDAttrl [(String, String)]
al
        = forall (a :: * -> * -> *) b. ArrowList a => [a b b] -> a b b
seqA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
dtdPrefix forall a. [a] -> [a] -> [a]
++)) forall a b. (a -> b) -> a -> b
$ [(String, String)]
al

addDefaultDTDecl        :: ArrowList a => a XmlTree XmlTree
addDefaultDTDecl :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
addDefaultDTDecl
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      ( forall {a :: * -> * -> *}.
ArrowDTD a =>
[(String, String)] -> a (NTree XNode) (NTree XNode)
addDTD forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) n.
ArrowXml a =>
a n (NTree XNode) -> a n String
xshow forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {b}. LA (String, b) (String, b)
hasDtdPrefix) )
    where
    hasDtdPrefix :: LA (String, b) (String, b)
hasDtdPrefix
        = forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String
dtdPrefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dtdPrefix)))
    addDTD :: [(String, String)] -> a (NTree XNode) (NTree XNode)
addDTD []
        = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    addDTD [(String, String)]
al
        = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
          ( forall (a :: * -> * -> *) n.
ArrowDTD a =>
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
mkDTDDoctype [(String, String)]
al forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
            forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
            forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowDTD a =>
a (NTree XNode) (NTree XNode)
isDTDDoctype) )      -- remove old DTD decl
          )

-- ------------------------------------------------------------

hasXmlPi                :: ArrowXml a => a XmlTree XmlTree
hasXmlPi :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
hasXmlPi
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA
      ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi
        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
hasName String
t_xml
      )

-- | add an \<?xml version=\"1.0\"?\> processing instruction
-- if it's not already there

addXmlPi                :: ArrowXml a => a XmlTree XmlTree
addXmlPi :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXmlPi
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA
      ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
0 ( ( forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n (NTree XNode) -> a n (NTree XNode)
mkPi (String -> QName
mkName String
t_xml) forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                               forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                               forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
a_version String
"1.0"
                             )
                             forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                             forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
                           )
        forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
        forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
hasXmlPi
      )

-- | add an encoding spec to the \<?xml version=\"1.0\"?\> processing instruction

addXmlPiEncoding        :: ArrowXml a => String -> a XmlTree XmlTree
addXmlPiEncoding :: forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
addXmlPiEncoding String
enc
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ( forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
a_encoding String
enc
                        forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                        ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
hasName String
t_xml )
                      )

-- | add an XHTML strict doctype declaration to a document

addXHtmlDoctypeStrict
  , addXHtmlDoctypeTransitional
  , addXHtmlDoctypeFrameset     :: ArrowXml a => a XmlTree XmlTree

-- | add an XHTML strict doctype declaration to a document

addXHtmlDoctypeStrict :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXHtmlDoctypeStrict
    = forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
"html" String
"-//W3C//DTD XHTML 1.0 Strict//EN" String
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"

-- | add an XHTML transitional doctype declaration to a document

addXHtmlDoctypeTransitional :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXHtmlDoctypeTransitional
    = forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
"html" String
"-//W3C//DTD XHTML 1.0 Transitional//EN" String
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"

-- | add an XHTML frameset doctype declaration to a document

addXHtmlDoctypeFrameset :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXHtmlDoctypeFrameset
    = forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
"html" String
"-//W3C//DTD XHTML 1.0 Frameset//EN" String
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"

-- | add a doctype declaration to a document
--
-- The arguments are the root element name, the PUBLIC id and the SYSTEM id

addDoctypeDecl  :: ArrowXml a => String -> String -> String -> a XmlTree XmlTree
addDoctypeDecl :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
rootElem String
public String
system
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
      forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
      ( forall (a :: * -> * -> *) n.
ArrowDTD a =>
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
mkDTDDoctype ( ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
public then forall a. a -> a
id else ( (String
k_public, String
public) forall a. a -> [a] -> [a]
: ) )
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
system then forall a. a -> a
id else ( (String
k_system, String
system) forall a. a -> [a] -> [a]
: ) )
                       forall a b. (a -> b) -> a -> b
$  [ (String
a_name, String
rootElem) ]
                     ) forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
        forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
        forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
      )

-- ------------------------------------------------------------