module Data.Conduit.Classy
( module Data.Conduit.Classy
, C.ResumableSource
, C.runResourceT
, C.Flush (..)
, C.ResourceT
, C.unwrapResumable
) where
import Prelude (Monad (..), Functor (..), ($), const, IO, Maybe, Either, Bool, (.), either)
import Data.Void (Void)
import Control.Applicative (Applicative (..))
import qualified Data.Conduit as C
import Data.Conduit.Internal (Pipe (PipeM))
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Trans.Resource (allocate, release, MonadThrow, MonadResource, ResourceT)
import Control.Monad.Trans.Control (liftWith, restoreT, MonadTransControl)
import Control.Monad.IO.Class (MonadIO)
import Data.Monoid (Monoid (..))
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 )
type Source m o = SourceM o m ()
newtype SourceM o m r = SourceM { unSourceM :: Pipe () () o () m r }
deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, ResourcePipe, MonadThrow)
instance Monad m => Monoid (SourceM o m ()) where
mempty = return ()
mappend = (>>)
type Conduit i m o = ConduitM i o m ()
newtype ConduitM i o m r = ConduitM { unConduitM :: Pipe i i o () m r }
deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, ResourcePipe, MonadThrow)
instance Monad m => Monoid (ConduitM i o m ()) where
mempty = return ()
mappend = (>>)
newtype Sink i m r = Sink { unSink :: Pipe i i Void () m r }
deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, ResourcePipe, MonadThrow)
instance Monad m => Monoid (Sink i m ()) where
mempty = return ()
mappend = (>>)
class (Monad m, Monad (PipeMonad m)) => IsPipe m where
type PipeInput m
type PipeTerm m
type PipeOutput m
type PipeMonad m :: * -> *
await :: m (Maybe (PipeInput m))
awaitE :: m (Either (PipeTerm m) (PipeInput m))
leftover :: PipeInput m -> m ()
yield :: PipeOutput m -> m ()
yieldOr :: PipeOutput m -> PipeMonad m () -> m ()
liftPipeMonad :: PipeMonad m a -> m a
addCleanup :: (Bool -> PipeMonad m ())
-> m r
-> m r
instance (Monad m, l ~ i) => IsPipe (Pipe l i o u m) where
type PipeInput (Pipe l i o u m) = i
type PipeTerm (Pipe l i o u m) = u
type PipeOutput (Pipe l i o u m) = o
type PipeMonad (Pipe l i o u m) = m
await = C.await
awaitE = C.awaitE
leftover = C.leftover
yield = C.yield
yieldOr = C.yieldOr
liftPipeMonad = lift
addCleanup = C.addCleanup
instance Monad m => IsPipe (SourceM o m) where
type PipeInput (SourceM o m) = ()
type PipeTerm (SourceM o m) = ()
type PipeOutput (SourceM o m) = o
type PipeMonad (SourceM o m) = m
await = SourceM await
awaitE = SourceM awaitE
leftover = SourceM . leftover
yield = SourceM . yield
yieldOr a = SourceM . yieldOr a
liftPipeMonad = lift
addCleanup c (SourceM p) = SourceM (addCleanup c p)
instance Monad m => IsPipe (ConduitM i o m) where
type PipeInput (ConduitM i o m) = i
type PipeTerm (ConduitM i o m) = ()
type PipeOutput (ConduitM i o m) = o
type PipeMonad (ConduitM i o m) = m
await = ConduitM await
awaitE = ConduitM awaitE
leftover = ConduitM . leftover
yield = ConduitM . yield
yieldOr a = ConduitM . yieldOr a
liftPipeMonad = lift
addCleanup c (ConduitM p) = ConduitM (addCleanup c p)
instance Monad m => IsPipe (Sink i m) where
type PipeInput (Sink i m) = i
type PipeTerm (Sink i m) = ()
type PipeOutput (Sink i m) = Void
type PipeMonad (Sink i m) = m
await = Sink await
awaitE = Sink awaitE
leftover = Sink . leftover
yield = Sink . yield
yieldOr a = Sink . yieldOr a
liftPipeMonad = lift
addCleanup c (Sink p) = Sink (addCleanup c p)
class (IsPipe m, MonadResource (PipeMonad m), MonadIO m) => ResourcePipe m where
bracketP :: IO a -> (a -> IO ()) -> (a -> m r) -> m r
instance (l ~ i, MonadResource m) => ResourcePipe (Pipe l i o u m) where
bracketP alloc free inside = PipeM $ do
(key, seed) <- allocate alloc free
return $ addCleanup (const $ release key) (inside seed)
#define GOALL(C, C2, T) instance C => IsPipe (T) where { type PipeInput (T) = PipeInput m; type PipeMonad (T) = PipeMonad m; type PipeTerm (T) = PipeTerm m; type PipeOutput (T) = PipeOutput m; await = lift await; awaitE = lift awaitE; leftover = lift . leftover; yield = lift . yield; yieldOr a = lift . yieldOr a; liftPipeMonad = lift . liftPipeMonad; addCleanup c r = liftWith (\run -> run $ addCleanup c r) >>= restoreT . return}; instance C2 => ResourcePipe (T) where { bracketP = controlBracketP }
#define GO(T) GOALL(IsPipe m, ResourcePipe m, T m)
#define GOX(X, T) GOALL((IsPipe m, X), (ResourcePipe m, X), T m)
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)
GO(ResourceT)
#undef GO
#undef GOX
#undef GOALL
controlBracketP :: (ResourcePipe m, Monad (t m), MonadTransControl t)
=> IO a -> (a -> IO ()) -> (a -> t m r) -> t m r
controlBracketP alloc free inside = liftWith (\run -> bracketP alloc free (run . inside)) >>= restoreT . return
awaitForever :: IsPipe m
=> (PipeInput m -> m r')
-> m (PipeTerm m)
awaitForever inner =
self
where
self = awaitE >>= either return (\i -> inner i >> self)
infixr 0 $$
infixl 1 $=
infixr 2 =$
infixr 2 =$=
infixr 0 $$+
infixr 0 $$++
infixr 0 $$+-
($$) :: Monad m => Source m a -> Sink a m b -> m b
SourceM src $$ Sink sink = src C.$$ sink
($=) :: Monad m => Source m a -> Conduit a m b -> Source m b
SourceM src $= ConduitM con = SourceM $ src C.$= con
(=$=) :: Monad m => Conduit a m b -> Conduit b m c -> Conduit a m c
ConduitM l =$= ConduitM r = ConduitM $ l C.=$= r
(=$) :: Monad m => Conduit a m b -> Sink b m c -> Sink a m c
ConduitM l =$ Sink r = Sink $ l C.=$ r
($$+) :: Monad m => Source m a -> Sink a m b -> m (C.ResumableSource m a, b)
SourceM src $$+ Sink sink = src C.$$+ sink
($$++) :: Monad m => C.ResumableSource m a -> Sink a m b -> m (C.ResumableSource m a, b)
rsrc $$++ Sink sink = rsrc C.$$++ sink
($$+-) :: Monad m => C.ResumableSource m a -> Sink a m b -> m b
rsrc $$+- Sink sink = rsrc C.$$+- sink