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

{- |
   Module     : Text.XML.HXT.DOM.ShowXml
   Copyright  : Copyright (C) 2008-9 Uwe Schmidt
   License    : MIT

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

   XML tree conversion to external string representation

-}

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

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)

-- -----------------------------------------------------------------------------
--
-- the toString conversion functions

-- |
-- convert a list of trees into a string
--
-- see also : 'xmlTreesToText' for filter version, 'Text.XML.HXT.Parser.XmlParsec.xread' for the inverse operation

xshow                           :: XmlTrees -> String
xshow :: XmlTrees -> String
xshow [(NTree (XText String
s) XmlTrees
_)]     = String
s                     -- special case optimisation
xshow [(NTree (XBlob Blob
b) XmlTrees
_)]     = Blob -> String
blobToString Blob
b        -- special case optimisation
xshow XmlTrees
ts                        = (String -> StringFct)
-> (String -> StringFct) -> XmlTrees -> StringFct
showXmlTrees String -> StringFct
showString String -> StringFct
showString XmlTrees
ts String
""

-- | convert an XML tree into a binary large object (a bytestring)

xshowBlob                       :: XmlTrees -> Blob
xshowBlob :: XmlTrees -> Blob
xshowBlob [(NTree (XBlob Blob
b) XmlTrees
_)] = Blob
b                     -- special case optimisation
xshowBlob [(NTree (XText String
s) XmlTrees
_)] = String -> Blob
stringToBlob String
s        -- special case optimisation
xshowBlob XmlTrees
ts                    = String -> Blob
stringToBlob forall a b. (a -> b) -> a -> b
$ XmlTrees -> String
xshow XmlTrees
ts

-- |
-- convert a list of trees into a blob.
--
-- Apply a quoting function for XML quoting of content,
-- a 2. quoting funtion for attribute values
-- and an encoding function after tree conversion

xshow'                          :: (Char -> StringFct) ->
                                   (Char -> StringFct) ->
                                   (Char -> StringFct) ->
                                   XmlTrees -> Blob
xshow' :: (Char -> StringFct)
-> (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> Blob
xshow' Char -> StringFct
cquot Char -> StringFct
aquot Char -> StringFct
enc XmlTrees
ts       = String -> Blob
stringToBlob forall a b. (a -> b) -> a -> b
$ ((Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
enc (XmlTrees -> StringFct
showTrees XmlTrees
ts String
"")) String
""
    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'' Char -> StringFct
cquot Char -> StringFct
aquot XmlTrees
ts          = XmlTrees -> StringFct
showTrees XmlTrees
ts String
""
    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 String -> StringFct
cf String -> StringFct
af
    = XmlTrees -> StringFct
showTrees
      where

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

      showTrees                 :: XmlTrees -> StringFct
      showTrees :: XmlTrees -> StringFct
showTrees                 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showXmlTree
      {-# INLINE showTrees #-}

      showTrees'                :: XmlTrees -> StringFct
      showTrees' :: XmlTrees -> StringFct
showTrees'                = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ StringFct
x StringFct
y -> StringFct
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showNL forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
y) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showXmlTree
      {-# INLINE showTrees' #-}

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

      showXmlTree             :: XmlTree  -> StringFct
      showXmlTree :: NTree XNode -> StringFct
showXmlTree (NTree (XText String
s) XmlTrees
_)                         -- common cases first
                                = String -> StringFct
cf String
s

      showXmlTree (NTree (XTag QName
t XmlTrees
al) [])
                                = StringFct
showLt forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
al forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showSlash forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showGt

      showXmlTree (NTree (XTag QName
t XmlTrees
al) XmlTrees
cs)
                                = StringFct
showLt forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
al forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showGt
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
cs
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showLt forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showSlash forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showGt

      showXmlTree (NTree (XAttr QName
an) XmlTrees
cs)
                                = StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
an
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showEq
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
af (XmlTrees -> String
xshow XmlTrees
cs)
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot

      showXmlTree (NTree (XBlob Blob
b) XmlTrees
_)
                                = String -> StringFct
cf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blob -> String
blobToString forall a b. (a -> b) -> a -> b
$ Blob
b

      showXmlTree (NTree (XCharRef Int
i) XmlTrees
_)
                                = String -> StringFct
showString String
"&#" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString (forall a. Show a => a -> String
show Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar Char
';'

      showXmlTree (NTree (XEntityRef String
r) XmlTrees
_)
                                = String -> StringFct
showString String
"&" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar Char
';'

      showXmlTree (NTree (XCmt String
c) XmlTrees
_)
                                = String -> StringFct
showString String
"<!--" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
"-->"

      showXmlTree (NTree (XCdata String
d) XmlTrees
_)
                                = String -> StringFct
showString String
"<![CDATA[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
d' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
"]]>"
                                  where
                                    -- quote "]]>" in CDATA contents
                                    d' :: String
d' = forall s. StringLike s => (s -> s) -> s -> s -> s
sed (forall a b. a -> b -> a
const String
"]]&gt;") String
"\\]\\]>" String
d

      showXmlTree (NTree (XPi QName
n XmlTrees
al) XmlTrees
_)
                                = String -> StringFct
showString String
"<?"
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> StringFct
showQName QName
n
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showPiAttr) XmlTrees
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
"?>"
                                  where
                                  showPiAttr        :: XmlTree -> StringFct
                                  showPiAttr :: NTree XNode -> StringFct
showPiAttr a :: NTree XNode
a@(NTree (XAttr QName
an) XmlTrees
cs)
                                      | QName -> String
qualifiedName QName
an forall a. Eq a => a -> a -> Bool
== String
a_value
                                          -- <?some-pi ... ?>
                                          -- no XML quoting of PI value
                                          = StringFct
showBlank 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
                                          -- <?xml version="..." ... ?>
                                          = NTree XNode -> StringFct
showXmlTree NTree XNode
a
                                  showPiAttr NTree XNode
a
                                      = NTree XNode -> StringFct
showXmlTree NTree XNode
a -- id

      showXmlTree (NTree (XDTD DTDElem
de Attributes
al) XmlTrees
cs)
                                = DTDElem -> Attributes -> XmlTrees -> StringFct
showXmlDTD DTDElem
de Attributes
al XmlTrees
cs

      showXmlTree (NTree (XError Int
l String
e) XmlTrees
_)
                                = String -> StringFct
showString String
"<!-- ERROR ("
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> StringFct
shows Int
l
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
"):\n"
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
e
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
"\n-->"

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

      showXmlDTD              :: DTDElem -> Attributes -> XmlTrees -> StringFct

      showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> StringFct
showXmlDTD DTDElem
DOCTYPE Attributes
al XmlTrees
cs  = String -> StringFct
showString String
"<!DOCTYPE "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showExternalId Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showInternalDTD XmlTrees
cs
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
">"
                                  where
                                  showInternalDTD :: XmlTrees -> StringFct
showInternalDTD [] = forall a. a -> a
id
                                  showInternalDTD XmlTrees
ds = String -> StringFct
showString String
" [\n"
                                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees' XmlTrees
ds
                                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar Char
']'

      showXmlDTD DTDElem
ELEMENT Attributes
al XmlTrees
cs  = String -> StringFct
showString String
"<!ELEMENT "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlTrees -> StringFct
showElemType (forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type Attributes
al) XmlTrees
cs
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" >"

      showXmlDTD DTDElem
ATTLIST Attributes
al XmlTrees
cs  = String -> StringFct
showString String
"<!ATTLIST "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( if forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_name 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
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_value Attributes
al of
                                          Maybe String
Nothing -> ( Attributes -> StringFct
showPEAttr
                                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl
                                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head
                                                     ) XmlTrees
cs
                                          Just String
a  -> ( String -> StringFct
showString String
a
                                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showAttrType (forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type Attributes
al)
                                                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showAttrKind (forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_kind Attributes
al)
                                                     )
                                        )
                                    )
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" >"
                                  where
                                  showAttrType :: String -> StringFct
showAttrType String
t
                                      | String
t forall a. Eq a => a -> a -> Bool
== String
k_peref
                                          = StringFct
showBlank forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showPEAttr Attributes
al
                                      | String
t forall a. Eq a => a -> a -> Bool
== String
k_enumeration
                                          = StringFct
showAttrEnum
                                      | String
t forall a. Eq a => a -> a -> Bool
== String
k_notation
                                          = StringFct
showBlank forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_notation forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showAttrEnum
                                      | Bool
otherwise
                                          = StringFct
showBlank forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
t

                                  showAttrEnum :: StringFct
showAttrEnum
                                      = String -> StringFct
showString String
" ("
                                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
                                              (\ StringFct
s1 StringFct
s2 -> StringFct
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" | " forall b c a. (b -> c) -> (a -> b) -> a -> c
.  StringFct
s2)
                                              (forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> StringFct
getEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. XmlNode a => a -> Maybe Attributes
getDTDAttrl) XmlTrees
cs)
                                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
")"
                                        where
                                        getEnum     :: Attributes -> StringFct
                                        getEnum :: Attributes -> StringFct
getEnum Attributes
l = String -> Attributes -> StringFct
showAttr String
a_name Attributes
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showPEAttr Attributes
l

                                  showAttrKind :: String -> StringFct
showAttrKind String
k
                                      | String
k forall a. Eq a => a -> a -> Bool
== String
k_default
                                          = StringFct
showBlank
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString (forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_default Attributes
al)
                                      | String
k forall a. Eq a => a -> a -> Bool
== String
k_fixed
                                          = StringFct
showBlank
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_fixed
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString (forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_default Attributes
al)
                                      | String
k forall a. Eq a => a -> a -> Bool
== String
""
                                          = forall a. a -> a
id
                                      | Bool
otherwise
                                          = StringFct
showBlank
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k

      showXmlDTD DTDElem
NOTATION Attributes
al XmlTrees
_cs
                                = String -> StringFct
showString String
"<!NOTATION "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showExternalId Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" >"

      showXmlDTD DTDElem
PENTITY Attributes
al XmlTrees
cs  = String -> Attributes -> XmlTrees -> StringFct
showEntity String
"% " Attributes
al XmlTrees
cs

      showXmlDTD DTDElem
ENTITY Attributes
al XmlTrees
cs   = String -> Attributes -> XmlTrees -> StringFct
showEntity String
"" Attributes
al XmlTrees
cs

      showXmlDTD DTDElem
PEREF Attributes
al XmlTrees
_cs   = Attributes -> StringFct
showPEAttr Attributes
al

      showXmlDTD DTDElem
CONDSECT Attributes
_ (NTree XNode
c1 : XmlTrees
cs)
                                = String -> StringFct
showString String
"<![ "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> StringFct
showXmlTree NTree XNode
c1
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" [\n"
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showTrees XmlTrees
cs
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
"]]>"

      showXmlDTD DTDElem
CONTENT Attributes
al XmlTrees
cs  = NTree XNode -> StringFct
showContent (DTDElem -> Attributes -> XmlTrees -> NTree XNode
mkDTDElem DTDElem
CONTENT Attributes
al XmlTrees
cs)

      showXmlDTD DTDElem
NAME Attributes
al XmlTrees
_cs    = String -> Attributes -> StringFct
showAttr String
a_name Attributes
al

      showXmlDTD DTDElem
de Attributes
al XmlTrees
_cs      = String -> StringFct
showString String
"NOT YET IMPLEMETED: "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString (forall a. Show a => a -> String
show DTDElem
de)
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString (forall a. Show a => a -> String
show Attributes
al)
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" [...]\n"

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

      showEntity                :: String -> Attributes -> XmlTrees -> StringFct
      showEntity :: String -> Attributes -> XmlTrees -> StringFct
showEntity String
kind Attributes
al XmlTrees
cs     = String -> StringFct
showString String
"<!ENTITY "
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
kind
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showExternalId Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showNData Attributes
al
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTrees -> StringFct
showEntityValue XmlTrees
cs
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" >"


      showEntityValue           :: XmlTrees -> StringFct
      showEntityValue :: XmlTrees -> StringFct
showEntityValue []        = forall a. a -> a
id
      showEntityValue XmlTrees
cs        = StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
af (XmlTrees -> String
xshow XmlTrees
cs)
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot

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

      showContent               :: XmlTree -> StringFct
      showContent :: NTree XNode -> StringFct
showContent (NTree (XDTD DTDElem
de Attributes
al) XmlTrees
cs)
                                = DTDElem -> StringFct
cont2String DTDElem
de
                                  where
                                  cont2String           :: DTDElem -> StringFct
                                  cont2String :: DTDElem -> StringFct
cont2String DTDElem
NAME      = String -> Attributes -> StringFct
showAttr String
a_name Attributes
al
                                  cont2String DTDElem
PEREF     = Attributes -> StringFct
showPEAttr Attributes
al
                                  cont2String DTDElem
CONTENT   = StringFct
showLpar
                                                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
                                                                (forall {c} {a}. String -> (String -> c) -> (a -> String) -> a -> c
combine (forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_kind Attributes
al))
                                                                (forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showContent XmlTrees
cs)
                                                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
                                                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_modifier Attributes
al
                                  cont2String DTDElem
n         = forall a. HasCallStack => String -> a
error (String
"cont2string " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DTDElem
n forall a. [a] -> [a] -> [a]
++ String
" is undefined")
                                  combine :: String -> (String -> c) -> (a -> String) -> a -> c
combine String
k String -> c
s1 a -> String
s2       = String -> c
s1
                                                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString ( if String
k forall a. Eq a => a -> a -> Bool
== String
v_seq
                                                                         then String
", "
                                                                         else String
" | "
                                                                       )
                                                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
s2

      showContent NTree XNode
n             = NTree XNode -> StringFct
showXmlTree NTree XNode
n

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

      showElemType              :: String -> XmlTrees -> StringFct
      showElemType :: String -> XmlTrees -> StringFct
showElemType String
t XmlTrees
cs
          | String
t forall a. Eq a => a -> a -> Bool
== String
v_pcdata       = StringFct
showLpar forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
v_pcdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
          | String
t forall a. Eq a => a -> a -> Bool
== String
v_mixed
            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) XmlTrees
cs     = StringFct
showLpar
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
v_pcdata
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> StringFct
mixedContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNode -> Attributes
selAttrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Tree t => t a -> a
getNode)
                                    ) XmlTrees
cs1
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_modifier Attributes
al1
          | String
t forall a. Eq a => a -> a -> Bool
== String
v_mixed                              -- incorrect tree, e.g. after erronius pe substitution
                                = StringFct
showLpar
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
          | String
t forall a. Eq a => a -> a -> Bool
== String
v_children
            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) XmlTrees
cs     = NTree XNode -> StringFct
showContent (forall a. [a] -> a
head XmlTrees
cs)
          | String
t forall a. Eq a => a -> a -> Bool
== String
v_children     = StringFct
showLpar
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showRpar
          | String
t forall a. Eq a => a -> a -> Bool
== String
k_peref        = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> StringFct
showContent forall a b. (a -> b) -> a -> b
$ XmlTrees
cs
          | Bool
otherwise           = String -> StringFct
showString String
t
          where
          [(NTree (XDTD DTDElem
CONTENT Attributes
al1) XmlTrees
cs1)] = XmlTrees
cs

          mixedContent          :: Attributes -> StringFct
          mixedContent :: Attributes -> StringFct
mixedContent Attributes
l        = String -> StringFct
showString String
" | " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> StringFct
showAttr String
a_name Attributes
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> StringFct
showPEAttr Attributes
l

          selAttrl :: XNode -> Attributes
selAttrl (XDTD DTDElem
_ Attributes
as)  = Attributes
as
          selAttrl (XText String
tex)  = [(String
a_name, String
tex)]
          selAttrl XNode
_            = []

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

showQName                       :: QName -> StringFct
showQName :: QName -> StringFct
showQName                       = QName -> StringFct
qualifiedName'
{-# INLINE showQName #-}

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

showQuoteString                 :: String -> StringFct
showQuoteString :: String -> StringFct
showQuoteString String
s               = StringFct
showQuot forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showQuot

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

showAttr                        :: String -> Attributes -> StringFct
showAttr :: String -> Attributes -> StringFct
showAttr String
k Attributes
al                   = String -> StringFct
showString (forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k forall a b. (a -> b) -> a -> b
$ Attributes
al)

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

showPEAttr                      :: Attributes -> StringFct
showPEAttr :: Attributes -> StringFct
showPEAttr Attributes
al                   = Maybe String -> StringFct
showPE (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_peref Attributes
al)
    where
    showPE :: Maybe String -> StringFct
showPE (Just String
pe)            = Char -> StringFct
showChar Char
'%'
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
pe
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringFct
showChar Char
';'
    showPE Maybe String
Nothing              = forall a. a -> a
id

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

showExternalId                  :: Attributes -> StringFct
showExternalId :: Attributes -> StringFct
showExternalId Attributes
al               = Maybe String -> Maybe String -> StringFct
id2Str (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k_system Attributes
al) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k_public Attributes
al)
    where
    id2Str :: Maybe String -> Maybe String -> StringFct
id2Str Maybe String
Nothing  Maybe String
Nothing     = forall a. a -> a
id
    id2Str (Just String
s) Maybe String
Nothing     = StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_system
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
s
    id2Str Maybe String
Nothing  (Just String
p)    = StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_public
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
p
    id2Str (Just String
s) (Just String
p)    = StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_public
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
p
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showQuoteString String
s

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

showNData                       :: Attributes -> StringFct
showNData :: Attributes -> StringFct
showNData Attributes
al                    = Maybe String -> StringFct
nd2Str (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k_ndata Attributes
al)
    where
    nd2Str :: Maybe String -> StringFct
nd2Str Maybe String
Nothing              = forall a. a -> a
id
    nd2Str (Just String
v)             = StringFct
showBlank
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
k_ndata
                                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
showBlank
                                  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 Char
' '
{-# INLINE showBlank #-}

showEq :: StringFct
showEq          = Char -> StringFct
showChar Char
'='
{-# INLINE showEq #-}

showLt :: StringFct
showLt          = Char -> StringFct
showChar Char
'<'
{-# INLINE showLt #-}

showGt :: StringFct
showGt          = Char -> StringFct
showChar Char
'>'
{-# INLINE showGt #-}

showSlash :: StringFct
showSlash       = Char -> StringFct
showChar Char
'/'
{-# INLINE showSlash #-}

showQuot :: StringFct
showQuot        = Char -> StringFct
showChar Char
'\"'
{-# INLINE showQuot #-}

showLpar :: StringFct
showLpar        = Char -> StringFct
showChar Char
'('
{-# INLINE showLpar #-}

showRpar :: StringFct
showRpar        = Char -> StringFct
showChar Char
')'
{-# INLINE showRpar #-}

showNL :: StringFct
showNL          = Char -> StringFct
showChar Char
'\n'
{-# INLINE showNL #-}

showChar        :: Char -> StringFct
showChar :: Char -> StringFct
showChar        = (:)
{-# INLINE showChar #-}

showString      :: String -> StringFct
showString :: String -> StringFct
showString      = forall a. [a] -> [a] -> [a]
(++)
{-# INLINE showString #-}

concatMap'      :: (Char -> StringFct) -> String -> StringFct
concatMap' :: (Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
f    = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Char
x StringFct
r -> Char -> StringFct
f Char
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFct
r) forall a. a -> a
id
{-# INLINE concatMap' #-}

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