pontarius-xmpp/Network/XMPP/Utilities.hs

-- Copyright © 2010-2011 Jon Kristensen. See the LICENSE file in the Pontarius
-- XMPP distribution for more details.

{-# OPTIONS_HADDOCK hide #-}

-- TODO: Document this module
-- TODO: Make is possible to customize characters
-- TODO: Make it possible to customize length

module Network.XMPP.Utilities ( elementToString
                              , elementsToString ) where

import Data.Word
import Data.XML.Types
import System.Crypto.Random
import System.Random
import qualified Data.ByteString as DB
import qualified Data.Map as DM
import qualified Data.Text as DT



-- =============================================================================
--  XML Utilities
-- =============================================================================


elementsToString :: [Element] -> String
elementsToString [] = ""
elementsToString (e:es) = (elementToString $ Just e) ++ elementsToString es

elementToString :: Maybe Element -> String
elementToString Nothing = ""
elementToString (Just e) = "<" ++ nameToString (elementName e) ++ xmlns ++
                           attributes (elementAttributes e) ++
                           ">" ++ (nodesToString $ elementNodes e) ++ "</" ++
                           nameToString (elementName e) ++ ">"
  where
    xmlns :: String
    xmlns = case nameNamespace $ elementName e of
      Nothing -> ""
      Just t -> " xmlns='" ++ (DT.unpack t) ++ "'"

    nameToString :: Name -> String
    nameToString Name { nameLocalName = n, namePrefix = Nothing } = DT.unpack n
    nameToString Name { nameLocalName = n, namePrefix = Just p } =
      (DT.unpack p) ++ ":" ++ (DT.unpack n)

    contentToString :: Content -> String
    contentToString (ContentText t) = DT.unpack t
    contentToString (ContentEntity t) = DT.unpack t

    attributes :: [(Name, [Content])] -> String
    attributes [] = ""
    attributes ((n, c):t) = (" " ++ (nameToString n) ++ "='" ++
                             concat (map contentToString c) ++ "'") ++
                            attributes t

    nodesToString :: [Node] -> String
    nodesToString [] = ""
    nodesToString ((NodeElement e):ns) = (elementToString $ Just e) ++
                                         (nodesToString ns)
    nodesToString ((NodeContent c):ns) = (contentToString c) ++
                                         (nodesToString ns)