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
canonicalizeTree' :: LA XmlTree XmlTree -> LA XmlTree XmlTree
canonicalizeTree' :: LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' LA (NTree XNode) (NTree XNode)
toBeRemoved
= ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
( (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` (forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isXmlPi))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD)
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes LA (NTree XNode) (NTree XNode)
toBeRemoved
canonicalizeNodes :: LA XmlTree XmlTree -> LA XmlTree XmlTree
canonicalizeNodes :: LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes LA (NTree XNode) (NTree XNode)
toBeRemoved
= forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA forall a b. (a -> b) -> a -> b
$
[ LA (NTree XNode) (NTree XNode)
toBeRemoved forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
, ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef )
forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
processAttrl
( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCharRef
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
LA (NTree XNode) (NTree XNode)
collapseXText'
)
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'
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
(forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. XmlTrees -> XmlTrees
has2XText)
)
)
, ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. XmlTrees -> XmlTrees
has2XText) )
forall a b. a -> b -> IfThen a b
:-> LA (NTree XNode) (NTree XNode)
collapseXText'
, forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [forall a. Enum a => Int -> a
toEnum Int
i])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
)
, forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
)
]
canonicalizeAllNodes :: ArrowList a => a XmlTree XmlTree
canonicalizeAllNodes :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
canonicalizeAllNodes = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt
{-# INLINE canonicalizeAllNodes #-}
canonicalizeForXPath :: ArrowList a => a XmlTree XmlTree
canonicalizeForXPath :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
canonicalizeForXPath = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeTree' forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
{-# INLINE canonicalizeForXPath #-}
canonicalizeContents :: ArrowList a => a XmlTree XmlTree
canonicalizeContents :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
canonicalizeContents = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
canonicalizeNodes forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
{-# INLINE canonicalizeContents #-}
has2XText :: XmlTrees -> XmlTrees
has2XText :: XmlTrees -> XmlTrees
has2XText ts0 :: XmlTrees
ts0@(NTree XNode
t1 : ts1 :: XmlTrees
ts1@(NTree XNode
t2 : XmlTrees
ts2))
| forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t1 = if forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t2
then XmlTrees
ts0
else XmlTrees -> XmlTrees
has2XText XmlTrees
ts2
| Bool
otherwise = XmlTrees -> XmlTrees
has2XText XmlTrees
ts1
has2XText XmlTrees
_ = []
collapseXText' :: LA XmlTree XmlTree
collapseXText' :: LA (NTree XNode) (NTree XNode)
collapseXText'
= forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NTree XNode -> XmlTrees -> XmlTrees
mergeText' []) )
where
mergeText' :: XmlTree -> XmlTrees -> XmlTrees
mergeText' :: NTree XNode -> XmlTrees -> XmlTrees
mergeText' NTree XNode
t1 (NTree XNode
t2 : XmlTrees
ts2)
| forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t1 Bool -> Bool -> Bool
&& forall a. XmlNode a => a -> Bool
XN.isText NTree XNode
t2
= let
s1 :: String
s1 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe String
XN.getText forall a b. (a -> b) -> a -> b
$ NTree XNode
t1
s2 :: String
s2 = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe String
XN.getText forall a b. (a -> b) -> a -> b
$ NTree XNode
t2
t :: NTree XNode
t = forall a. XmlNode a => String -> a
XN.mkText (String
s1 forall a. [a] -> [a] -> [a]
++ String
s2)
in
NTree XNode
t forall a. a -> [a] -> [a]
: XmlTrees
ts2
mergeText' NTree XNode
t1 XmlTrees
ts
= NTree XNode
t1 forall a. a -> [a] -> [a]
: XmlTrees
ts
collapseXText :: ArrowList a => a XmlTree XmlTree
collapseXText :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
collapseXText = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA LA (NTree XNode) (NTree XNode)
collapseXText'
collapseAllXText :: ArrowList a => a XmlTree XmlTree
collapseAllXText :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
collapseAllXText = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processBottomUp LA (NTree XNode) (NTree XNode)
collapseXText'
xshowEscapeXml :: ArrowXml a => a n XmlTree -> a n String
xshowEscapeXml :: forall (a :: * -> * -> *) n.
ArrowXml a =>
a n (NTree XNode) -> a n String
xshowEscapeXml a n (NTree XNode)
f = a n (NTree XNode)
f forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> String
XS.xshow'' (Char -> StringFct, Char -> StringFct)
escapeXmlRefs)
type EntityRefTable = M.Map Int String
xmlEntityRefTable
, xhtmlEntityRefTable :: EntityRefTable
xmlEntityRefTable :: EntityRefTable
xmlEntityRefTable = [(String, Int)] -> EntityRefTable
buildEntityRefTable forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xmlEntities
xhtmlEntityRefTable :: EntityRefTable
xhtmlEntityRefTable = [(String, Int)] -> EntityRefTable
buildEntityRefTable forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xhtmlEntities
buildEntityRefTable :: [(String, Int)] -> EntityRefTable
buildEntityRefTable :: [(String, Int)] -> EntityRefTable
buildEntityRefTable = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ (String
x,Int
y) -> (Int
y,String
x) )
type EntitySubstTable = M.Map String String
xhtmlEntitySubstTable :: EntitySubstTable
xhtmlEntitySubstTable :: EntitySubstTable
xhtmlEntitySubstTable = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum) forall a b. (a -> b) -> a -> b
$ [(String, Int)]
xhtmlEntities
substXHTMLEntityRef :: LA XmlTree XmlTree
substXHTMLEntityRef :: LA (NTree XNode) (NTree XNode)
substXHTMLEntityRef
= ( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getEntityRef
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL String -> [String]
subst
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` forall (a :: * -> * -> *) b. ArrowList a => a b b
this
where
subst :: String -> [String]
subst String
name
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name EntitySubstTable
xhtmlEntitySubstTable
substAllXHTMLEntityRefs :: ArrowXml a => a XmlTree XmlTree
substAllXHTMLEntityRefs :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
substAllXHTMLEntityRefs
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processBottomUp LA (NTree XNode) (NTree XNode)
substXHTMLEntityRef
escapeXmlRefs :: (Char -> String -> String, Char -> String -> String)
escapeXmlRefs :: (Char -> StringFct, Char -> StringFct)
escapeXmlRefs = (Char -> StringFct
cquote, Char -> StringFct
aquote)
where
cquote :: Char -> StringFct
cquote Char
c
| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<&" = (Char
'&' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
| Bool
otherwise = (Char
c forall a. a -> [a] -> [a]
:)
aquote :: Char -> StringFct
aquote Char
c
| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>\"\'&\n\r\t"
= (Char
'&' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
| Bool
otherwise = (Char
c forall a. a -> [a] -> [a]
:)
escapeHtmlRefs :: (Char -> String -> String, Char -> String -> String)
escapeHtmlRefs :: (Char -> StringFct, Char -> StringFct)
escapeHtmlRefs = (Char -> StringFct
cquote, Char -> StringFct
aquote)
where
cquote :: Char -> StringFct
cquote Char
c
| Char -> Bool
isHtmlTextEsc Char
c
= (Char
'&' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xhtmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
| Bool
otherwise = (Char
c forall a. a -> [a] -> [a]
:)
aquote :: Char -> StringFct
aquote Char
c
| Char -> Bool
isHtmlAttrEsc Char
c
= (Char
'&' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> EntityRefTable -> String
lookupRef Char
c EntityRefTable
xhtmlEntityRefTable) forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
';' forall a. a -> [a] -> [a]
:)
| Bool
otherwise = (Char
c forall a. a -> [a] -> [a]
:)
isHtmlTextEsc :: Char -> Bool
isHtmlTextEsc Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= forall a. Enum a => Int -> a
toEnum(Int
128) Bool -> Bool -> Bool
|| ( Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<&" )
isHtmlAttrEsc :: Char -> Bool
isHtmlAttrEsc Char
c = Char
c forall a. Ord a => a -> a -> Bool
>= forall a. Enum a => Int -> a
toEnum(Int
128) Bool -> Bool -> Bool
|| ( Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"<>\"\'&\n\r\t" )
lookupRef :: Char -> EntityRefTable -> String
lookupRef :: Char -> EntityRefTable -> String
lookupRef Char
c = forall a. a -> Maybe a -> a
fromMaybe (Char
'#' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum Char
c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. Enum a => a -> Int
fromEnum Char
c)
{-# INLINE lookupRef #-}
preventEmptyElements :: ArrowList a => [String] -> Bool -> a XmlTree XmlTree
preventEmptyElements :: forall (a :: * -> * -> *).
ArrowList a =>
[String] -> Bool -> a (NTree XNode) (NTree XNode)
preventEmptyElements [String]
ns Bool
isHtml
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [ ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
LA (NTree XNode) (NTree XNode)
isNoneEmpty
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
)
forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"")
]
where
isNoneEmpty :: LA (NTree XNode) (NTree XNode)
isNoneEmpty
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ns) = forall (a :: * -> * -> *).
ArrowXml a =>
(QName -> Bool) -> a (NTree XNode) (NTree XNode)
hasNameWith (QName -> String
localPart forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ns))
| Bool
isHtml = forall (a :: * -> * -> *).
ArrowXml a =>
(QName -> Bool) -> a (NTree XNode) (NTree XNode)
hasNameWith (QName -> String
localPart forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
emptyHtmlTags))
| Bool
otherwise = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
haskellRepOfXmlDoc :: ArrowList a => a XmlTree XmlTree
haskellRepOfXmlDoc :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
haskellRepOfXmlDoc
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl] [forall a. Show a => a -> String
show forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText]
numberLinesInXmlDoc :: ArrowList a => a XmlTree XmlTree
numberLinesInXmlDoc :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
numberLinesInXmlDoc
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (forall (a :: * -> * -> *).
ArrowXml a =>
StringFct -> a (NTree XNode) (NTree XNode)
changeText StringFct
numberLines)
where
numberLines :: String -> String
numberLines :: StringFct
numberLines String
str
= forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
n String
l -> Int -> String
lineNr Int
n forall a. [a] -> [a] -> [a]
++ String
l forall a. [a] -> [a] -> [a]
++ String
"\n") [Int
1..] (String -> [String]
lines String
str)
where
lineNr :: Int -> String
lineNr :: Int -> String
lineNr Int
n = (forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take Int
6 (forall a. [a] -> [a]
reverse (forall a. Show a => a -> String
show Int
n) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
6 Char
' '))) forall a. [a] -> [a] -> [a]
++ String
" "
treeRepOfXmlDoc :: ArrowList a => a XmlTree XmlTree
treeRepOfXmlDoc :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
treeRepOfXmlDoc
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl] [NTree XNode -> String
formatXmlTree forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText]
addHeadlineToXmlDoc :: ArrowXml a => a XmlTree XmlTree
addHeadlineToXmlDoc :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addHeadlineToXmlDoc
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ ( forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
addTitle forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
a_source forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ StringFct
formatTitle) )
where
addTitle :: String -> a (NTree XNode) (NTree XNode)
addTitle String
str
= forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
str forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n" )
formatTitle :: StringFct
formatTitle String
str
= String
"\n" forall a. [a] -> [a] -> [a]
++ String
headline forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
underline forall a. [a] -> [a] -> [a]
++ String
"\n\n"
where
headline :: String
headline = String
"content of: " forall a. [a] -> [a] -> [a]
++ String
str
underline :: String
underline = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Char
'=') String
headline
removeComment :: ArrowXml a => a XmlTree XmlTree
= forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt
removeAllComment :: ArrowXml a => a XmlTree XmlTree
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCmt forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none]
removeWhiteSpace :: ArrowXml a => a XmlTree XmlTree
removeWhiteSpace :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeWhiteSpace = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace
removeAllWhiteSpace :: ArrowXml a => a XmlTree XmlTree
removeAllWhiteSpace :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeAllWhiteSpace = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none]
removeDocWhiteSpace :: ArrowXml a => a XmlTree XmlTree
removeDocWhiteSpace :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeDocWhiteSpace = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ LA (NTree XNode) (NTree XNode)
removeRootWhiteSpace
removeRootWhiteSpace :: LA XmlTree XmlTree
removeRootWhiteSpace :: LA (NTree XNode) (NTree XNode)
removeRootWhiteSpace
= forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren LA (NTree XNode) (NTree XNode)
processRootElement
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
where
processRootElement :: LA XmlTree XmlTree
processRootElement :: LA (NTree XNode) (NTree XNode)
processRootElement
= forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeWhiteSpace forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
processChild
where
processChild :: LA (NTree XNode) (NTree XNode)
processChild
= forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD
forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
removeAllWhiteSpace
, forall (a :: * -> * -> *) b. ArrowList a => a b b
this
forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees forall a. Int -> LA a (NTree XNode)
insertNothing Bool
False Int
1
)
]
indentDoc :: ArrowXml a => a XmlTree XmlTree
indentDoc :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
indentDoc = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
( ( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` LA (NTree XNode) (NTree XNode)
indentRoot )
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
(forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n (NTree XNode)] -> [a n (NTree XNode)] -> a n (NTree XNode)
root [] [forall (a :: * -> * -> *) b. ArrowList a => a b b
this] forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
indentRoot forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)
)
indentRoot :: LA XmlTree XmlTree
indentRoot :: LA (NTree XNode) (NTree XNode)
indentRoot = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren LA (NTree XNode) (NTree XNode)
indentRootChildren
where
indentRootChildren :: LA (NTree XNode) (NTree XNode)
indentRootChildren
= LA (NTree XNode) (NTree XNode)
removeText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
indentChild forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA (NTree XNode) (NTree XNode)
insertNL
where
removeText :: LA (NTree XNode) (NTree XNode)
removeText = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText
insertNL :: LA (NTree XNode) (NTree XNode)
insertNL = forall (a :: * -> * -> *) b. ArrowList a => a b b
this forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
indentChild :: LA (NTree XNode) (NTree XNode)
indentChild = ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
(Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees (forall a. Int -> Int -> LA a (NTree XNode)
insertIndentation Int
2) Bool
False Int
1
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isDTD
)
indentTrees :: (Int -> LA XmlTree XmlTree) -> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees :: (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees Int -> LA (NTree XNode) (NTree XNode)
_ Bool
_ Int
_ []
= []
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace Int
level XmlTrees
ts
= forall {b} {b}. LA b b -> [b] -> [b]
runLAs LA (NTree XNode) (NTree XNode)
lsf XmlTrees
ls
forall a. [a] -> [a] -> [a]
++
XmlTrees -> XmlTrees
indentRest XmlTrees
rs
where
runLAs :: LA b b -> [b] -> [b]
runLAs LA b b
f [b]
l
= forall a b. LA a b -> a -> [b]
runLA (forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL [b]
l forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA b b
f) forall a. HasCallStack => a
undefined
(XmlTrees
ls, XmlTrees
rs)
= forall a. (a -> Bool) -> [a] -> ([a], [a])
break forall a. XmlNode a => a -> Bool
XN.isElem XmlTrees
ts
isSignificant :: Bool
isSignificant :: Bool
isSignificant
= Bool
preserveSpace
Bool -> Bool -> Bool
||
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {b}. LA b b -> [b] -> [b]
runLAs LA (NTree XNode) (NTree XNode)
isSignificantPart) XmlTrees
ls
isSignificantPart :: LA XmlTree XmlTree
isSignificantPart :: LA (NTree XNode) (NTree XNode)
isSignificantPart
= forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA
[ forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace
, forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata
, forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef
, forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isEntityRef
]
lsf :: LA XmlTree XmlTree
lsf :: LA (NTree XNode) (NTree XNode)
lsf
| Bool
isSignificant
= forall (a :: * -> * -> *) b. ArrowList a => a b b
this
| Bool
otherwise
= (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isWhiteSpace)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(Int -> LA (NTree XNode) (NTree XNode)
indentFilter Int
level forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *) b. ArrowList a => a b b
this)
indentRest :: XmlTrees -> XmlTrees
indentRest :: XmlTrees -> XmlTrees
indentRest []
| Bool
isSignificant
= []
| Bool
otherwise
= forall a b. LA a b -> a -> [b]
runLA (Int -> LA (NTree XNode) (NTree XNode)
indentFilter (Int
level forall a. Num a => a -> a -> a
- Int
1)) forall a. HasCallStack => a
undefined
indentRest (NTree XNode
t':XmlTrees
ts')
= forall a b. LA a b -> a -> [b]
runLA ( ( LA (NTree XNode) (NTree XNode)
indentElem
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
LA (NTree XNode) (NTree XNode)
lsf
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem
) NTree XNode
t'
forall a. [a] -> [a] -> [a]
++
( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null XmlTrees
ts'
then XmlTrees -> XmlTrees
indentRest
else (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace Int
level
) XmlTrees
ts'
where
indentElem :: LA (NTree XNode) (NTree XNode)
indentElem
= forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
XmlTrees -> XmlTrees
indentChildren
)
xmlSpaceAttrValue :: String
xmlSpaceAttrValue :: String
xmlSpaceAttrValue
= forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. LA a b -> a -> [b]
runLA (forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"xml:space") forall a b. (a -> b) -> a -> b
$ NTree XNode
t'
preserveSpace' :: Bool
preserveSpace' :: Bool
preserveSpace'
= ( forall a. a -> Maybe a -> a
fromMaybe Bool
preserveSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
xmlSpaceAttrValue
) [ (String
"preserve", Bool
True)
, (String
"default", Bool
False)
]
indentChildren :: XmlTrees -> XmlTrees
indentChildren :: XmlTrees -> XmlTrees
indentChildren XmlTrees
cs'
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isXmlSpaceChar) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe String
XN.getText) XmlTrees
cs'
= []
| Bool
otherwise
= (Int -> LA (NTree XNode) (NTree XNode))
-> Bool -> Int -> XmlTrees -> XmlTrees
indentTrees Int -> LA (NTree XNode) (NTree XNode)
indentFilter Bool
preserveSpace' (Int
level forall a. Num a => a -> a -> a
+ Int
1) XmlTrees
cs'
insertIndentation :: Int -> Int -> LA a XmlTree
insertIndentation :: forall a. Int -> Int -> LA a (NTree XNode)
insertIndentation Int
indentWidth Int
level
= forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt (Char
'\n' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (Int
level forall a. Num a => a -> a -> a
* Int
indentWidth) Char
' ')
insertNothing :: Int -> LA a XmlTree
insertNothing :: forall a. Int -> LA a (NTree XNode)
insertNothing Int
_ = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
transfCdata :: ArrowXml a => a XmlTree XmlTree
transfCdata :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCdata = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
(forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText) forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata
transfAllCdata :: ArrowXml a => a XmlTree XmlTree
transfAllCdata :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfAllCdata = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCdata forall a b. a -> b -> IfThen a b
:-> (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCdata forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText)]
transfCharRef :: ArrowXml a => a XmlTree XmlTree
transfCharRef :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfCharRef = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
( forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [forall a. Enum a => Int -> a
toEnum Int
i]) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText )
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef
transfAllCharRef :: ArrowXml a => a XmlTree XmlTree
transfAllCharRef :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
transfAllCharRef = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ forall b c.
[IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))]
-> LA (NTree b) (NTree b)
editNTreeA [forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isCharRef forall a b. a -> b -> IfThen a b
:-> (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Int
getCharRef forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ Int
i -> [forall a. Enum a => Int -> a
toEnum Int
i]) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText)]
rememberDTDAttrl :: ArrowList a => a XmlTree XmlTree
rememberDTDAttrl :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
rememberDTDAttrl
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
( ( forall {a :: * -> * -> *}.
ArrowXml a =>
[(String, String)] -> a (NTree XNode) (NTree XNode)
addDTDAttrl forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowDTD a =>
a (NTree XNode) (NTree XNode)
isDTDDoctype forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) [(String, String)]
getDTDAttrl ) )
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
)
where
addDTDAttrl :: [(String, String)] -> a (NTree XNode) (NTree XNode)
addDTDAttrl [(String, String)]
al
= forall (a :: * -> * -> *) b. ArrowList a => [a b b] -> a b b
seqA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String
dtdPrefix forall a. [a] -> [a] -> [a]
++)) forall a b. (a -> b) -> a -> b
$ [(String, String)]
al
addDefaultDTDecl :: ArrowList a => a XmlTree XmlTree
addDefaultDTDecl :: forall (a :: * -> * -> *).
ArrowList a =>
a (NTree XNode) (NTree XNode)
addDefaultDTDecl
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
( forall {a :: * -> * -> *}.
ArrowDTD a =>
[(String, String)] -> a (NTree XNode) (NTree XNode)
addDTD forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
getAttrl forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) n.
ArrowXml a =>
a n (NTree XNode) -> a n String
xshow forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {b}. LA (String, b) (String, b)
hasDtdPrefix) )
where
hasDtdPrefix :: LA (String, b) (String, b)
hasDtdPrefix
= forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String
dtdPrefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dtdPrefix)))
addDTD :: [(String, String)] -> a (NTree XNode) (NTree XNode)
addDTD []
= forall (a :: * -> * -> *) b. ArrowList a => a b b
this
addDTD [(String, String)]
al
= forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
( forall (a :: * -> * -> *) n.
ArrowDTD a =>
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
mkDTDDoctype [(String, String)]
al forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowDTD a =>
a (NTree XNode) (NTree XNode)
isDTDDoctype) )
)
hasXmlPi :: ArrowXml a => a XmlTree XmlTree
hasXmlPi :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
hasXmlPi
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA
( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
hasName String
t_xml
)
addXmlPi :: ArrowXml a => a XmlTree XmlTree
addXmlPi :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXmlPi
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA
( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
Int -> a (t b) (t b) -> a (t b) (t b)
insertChildrenAt Int
0 ( ( forall (a :: * -> * -> *) n.
ArrowXml a =>
QName -> a n (NTree XNode) -> a n (NTree XNode)
mkPi (String -> QName
mkName String
t_xml) forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
a_version String
"1.0"
)
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
hasXmlPi
)
addXmlPiEncoding :: ArrowXml a => String -> a XmlTree XmlTree
addXmlPiEncoding :: forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
addXmlPiEncoding String
enc
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ( forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
a_encoding String
enc
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
( forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isPi forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {a :: * -> * -> *}.
ArrowXml a =>
String -> a (NTree XNode) (NTree XNode)
hasName String
t_xml )
)
addXHtmlDoctypeStrict
, addXHtmlDoctypeTransitional
, addXHtmlDoctypeFrameset :: ArrowXml a => a XmlTree XmlTree
addXHtmlDoctypeStrict :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXHtmlDoctypeStrict
= forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
"html" String
"-//W3C//DTD XHTML 1.0 Strict//EN" String
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"
addXHtmlDoctypeTransitional :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXHtmlDoctypeTransitional
= forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
"html" String
"-//W3C//DTD XHTML 1.0 Transitional//EN" String
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"
addXHtmlDoctypeFrameset :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
addXHtmlDoctypeFrameset
= forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
"html" String
"-//W3C//DTD XHTML 1.0 Frameset//EN" String
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"
addDoctypeDecl :: ArrowXml a => String -> String -> String -> a XmlTree XmlTree
addDoctypeDecl :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> String -> a (NTree XNode) (NTree XNode)
addDoctypeDecl String
rootElem String
public String
system
= forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
( forall (a :: * -> * -> *) n.
ArrowDTD a =>
[(String, String)] -> a n (NTree XNode) -> a n (NTree XNode)
mkDTDDoctype ( ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
public then forall a. a -> a
id else ( (String
k_public, String
public) forall a. a -> [a] -> [a]
: ) )
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
system then forall a. a -> a
id else ( (String
k_system, String
system) forall a. a -> [a] -> [a]
: ) )
forall a b. (a -> b) -> a -> b
$ [ (String
a_name, String
rootElem) ]
) forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> a n (NTree XNode)
txt String
"\n"
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
)