module Network.XMPP.Utilities ( elementToString
, elementsToString
, getID
, getID_) 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
characters :: String
characters = "abcdef0123456789"
getID :: IO String
getID = getID_ 8
getID_ :: Int -> IO String
getID_ i =
do se <- getSeed
let st = mkStdGen se
return $ take i (idSequence st)
where
idSequence :: StdGen -> String
idSequence st = [characters !! (fst $ rand st)] ++ idSequence (snd $ rand st)
rand :: StdGen -> (Int, StdGen)
rand st = randomR (0, length characters 1) st
getSeed :: IO Int
getSeed =
do h <- openHandle
b <- hGetEntropy h 8
let w = DB.unpack b
let s = seed w
closeHandle h
return s
where seed :: [Word8] -> Int
seed [] = 1
seed (x:xs) = ((fromIntegral x) + 1) * (seed xs)
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)