conduit 1.0.10.1 → 1.0.11
raw patch · 7 files changed
+699/−22 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- Data/Conduit.hs +5/−0
- Data/Conduit/Binary.hs +19/−13
- Data/Conduit/Internal.hs +93/−0
- Data/Conduit/Lift.hs +535/−0
- Data/Conduit/List.hs +1/−0
- conduit.cabal +2/−2
- test/main.hs +44/−7
Data/Conduit.hs view
@@ -25,6 +25,11 @@ , addCleanup , yieldOr + -- ** Exception handling+ , catchC+ , handleC+ , tryC+ -- * Generalized conduit types , Producer , Consumer
Data/Conduit/Binary.hs view
@@ -57,6 +57,11 @@ #elif NO_HANDLES import qualified System.PosixFile as F #endif+import Data.ByteString.Internal (ByteString (PS), inlinePerformIO)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.ForeignPtr (touchForeignPtr)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (peek) -- | Stream the contents of a file as binary data. --@@ -380,20 +385,21 @@ sinkLbs :: Monad m => Sink S.ByteString m L.ByteString sinkLbs = fmap L.fromChunks consume +mapM_BS :: Monad m => (Word8 -> m ()) -> S.ByteString -> m ()+mapM_BS f (PS fptr offset len) = do+ let start = unsafeForeignPtrToPtr fptr `plusPtr` offset+ end = start `plusPtr` len+ loop ptr+ | ptr >= end = inlinePerformIO (touchForeignPtr fptr) `seq` return ()+ | otherwise = do+ f (inlinePerformIO (peek ptr))+ loop (ptr `plusPtr` 1)+ loop start+{-# INLINE mapM_BS #-}+ -- | Perform a computation on each @Word8@ in a stream. -- -- Since 1.0.10 mapM_ :: Monad m => (Word8 -> m ()) -> Consumer S.ByteString m ()-mapM_ f =- awaitForever (lift . go)- where- go bs =- loop 0- where- len = S.length bs- loop i- | i < len = do- f (S.index bs i)- loop (i + 1)- | otherwise = return ()-{-# INLINE [1] mapM_ #-}+mapM_ f = awaitForever (lift . mapM_BS f)+{-# INLINE mapM_ #-}
Data/Conduit/Internal.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}@@ -42,6 +43,13 @@ , conduitToPipe , toProducer , toConsumer+ -- * Exceptions+ , catchP+ , handleP+ , tryP+ , catchC+ , handleC+ , tryC -- * Utilities , transPipe , mapOutput@@ -54,6 +62,7 @@ ) where import Control.Applicative (Applicative (..))+import Control.Exception.Lifted (Exception, catch) import Control.Monad ((>=>), liftM, ap, when) import Control.Monad.Error.Class(MonadError(..)) import Control.Monad.Reader.Class(MonadReader(..))@@ -745,3 +754,87 @@ -- | Since 1.0.4 instance MFunctor (Pipe l i o u) where hoist = transPipe++-- | See 'catchC' for more details.+--+-- Since 1.0.11+catchP :: (MonadBaseControl IO m, Exception e)+ => Pipe l i o u m r+ -> (e -> Pipe l i o u m r)+ -> Pipe l i o u m r+catchP p0 onErr =+ go p0+ where+ go (Done r) = Done r+ go (PipeM mp) = PipeM $ catch (liftM go mp) (return . onErr)+ go (Leftover p i) = Leftover (go p) i+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ go (HaveOutput p c o) = HaveOutput (go p) c o+{-# INLINABLE catchP #-}++-- | The same as @flip catchP@.+--+-- Since 1.0.11+handleP :: (MonadBaseControl IO m, Exception e)+ => (e -> Pipe l i o u m r)+ -> Pipe l i o u m r+ -> Pipe l i o u m r+handleP = flip catchP+{-# INLINE handleP #-}++-- | See 'tryC' for more details.+--+-- Since 1.0.11+tryP :: (MonadBaseControl IO m, Exception e)+ => Pipe l i o u m r+ -> Pipe l i o u m (Either e r)+tryP =+ go+ where+ go (Done r) = Done (Right r)+ go (PipeM mp) = PipeM $ catch (liftM go mp) (return . Done . Left)+ go (Leftover p i) = Leftover (go p) i+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ go (HaveOutput p c o) = HaveOutput (go p) c o+{-# INLINABLE tryP #-}++-- | Catch all exceptions thrown by the current component of the pipeline.+--+-- Note: this will /not/ catch exceptions thrown by other components! For+-- example, if an exception is thrown in a @Source@ feeding to a @Sink@, and+-- the @Sink@ uses @catchC@, the exception will /not/ be caught.+--+-- Due to this behavior (as well as lack of async exception handling), you+-- should not try to implement combinators such @onException@ in terms of this+-- primitive.+--+-- Note also that the exception handling will /not/ be applied to any+-- finalizers generated by this conduit.+--+-- Since 1.0.11+catchC :: (MonadBaseControl IO m, Exception e)+ => ConduitM i o m r+ -> (e -> ConduitM i o m r)+ -> ConduitM i o m r+catchC (ConduitM p) f = ConduitM (catchP p (unConduitM . f))+{-# INLINE catchC #-}++-- | The same as @flip catchC@.+--+-- Since 1.0.11+handleC :: (MonadBaseControl IO m, Exception e)+ => (e -> ConduitM i o m r)+ -> ConduitM i o m r+ -> ConduitM i o m r+handleC = flip catchC+{-# INLINE handleC #-}++-- | A version of @try@ for use within a pipeline. See the comments in @catchC@+-- for more details.+--+-- Since 1.0.11+tryC :: (MonadBaseControl IO m, Exception e)+ => ConduitM i o m r+ -> ConduitM i o m (Either e r)+tryC = ConduitM . tryP . unConduitM+{-# INLINE tryC #-}
+ Data/Conduit/Lift.hs view
@@ -0,0 +1,535 @@+{-# LANGUAGE RankNTypes #-}+{- | Allow monad transformers to be run/eval/exec in a section of conduit+ rather then needing to run across the whole conduit.+The circumvents many of the problems with breaking the monad transformer laws.+Read more about when the monad transformer laws are broken:+<https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>++This method has a considerable number of advantages over the other two +recommended methods.++* Run the monad transformer outisde of the conduit+* Use a mutable varible inside a readerT to retain side effects.++This functionality has existed for awhile in the pipes ecosystem and my recent+improvement to the Pipes.Lift module has allowed it to almost mechanically +translated for conduit.++-}+++module Data.Conduit.Lift (+ -- * ErrorT+ errorC,+ runErrorC,+ catchErrorC,+-- liftCatchError,++ -- * MaybeT+ maybeC,+ runMaybeC,++ -- * ReaderT+ readerC,+ runReaderC,++ -- * StateT+ stateC,+ runStateC,+ evalStateC,+ execStateC,++ -- ** Strict+ stateSC,+ runStateSC,+ evalStateSC,+ execStateSC,++ -- * WriterT+ writerC,+ runWriterC,+ execWriterC,++ -- ** Strict+ writerSC,+ runWriterSC,+ execWriterSC,++ -- * RWST+ rwsC,+ runRWSC,+ evalRWSC,+ execRWSC,++ -- ** Strict+ rwsSC,+ runRWSSC,+ evalRWSSC,+ execRWSSC,++ -- * Utilities++ distribute+ ) where++import Data.Conduit+import Data.Conduit.Internal (ConduitM (..), Pipe (..))++import Control.Monad.Morph (hoist, lift, MFunctor(..), )+import Control.Monad.Trans.Class (MonadTrans(..))++import Data.Monoid (Monoid(..))+++import qualified Control.Monad.Trans.Error as E+import qualified Control.Monad.Trans.Maybe as M+import qualified Control.Monad.Trans.Reader as R++import qualified Control.Monad.Trans.State.Strict as SS+import qualified Control.Monad.Trans.Writer.Strict as WS+import qualified Control.Monad.Trans.RWS.Strict as RWSS++import qualified Control.Monad.Trans.State.Lazy as SL+import qualified Control.Monad.Trans.Writer.Lazy as WL+import qualified Control.Monad.Trans.RWS.Lazy as RWSL+++catAwaitLifted+ :: (Monad (t (ConduitM o1 o m)), Monad m, MonadTrans t) =>+ ConduitM i o1 (t (ConduitM o1 o m)) ()+catAwaitLifted = go+ where+ go = do+ x <- lift . lift $ await+ case x of+ Nothing -> return ()+ Just x2 -> do+ yield x2+ go++catYieldLifted+ :: (Monad (t (ConduitM i o1 m)), Monad m, MonadTrans t) =>+ ConduitM o1 o (t (ConduitM i o1 m)) ()+catYieldLifted = go+ where+ go = do+ x <- await+ case x of+ Nothing -> return ()+ Just x2 -> do+ lift . lift $ yield x2+ go+++distribute+ :: (Monad (t (ConduitM b o m)), Monad m, Monad (t m), MonadTrans t,+ MFunctor t) =>+ ConduitM b o (t m) () -> t (ConduitM b o m) ()+distribute p = catAwaitLifted =$= hoist (hoist lift) p $$ catYieldLifted++-- | Run 'E.ErrorT' in the base monad+--+-- Since 1.0.11+errorC+ :: (Monad m, Monad (t (E.ErrorT e m)), MonadTrans t, E.Error e,+ MFunctor t) =>+ t m (Either e b) -> t (E.ErrorT e m) b+errorC p = do+ x <- hoist lift p+ lift $ E.ErrorT (return x)++-- | Run 'E.ErrorT' in the base monad+--+-- Since 1.0.11+runErrorC+ :: (Monad m, E.Error e) =>+ ConduitM i o (E.ErrorT e m) r -> ConduitM i o m (Either e r)+runErrorC =+ ConduitM . go . unConduitM+ where+ go (Done r) = Done (Right r)+ go (PipeM mp) = PipeM $ do+ eres <- E.runErrorT mp+ return $ case eres of+ Left e -> Done $ Left e+ Right p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p f o) = HaveOutput (go p) (E.runErrorT f >> return ()) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+{-# INLINABLE runErrorC #-}++-- | Catch an error in the base monad+--+-- Since 1.0.11+catchErrorC+ :: (Monad m, E.Error e) =>+ ConduitM i o (E.ErrorT e m) r+ -> (e -> ConduitM i o (E.ErrorT e m) r)+ -> ConduitM i o (E.ErrorT e m) r+catchErrorC c0 h =+ ConduitM $ go $ unConduitM c0+ where+ go (Done r) = Done r+ go (PipeM mp) = PipeM $ do+ eres <- lift $ E.runErrorT mp+ return $ case eres of+ Left e -> unConduitM $ h e+ Right p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p f o) = HaveOutput (go p) f o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+{-# INLINABLE catchErrorC #-}++-- | Wrap the base monad in 'M.MaybeT'+--+-- Since 1.0.11+maybeC+ :: (Monad m, Monad (t (M.MaybeT m)),+ MonadTrans t,+ MFunctor t) =>+ t m (Maybe b) -> t (M.MaybeT m) b+maybeC p = do+ x <- hoist lift p+ lift $ M.MaybeT (return x)+{-# INLINABLE maybeC #-}++-- | Run 'M.MaybeT' in the base monad+--+-- Since 1.0.11+runMaybeC+ :: Monad m =>+ ConduitM i o (M.MaybeT m) r -> ConduitM i o m (Maybe r)+runMaybeC =+ ConduitM . go . unConduitM+ where+ go (Done r) = Done (Just r)+ go (PipeM mp) = PipeM $ do+ mres <- M.runMaybeT mp+ return $ case mres of+ Nothing -> Done Nothing+ Just p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p c o) = HaveOutput (go p) (M.runMaybeT c >> return ()) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+{-# INLINABLE runMaybeC #-}++-- | Wrap the base monad in 'R.ReaderT'+--+-- Since 1.0.11+readerC+ :: (Monad m, Monad (t1 (R.ReaderT t m)),+ MonadTrans t1,+ MFunctor t1) =>+ (t -> t1 m b) -> t1 (R.ReaderT t m) b+readerC k = do+ i <- lift R.ask+ hoist lift (k i)+{-# INLINABLE readerC #-}++-- | Run 'R.ReaderT' in the base monad+--+-- Since 1.0.11+runReaderC+ :: Monad m =>+ r -> ConduitM i o (R.ReaderT r m) res -> ConduitM i o m res+runReaderC r = hoist (`R.runReaderT` r)+{-# INLINABLE runReaderC #-}+++-- | Wrap the base monad in 'SL.StateT'+--+-- Since 1.0.11+stateC+ :: (Monad m, Monad (t1 (SL.StateT t m)),+ MonadTrans t1,+ MFunctor t1) =>+ (t -> t1 m (b, t)) -> t1 (SL.StateT t m) b+stateC k = do+ s <- lift SL.get+ (r, s') <- hoist lift (k s)+ lift (SL.put s')+ return r+{-# INLINABLE stateC #-}++thread :: Monad m+ => (r -> s -> res)+ -> (forall a. t m a -> s -> m (a, s))+ -> s+ -> ConduitM i o (t m) r+ -> ConduitM i o m res+thread toRes runM s0 =+ ConduitM . go s0 . unConduitM+ where+ go s (Done r) = Done (toRes r s)+ go s (PipeM mp) = PipeM $ do+ (p, s') <- runM mp s+ return $ go s' p+ go s (Leftover p i) = Leftover (go s p) i+ go s (NeedInput x y) = NeedInput (go s . x) (go s . y)+ go s (HaveOutput p f o) = HaveOutput (go s p) (runM f s >> return ()) o+{-# INLINABLE thread #-}++-- | Run 'SL.StateT' in the base monad+--+-- Since 1.0.11+runStateC+ :: Monad m =>+ s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m (r, s)+runStateC = thread (,) SL.runStateT+{-# INLINABLE runStateC #-}++-- | Evaluate 'SL.StateT' in the base monad+--+-- Since 1.0.11+evalStateC+ :: Monad m =>+ s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m r+evalStateC s p = fmap fst $ runStateC s p+{-# INLINABLE evalStateC #-}++-- | Execute 'SL.StateT' in the base monad+--+-- Since 1.0.11+execStateC+ :: Monad m =>+ s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m s+execStateC s p = fmap snd $ runStateC s p+{-# INLINABLE execStateC #-}+++-- | Wrap the base monad in 'SS.StateT'+--+-- Since 1.0.11+stateSC+ :: (Monad m, Monad (t1 (SS.StateT t m)),+ MonadTrans t1,+ MFunctor t1) =>+ (t -> t1 m (b, t)) -> t1 (SS.StateT t m) b+stateSC k = do+ s <- lift SS.get+ (r, s') <- hoist lift (k s)+ lift (SS.put s')+ return r+{-# INLINABLE stateSC #-}++-- | Run 'SS.StateT' in the base monad+--+-- Since 1.0.11+runStateSC+ :: Monad m =>+ s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m (r, s)+runStateSC = thread (,) SS.runStateT+{-# INLINABLE runStateSC #-}++-- | Evaluate 'SS.StateT' in the base monad+--+-- Since 1.0.11+evalStateSC+ :: Monad m =>+ s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m r+evalStateSC s p = fmap fst $ runStateSC s p+{-# INLINABLE evalStateSC #-}++-- | Execute 'SS.StateT' in the base monad+--+-- Since 1.0.11+execStateSC+ :: Monad m =>+ s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m s+execStateSC s p = fmap snd $ runStateSC s p+{-# INLINABLE execStateSC #-}+++-- | Wrap the base monad in 'WL.WriterT'+--+-- Since 1.0.11+writerC+ :: (Monad m, Monad (t (WL.WriterT w m)), MonadTrans t, Monoid w,+ MFunctor t) =>+ t m (b, w) -> t (WL.WriterT w m) b+writerC p = do+ (r, w) <- hoist lift p+ lift $ WL.tell w+ return r+{-# INLINABLE writerC #-}++-- | Run 'WL.WriterT' in the base monad+--+-- Since 1.0.11+runWriterC+ :: (Monad m, Monoid w) =>+ ConduitM i o (WL.WriterT w m) r -> ConduitM i o m (r, w)+runWriterC = thread (,) run mempty+ where+ run m w = do+ (a, w') <- WL.runWriterT m+ return (a, w `mappend` w')+{-# INLINABLE runWriterC #-}++-- | Execute 'WL.WriterT' in the base monad+--+-- Since 1.0.11+execWriterC+ :: (Monad m, Monoid w) =>+ ConduitM i o (WL.WriterT w m) r -> ConduitM i o m w+execWriterC p = fmap snd $ runWriterC p+{-# INLINABLE execWriterC #-}+++-- | Wrap the base monad in 'WS.WriterT'+--+-- Since 1.0.11+writerSC+ :: (Monad m, Monad (t (WS.WriterT w m)), MonadTrans t, Monoid w,+ MFunctor t) =>+ t m (b, w) -> t (WS.WriterT w m) b+writerSC p = do+ (r, w) <- hoist lift p+ lift $ WS.tell w+ return r+{-# INLINABLE writerSC #-}++-- | Run 'WS.WriterT' in the base monad+--+-- Since 1.0.11+runWriterSC+ :: (Monad m, Monoid w) =>+ ConduitM i o (WS.WriterT w m) r -> ConduitM i o m (r, w)+runWriterSC = thread (,) run mempty+ where+ run m w = do+ (a, w') <- WS.runWriterT m+ return (a, w `mappend` w')+{-# INLINABLE runWriterSC #-}++-- | Execute 'WS.WriterT' in the base monad+--+-- Since 1.0.11+execWriterSC+ :: (Monad m, Monoid w) =>+ ConduitM i o (WS.WriterT w m) r -> ConduitM i o m w+execWriterSC p = fmap snd $ runWriterSC p+{-# INLINABLE execWriterSC #-}+++-- | Wrap the base monad in 'RWSL.RWST'+--+-- Since 1.0.11+rwsC+ :: (Monad m, Monad (t1 (RWSL.RWST t w t2 m)), MonadTrans t1,+ Monoid w, MFunctor t1) =>+ (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSL.RWST t w t2 m) b+rwsC k = do+ i <- lift RWSL.ask+ s <- lift RWSL.get+ (r, s', w) <- hoist lift (k i s)+ lift $ do+ RWSL.put s'+ RWSL.tell w+ return r+{-# INLINABLE rwsC #-}++-- | Run 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+runRWSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitM i o (RWSL.RWST r w s m) res+ -> ConduitM i o m (res, s, w)+runRWSC r s0 = thread toRes run (s0, mempty)+ where+ toRes a (s, w) = (a, s, w)+ run m (s, w) = do+ (res, s', w') <- RWSL.runRWST m r s+ return (res, (s', w `mappend` w'))+{-# INLINABLE runRWSC #-}++-- | Evaluate 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+evalRWSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitM i o (RWSL.RWST r w s m) res+ -> ConduitM i o m (res, w)+evalRWSC i s p = fmap f $ runRWSC i s p+ where f x = let (r, _, w) = x in (r, w)+{-# INLINABLE evalRWSC #-}++-- | Execute 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+execRWSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitM i o (RWSL.RWST r w s m) res+ -> ConduitM i o m (s, w)+execRWSC i s p = fmap f $ runRWSC i s p+ where f x = let (_, s2, w2) = x in (s2, w2)+{-# INLINABLE execRWSC #-}+++-- | Wrap the base monad in 'RWSS.RWST'+--+-- Since 1.0.11+rwsSC+ :: (Monad m, Monad (t1 (RWSS.RWST t w t2 m)), MonadTrans t1,+ Monoid w, MFunctor t1) =>+ (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSS.RWST t w t2 m) b+rwsSC k = do+ i <- lift RWSS.ask+ s <- lift RWSS.get+ (r, s', w) <- hoist lift (k i s)+ lift $ do+ RWSS.put s'+ RWSS.tell w+ return r+{-# INLINABLE rwsSC #-}++-- | Run 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+runRWSSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitM i o (RWSS.RWST r w s m) res+ -> ConduitM i o m (res, s, w)+runRWSSC r s0 = thread toRes run (s0, mempty)+ where+ toRes a (s, w) = (a, s, w)+ run m (s, w) = do+ (res, s', w') <- RWSS.runRWST m r s+ return (res, (s', w `mappend` w'))+{-# INLINABLE runRWSSC #-}++-- | Evaluate 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+evalRWSSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitM i o (RWSS.RWST r w s m) res+ -> ConduitM i o m (res, w)+evalRWSSC i s p = fmap f $ runRWSSC i s p+ where f x = let (r, _, w) = x in (r, w)+{-# INLINABLE evalRWSSC #-}++-- | Execute 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+execRWSSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitM i o (RWSS.RWST r w s m) res+ -> ConduitM i o m (s, w)+execRWSSC i s p = fmap f $ runRWSSC i s p+ where f x = let (_, s2, w2) = x in (s2, w2)+{-# INLINABLE execRWSSC #-}+
Data/Conduit/List.hs view
@@ -176,6 +176,7 @@ => (a -> m ()) -> Consumer a m () mapM_ f = awaitForever $ lift . f+{-# INLINE [1] mapM_ #-} srcMapM_ :: Monad m => Source m a -> (a -> m ()) -> m () srcMapM_ (CI.ConduitM src) f =
conduit.cabal view
@@ -1,5 +1,5 @@ Name: conduit-Version: 1.0.10.1+Version: 1.0.11 Synopsis: Streaming data processing library. Description: @conduit@ is a solution to the streaming data problem, allowing for production, transformation, and consumption of streams of data in constant memory. It is an alternative to lazy I\/O which guarantees deterministic resource handling, and fits in the same general solution space as @enumerator@\/@iteratee@ and @pipes@. For a tutorial, please visit <https://haskell.fpcomplete.com/user/snoyberg/library-documentation/conduit-overview>.@@ -48,7 +48,7 @@ Data.Conduit.Lazy Data.Conduit.Internal Data.Conduit.Util- -- Hiding while some details are worked out Data.Conduit.Lift+ Data.Conduit.Lift Build-depends: base >= 4.3 && < 5 , resourcet >= 0.4.3 && < 0.5 , lifted-base >= 0.1
test/main.hs view
@@ -4,8 +4,9 @@ import Test.Hspec.QuickCheck (prop) import Test.QuickCheck.Monadic (assert, monadicIO, run) +import Control.Exception (IOException) import qualified Data.Conduit as C--- FIXME import qualified Data.Conduit.Lift as C+import qualified Data.Conduit.Lift as C import qualified Data.Conduit.Util as C import qualified Data.Conduit.Internal as CI import qualified Data.Conduit.List as CL@@ -27,13 +28,14 @@ import qualified Data.Text.Lazy.Encoding as TLE import Control.Monad.Trans.Resource (runExceptionT, runExceptionT_, allocate, resourceForkIO) import Control.Concurrent (threadDelay, killThread)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Writer (execWriter, tell, runWriterT) import Control.Monad.Trans.State (evalStateT, get, put, modify)+import Control.Monad.Trans.Maybe (MaybeT (..)) import Control.Applicative (pure, (<$>), (<*>)) import Data.Functor.Identity (Identity,runIdentity)-import Control.Monad (forever)+import Control.Monad (forever, void) import Data.Void (Void) import qualified Control.Concurrent.MVar as M import Control.Monad.Error (catchError, throwError, Error)@@ -1077,7 +1079,6 @@ -- FIXME this is broken it "test2" $ verify test2L test2R "p2" "p1" "p3" it "test3" $ verify test3L test3R "p2" "p3" "p1" - {- FIXME describe "Data.Conduit.Lift" $ do it "execStateC" $ do let sink = C.execStateC 0 $ CL.mapM_ $ modify . (+)@@ -1085,19 +1086,55 @@ res <- src C.$$ sink res `shouldBe` sum [1..10] - it "execWriterT" $ do+ it "execWriterC" $ do let sink = C.execWriterC $ CL.mapM_ $ tell . return src = mapM_ C.yield [1..10 :: Int] res <- src C.$$ sink res `shouldBe` [1..10] - it "runErrorT" $ do+ it "runErrorC" $ do let sink = C.runErrorC $ do x <- C.catchErrorC (lift $ throwError "foo") return return $ x ++ "bar" res <- return () C.$$ sink res `shouldBe` Right ("foobar" :: String)- -}++ it "runMaybeC" $ do+ let src = void $ C.runMaybeC $ do+ C.yield 1+ () <- lift $ MaybeT $ return Nothing+ C.yield 2+ sink = CL.consume+ res <- src C.$$ sink+ res `shouldBe` [1 :: Int]++ describe "exception handling" $ do+ it "catchC" $ do+ ref <- I.newIORef 0+ let src = do+ C.catchC (CB.sourceFile "some-file-that-does-not-exist") onErr+ C.handleC onErr $ CB.sourceFile "conduit.cabal"+ onErr :: MonadIO m => IOException -> m ()+ onErr _ = liftIO $ I.modifyIORef ref (+ 1)+ contents <- L.readFile "conduit.cabal"+ res <- C.runResourceT $ src C.$$ CB.sinkLbs+ res `shouldBe` contents+ errCount <- I.readIORef ref+ errCount `shouldBe` (1 :: Int)+ it "tryC" $ do+ ref <- I.newIORef undefined+ let src = do+ res1 <- C.tryC $ CB.sourceFile "some-file-that-does-not-exist"+ res2 <- C.tryC $ CB.sourceFile "conduit.cabal"+ liftIO $ I.writeIORef ref (res1, res2)+ contents <- L.readFile "conduit.cabal"+ res <- C.runResourceT $ src C.$$ CB.sinkLbs+ res `shouldBe` contents+ exc <- I.readIORef ref+ case exc :: (Either IOException (), Either IOException ()) of+ (Left _, Right ()) ->+ return ()+ _ -> error $ show exc it' :: String -> IO () -> Spec it' = it