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

{- |
   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
    = ( LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
        ( (LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` (LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isXmlPi))    -- remove XML PI and all text around XML root element
          LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (t :: * -> *) b c. Tree t => LA (t b) c -> LA (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD)              -- remove DTD parts, except PIs whithin DTD
        )
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
      )
      LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
    = [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA ([IfThen
    (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
 -> LA (NTree XNode) (NTree XNode))
-> [IfThen
      (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      [ LA (NTree XNode) (NTree XNode)
toBeRemoved     LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      , ( LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef )   -- canonicalize attribute list
                        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> ( LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
processAttrl
                              ( LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCharRef
                                LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
                              )
                              LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
                                LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                                (LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren LA (NTree XNode) (NTree XNode)
-> ([NTree XNode] -> [NTree XNode])
-> LA (NTree XNode) (NTree XNode)
forall b c d. LA b c -> ([c] -> [d]) -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. [NTree XNode] -> [NTree XNode]
has2XText)
                              )
                            )
      , ( LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren LA (NTree XNode) (NTree XNode)
-> ([NTree XNode] -> [NTree XNode])
-> LA (NTree XNode) (NTree XNode)
forall b c d. LA b c -> ([c] -> [d]) -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. [NTree XNode] -> [NTree XNode]
has2XText) )
                        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
collapseXText'                      -- combine text in content

      , LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef       LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> ( LA (NTree XNode) Int
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef
                              LA (NTree XNode) Int
-> LA Int (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              (Int -> String) -> LA Int String
forall b c. (b -> c) -> LA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i])
                              LA Int String -> LA String (NTree XNode) -> LA Int (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              LA String (NTree XNode)
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
                            )
      , LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata         LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> ( LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata
                              LA (NTree XNode) String
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              LA String (NTree XNode)
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    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
                          LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' LA (NTree XNode) (NTree XNode)
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    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' LA (NTree XNode) (NTree XNode)
forall b c. LA b c
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    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
                          LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
{-# INLINE canonicalizeContents #-}

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

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

collapseXText'          :: LA XmlTree XmlTree
collapseXText' :: LA (NTree XNode) (NTree XNode)
collapseXText'
    = LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) [NTree XNode]
forall b c. LA b c -> LA b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren LA (NTree XNode) [NTree XNode]
-> LA [NTree XNode] (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([NTree XNode] -> [NTree XNode]) -> LA [NTree XNode] (NTree XNode)
forall b c. (b -> [c]) -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((NTree XNode -> [NTree XNode] -> [NTree XNode])
-> [NTree XNode] -> [NTree XNode] -> [NTree XNode]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NTree XNode -> [NTree XNode] -> [NTree XNode]
mergeText' []) )
    where
    mergeText'  :: XmlTree -> XmlTrees -> XmlTrees
    mergeText' :: NTree XNode -> [NTree XNode] -> [NTree XNode]
mergeText' NTree XNode
t1 (NTree XNode
t2 : [NTree XNode]
ts2)
        | NTree XNode -> Bool
forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t1 Bool -> Bool -> Bool
&& NTree XNode -> Bool
forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t2
            = let
              s1 :: String
s1 = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (NTree XNode -> Maybe String) -> NTree XNode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe String
forall a. XmlNode a => a -> Maybe String
XN.getText (NTree XNode -> String) -> NTree XNode -> String
forall a b. (a -> b) -> a -> b
$ NTree XNode
t1
              s2 :: String
s2 = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (NTree XNode -> Maybe String) -> NTree XNode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe String
forall a. XmlNode a => a -> Maybe String
XN.getText (NTree XNode -> String) -> NTree XNode -> String
forall a b. (a -> b) -> a -> b
$ NTree XNode
t2
              t :: NTree XNode
t  = String -> NTree XNode
forall a. XmlNode a => String -> a
XN.mkText (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2)
              in
              NTree XNode
t NTree XNode -> [NTree XNode] -> [NTree XNode]
forall a. a -> [a] -> [a]
: [NTree XNode]
ts2
    mergeText' NTree XNode
t1 [NTree XNode]
ts
        = NTree XNode
t1 NTree XNode -> [NTree XNode] -> [NTree XNode]
forall a. a -> [a] -> [a]
: [NTree XNode]
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           = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
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        = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t 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 a n (NTree XNode) -> ([NTree XNode] -> String) -> a n String
forall b c d. a b c -> ([c] -> d) -> a b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (((Char -> String -> String)
 -> (Char -> String -> String) -> [NTree XNode] -> String)
-> (Char -> String -> String, Char -> String -> String)
-> [NTree XNode]
-> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Char -> String -> String)
-> (Char -> String -> String) -> [NTree XNode] -> String
XS.xshow'' (Char -> String -> String, Char -> String -> String)
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 ([(String, Int)] -> EntityRefTable)
-> [(String, Int)] -> EntityRefTable
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xmlEntities
xhtmlEntityRefTable :: EntityRefTable
xhtmlEntityRefTable     = [(String, Int)] -> EntityRefTable
buildEntityRefTable ([(String, Int)] -> EntityRefTable)
-> [(String, Int)] -> EntityRefTable
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xhtmlEntities

buildEntityRefTable     :: [(String, Int)] -> EntityRefTable
buildEntityRefTable :: [(String, Int)] -> EntityRefTable
buildEntityRefTable     = [(Int, String)] -> EntityRefTable
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, String)] -> EntityRefTable)
-> ([(String, Int)] -> [(Int, String)])
-> [(String, Int)]
-> EntityRefTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> (Int, String))
-> [(String, Int)] -> [(Int, String)]
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   = [(String, String)] -> EntitySubstTable
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, String)] -> EntitySubstTable)
-> ([(String, Int)] -> [(String, String)])
-> [(String, Int)]
-> EntitySubstTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> (String, String))
-> [(String, Int)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> String) -> (String, Int) -> (String, String)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Int -> String) -> (String, Int) -> (String, String))
-> (Int -> String) -> (String, Int) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum) ([(String, Int)] -> EntitySubstTable)
-> [(String, Int)] -> EntitySubstTable
forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xhtmlEntities

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

substXHTMLEntityRef     :: LA XmlTree XmlTree
substXHTMLEntityRef :: LA (NTree XNode) (NTree XNode)
substXHTMLEntityRef
    = ( LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getEntityRef
        LA (NTree XNode) String
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        (String -> [String]) -> LA String String
forall b c. (b -> [c]) -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL String -> [String]
subst
        LA String String
-> LA String (NTree XNode) -> LA String (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        LA String (NTree XNode)
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
      )
      LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    where
      subst :: String -> [String]
subst String
name
          = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> EntitySubstTable -> Maybe String
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t 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 -> String -> String, Char -> String -> String)
escapeXmlRefs           = (Char -> String -> String
cquote, Char -> String -> String
aquote)
    where
    cquote :: Char -> String -> String
cquote Char
c
        | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<&" = (Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
:)
                          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xmlEntityRefTable) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
                          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' Char -> String -> String
forall a. a -> [a] -> [a]
:)
        | Bool
otherwise     = (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:)
    aquote :: Char -> String -> String
aquote Char
c
        | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>\"\'&\n\r\t"
                        = (Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
:)
                          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xmlEntityRefTable) String -> String -> String
forall a. [a] -> [a] -> [a]
++)
                          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' Char -> String -> String
forall a. a -> [a] -> [a]
:)
        | Bool
otherwise     = (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:)

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

    isHtmlTextEsc :: Char -> Bool
isHtmlTextEsc Char
c     = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Char
forall a. Enum a => Int -> a
toEnum(Int
128) Bool -> Bool -> Bool
|| ( Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<&" )
    isHtmlAttrEsc :: Char -> Bool
isHtmlAttrEsc Char
c     = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Char
forall a. Enum a => Int -> a
toEnum(Int
128) Bool -> Bool -> Bool
|| ( Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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             = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c))
                          (Maybe String -> String)
-> (EntityRefTable -> Maybe String) -> EntityRefTable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> EntityRefTable -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Char -> Int
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [ ( LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem
                     LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
                     LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall b c. LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                   )
                   LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (String -> LA (NTree XNode) (NTree XNode)
forall n. String -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"")
                 ]
    where
    isNoneEmpty :: LA (NTree XNode) (NTree XNode)
isNoneEmpty
        | Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ns) = (QName -> Bool) -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
(QName -> Bool) -> a (NTree XNode) (NTree XNode)
hasNameWith (QName -> String
localPart (QName -> String) -> (String -> Bool) -> QName -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ns))
        | Bool
isHtml        = (QName -> Bool) -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
(QName -> Bool) -> a (NTree XNode) (NTree XNode)
hasNameWith (QName -> String
localPart (QName -> String) -> (String -> Bool) -> QName -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
emptyHtmlTags))
        | Bool
otherwise     = LA (NTree XNode) (NTree XNode)
forall b. LA b b
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      [LA (NTree XNode) (NTree XNode)]
-> [LA (NTree XNode) (NTree XNode)]
-> LA (NTree XNode) (NTree XNode)
forall n.
[LA n (NTree XNode)] -> [LA n (NTree XNode)] -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl] [NTree XNode -> String
forall a. Show a => a -> String
show (NTree XNode -> String)
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> LA String (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ((String -> String) -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a (NTree XNode) (NTree XNode)
changeText String -> String
numberLines)
    where
    numberLines :: String -> String
    numberLines :: String -> String
numberLines String
str
        = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
          (Int -> String -> String) -> [Int] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
n String
l -> Int -> String
lineNr Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") [Int
1..] (String -> [String]
lines String
str)
        where
        lineNr   :: Int -> String
        lineNr :: Int -> String
lineNr Int
n = (String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
6 (String -> String
forall a. [a] -> [a]
reverse (Int -> String
forall a. Show a => a -> String
show Int
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
6 Char
' '))) String -> String -> String
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      [LA (NTree XNode) (NTree XNode)]
-> [LA (NTree XNode) (NTree XNode)]
-> LA (NTree XNode) (NTree XNode)
forall n.
[LA n (NTree XNode)] -> [LA n (NTree XNode)] -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl] [NTree XNode -> String
formatXmlTree (NTree XNode -> String)
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> LA String (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ ( String -> LA (NTree XNode) (NTree XNode)
forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
addTitle (String -> LA (NTree XNode) (NTree XNode))
-> LA (NTree XNode) String -> LA (NTree XNode) (NTree XNode)
forall c b d. (c -> LA b d) -> LA b c -> LA b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (String -> LA (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
a_source LA (NTree XNode) String
-> (String -> String) -> LA (NTree XNode) String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> String
formatTitle) )
    where
    addTitle :: String -> a (NTree XNode) (NTree XNode)
addTitle String
str
        = a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( String -> a (NTree XNode) (NTree XNode)
forall n. String -> a n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
str a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> a (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> String -> a (NTree XNode) (NTree XNode)
forall n. String -> a n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n" )
    formatTitle :: String -> String
formatTitle String
str
        = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
headline String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
underline String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
        where
        headline :: String
headline  = String
"content of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
        underline :: String
underline = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char
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           = a (NTree XNode) (NTree XNode)
forall b c. a b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall b c. a b b -> a b c -> a b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` a (NTree XNode) (NTree XNode)
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        = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
forall b c. LA b c
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        = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
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     = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
forall b c. LA b c
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     = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode)
removeRootWhiteSpace


removeRootWhiteSpace    :: LA XmlTree XmlTree
removeRootWhiteSpace :: LA (NTree XNode) (NTree XNode)
removeRootWhiteSpace
    =  LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
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
       LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
       LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
    where
    processRootElement  :: LA XmlTree XmlTree
    processRootElement :: LA (NTree XNode) (NTree XNode)
processRootElement
        = LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeWhiteSpace LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
            = [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c d. [IfThen (LA b c) (LA b d)] -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD
                        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeAllWhiteSpace                 -- whitespace in DTD is redundant
                      , LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                              LA (NTree XNode) (NTree XNode)
-> ([NTree XNode] -> [NTree XNode])
-> LA (NTree XNode) (NTree XNode)
forall b c d. LA b c -> ([c] -> [d]) -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> [NTree XNode] -> [NTree XNode]
indentTrees Int -> LA (NTree XNode) (NTree XNode)
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               = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
                          ( ( LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c d. LA b c -> LA b d -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` LA (NTree XNode) (NTree XNode)
indentRoot )
                            LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                            ([LA (NTree XNode) (NTree XNode)]
-> [LA (NTree XNode) (NTree XNode)]
-> LA (NTree XNode) (NTree XNode)
forall n.
[LA n (NTree XNode)] -> [LA n (NTree XNode)] -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [] [LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this] LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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 LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
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              = LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
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 LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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 LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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      = LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText
        insertNL :: LA (NTree XNode) (NTree XNode)
insertNL        = LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> String -> LA (NTree XNode) (NTree XNode)
forall n. String -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
        indentChild :: LA (NTree XNode) (NTree XNode)
indentChild     = ( LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
                            ( LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                              LA (NTree XNode) (NTree XNode)
-> ([NTree XNode] -> [NTree XNode])
-> LA (NTree XNode) (NTree XNode)
forall b c d. LA b c -> ([c] -> [d]) -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
                              (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> [NTree XNode] -> [NTree XNode]
indentTrees (Int -> Int -> LA (NTree XNode) (NTree XNode)
forall a. Int -> Int -> LA a (NTree XNode)
insertIndentation Int
2) Bool
False Int
1
                            )
                            LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` LA (NTree XNode) (NTree XNode)
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 -> [NTree XNode] -> [NTree XNode]
indentTrees Int -> LA (NTree XNode) (NTree XNode)
_ Bool
_ Int
_ []
    = []
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace Int
level [NTree XNode]
ts
    = LA (NTree XNode) (NTree XNode) -> [NTree XNode] -> [NTree XNode]
forall {b} {b}. LA b b -> [b] -> [b]
runLAs LA (NTree XNode) (NTree XNode)
lsf [NTree XNode]
ls
      [NTree XNode] -> [NTree XNode] -> [NTree XNode]
forall a. [a] -> [a] -> [a]
++
      [NTree XNode] -> [NTree XNode]
indentRest [NTree XNode]
rs
      where
      runLAs :: LA b b -> [b] -> [b]
runLAs LA b b
f [b]
l
          = LA Any b -> Any -> [b]
forall a b. LA a b -> a -> [b]
runLA ([b] -> LA Any b
forall c b. [c] -> LA b c
forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL [b]
l LA Any b -> LA b b -> LA Any b
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) Any
forall a. HasCallStack => a
undefined

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

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

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

      lsf       :: LA XmlTree XmlTree
      lsf :: LA (NTree XNode) (NTree XNode)
lsf
          | Bool
isSignificant
              = LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          | Bool
otherwise
              = (LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace)
                LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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 LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this)

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

      indentRest (NTree XNode
t':[NTree XNode]
ts')
          = LA (NTree XNode) (NTree XNode) -> NTree XNode -> [NTree XNode]
forall a b. LA a b -> a -> [b]
runLA ( ( LA (NTree XNode) (NTree XNode)
indentElem
                      LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
                    )
                    LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem
                  ) NTree XNode
t'
            [NTree XNode] -> [NTree XNode] -> [NTree XNode]
forall a. [a] -> [a] -> [a]
++
            ( if [NTree XNode] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NTree XNode]
ts'
              then [NTree XNode] -> [NTree XNode]
indentRest
              else (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> [NTree XNode] -> [NTree XNode]
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace Int
level
            ) [NTree XNode]
ts'
          where
          indentElem :: LA (NTree XNode) (NTree XNode)
indentElem
              = LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                  LA (NTree XNode) (NTree XNode)
-> ([NTree XNode] -> [NTree XNode])
-> LA (NTree XNode) (NTree XNode)
forall b c d. LA b c -> ([c] -> [d]) -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
                                  [NTree XNode] -> [NTree XNode]
indentChildren
                                )

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

          preserveSpace'        :: Bool
          preserveSpace' :: Bool
preserveSpace'
              = ( Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
preserveSpace
                  (Maybe Bool -> Bool)
-> ([(String, Bool)] -> Maybe Bool) -> [(String, Bool)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> [(String, Bool)] -> Maybe Bool
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 :: [NTree XNode] -> [NTree XNode]
indentChildren [NTree XNode]
cs'
              | (NTree XNode -> Bool) -> [NTree XNode] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isXmlSpaceChar) (Maybe String -> Bool)
-> (NTree XNode -> Maybe String) -> NTree XNode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe String
forall a. XmlNode a => a -> Maybe String
XN.getText) [NTree XNode]
cs'
                  = []
              | Bool
otherwise
                  = (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> [NTree XNode] -> [NTree XNode]
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace' (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [NTree XNode]
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
    = String -> LA a (NTree XNode)
forall n. String -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt (Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
level Int -> Int -> Int
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
_         = LA a (NTree XNode)
forall b c. LA b c
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             = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
                          (LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata LA (NTree XNode) String
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String (NTree XNode)
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText) LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` LA (NTree XNode) (NTree XNode)
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          = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> (LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata LA (NTree XNode) String
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String (NTree XNode)
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           = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
                          ( LA (NTree XNode) Int
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef LA (NTree XNode) Int
-> LA Int (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> String) -> LA Int String
forall b c. (b -> c) -> LA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i]) LA Int String -> LA String (NTree XNode) -> LA Int (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String (NTree XNode)
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText )
                          LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                          LA (NTree XNode) (NTree XNode)
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        = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$ [IfThen
   (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))]
-> LA (NTree XNode) (NTree XNode)
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode)
-> IfThen
     (LA (NTree XNode) (NTree XNode)) (LA (NTree XNode) (NTree XNode))
forall a b. a -> b -> IfThen a b
:-> (LA (NTree XNode) Int
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef LA (NTree XNode) Int
-> LA Int (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> String) -> LA Int String
forall b c. (b -> c) -> LA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i]) LA Int String -> LA String (NTree XNode) -> LA Int (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      ( ( [(String, String)] -> LA (NTree XNode) (NTree XNode)
forall {a :: * -> * -> *}.
ArrowXml a =>
[(String, String)] -> a (NTree XNode) (NTree XNode)
addDTDAttrl ([(String, String)] -> LA (NTree XNode) (NTree XNode))
-> LA (NTree XNode) [(String, String)]
-> LA (NTree XNode) (NTree XNode)
forall c b d. (c -> LA b d) -> LA b c -> LA b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) [(String, String)]
-> LA (NTree XNode) [(String, String)]
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)
forall (a :: * -> * -> *).
ArrowDTD a =>
a (NTree XNode) (NTree XNode)
isDTDDoctype LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) [(String, String)]
-> LA (NTree XNode) [(String, String)]
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) [(String, String)]
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) [(String, String)]
getDTDAttrl ) )
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
        LA (NTree XNode) (NTree XNode)
forall b. LA b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      )
    where
    addDTDAttrl :: [(String, String)] -> a (NTree XNode) (NTree XNode)
addDTDAttrl [(String, String)]
al
        = [a (NTree XNode) (NTree XNode)] -> a (NTree XNode) (NTree XNode)
forall b. [a b b] -> a b b
forall (a :: * -> * -> *) b. ArrowList a => [a b b] -> a b b
seqA ([a (NTree XNode) (NTree XNode)] -> a (NTree XNode) (NTree XNode))
-> ([(String, String)] -> [a (NTree XNode) (NTree XNode)])
-> [(String, String)]
-> a (NTree XNode) (NTree XNode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> a (NTree XNode) (NTree XNode))
-> [(String, String)] -> [a (NTree XNode) (NTree XNode)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> a (NTree XNode) (NTree XNode))
-> (String, String) -> a (NTree XNode) (NTree XNode)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr) ([(String, String)] -> [a (NTree XNode) (NTree XNode)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [a (NTree XNode) (NTree XNode)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, String) -> (String, String)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
dtdPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++)) ([(String, String)] -> a (NTree XNode) (NTree XNode))
-> [(String, String)] -> a (NTree XNode) (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      ( [(String, String)] -> LA (NTree XNode) (NTree XNode)
forall {a :: * -> * -> *}.
ArrowDTD a =>
[(String, String)] -> a (NTree XNode) (NTree XNode)
addDTD ([(String, String)] -> LA (NTree XNode) (NTree XNode))
-> LA (NTree XNode) [(String, String)]
-> LA (NTree XNode) (NTree XNode)
forall c b d. (c -> LA b d) -> LA b c -> LA b d
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< LA (NTree XNode) (String, String)
-> LA (NTree XNode) [(String, String)]
forall b c. LA b c -> LA b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (String, String)
-> LA (NTree XNode) (String, String)
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getName LA (NTree XNode) String
-> LA (NTree XNode) String -> LA (NTree XNode) (String, String)
forall b c c'. LA b c -> LA b c' -> LA b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) String
forall n. LA n (NTree XNode) -> LA n String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n (NTree XNode) -> a n String
xshow LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren) LA (NTree XNode) (String, String)
-> LA (String, String) (String, String)
-> LA (NTree XNode) (String, String)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (String, String) (String, String)
forall {b}. LA (String, b) (String, b)
hasDtdPrefix) )
    where
    hasDtdPrefix :: LA (String, b) (String, b)
hasDtdPrefix
        = ((String, b) -> Bool) -> LA (String, b) (String, b)
forall b. (b -> Bool) -> LA b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA ((String, b) -> String
forall a b. (a, b) -> a
fst ((String, b) -> String) -> (String -> Bool) -> (String, b) -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String
dtdPrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
          LA (String, b) (String, b)
-> LA (String, b) (String, b) -> LA (String, b) (String, b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ((String, b) -> (String, b)) -> LA (String, b) (String, b)
forall b c. (b -> c) -> LA b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((String -> String) -> (String, b) -> (String, b)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dtdPrefix)))
    addDTD :: [(String, String)] -> a (NTree XNode) (NTree XNode)
addDTD []
        = a (NTree XNode) (NTree XNode)
forall b. a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    addDTD [(String, String)]
al
        = a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => a (t b) (t b) -> a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
          ( [(String, String)]
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall n.
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowDTD a =>
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
mkDTDDoctype [(String, String)]
al a (NTree XNode) (NTree XNode)
forall b c. a b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
            a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            String -> a (NTree XNode) (NTree XNode)
forall n. String -> a n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
            a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
            ( a (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (a (NTree XNode) (NTree XNode)
forall b c. a b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall b c. a b b -> a b c -> a b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` a (NTree XNode) (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA
      ( LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        String -> LA (NTree XNode) (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA
      ( Int
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b.
Tree t =>
Int -> LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
0 ( ( QName
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall n. QName -> LA n (NTree XNode) -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n (NTree XNode) -> a n (NTree XNode)
mkPi (String -> QName
mkName String
t_xml) LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                               LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                               String -> String -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
a_version String
"1.0"
                             )
                             LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
                             String -> LA (NTree XNode) (NTree XNode)
forall n. String -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
                           )
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
        LA (NTree XNode) (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ( String -> String -> LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
a_encoding String
enc
                        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b b -> LA b c -> LA b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                        ( LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String -> LA (NTree XNode) (NTree XNode)
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
    = String -> String -> String -> a (NTree XNode) (NTree XNode)
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
    = String -> String -> String -> a (NTree XNode) (NTree XNode)
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
    = String -> String -> String -> a (NTree XNode) (NTree XNode)
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
    = LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode))
-> LA (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall a b. (a -> b) -> a -> b
$
      LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
      ( [(String, String)]
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall n.
[(String, String)] -> LA n (NTree XNode) -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowDTD a =>
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
mkDTDDoctype ( ( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
public then [(String, String)] -> [(String, String)]
forall a. a -> a
id else ( (String
k_public, String
public) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: ) )
                       ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       ( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
system then [(String, String)] -> [(String, String)]
forall a. a -> a
id else ( (String
k_system, String
system) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: ) )
                       ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$  [ (String
a_name, String
rootElem) ]
                     ) LA (NTree XNode) (NTree XNode)
forall b c. LA b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        String -> LA (NTree XNode) (NTree XNode)
forall n. String -> LA n (NTree XNode)
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
        LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
        LA (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
      )

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