{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -fno-warn-deprecations #-} -- Suppress warnings around Control.Monad.Trans.Error
-- | Use lazy I\/O for consuming the contents of a source. Warning: All normal
-- warnings of lazy I\/O apply. In particular, if you are using this with a
-- @ResourceT@ transformer, you must force the list to be evaluated before
-- exiting the @ResourceT@.
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)
import Control.Monad.Trans.List     ( ListT    )
import Control.Monad.Trans.Maybe    ( MaybeT   )
import Control.Monad.Trans.Error    ( ErrorT, Error)
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

-- | Use lazy I\/O to consume all elements from a @Source@.
--
-- This function relies on 'monadActive' to determine if the underlying monadic
-- state has been closed.
--
-- Since 0.3.0
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)

-- | Determine if some monad is still active. This is intended to prevent usage
-- of a monadic state after it has been closed.  This is necessary for such
-- cases as lazy I\/O, where an unevaluated thunk may still refer to a
-- closed @ResourceT@.
--
-- Since 0.3.0
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 -- recurse

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)
GO(ListT)
GO(MaybeT)
GOX(Error e, ErrorT e)
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