module Network.XMPP.Utils
(
toContent
, toFilter
, noelem
, sattr
, strAttr
, ptag
, itag
, getVals
, isVal
, getText
, getText_
, mread
, mattr
, mattr'
, debug
, debugIO
, literal
) where
import Control.Monad.State
import Text.XML.HaXml hiding (tag)
import Text.XML.HaXml.Posn
import qualified Text.XML.HaXml.Pretty as P
import Text.PrettyPrint.HughesPJ (hcat)
import Text.XML.HaXml.Xtract.Parse (xtract)
import Network.XMPP.Types
toContent :: CFilter Posn -> Content Posn
toContent filter =
head $ filter (CElem noelem noPos)
toFilter :: Content Posn -> CFilter Posn
toFilter x = (\_ -> [x])
noelem =
Elem (N "root") [] []
strAttr s d = (s, literal d)
sattr = strAttr
ptag = mkElemAttr
itag s att = mkElemAttr s att []
getVals :: String ->
[Content Posn] ->
[String]
getVals q ext = map (\x -> getText_ $ xtract id q x) ext
isVal :: String -> String -> [Content Posn] -> Bool
isVal str cont = any (== str) . (getVals cont)
getText cs@(CString{}) = render . P.content $ cs
getText cs@(CRef{}) = render . P.content $ cs
getText x = error $ "Attempt to extract text from content that is not a string: " ++ render ( P.content x )
getText_ = render . hcat . map P.content
mread "" = Nothing
mread a = Just $ read a
mattr s (Just a) = [ strAttr s (show a) ]
mattr _ Nothing = []
mattr' s (Just a) = [ strAttr s a ]
mattr' _ Nothing = []
debug :: String -> XmppStateT ()
debugIO :: String -> IO ()
#ifdef DEBUG
debug = liftIO . putStrLn
debugIO = putStrLn
#else
debug _ = return ()
debugIO _ = return ()
#endif