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

    {- |
       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
        , showElemType
        )
    where

    import Data.Maybe
    import Data.Tree.NTree.TypeDefs

    import Text.XML.HXT.DOM.TypeDefs                -- XML Tree types
    import Text.XML.HXT.DOM.XmlKeywords
    import Text.XML.HXT.DOM.XmlNode                 ( mkDTDElem
                                                    , getDTDAttrl
                                                    )

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

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

    xshow   :: XmlTrees -> String
    xshow [(NTree (XText s) _)]     = s                     -- special case optimisation
    xshow ts                        = showXmlTrees ts ""

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

    showXmlTree             :: XmlTree  -> String -> String

    showXmlTree (NTree (XText s) _)
        = showString s

    showXmlTree (NTree (XCharRef i) _)
        = showString "&#" . showString (show i) . showChar ';'

    showXmlTree (NTree (XEntityRef r) _)
        = showString "&" . showString r . showChar ';'

    showXmlTree (NTree (XCmt c) _)
        = showString "<!--" . showString c . showString "-->"

    showXmlTree (NTree (XCdata d) _)
        = showString "<![CDATA[" . showString d . showString "]]>"

    showXmlTree (NTree (XPi n al) _)
        = showString "<?"
          .
          showQName n
          .
          (foldr (.) id . map showPiAttr) al
          .
          showString "?>"
          where
          showPiAttr        :: XmlTree -> String -> String
          showPiAttr a@(NTree (XAttr an) cs)
              | qualifiedName an == a_value
                  = showBlank . showXmlTrees cs
              | otherwise
                  = showXmlTree a
          showPiAttr _
              = id

    showXmlTree (NTree (XTag t al) [])
        = showLt . showQName t . showXmlTrees al . showSlash . showGt

    showXmlTree (NTree (XTag t al) cs)
        = showLt . showQName t . showXmlTrees al . showGt
          . showXmlTrees cs
          . showLt . showSlash . showQName t . showGt

    showXmlTree (NTree (XDTD de al) cs)
        = showXmlDTD de al cs

    showXmlTree (NTree (XAttr an) cs)
        = showBlank . showQName an . showEq . showQuoteString (xshow cs)

    showXmlTree (NTree (XError l e) _)
        = showString "<!-- ERROR (" . shows l . showString "):\n" . showString e . showString "\n-->"

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

    showXmlTrees            :: XmlTrees -> String -> String
    showXmlTrees            = foldr (.) id . map showXmlTree

    showXmlTrees'           :: XmlTrees -> String -> String
    showXmlTrees'           = foldr (\ x y -> x . showNL . y) id . map showXmlTree

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

    showQName               :: QName -> String -> String
    showQName
        = showString . qualifiedName

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

    showQuoteString         :: String -> String -> String
    showQuoteString s
        | '\"' `elem` s
            = showApos . showString s . showApos
        | otherwise
            = showQuot . showString s . showQuot

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

    showAttr        :: String -> Attributes -> String -> String
    showAttr k al
        = showString (fromMaybe "" . lookup k $ al)

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

    showPEAttr      :: Attributes -> String -> String
    showPEAttr al
        = showPE (lookup a_peref al)
          where
          showPE (Just pe) = showChar '%' . showString pe . showChar ';'
          showPE Nothing   = id

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

    showExternalId  :: Attributes -> String -> String
    showExternalId al
        = id2Str (lookup k_system al) (lookup k_public al)
          where
          id2Str Nothing  Nothing  = id
          id2Str (Just s) Nothing  = showBlank . showString k_system . showBlank . showQuoteString s
          id2Str Nothing  (Just p) = showBlank . showString k_public . showBlank . showQuoteString p
          id2Str (Just s) (Just p) = showBlank . showString k_public . showBlank . showQuoteString p . showBlank . showQuoteString s

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

    showNData       :: Attributes -> String -> String
    showNData al
        = nd2Str (lookup k_ndata al)
          where
          nd2Str Nothing    = id
          nd2Str (Just v)   = showBlank . showString k_ndata . showBlank . showString v

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

    showXmlDTD              :: DTDElem -> Attributes -> XmlTrees -> String -> String

    showXmlDTD DOCTYPE al cs
        = showString "<!DOCTYPE "
          .
          showAttr a_name al
          .
          showExternalId al
          .
          showInternalDTD cs
          .
          showString ">"
          where
          showInternalDTD [] = id
          showInternalDTD ds = showString " [\n" . showXmlTrees' ds . showChar ']'

    showXmlDTD ELEMENT al cs
        = showString "<!ELEMENT "
          .
          showAttr a_name al
          .
          showBlank
          .
          showElemType (lookup1 a_type al) cs
          .
          showString " >"

    showXmlDTD ATTLIST al cs
        = showString "<!ATTLIST "
          .
          ( if isNothing . lookup a_name $ al
            then
            showXmlTrees cs
            else
            showAttr a_name al
            .
            showBlank
            .
            ( case lookup a_value al of
              Nothing -> ( showPEAttr
                           . fromMaybe [] . getDTDAttrl
                           . head
                         ) cs
              Just a  -> ( showString a
                           .
                           showAttrType (lookup1 a_type al)
                           .
                           showAttrKind (lookup1 a_kind al)
                         )
            )
          )
          .
          showString " >"
          where
          showAttrType t
              | t == k_peref
                  = showBlank . showPEAttr al
              | t == k_enumeration
                  = showAttrEnum
              | t == k_notation
                  = showBlank . showString k_notation . showAttrEnum
              | otherwise
                  = showBlank . showString t

          showAttrEnum
              = showString " ("
                .
                foldr1 (\ s1 s2 -> s1 . showString " | " .  s2) (map (getEnum . fromMaybe [] . getDTDAttrl) cs)
                .
                showString ")"
                where
                getEnum     :: Attributes -> String -> String
                getEnum l = showAttr a_name l . showPEAttr l

          showAttrKind k
              | k == k_default
                  = showBlank . showQuoteString (lookup1 a_default al)
              | k == k_fixed
                  = showBlank . showString k_fixed
                    .
                    showBlank . showQuoteString (lookup1 a_default al)
              | k == ""
                  = id
              | otherwise
                  = showBlank . showString k

    showXmlDTD NOTATION al _cs
        = showString "<!NOTATION "
          .
          showAttr a_name al
          .
          showExternalId al
          .
          showString " >"

    showXmlDTD PENTITY al cs
        = showEntity "% " al cs

    showXmlDTD ENTITY al cs
        = showEntity "" al cs

    showXmlDTD PEREF al _cs
        = showPEAttr al

    showXmlDTD CONDSECT _ (c1 : cs)
        = showString "<![ "
          .
          showXmlTree c1
          .
          showString " [\n"
          .
          showXmlTrees cs
          .
          showString "]]>"

    showXmlDTD CONTENT al cs
        = showContent (mkDTDElem CONTENT al cs)

    showXmlDTD NAME al _cs
        = showAttr a_name al

    showXmlDTD de al _cs
        = showString "NOT YET IMPLEMETED: " . showString (show de) . showBlank . showString (show al) . showString " [...]\n"

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

    showElemType    :: String -> XmlTrees -> String -> String
    showElemType t cs
        | t == v_pcdata
            = showLpar . showString v_pcdata . showRpar

        | t == v_mixed && (not . null) cs
            = showLpar
              .
              showString v_pcdata
              .
              ( foldr (.) id . map (mixedContent . selAttrl . getNode) ) cs1
              .
              showRpar
              .
              showAttr a_modifier al1
        | t == v_mixed                              -- incorrect tree, e.g. after erronius pe substitution
            = showLpar
              .
              showRpar
        | t == v_children && (not . null) cs
            = showContent (head cs)
        | t == v_children
            = showLpar
              . showRpar
        | t == k_peref
            = foldr (.) id . map showContent $ cs
        | otherwise
            = showString t
        where
        [(NTree (XDTD CONTENT al1) cs1)] = cs

        mixedContent :: Attributes -> String -> String
        mixedContent l
            = showString " | " . showAttr a_name l . showPEAttr l

        selAttrl (XDTD _ as) = as
        selAttrl (XText tex) = [(a_name, tex)]
        selAttrl _           = []

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

    showContent     :: XmlTree -> String -> String
    showContent (NTree (XDTD de al) cs)
        = cont2String de
          where
          cont2String       :: DTDElem -> String -> String
          cont2String NAME
              = showAttr a_name al
          cont2String PEREF
              = showPEAttr al
          cont2String CONTENT
              = showLpar
                .
                foldr1 (combine (lookup1 a_kind al)) (map showContent cs)
                .
                showRpar
                .
                showAttr a_modifier al
          cont2String n
              = error ("cont2string " ++ show n ++ " is undefined")
          combine k s1 s2
              = s1
                .
                showString ( if k == v_seq
                             then ", "
                             else " | "
                           )
                .
                s2

    showContent n
        = showXmlTree n

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

    showEntity      :: String -> Attributes -> XmlTrees -> String -> String

    showEntity kind al cs
        = showString "<!ENTITY "
          .
          showString kind
          .
          showAttr a_name al
          .
          showExternalId al
          .
          showNData al
          .
          showEntityValue cs
          .
          showString " >"

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

    showEntityValue :: XmlTrees -> String -> String

    showEntityValue []
        = id

    showEntityValue cs
        = showBlank . showQuoteString (xshow cs)

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

    showBlank,
      showEq, showLt, showGt, showSlash, showApos, showQuot, showLpar, showRpar, showNL :: String -> String

    showBlank       = showChar ' '
    showEq          = showChar '='
    showLt          = showChar '<'
    showGt          = showChar '>'
    showSlash       = showChar '/'
    showApos        = showChar '\''
    showQuot        = showChar '\"'
    showLpar        = showChar '('
    showRpar        = showChar ')'
    showNL          = showChar '\n'

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