Utils.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Network.XMPP.Utils
-- Copyright   :  (c) pierre, 2007
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  Dmitry Astapov <dastapov@gmail.com>, pierre <k.pierre.k@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Various XMPP\/XML utilities 
--
-----------------------------------------------------------------------------

module Network.XMPP.Utils
  (
    toContent
  , toFilter
  , noelem
  , sattr
  , strAttr
  , ptag
  , itag
  , getVals
  , isVal
  , getText
  , getText_
  , mread
  , mattr
  , mattr'
  , debug
  , literal -- from HaXML
  ) 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    (render, hcat)
import Text.XML.HaXml.Xtract.Parse (xtract)
    
import Network.XMPP.Types

-- | Conversion from\/to HaXML's Content and CFilter 
toContent :: CFilter Posn -> Content Posn
toContent filter =
    head $ filter (CElem noelem noPos) 

toFilter :: Content Posn -> CFilter Posn
toFilter x =  (\_ -> [x])

noelem = 
    Elem "root" [] []

strAttr s d = (s, literal d)
sattr = strAttr

ptag = mkElemAttr
itag s att = mkElemAttr s att []

-- | Returns strings extracted by xtract query 
getVals :: String ->
          [Content Posn] ->
          [String]
getVals q ext = map (\x -> getText_ $ xtract id q x) ext

-- | Queries xml for specific value
-- @isVal str = any (== str) . getVals@
isVal :: String -> String -> [Content Posn] -> Bool
isVal str cont = any (== str) . (getVals cont)

-- 
getText cs@(CString _ s _)  = 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 s Nothing = []

mattr' s (Just a) = [ strAttr s a ]
mattr' s Nothing = []

debug :: String -> XmppStateT ()
debug = liftIO . putStrLn