{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Data.Conduit.Lazy
( lazyConsume
, MonadActive (..)
) where
import Data.Conduit
import Data.Conduit.Internal (Pipe (..), ConduitT (..))
import System.IO.Unsafe (unsafeInterleaveIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withUnliftIO, unliftIO)
import Control.Monad.Trans.Identity ( IdentityT)
#if !MIN_VERSION_transformers(0,6,0)
import Control.Monad.Trans.Error ( ErrorT, Error)
import Control.Monad.Trans.List ( ListT )
#endif
import Control.Monad.Trans.Maybe ( MaybeT )
import Control.Monad.Trans.Reader ( ReaderT )
import Control.Monad.Trans.State ( StateT )
import Control.Monad.Trans.Writer ( WriterT )
import Control.Monad.Trans.RWS ( RWST )
import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST )
import qualified Control.Monad.Trans.State.Strict as Strict ( StateT )
import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
#if (__GLASGOW_HASKELL__ < 710)
import Data.Monoid (Monoid)
#endif
import Control.Monad.ST (ST)
import qualified Control.Monad.ST.Lazy as Lazy
import Data.Functor.Identity (Identity)
import Control.Monad.Trans.Resource.Internal (ResourceT (ResourceT), ReleaseMap (ReleaseMapClosed))
import qualified Data.IORef as I
lazyConsume
:: forall m a.
(MonadUnliftIO m, MonadActive m)
=> Source m a
-> m [a]
lazyConsume :: Source m a -> m [a]
lazyConsume (ConduitT forall b. (() -> Pipe () () a () m b) -> Pipe () () a () m b
f0) =
(UnliftIO m -> IO [a]) -> m [a]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO m -> IO [a]) -> m [a])
-> (UnliftIO m -> IO [a]) -> m [a]
forall a b. (a -> b) -> a -> b
$ \UnliftIO m
u ->
let go :: Pipe () () a () m () -> IO [a]
go :: Pipe () () a () m () -> IO [a]
go (Done ()
_) = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (HaveOutput Pipe () () a () m ()
src a
x) = do
[a]
xs <- IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ Pipe () () a () m () -> IO [a]
go Pipe () () a () m ()
src
[a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
go (PipeM m (Pipe () () a () m ())
msrc) = IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ do
Bool
a <- UnliftIO m -> m Bool -> IO Bool
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m Bool
forall (m :: * -> *). MonadActive m => m Bool
monadActive
if Bool
a
then UnliftIO m -> m (Pipe () () a () m ()) -> IO (Pipe () () a () m ())
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m (Pipe () () a () m ())
msrc IO (Pipe () () a () m ())
-> (Pipe () () a () m () -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pipe () () a () m () -> IO [a]
go
else [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go (NeedInput () -> Pipe () () a () m ()
_ () -> Pipe () () a () m ()
c) = Pipe () () a () m () -> IO [a]
go (() -> Pipe () () a () m ()
c ())
go (Leftover Pipe () () a () m ()
p ()
_) = Pipe () () a () m () -> IO [a]
go Pipe () () a () m ()
p
in Pipe () () a () m () -> IO [a]
go ((() -> Pipe () () a () m ()) -> Pipe () () a () m ()
forall b. (() -> Pipe () () a () m b) -> Pipe () () a () m b
f0 () -> Pipe () () a () m ()
forall l i o u (m :: * -> *) r. r -> Pipe l i o u m r
Done)
class Monad m => MonadActive m where
monadActive :: m Bool
instance (MonadIO m, MonadActive m) => MonadActive (ResourceT m) where
monadActive :: ResourceT m Bool
monadActive = (IORef ReleaseMap -> m Bool) -> ResourceT m Bool
forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m Bool) -> ResourceT m Bool)
-> (IORef ReleaseMap -> m Bool) -> ResourceT m Bool
forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
rmMap -> do
ReleaseMap
rm <- IO ReleaseMap -> m ReleaseMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReleaseMap -> m ReleaseMap) -> IO ReleaseMap -> m ReleaseMap
forall a b. (a -> b) -> a -> b
$ IORef ReleaseMap -> IO ReleaseMap
forall a. IORef a -> IO a
I.readIORef IORef ReleaseMap
rmMap
case ReleaseMap
rm of
ReleaseMap
ReleaseMapClosed -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
ReleaseMap
_ -> m Bool
forall (m :: * -> *). MonadActive m => m Bool
monadActive
instance MonadActive Identity where
monadActive :: Identity Bool
monadActive = Bool -> Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
instance MonadActive IO where
monadActive :: IO Bool
monadActive = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
instance MonadActive (ST s) where
monadActive :: ST s Bool
monadActive = Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
instance MonadActive (Lazy.ST s) where
monadActive :: ST s Bool
monadActive = Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
#define GO(T) instance MonadActive m => MonadActive (T m) where monadActive = lift monadActive
#define GOX(X, T) instance (X, MonadActive m) => MonadActive (T m) where monadActive = lift monadActive
GO(IdentityT)
#if !MIN_VERSION_transformers(0,6,0)
GOX(Error e, ErrorT e)
GO(ListT)
#endif
GO(MaybeT)
GO(ReaderT r)
GO(StateT s)
GOX(Monoid w, WriterT w)
GOX(Monoid w, RWST r w s)
GOX(Monoid w, Strict.RWST r w s)
GO(Strict.StateT s)
GOX(Monoid w, Strict.WriterT w)
#undef GO
#undef GOX
instance MonadActive m => MonadActive (Pipe l i o u m) where
monadActive :: Pipe l i o u m Bool
monadActive = m Bool -> Pipe l i o u m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadActive m => m Bool
monadActive
instance MonadActive m => MonadActive (ConduitT i o m) where
monadActive :: ConduitT i o m Bool
monadActive = m Bool -> ConduitT i o m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadActive m => m Bool
monadActive