module Text.XML.HXT.DOM.ShowXml
( xshow
, xshowBlob
, xshow'
, xshow''
)
where
import Prelude hiding (showChar, showString)
import Data.Maybe
import Data.Tree.Class
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.DOM.TypeDefs
import Text.XML.HXT.DOM.XmlKeywords
import Text.XML.HXT.DOM.XmlNode (getDTDAttrl, mkDTDElem)
import Text.Regex.XMLSchema.Generic(sed)
xshow :: XmlTrees -> String
xshow :: XmlTrees -> String
xshow [(NTree (XText s :: String
s) _)] = String
s
xshow [(NTree (XBlob b :: Blob
b) _)] = Blob -> String
blobToString Blob
b
xshow ts :: XmlTrees
ts = (String -> StringFct)
-> (String -> StringFct) -> XmlTrees -> StringFct
showXmlTrees String -> StringFct
showString String -> StringFct
showString XmlTrees
ts ""
xshowBlob :: XmlTrees -> Blob
xshowBlob :: XmlTrees -> Blob
xshowBlob [(NTree (XBlob b :: Blob
b) _)] = Blob
b
xshowBlob [(NTree (XText s :: String
s) _)] = String -> Blob
stringToBlob String
s
xshowBlob ts :: XmlTrees
ts = String -> Blob
stringToBlob (String -> Blob) -> String -> Blob
forall a b. (a -> b) -> a -> b
$ XmlTrees -> String
xshow XmlTrees
ts
xshow' :: (Char -> StringFct) ->
(Char -> StringFct) ->
(Char -> StringFct) ->
XmlTrees -> Blob
xshow' :: (Char -> StringFct)
-> (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> Blob
xshow' cquot :: Char -> StringFct
cquot aquot :: Char -> StringFct
aquot enc :: Char -> StringFct
enc ts :: XmlTrees
ts = String -> Blob
stringToBlob (String -> Blob) -> String -> Blob
forall a b. (a -> b) -> a -> b
$ ((Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
enc (XmlTrees -> StringFct
showTrees XmlTrees
ts "")) ""
where
showTrees :: XmlTrees -> StringFct
showTrees = (String -> StringFct)
-> (String -> StringFct) -> XmlTrees -> StringFct
showXmlTrees ((Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
cquot) ((Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
aquot)
xshow'' :: (Char -> StringFct) ->
(Char -> StringFct) ->
XmlTrees -> String
xshow'' :: (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> String
xshow'' cquot :: Char -> StringFct
cquot aquot :: Char -> StringFct
aquot ts :: XmlTrees
ts = XmlTrees -> StringFct
showTrees XmlTrees
ts ""
where
showTrees :: XmlTrees -> StringFct
showTrees = (String -> StringFct)
-> (String -> StringFct) -> XmlTrees -> StringFct
showXmlTrees ((Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
cquot) ((Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
aquot)
type StringFct = String -> String
showXmlTrees :: (String -> StringFct) ->
(String -> StringFct) ->
XmlTrees -> StringFct
showXmlTrees :: (String -> StringFct)
-> (String -> StringFct) -> XmlTrees -> StringFct
showXmlTrees cf :: String -> StringFct
cf af :: String -> StringFct
af
= XmlTrees -> StringFct
showTrees
where
showTrees :: XmlTrees -> StringFct
showTrees :: XmlTrees -> StringFct
showTrees = (StringFct -> StringFct -> StringFct)
-> StringFct -> [StringFct] -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) StringFct
forall a. a -> a
id ([StringFct] -> StringFct)
-> (XmlTrees -> [StringFct]) -> XmlTrees -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showXmlTree
{-# INLINE showTrees #-}
showTrees' :: XmlTrees -> StringFct
showTrees' :: XmlTrees -> StringFct
showTrees' = (StringFct -> StringFct -> StringFct)
-> StringFct -> [StringFct] -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ x :: StringFct
x y :: StringFct
y -> StringFct
x StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showNL StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
y) StringFct
forall a. a -> a
id ([StringFct] -> StringFct)
-> (XmlTrees -> [StringFct]) -> XmlTrees -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showXmlTree
{-# INLINE showTrees' #-}
showXmlTree :: XmlTree -> StringFct
showXmlTree :: NTree XNode -> StringFct
showXmlTree (NTree (XText s :: String
s) _)
= String -> StringFct
cf String
s
showXmlTree (NTree (XTag t :: QName
t al :: XmlTrees
al) [])
= StringFct
showLt StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
t StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
al StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showSlash StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showGt
showXmlTree (NTree (XTag t :: QName
t al :: XmlTrees
al) cs :: XmlTrees
cs)
= StringFct
showLt StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
t StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
al StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showGt
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
cs
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showLt StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showSlash StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
t StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showGt
showXmlTree (NTree (XAttr an :: QName
an) cs :: XmlTrees
cs)
= StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
an
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showEq
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
af (XmlTrees -> String
xshow XmlTrees
cs)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
showXmlTree (NTree (XBlob b :: Blob
b) _)
= String -> StringFct
cf (String -> StringFct) -> (Blob -> String) -> Blob -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> String
blobToString (Blob -> StringFct) -> Blob -> StringFct
forall a b. (a -> b) -> a -> b
$ Blob
b
showXmlTree (NTree (XCharRef i :: Int
i) _)
= String -> StringFct
showString "&#" StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString (Int -> String
forall a. Show a => a -> String
show Int
i) StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar ';'
showXmlTree (NTree (XEntityRef r :: String
r) _)
= String -> StringFct
showString "&" StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
r StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar ';'
showXmlTree (NTree (XCmt c :: String
c) _)
= String -> StringFct
showString "<!--" StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
c StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString "-->"
showXmlTree (NTree (XCdata d :: String
d) _)
= String -> StringFct
showString "<![CDATA[" StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
d' StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString "]]>"
where
d' :: String
d' = StringFct -> String -> StringFct
forall s. StringLike s => (s -> s) -> s -> s -> s
sed (String -> StringFct
forall a b. a -> b -> a
const "]]>") "\\]\\]>" String
d
showXmlTree (NTree (XPi n :: QName
n al :: XmlTrees
al) _)
= String -> StringFct
showString "<?"
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
n
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StringFct -> StringFct -> StringFct)
-> StringFct -> [StringFct] -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) StringFct
forall a. a -> a
id ([StringFct] -> StringFct)
-> (XmlTrees -> [StringFct]) -> XmlTrees -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showPiAttr) XmlTrees
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString "?>"
where
showPiAttr :: XmlTree -> StringFct
showPiAttr :: NTree XNode -> StringFct
showPiAttr a :: NTree XNode
a@(NTree (XAttr an :: QName
an) cs :: XmlTrees
cs)
| QName -> String
qualifiedName QName
an String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a_value
= StringFct
showBlank StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> StringFct)
-> (String -> StringFct) -> XmlTrees -> StringFct
showXmlTrees String -> StringFct
showString String -> StringFct
showString XmlTrees
cs
| Bool
otherwise
= NTree XNode -> StringFct
showXmlTree NTree XNode
a
showPiAttr a :: NTree XNode
a
= NTree XNode -> StringFct
showXmlTree NTree XNode
a
showXmlTree (NTree (XDTD de :: DTDElem
de al :: Attributes
al) cs :: XmlTrees
cs)
= DTDElem -> Attributes -> XmlTrees -> StringFct
showXmlDTD DTDElem
de Attributes
al XmlTrees
cs
showXmlTree (NTree (XError l :: Int
l e :: String
e) _)
= String -> StringFct
showString "<!-- ERROR ("
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StringFct
forall a. Show a => a -> StringFct
shows Int
l
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString "):\n"
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
e
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString "\n-->"
showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> StringFct
showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> StringFct
showXmlDTD DOCTYPE al :: Attributes
al cs :: XmlTrees
cs = String -> StringFct
showString "<!DOCTYPE "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showExternalId Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showInternalDTD XmlTrees
cs
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString ">"
where
showInternalDTD :: XmlTrees -> StringFct
showInternalDTD [] = StringFct
forall a. a -> a
id
showInternalDTD ds :: XmlTrees
ds = String -> StringFct
showString " [\n"
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees' XmlTrees
ds
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar ']'
showXmlDTD ELEMENT al :: Attributes
al cs :: XmlTrees
cs = String -> StringFct
showString "<!ELEMENT "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlTrees -> StringFct
showElemType (String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type Attributes
al) XmlTrees
cs
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " >"
showXmlDTD ATTLIST al :: Attributes
al cs :: XmlTrees
cs = String -> StringFct
showString "<!ATTLIST "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( if Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool)
-> (Attributes -> Maybe String) -> Attributes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_name (Attributes -> Bool) -> Attributes -> Bool
forall a b. (a -> b) -> a -> b
$ Attributes
al
then
XmlTrees -> StringFct
showTrees XmlTrees
cs
else
String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( case String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_value Attributes
al of
Nothing -> ( Attributes -> StringFct
showPEAttr
(Attributes -> StringFct)
-> (XmlTrees -> Attributes) -> XmlTrees -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Attributes -> Attributes)
-> (XmlTrees -> Maybe Attributes) -> XmlTrees -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl
(NTree XNode -> Maybe Attributes)
-> (XmlTrees -> NTree XNode) -> XmlTrees -> Maybe Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> NTree XNode
forall a. [a] -> a
head
) XmlTrees
cs
Just a :: String
a -> ( String -> StringFct
showString String
a
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showAttrType (String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type Attributes
al)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showAttrKind (String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_kind Attributes
al)
)
)
)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " >"
where
showAttrType :: String -> StringFct
showAttrType t :: String
t
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_peref
= StringFct
showBlank StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showPEAttr Attributes
al
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_enumeration
= StringFct
showAttrEnum
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_notation
= StringFct
showBlank StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_notation StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showAttrEnum
| Bool
otherwise
= StringFct
showBlank StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
t
showAttrEnum :: StringFct
showAttrEnum
= String -> StringFct
showString " ("
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringFct -> StringFct -> StringFct) -> [StringFct] -> StringFct
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
(\ s1 :: StringFct
s1 s2 :: StringFct
s2 -> StringFct
s1 StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " | " StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
s2)
((NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> StringFct
getEnum (Attributes -> StringFct)
-> (NTree XNode -> Attributes) -> NTree XNode -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Attributes -> Attributes)
-> (NTree XNode -> Maybe Attributes) -> NTree XNode -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl) XmlTrees
cs)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString ")"
where
getEnum :: Attributes -> StringFct
getEnum :: Attributes -> StringFct
getEnum l :: Attributes
l = String -> Attributes -> StringFct
showAttr String
a_name Attributes
l StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showPEAttr Attributes
l
showAttrKind :: String -> StringFct
showAttrKind k :: String
k
| String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_default
= StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString (String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_default Attributes
al)
| String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_fixed
= StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_fixed
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString (String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_default Attributes
al)
| String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ""
= StringFct
forall a. a -> a
id
| Bool
otherwise
= StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k
showXmlDTD NOTATION al :: Attributes
al _cs :: XmlTrees
_cs
= String -> StringFct
showString "<!NOTATION "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showExternalId Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " >"
showXmlDTD PENTITY al :: Attributes
al cs :: XmlTrees
cs = String -> Attributes -> XmlTrees -> StringFct
showEntity "% " Attributes
al XmlTrees
cs
showXmlDTD ENTITY al :: Attributes
al cs :: XmlTrees
cs = String -> Attributes -> XmlTrees -> StringFct
showEntity "" Attributes
al XmlTrees
cs
showXmlDTD PEREF al :: Attributes
al _cs :: XmlTrees
_cs = Attributes -> StringFct
showPEAttr Attributes
al
showXmlDTD CONDSECT _ (c1 :: NTree XNode
c1 : cs :: XmlTrees
cs)
= String -> StringFct
showString "<![ "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> StringFct
showXmlTree NTree XNode
c1
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " [\n"
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
cs
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString "]]>"
showXmlDTD CONTENT al :: Attributes
al cs :: XmlTrees
cs = NTree XNode -> StringFct
showContent (DTDElem -> Attributes -> XmlTrees -> NTree XNode
mkDTDElem DTDElem
CONTENT Attributes
al XmlTrees
cs)
showXmlDTD NAME al :: Attributes
al _cs :: XmlTrees
_cs = String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
showXmlDTD de :: DTDElem
de al :: Attributes
al _cs :: XmlTrees
_cs = String -> StringFct
showString "NOT YET IMPLEMETED: "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString (DTDElem -> String
forall a. Show a => a -> String
show DTDElem
de)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString (Attributes -> String
forall a. Show a => a -> String
show Attributes
al)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " [...]\n"
showEntity :: String -> Attributes -> XmlTrees -> StringFct
showEntity :: String -> Attributes -> XmlTrees -> StringFct
showEntity kind :: String
kind al :: Attributes
al cs :: XmlTrees
cs = String -> StringFct
showString "<!ENTITY "
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
kind
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showExternalId Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showNData Attributes
al
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showEntityValue XmlTrees
cs
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString " >"
showEntityValue :: XmlTrees -> StringFct
showEntityValue :: XmlTrees -> StringFct
showEntityValue [] = StringFct
forall a. a -> a
id
showEntityValue cs :: XmlTrees
cs = StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
af (XmlTrees -> String
xshow XmlTrees
cs)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
showContent :: XmlTree -> StringFct
showContent :: NTree XNode -> StringFct
showContent (NTree (XDTD de :: DTDElem
de al :: Attributes
al) cs :: XmlTrees
cs)
= DTDElem -> StringFct
cont2String DTDElem
de
where
cont2String :: DTDElem -> StringFct
cont2String :: DTDElem -> StringFct
cont2String NAME = String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
cont2String PEREF = Attributes -> StringFct
showPEAttr Attributes
al
cont2String CONTENT = StringFct
showLpar
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringFct -> StringFct -> StringFct) -> [StringFct] -> StringFct
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
(String -> StringFct -> StringFct -> StringFct
forall c a. String -> (String -> c) -> (a -> String) -> a -> c
combine (String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_kind Attributes
al))
((NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showContent XmlTrees
cs)
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_modifier Attributes
al
cont2String n :: DTDElem
n = String -> StringFct
forall a. HasCallStack => String -> a
error ("cont2string " String -> StringFct
forall a. [a] -> [a] -> [a]
++ DTDElem -> String
forall a. Show a => a -> String
show DTDElem
n String -> StringFct
forall a. [a] -> [a] -> [a]
++ " is undefined")
combine :: String -> (String -> c) -> (a -> String) -> a -> c
combine k :: String
k s1 :: String -> c
s1 s2 :: a -> String
s2 = String -> c
s1
(String -> c) -> (a -> String) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString ( if String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_seq
then ", "
else " | "
)
StringFct -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
s2
showContent n :: NTree XNode
n = NTree XNode -> StringFct
showXmlTree NTree XNode
n
showElemType :: String -> XmlTrees -> StringFct
showElemType :: String -> XmlTrees -> StringFct
showElemType t :: String
t cs :: XmlTrees
cs
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_pcdata = StringFct
showLpar StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
v_pcdata StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_mixed
Bool -> Bool -> Bool
&&
(Bool -> Bool
not (Bool -> Bool) -> (XmlTrees -> Bool) -> XmlTrees -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) XmlTrees
cs = StringFct
showLpar
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
v_pcdata
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (StringFct -> StringFct -> StringFct)
-> StringFct -> [StringFct] -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) StringFct
forall a. a -> a
id
([StringFct] -> StringFct)
-> (XmlTrees -> [StringFct]) -> XmlTrees -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> StringFct
mixedContent (Attributes -> StringFct)
-> (NTree XNode -> Attributes) -> NTree XNode -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNode -> Attributes
selAttrl (XNode -> Attributes)
-> (NTree XNode -> XNode) -> NTree XNode -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> XNode
forall (t :: * -> *) a. Tree t => t a -> a
getNode)
) XmlTrees
cs1
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_modifier Attributes
al1
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_mixed
= StringFct
showLpar
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_children
Bool -> Bool -> Bool
&&
(Bool -> Bool
not (Bool -> Bool) -> (XmlTrees -> Bool) -> XmlTrees -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) XmlTrees
cs = NTree XNode -> StringFct
showContent (XmlTrees -> NTree XNode
forall a. [a] -> a
head XmlTrees
cs)
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_children = StringFct
showLpar
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_peref = (StringFct -> StringFct -> StringFct)
-> StringFct -> [StringFct] -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) StringFct
forall a. a -> a
id
([StringFct] -> StringFct)
-> (XmlTrees -> [StringFct]) -> XmlTrees -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree XNode -> StringFct) -> XmlTrees -> [StringFct]
forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showContent (XmlTrees -> StringFct) -> XmlTrees -> StringFct
forall a b. (a -> b) -> a -> b
$ XmlTrees
cs
| Bool
otherwise = String -> StringFct
showString String
t
where
[(NTree (XDTD CONTENT al1 :: Attributes
al1) cs1 :: XmlTrees
cs1)] = XmlTrees
cs
mixedContent :: Attributes -> StringFct
mixedContent :: Attributes -> StringFct
mixedContent l :: Attributes
l = String -> StringFct
showString " | " StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
l StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showPEAttr Attributes
l
selAttrl :: XNode -> Attributes
selAttrl (XDTD _ as :: Attributes
as) = Attributes
as
selAttrl (XText tex :: String
tex) = [(String
a_name, String
tex)]
selAttrl _ = []
showQName :: QName -> StringFct
showQName :: QName -> StringFct
showQName = QName -> StringFct
qualifiedName'
{-# INLINE showQName #-}
showQuoteString :: String -> StringFct
showQuoteString :: String -> StringFct
showQuoteString s :: String
s = StringFct
showQuot StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
s StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
showAttr :: String -> Attributes -> StringFct
showAttr :: String -> Attributes -> StringFct
showAttr k :: String
k al :: Attributes
al = String -> StringFct
showString (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String)
-> (Attributes -> Maybe String) -> Attributes -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k (Attributes -> String) -> Attributes -> String
forall a b. (a -> b) -> a -> b
$ Attributes
al)
showPEAttr :: Attributes -> StringFct
showPEAttr :: Attributes -> StringFct
showPEAttr al :: Attributes
al = Maybe String -> StringFct
showPE (String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_peref Attributes
al)
where
showPE :: Maybe String -> StringFct
showPE (Just pe :: String
pe) = Char -> StringFct
showChar '%'
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
pe
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar ';'
showPE Nothing = StringFct
forall a. a -> a
id
showExternalId :: Attributes -> StringFct
showExternalId :: Attributes -> StringFct
showExternalId al :: Attributes
al = Maybe String -> Maybe String -> StringFct
id2Str (String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k_system Attributes
al) (String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k_public Attributes
al)
where
id2Str :: Maybe String -> Maybe String -> StringFct
id2Str Nothing Nothing = StringFct
forall a. a -> a
id
id2Str (Just s :: String
s) Nothing = StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_system
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
s
id2Str Nothing (Just p :: String
p) = StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_public
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
p
id2Str (Just s :: String
s) (Just p :: String
p) = StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_public
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
p
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
s
showNData :: Attributes -> StringFct
showNData :: Attributes -> StringFct
showNData al :: Attributes
al = Maybe String -> StringFct
nd2Str (String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k_ndata Attributes
al)
where
nd2Str :: Maybe String -> StringFct
nd2Str Nothing = StringFct
forall a. a -> a
id
nd2Str (Just v :: String
v) = StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_ndata
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
v
showBlank,
showEq, showLt, showGt, showSlash, showQuot, showLpar, showRpar, showNL :: StringFct
showBlank :: StringFct
showBlank = Char -> StringFct
showChar ' '
{-# INLINE showBlank #-}
showEq :: StringFct
showEq = Char -> StringFct
showChar '='
{-# INLINE showEq #-}
showLt :: StringFct
showLt = Char -> StringFct
showChar '<'
{-# INLINE showLt #-}
showGt :: StringFct
showGt = Char -> StringFct
showChar '>'
{-# INLINE showGt #-}
showSlash :: StringFct
showSlash = Char -> StringFct
showChar '/'
{-# INLINE showSlash #-}
showQuot :: StringFct
showQuot = Char -> StringFct
showChar '\"'
{-# INLINE showQuot #-}
showLpar :: StringFct
showLpar = Char -> StringFct
showChar '('
{-# INLINE showLpar #-}
showRpar :: StringFct
showRpar = Char -> StringFct
showChar ')'
{-# INLINE showRpar #-}
showNL :: StringFct
showNL = Char -> StringFct
showChar '\n'
{-# INLINE showNL #-}
showChar :: Char -> StringFct
showChar :: Char -> StringFct
showChar = (:)
{-# INLINE showChar #-}
showString :: String -> StringFct
showString :: String -> StringFct
showString = String -> StringFct
forall a. [a] -> [a] -> [a]
(++)
{-# INLINE showString #-}
concatMap' :: (Char -> StringFct) -> String -> StringFct
concatMap' :: (Char -> StringFct) -> String -> StringFct
concatMap' f :: Char -> StringFct
f = (Char -> StringFct -> StringFct)
-> StringFct -> String -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ x :: Char
x r :: StringFct
r -> Char -> StringFct
f Char
x StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
r) StringFct
forall a. a -> a
id
{-# INLINE concatMap' #-}