{- |
   Maintainer  :  simons@cryp.to
   Stability   :  experimental
   Portability :  portable

   The preferred method for rendering a 'Document' or single 'Content'
   is by using the pretty printing facility defined in "Pretty".
   Pretty-printing does not work well for cases, however, where the
   formatting in the XML document is significant. Examples of this
   case are XHTML's @\<pre\>@ tag, Docbook's @\<literallayout\>@ tag,
   and many more.

   Theoretically, the document author could avoid this problem by
   wrapping the contents of these tags in a \<![CDATA[...]]\> section,
   but often this is not practical, for instance when the
   literal-layout section contains other elements. Finally, program
   writers could manually format these elements by transforming them
   into a 'literal' string in their 'CFliter', etc., but this is
   annoying to do and prone to omissions and formatting errors.

   As an alternative, this module provides the function 'verbatim',
   which will format XML 'Content' as a 'String' while retaining the
   formatting of the input document unchanged.

   /Known problems/:

    * HaXml's parser eats line feeds between two tags.

    * 'Attribute's should be formatted by making them an instance of
      'Verbatim' as well, but since an 'Attribute' is just a tuple,
      not a full data type, the helper function 'verbAttr' must be
      used instead.

    * 'CMisc' is not yet supported.

    * 'Element's, which contain no content, are formatted as
       @\<element-name\/\>@, even if they were not defined as being of
       type @EMPTY@. In XML this perfectly alright, but in SGML it is
       not. Those, who wish to use 'verbatim' to format parts of say
       an HTML page will have to (a) replace problematic elements by
       'literal's /before/ running 'verbatim' or (b) use a second
       search-and-replace stage to fix this.
 -}

module Text.XML.HaXml.Verbatim where

import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces

qname :: QName -> String
qname :: QName -> String
qname QName
n = QName -> String
printableName QName
n

-- |This class promises that the function 'verbatim' knows how to
-- format this data type into a string without changing the
-- formatting.

class Verbatim a where
    verbatim :: a -> String

instance (Verbatim a) => Verbatim [a] where
    verbatim :: [a] -> String
verbatim  = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Verbatim a => a -> String
verbatim)

instance Verbatim Char where
    verbatim :: Char -> String
verbatim Char
c = [Char
c]

instance (Verbatim a, Verbatim b) => Verbatim (Either a b) where
    verbatim :: Either a b -> String
verbatim (Left a
v)  = a -> String
forall a. Verbatim a => a -> String
verbatim a
v
    verbatim (Right b
v) = b -> String
forall a. Verbatim a => a -> String
verbatim b
v

instance Verbatim (Content i) where
    verbatim :: Content i -> String
verbatim (CElem Element i
c i
_)     = Element i -> String
forall a. Verbatim a => a -> String
verbatim Element i
c
    verbatim (CString Bool
_ String
c i
_) = String
c
    verbatim (CRef Reference
c i
_)      = Reference -> String
forall a. Verbatim a => a -> String
verbatim Reference
c
    verbatim (CMisc (Comment String
c) i
_) = String
"<!--"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"-->"
    verbatim (CMisc Misc
_ i
_)     = String
"<? ?>"
 -- verbatim (CMisc _ _)     = error "NYI: verbatim not defined for CMisc"

instance Verbatim (Element i) where
    verbatim :: Element i -> String
verbatim (Elem QName
nam [Attribute]
att [])   = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
qname QName
nam
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([Attribute] -> [String]) -> [Attribute] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
verbAttr)) [Attribute]
att
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/>"
    verbatim (Elem QName
nam [Attribute]
att [Content i]
cont) = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
qname QName
nam
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([Attribute] -> [String]) -> [Attribute] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
verbAttr)) [Attribute]
att
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Content i] -> String
forall a. Verbatim a => a -> String
verbatim [Content i]
cont String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</"
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
qname QName
nam String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

instance Verbatim Reference where
    verbatim :: Reference -> String
verbatim (RefEntity String
r) = String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Verbatim a => a -> String
verbatim String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    verbatim (RefChar CharRef
c)   = String
"&#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CharRef -> String
forall a. Show a => a -> String
show CharRef
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"

instance Verbatim AttValue where
    verbatim :: AttValue -> String
verbatim (AttValue [Either String Reference]
v) = [Either String Reference] -> String
forall a. Verbatim a => a -> String
verbatim [Either String Reference]
v

-- |This is a helper function is required because Haskell does not
-- allow to make an ordinary tuple (like 'Attribute') an instance of a
-- class. The resulting output will preface the actual attribute with
-- a single blank so that lists of 'Attribute's can be handled
-- implicitly by the definition for lists of 'Verbatim' data types.

verbAttr :: Attribute -> String
verbAttr :: Attribute -> String
verbAttr (QName
n, AttValue [Either String Reference]
v) = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
qname QName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Either String Reference] -> String
forall a. Verbatim a => a -> String
verbatim [Either String Reference]
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""