From 9fd7e8daff55e2cbee878cc89bd4063683e64e14 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Tue, 3 Apr 2012 13:59:27 +0200 Subject: [PATCH] conduit 0.4, switched back to xml-conduit --- src/Network/XMPP/Monad.hs | 37 ++++++++++++++++++++++++++++--------- src/Network/XMPP/Stream.hs | 7 ++++--- src/Network/XMPP/TLS.hs | 3 +-- src/Network/XMPP/Types.hs | 4 ++-- src/xml-conduit-testcase.hs | 22 ++++++++++++++++++++++ 5 files changed, 57 insertions(+), 16 deletions(-) create mode 100644 src/xml-conduit-testcase.hs diff --git a/src/Network/XMPP/Monad.hs b/src/Network/XMPP/Monad.hs index 127c5d8..f80a17c 100644 --- a/src/Network/XMPP/Monad.hs +++ b/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 - src <- bufferSource $ raw $= CH.parseBS defaultParseOptions + let raw = CB.sourceHandle handle $= conduitStdout + 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 = + [ "" + , "" + , "" + , "" + , error "Booh!" + ] :: [BS.ByteString] + + +main :: IO () +main = (runResourceT $ CL.sourceList xml $= XP.parseBytes def $$ CL.take 2 ) + >>= print + diff --git a/src/Network/XMPP/Stream.hs b/src/Network/XMPP/Stream.hs index f8f773e..3bf5e98 100644 --- a/src/Network/XMPP/Stream.hs +++ b/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 diff --git a/src/Network/XMPP/TLS.hs b/src/Network/XMPP/TLS.hs index 3ab79c8..d9387b9 100644 --- a/src/Network/XMPP/TLS.hs +++ b/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 <- lift . bufferSource $ raw' + (raw, snk, push) <- lift $ TLS.tlsinit params handle modify (\x -> x { sRawSrc = raw -- , sConSrc = -- Note: this momentarily leaves us in an diff --git a/src/Network/XMPP/Types.hs b/src/Network/XMPP/Types.hs index 76ec5db..ecfa840 100644 --- a/src/Network/XMPP/Types.hs +++ b/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 - , sRawSrc :: BufferedSource (ResourceT IO) BS.ByteString + { sConSrc :: Source (ResourceT IO) Event + , sRawSrc :: Source (ResourceT IO) BS.ByteString , sConPush :: [Event] -> ResourceT IO () , sConPushBS :: BS.ByteString -> IO () , sConHandle :: Maybe Handle diff --git a/src/xml-conduit-testcase.hs b/src/xml-conduit-testcase.hs new file mode 100644 index 0000000..427d032 --- /dev/null +++ b/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 = + [ "" + , "" + , "" + , "" + , error "Booh!" + ] :: [BS.ByteString] + +main :: IO () +main = (runResourceT $ CL.sourceList xml $= XP.parseBytes def $$ CL.take 2 ) + >>= print \ No newline at end of file