    -----------------------------------------------------------------------------
    -- |
    -- Module      :  HSP.XML
    -- Copyright   :  (c) Niklas Broberg 2008-2013
    -- License     :  BSD-style (see the file LICENSE.txt)
    --
    -- Maintainer  :  Niklas Broberg, niklas.broberg@gmail.com
    -- Stability   :  experimental
    -- Portability :  Haskell 98
    --
    -- Datatypes and type classes comprising the basic model behind
    -- the scenes of Haskell Server Pages tags.
    -----------------------------------------------------------------------------
    module HSP.XML (
            -- * The 'XML' datatype
            XML(..),
            XMLMetaData(..),
            Namespace,
            NSName,
            Attributes,
            Children,
            pcdata,
            cdata,
            -- * The Attribute type
            Attribute(..),
            AttrValue(..),
            attrVal, pAttrVal,
            -- * Functions
            renderXML,
            isElement, isCDATA,
            fromStringLit
            ) where

    import Data.List                        (intersperse)
    import Data.Monoid                      ((<>), mconcat)
    import Data.String                      (fromString)
    import Data.Text.Lazy.Builder           (Builder, fromLazyText, singleton, toLazyText)
    import Data.Text.Lazy                   (Text)
    import qualified Data.Text.Lazy         as Text
    import HSP.XML.PCDATA                   (escape)

    ---------------------------------------------------------------
    -- fromStringLit

    fromStringLit :: String -> Text
    fromStringLit = Text.pack

    ---------------------------------------------------------------
    -- Namespace/NSName

    type Namespace  = Maybe Text
    type NSName = (Namespace, Text)

    ---------------------------------------------------------------
    -- Attributes
    newtype Attribute = MkAttr (NSName, AttrValue)
      deriving Show

    -- | Represents an attribue value.
    data AttrValue = Value Bool Text | NoValue

    -- fromStringLit :: String -> Text
    -- fromStringLit = Text.pack

    -- | Create an attribue value from a string.
    attrVal, pAttrVal :: Text -> AttrValue
    attrVal  = Value False
    pAttrVal = Value True

    instance Show AttrValue where
     show (Value _ txt) = Text.unpack txt
     show NoValue = ""

    type Attributes = [Attribute]

    ---------------------------------------------------------------
    -- XML
    -- | The XML datatype representation. Is either an Element or CDATA.
    data XML
        = Element NSName Attributes Children
        | CDATA Bool Text
          deriving Show

    type Children = [XML]

    -- | Embeds a string as a CDATA XML value.
    cdata , pcdata :: Text -> XML
    cdata  = CDATA False
    pcdata = CDATA True

    -- | Test whether an XML value is an Element or CDATA
    isElement, isCDATA :: XML -> Bool
    isElement (Element {}) = True
    isElement _ = False
    isCDATA = not . isElement

    ---------------------------------------------------------------
    -- XMLMetaData

    -- |The XMLMetaData datatype
    --
    -- Specify the DOCTYPE, content-type, and preferred render for XML data.
    --
    -- See also: 'HSP.Monad.setMetaData' and 'HSP.Monad.withMetaData'
    data XMLMetaData = XMLMetaData
      {  doctype           :: (Bool, Text) -- ^ (show doctype when rendering, DOCTYPE string)
      ,  contentType       :: Text
      ,  preferredRenderer :: XML -> Builder
      }

    ------------------------------------------------------------------
    -- Rendering

    data TagType = Open | Close | Single

    renderTag :: TagType -> Int -> NSName -> Attributes -> Builder
    renderTag typ n name attrs =
            let (start,end) = case typ of
                               Open   -> (singleton  '<',  singleton  '>')
                               Close  -> (fromString "</", singleton  '>')
                               Single -> (singleton  '<',  fromString "/>")
                nam = showNSName name
                as  = renderAttrs attrs
             in mconcat [start, nam, as, end]

      where renderAttrs :: Attributes -> Builder
            renderAttrs [] = nl
            renderAttrs attrs' = singleton ' ' <> mconcat  ats <>  nl
              where ats = intersperse (singleton ' ') $ fmap renderAttr attrs'

            renderAttr :: Attribute -> Builder
            renderAttr (MkAttr (nam, (Value needsEscape val))) =
                showNSName nam <> singleton '=' <> renderAttrVal  (if needsEscape then escape val else fromLazyText val)
            renderAttr (MkAttr (nam, NoValue)) = showNSName nam <> singleton '=' <> renderAttrVal (fromString "")

            renderAttrVal :: Builder -> Builder
            renderAttrVal txt = singleton '\"' <> txt <> singleton '\"'

            showNSName (Nothing, s) = fromLazyText s
            showNSName (Just d, s)  = fromLazyText d <> singleton ':' <> fromLazyText s

            nl = singleton '\n' <> fromString (replicate n ' ')

    renderXML' :: Int -> XML -> Builder
    renderXML' _ (CDATA needsEscape cd) = if needsEscape then escape cd else fromLazyText cd
    renderXML' n (Element name attrs []) = renderTag Single n name attrs
    renderXML' n (Element name attrs children) =
            let open  = renderTag Open n name attrs
                cs    = renderChildren n children
                close = renderTag Close n name []
             in open <> cs <> close

      where renderChildren :: Int -> Children -> Builder
            renderChildren n' cs = mconcat $ map (renderXML' (n'+2)) cs

    -- TODO: indents are incorrectly calculated

    -- | Pretty-prints XML values.
    renderXML :: XML -> Text
    renderXML xml = toLazyText $ renderXML' 0 xml