module Network.XMPP.Print
(
renderXmpp
, putXmppLn
, hPutXmpp
, hPutNode
, stream
, streamEnd
, to
) where
import System.IO
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Text.XML (Node)
import Text.XML.HaXml hiding (tag)
import Text.XML.HaXml.Posn (Posn)
import qualified Text.XML.HaXml.Pretty as P
import Text.Blaze.Renderer.Text (renderMarkup)
import Text.Blaze (toMarkup)
import Network.XMPP.UTF8
import Network.XMPP.Utils
import Network.XMPP.XML
putXmppLn :: Content Posn -> IO ()
putXmppLn :: Content Posn -> IO ()
putXmppLn = String -> IO ()
putStrLn (String -> IO ())
-> (Content Posn -> String) -> Content Posn -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content Posn -> String
renderXmpp
hPutXmpp :: Handle -> Content Posn -> IO ()
hPutXmpp :: Handle -> Content Posn -> IO ()
hPutXmpp Handle
h Content Posn
msg =
do let str :: String
str = Content Posn -> String
renderXmpp Content Posn
msg
String -> IO ()
debugIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Sending: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
toUTF8 String
str
hPutNode :: Handle -> Node -> IO ()
hPutNode :: Handle -> Node -> IO ()
hPutNode Handle
h Node
n = do
let str :: String
str = Text -> String
T.unpack (Text -> String) -> (Node -> Text) -> Node -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (Node -> Text) -> Node -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markup -> Text
renderMarkup (Markup -> Text) -> (Node -> Markup) -> Node -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Markup
forall a. ToMarkup a => a -> Markup
toMarkup (Node -> String) -> Node -> String
forall a b. (a -> b) -> a -> b
$ Node
n
String -> IO ()
debugIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Sending: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
toUTF8 String
str
renderXmpp :: Content Posn -> String
renderXmpp :: Content Posn -> String
renderXmpp Content Posn
theXml = case Content Posn
theXml of
xml :: Content Posn
xml@(CElem (Elem (N String
"stream:stream") [Attribute]
_ [Content Posn]
_) Posn
_) ->
(:) Char
'<' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Content Posn -> Doc
forall i. Content i -> Doc
P.content Content Posn
xml
Content Posn
xml -> Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Content Posn -> Doc
forall i. Content i -> Doc
P.content Content Posn
xml
stream :: Show a => a -> T.Text -> CFilter i
stream :: a -> Text -> CFilter i
stream a
typ Text
server =
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i.
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
mkElemAttr String
"stream:stream"
[ String -> String -> (String, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr String
"xmlns:stream" String
"http://etherx.jabber.org/streams"
, String -> String -> (String, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr String
"xml:language" String
"en"
, String -> String -> (String, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr String
"version" String
"1.0"
, String -> String -> (String, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr String
"to" (String -> (String, CFilter i)) -> String -> (String, CFilter i)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
server
, String -> String -> (String, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr String
"xmlns" (a -> String
forall a. Show a => a -> String
show a
typ)
]
[ String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i.
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
mkElemAttr String
"" [] [] ]
streamEnd :: CFilter i
streamEnd :: CFilter i
streamEnd = String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i.
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
mkElemAttr String
"/stream:stream" [] [String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i.
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
mkElemAttr String
"" [] []]
to :: String -> (String, CFilter i)
to :: String -> (String, CFilter i)
to = String -> String -> (String, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr String
"to"