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

{- |
   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 (String -> Blob) -> String -> Blob
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 (String -> Blob) -> String -> Blob
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                 = (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 (\ StringFct
x 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 String
s) XmlTrees
_)                         -- common cases first
                                = String -> StringFct
cf String
s

      showXmlTree (NTree (XTag QName
t 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 QName
t XmlTrees
al) 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 QName
an) 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 Blob
b) XmlTrees
_)
                                = 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 Int
i) XmlTrees
_)
                                = String -> StringFct
showString String
"&#" 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 Char
';'

      showXmlTree (NTree (XEntityRef String
r) XmlTrees
_)
                                = String -> StringFct
showString String
"&" 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 Char
';'

      showXmlTree (NTree (XCmt String
c) XmlTrees
_)
                                = String -> StringFct
showString String
"<!--" 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 String
"-->"

      showXmlTree (NTree (XCdata String
d) XmlTrees
_)
                                = String -> StringFct
showString String
"<![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 String
"]]>"
                                  where
                                    -- quote "]]>" in CDATA contents
                                    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
"]]&gt;") String
"\\]\\]>" String
d

      showXmlTree (NTree (XPi QName
n XmlTrees
al) XmlTrees
_)
                                = String -> StringFct
showString String
"<?"
                                  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 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a_value
                                          -- <?some-pi ... ?>
                                          -- no XML quoting of PI 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
                                          -- <?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 ("
                                  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 String
"):\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 String
"\n-->"

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

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

      showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> StringFct
showXmlDTD DTDElem
DOCTYPE Attributes
al XmlTrees
cs  = String -> StringFct
showString String
"<!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 String
">"
                                  where
                                  showInternalDTD :: XmlTrees -> StringFct
showInternalDTD [] = StringFct
forall a. a -> a
id
                                  showInternalDTD XmlTrees
ds = String -> StringFct
showString String
" [\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 Char
']'

      showXmlDTD DTDElem
ELEMENT Attributes
al XmlTrees
cs  = String -> StringFct
showString String
"<!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 String
" >"

      showXmlDTD DTDElem
ATTLIST Attributes
al XmlTrees
cs  = String -> StringFct
showString String
"<!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
                                          Maybe String
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 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 String
" >"
                                  where
                                  showAttrType :: String -> StringFct
showAttrType 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 String
" ("
                                        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
                                              (\ StringFct
s1 StringFct
s2 -> StringFct
s1 StringFct -> StringFct -> StringFct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringFct
showString String
" | " 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 String
")"
                                        where
                                        getEnum     :: Attributes -> StringFct
                                        getEnum :: Attributes -> StringFct
getEnum 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 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
== String
""
                                          = 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 DTDElem
NOTATION Attributes
al XmlTrees
_cs
                                = String -> StringFct
showString String
"<!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 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
"<![ "
                                  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 String
" [\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 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: "
                                  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 String
" [...]\n"

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

      showEntity                :: String -> Attributes -> XmlTrees -> StringFct
      showEntity :: String -> Attributes -> XmlTrees -> StringFct
showEntity String
kind Attributes
al XmlTrees
cs     = String -> StringFct
showString String
"<!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 String
" >"


      showEntityValue           :: XmlTrees -> StringFct
      showEntityValue :: XmlTrees -> StringFct
showEntityValue []        = StringFct
forall a. a -> a
id
      showEntityValue 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 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
                                                          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 DTDElem
n         = String -> StringFct
forall a. HasCallStack => String -> a
error (String
"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]
++ String
" is undefined")
                                  combine :: String -> (String -> c) -> (a -> String) -> a -> c
combine String
k String -> c
s1 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 String
", "
                                                                         else String
" | "
                                                                       )
                                                          StringFct -> (a -> String) -> a -> 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 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                              -- incorrect tree, e.g. after erronius pe substitution
                                = 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 DTDElem
CONTENT Attributes
al1) XmlTrees
cs1)] = XmlTrees
cs

          mixedContent          :: Attributes -> StringFct
          mixedContent :: Attributes -> StringFct
mixedContent Attributes
l        = String -> StringFct
showString String
" | " 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 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 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 String
k Attributes
al                   = String -> StringFct
showString (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (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 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 String
pe)            = Char -> StringFct
showChar Char
'%'
                                  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 Char
';'
    showPE Maybe String
Nothing              = StringFct
forall a. a -> a
id

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

showExternalId                  :: Attributes -> StringFct
showExternalId :: Attributes -> StringFct
showExternalId 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 Maybe String
Nothing  Maybe String
Nothing     = StringFct
forall a. a -> a
id
    id2Str (Just String
s) Maybe String
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 Maybe String
Nothing  (Just 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 String
s) (Just 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 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 Maybe String
Nothing              = StringFct
forall a. a -> a
id
    nd2Str (Just 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 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      = String -> StringFct
forall a. [a] -> [a] -> [a]
(++)
{-# INLINE showString #-}

concatMap'      :: (Char -> StringFct) -> String -> StringFct
concatMap' :: (Char -> StringFct) -> String -> StringFct
concatMap' Char -> StringFct
f    = (Char -> StringFct -> StringFct)
-> StringFct -> String -> StringFct
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Char
x 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' #-}

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