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

    {- |
       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'

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