conduit 0.4, switched back to xml-conduit

src/Network/XMPP/Monad.hs

@@ -11,18 +11,19 @@ import Control.Monad.Trans.Resource
 import Control.Monad.Trans.State
 
 import Data.ByteString as BS
+import Data.Default(def)
 import Data.Text(Text)
 
 import Data.Conduit
 import Data.Conduit.Binary as CB
-import Data.Conduit.Hexpat as CH
+-- import Data.Conduit.Hexpat as CH
 import Data.Conduit.List as CL
 import Data.Conduit.Text as CT
 import Data.Conduit.TLS
 
 import Data.XML.Pickle
 import Data.XML.Types
---import Text.XML.Stream.Parse as XP
+import Text.XML.Stream.Parse as XP
 import Text.XML.Stream.Render as XR
 import Text.XML.Stream.Elements
 
@@ -49,14 +50,15 @@ pushOpen e = do
   lift . sink $ openElementToEvents e
   return ()
 
-
 pulls :: Sink Event (ResourceT IO) a -> XMPPMonad a
 pulls snk = do
   source <- gets sConSrc
-  lift $ source $$ snk
+  (src', r) <- lift $ source $$+ snk
+  modify $ (\s -> s {sConSrc = src'})
+  return r
 
 pullE :: XMPPMonad Element
-pullE =  pulls elementFromEvents
+pullE = pulls elementFromEvents
 
 pullPickle :: Show b => PU [Node] b -> XMPPMonad b
 pullPickle p = unpickleElem p <$> pullE
@@ -70,13 +72,13 @@ xmppFromHandle
      -> IO (a, XMPPState)
 xmppFromHandle handle hostname username resource f = runResourceT $ do
   liftIO $ hSetBuffering handle NoBuffering
-  raw <- bufferSource $ CB.sourceHandle handle
+  let raw = CB.sourceHandle handle $= conduitStdout
-  src <- bufferSource $ raw $= CH.parseBS defaultParseOptions
+  let src = raw $= XP.parseBytes def
   let st = XMPPState
              src
-             raw
+             (raw)
              (\xs -> CL.sourceList xs
-                     $$ XR.renderBytes def =$ CB.sinkHandle handle)
+                     $$ XR.renderBytes def =$ conduitStdout =$ CB.sinkHandle handle)
              (BS.hPut handle)
              (Just handle)
              def
@@ -85,3 +87,20 @@ xmppFromHandle handle hostname username resource f = runResourceT $ do
              username
              resource
   runStateT f st
+
+
+xml =
+   [ "<?xml version='1.0'?>"
+   , "<stream:stream xmlns='jabber:client' "
+   , "xmlns:stream='http://etherx.jabber.org/streams' id='1365401808' "
+   , "from='examplehost.org' version='1.0' xml:lang='en'>"
+   , "<stream:features>"
+   , "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>"
+   , error "Booh!"
+   ] :: [BS.ByteString]
+
+
+main :: IO ()
+main = (runResourceT $ CL.sourceList xml $= XP.parseBytes def $$ CL.take 2 )
+         >>= print
+

src/Network/XMPP/Stream.hs

@@ -14,7 +14,8 @@ import           Network.XMPP.Pickle
 import           Network.XMPP.Types
 
 import           Data.Conduit
-import qualified Data.Conduit.Hexpat as CH
+import           Data.Default(def)
+-- import qualified Data.Conduit.Hexpat as CH
 import           Data.Conduit.List as CL
 import           Data.Conduit.Text as CT
 import           Data.Default(def)
@@ -25,7 +26,7 @@ import           Data.XML.Types
 
 -- import qualified Text.XML.Stream.Parse as XP
 import           Text.XML.Stream.Elements
-
+import           Text.XML.Stream.Parse as XP
 
 -- import Text.XML.Stream.Elements
 
@@ -54,7 +55,7 @@ xmppRestartStream :: XMPPMonad ()
 xmppRestartStream = do
   raw <- gets sRawSrc
   src <- gets sConSrc
-  newsrc <- lift (bufferSource $ raw $= CH.parseBS CH.defaultParseOptions)
+  let newsrc = raw $= XP.parseBytes def
   modify (\s -> s{sConSrc = newsrc})
   xmppStartStream
 

src/Network/XMPP/TLS.hs

@@ -40,8 +40,7 @@ xmppStartTLS params = do
       pushN starttlsE
       Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] [] <- pullE
       Just handle <- gets sConHandle
-      (raw', snk, push) <- lift $ TLS.tlsinit params handle
+      (raw, snk, push) <- lift $ TLS.tlsinit params handle
-      raw <- lift . bufferSource $ raw'
       modify (\x -> x
                      { sRawSrc = raw
 --                   , sConSrc =  -- Note: this momentarily leaves us in an

src/Network/XMPP/Types.hs

@@ -34,8 +34,8 @@ instance Show JID where
 type XMPPMonad a = StateT XMPPState (ResourceT IO) a
 
 data XMPPState = XMPPState
-               { sConSrc    :: BufferedSource (ResourceT IO) Event
+               { sConSrc    :: Source (ResourceT IO) Event
-               , sRawSrc    :: BufferedSource (ResourceT IO) BS.ByteString
+               , sRawSrc    :: Source (ResourceT IO) BS.ByteString
                , sConPush   :: [Event] -> ResourceT IO ()
                , sConPushBS :: BS.ByteString -> IO ()
                , sConHandle :: Maybe Handle

src/xml-conduit-testcase.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Test where
+
+import qualified Data.ByteString as BS
+import Data.Conduit
+import Data.Default
+import qualified Data.Conduit.List as CL
+import qualified Text.XML.Stream.Parse as XP
+
+xml =
+   [ "<?xml version='1.0'?>"
+   , "<stream:stream xmlns='jabber:client' "
+   , "xmlns:stream='http://etherx.jabber.org/streams' id='1365401808' "
+   , "from='examplehost.org' version='1.0' xml:lang='en'>"
+   , "<stream:features>"
+   , "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>"
+   , error "Booh!"
+   ] :: [BS.ByteString]
+
+main :: IO ()
+main = (runResourceT $ CL.sourceList xml $= XP.parseBytes def $$ CL.take 2 )
+         >>= print