{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
module Foundation.Conduit.Internal
( Pipe(..)
, Conduit(..)
, ZipSink(..)
, ResourceT(..)
, MonadResource(..)
, runResourceT
, await
, awaitForever
, yield
, yieldOr
, leftover
, runConduit
, runConduitRes
, runConduitPure
, fuse
, bracketConduit
) where
import Basement.Imports hiding (throw)
import Foundation.Monad
import Foundation.Numerical
import Basement.Monad
import Control.Monad ((>=>), liftM, void, mapM_, join)
import Control.Exception (SomeException, mask_)
import Data.IORef (atomicModifyIORef)
data Pipe leftOver input output upstream monad result =
Yield (Pipe leftOver input output upstream monad result) (monad ()) output
| Await (input -> Pipe leftOver input output upstream monad result)
(upstream -> Pipe leftOver input output upstream monad result)
| Done result
| PipeM (monad (Pipe leftOver input output upstream monad result))
| Leftover (Pipe leftOver input output upstream monad result) leftOver
instance Applicative m => Functor (Pipe l i o u m) where
fmap :: (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
fmap = (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)
{-# INLINE fmap #-}
instance Applicative m => Applicative (Pipe l i o u m) where
pure :: a -> Pipe l i o u m a
pure = a -> Pipe l i o u m a
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done
{-# INLINE pure #-}
Yield Pipe l i o u m (a -> b)
p m ()
c o
o <*> :: Pipe l i o u m (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
<*> Pipe l i o u m a
fa = Pipe l i o u m b -> m () -> o -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield (Pipe l i o u m (a -> b)
p Pipe l i o u m (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pipe l i o u m a
fa) m ()
c o
o
Await i -> Pipe l i o u m (a -> b)
p u -> Pipe l i o u m (a -> b)
c <*> Pipe l i o u m a
fa = (i -> Pipe l i o u m b)
-> (u -> Pipe l i o u m b) -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await (\i
i -> i -> Pipe l i o u m (a -> b)
p i
i Pipe l i o u m (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pipe l i o u m a
fa) (\u
o -> u -> Pipe l i o u m (a -> b)
c u
o Pipe l i o u m (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pipe l i o u m a
fa)
Done a -> b
r <*> Pipe l i o u m a
fa = a -> b
r (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipe l i o u m a
fa
PipeM m (Pipe l i o u m (a -> b))
mp <*> Pipe l i o u m a
fa = m (Pipe l i o u m b) -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe l i o u m (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pipe l i o u m a
fa) (Pipe l i o u m (a -> b) -> Pipe l i o u m b)
-> m (Pipe l i o u m (a -> b)) -> m (Pipe l i o u m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pipe l i o u m (a -> b))
mp)
Leftover Pipe l i o u m (a -> b)
p l
i <*> Pipe l i o u m a
fa = Pipe l i o u m b -> l -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> leftOver -> Pipe leftOver input output upstream monad result
Leftover (Pipe l i o u m (a -> b)
p Pipe l i o u m (a -> b) -> Pipe l i o u m a -> Pipe l i o u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pipe l i o u m a
fa) l
i
{-# INLINE (<*>) #-}
instance (Functor m, Monad m) => Monad (Pipe l i o u m) where
return :: a -> Pipe l i o u m a
return = a -> Pipe l i o u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Yield Pipe l i o u m a
p m ()
c o
o >>= :: Pipe l i o u m a -> (a -> Pipe l i o u m b) -> Pipe l i o u m b
>>= a -> Pipe l i o u m b
fp = Pipe l i o u m b -> m () -> o -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield (Pipe l i o u m a
p Pipe l i o u m a -> (a -> Pipe l i o u m b) -> Pipe l i o u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Pipe l i o u m b
fp) m ()
c o
o
Await i -> Pipe l i o u m a
p u -> Pipe l i o u m a
c >>= a -> Pipe l i o u m b
fp = (i -> Pipe l i o u m b)
-> (u -> Pipe l i o u m b) -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await (i -> Pipe l i o u m a
p (i -> Pipe l i o u m a)
-> (a -> Pipe l i o u m b) -> i -> Pipe l i o u m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Pipe l i o u m b
fp) (u -> Pipe l i o u m a
c (u -> Pipe l i o u m a)
-> (a -> Pipe l i o u m b) -> u -> Pipe l i o u m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Pipe l i o u m b
fp)
Done a
x >>= a -> Pipe l i o u m b
fp = a -> Pipe l i o u m b
fp a
x
PipeM m (Pipe l i o u m a)
mp >>= a -> Pipe l i o u m b
fp = m (Pipe l i o u m b) -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe l i o u m a -> (a -> Pipe l i o u m b) -> Pipe l i o u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Pipe l i o u m b
fp) (Pipe l i o u m a -> Pipe l i o u m b)
-> m (Pipe l i o u m a) -> m (Pipe l i o u m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pipe l i o u m a)
mp)
Leftover Pipe l i o u m a
p l
i >>= a -> Pipe l i o u m b
fp = Pipe l i o u m b -> l -> Pipe l i o u m b
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> leftOver -> Pipe leftOver input output upstream monad result
Leftover (Pipe l i o u m a
p Pipe l i o u m a -> (a -> Pipe l i o u m b) -> Pipe l i o u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Pipe l i o u m b
fp) l
i
newtype Conduit input output monad result = Conduit
{ Conduit input output monad result
-> forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a
unConduit :: forall a . (result -> Pipe input input output () monad a) -> Pipe input input output () monad a
}
instance Functor (Conduit i o m) where
fmap :: (a -> b) -> Conduit i o m a -> Conduit i o m b
fmap a -> b
f (Conduit forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a
c) = (forall a. (b -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m b
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (b -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m b)
-> (forall a. (b -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m b
forall a b. (a -> b) -> a -> b
$ \b -> Pipe i i o () m a
resPipe -> (a -> Pipe i i o () m a) -> Pipe i i o () m a
forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a
c (b -> Pipe i i o () m a
resPipe (b -> Pipe i i o () m a) -> (a -> b) -> a -> Pipe i i o () m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f)
instance Applicative (Conduit i o m) where
pure :: a -> Conduit i o m a
pure a
x = (forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((a -> Pipe i i o () m a) -> a -> Pipe i i o () m a
forall a b. (a -> b) -> a -> b
$ a
x)
{-# INLINE pure #-}
Conduit i o m (a -> b)
fab <*> :: Conduit i o m (a -> b) -> Conduit i o m a -> Conduit i o m b
<*> Conduit i o m a
fa = Conduit i o m (a -> b)
fab Conduit i o m (a -> b)
-> ((a -> b) -> Conduit i o m b) -> Conduit i o m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
ab -> Conduit i o m a
fa Conduit i o m a -> (a -> Conduit i o m b) -> Conduit i o m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> b -> Conduit i o m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
ab a
a)
{-# INLINE (<*>) #-}
instance Monad (Conduit i o m) where
return :: a -> Conduit i o m a
return = a -> Conduit i o m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Conduit forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a
f >>= :: Conduit i o m a -> (a -> Conduit i o m b) -> Conduit i o m b
>>= a -> Conduit i o m b
g = (forall a. (b -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m b
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (b -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m b)
-> (forall a. (b -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m b
forall a b. (a -> b) -> a -> b
$ \b -> Pipe i i o () m a
h -> (a -> Pipe i i o () m a) -> Pipe i i o () m a
forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a
f ((a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> (a -> Pipe i i o () m a) -> Pipe i i o () m a
forall a b. (a -> b) -> a -> b
$ \a
a -> Conduit i o m b -> (b -> Pipe i i o () m a) -> Pipe i i o () m a
forall input output (monad :: * -> *) result.
Conduit input output monad result
-> forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a
unConduit (a -> Conduit i o m b
g a
a) b -> Pipe i i o () m a
h
instance MonadTrans (Conduit i o) where
lift :: m a -> Conduit i o m a
lift m a
m = (forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a)
-> (forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a
forall a b. (a -> b) -> a -> b
$ \a -> Pipe i i o () m a
rest -> m (Pipe i i o () m a) -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM (m (Pipe i i o () m a) -> Pipe i i o () m a)
-> m (Pipe i i o () m a) -> Pipe i i o () m a
forall a b. (a -> b) -> a -> b
$ (a -> Pipe i i o () m a) -> m a -> m (Pipe i i o () m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Pipe i i o () m a
rest m a
m
instance MonadIO m => MonadIO (Conduit i o m) where
liftIO :: IO a -> Conduit i o m a
liftIO = m a -> Conduit i o m a
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m a -> Conduit i o m a)
-> (IO a -> m a) -> IO a -> Conduit i o m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadFailure m => MonadFailure (Conduit i o m) where
type Failure (Conduit i o m) = Failure m
mFail :: Failure (Conduit i o m) -> Conduit i o m ()
mFail = m () -> Conduit i o m ()
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m () -> Conduit i o m ())
-> (Failure m -> m ()) -> Failure m -> Conduit i o m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Failure m -> m ()
forall (m :: * -> *). MonadFailure m => Failure m -> m ()
mFail
instance MonadThrow m => MonadThrow (Conduit i o m) where
throw :: e -> Conduit i o m a
throw = m a -> Conduit i o m a
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m a -> Conduit i o m a) -> (e -> m a) -> e -> Conduit i o m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw
instance MonadCatch m => MonadCatch (Conduit i o m) where
catch :: Conduit i o m a -> (e -> Conduit i o m a) -> Conduit i o m a
catch (Conduit forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a
c0) e -> Conduit i o m a
onExc = (forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a)
-> (forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m a
forall a b. (a -> b) -> a -> b
$ \a -> Pipe i i o () m a
rest -> let
go :: Pipe i i o () m a -> Pipe i i o () m a
go (PipeM m (Pipe i i o () m a)
m) =
m (Pipe i i o () m a) -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM (m (Pipe i i o () m a) -> Pipe i i o () m a)
-> m (Pipe i i o () m a) -> Pipe i i o () m a
forall a b. (a -> b) -> a -> b
$ m (Pipe i i o () m a)
-> (e -> m (Pipe i i o () m a)) -> m (Pipe i i o () m a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((Pipe i i o () m a -> Pipe i i o () m a)
-> m (Pipe i i o () m a) -> m (Pipe i i o () m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Pipe i i o () m a -> Pipe i i o () m a
go m (Pipe i i o () m a)
m) (\e
x -> Pipe i i o () m a -> m (Pipe i i o () m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pipe i i o () m a -> m (Pipe i i o () m a))
-> Pipe i i o () m a -> m (Pipe i i o () m a)
forall a b. (a -> b) -> a -> b
$ Conduit i o m a -> (a -> Pipe i i o () m a) -> Pipe i i o () m a
forall input output (monad :: * -> *) result.
Conduit input output monad result
-> forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a
unConduit (e -> Conduit i o m a
onExc e
x) a -> Pipe i i o () m a
rest)
go (Done a
r) = a -> Pipe i i o () m a
rest a
r
go (Await i -> Pipe i i o () m a
p () -> Pipe i i o () m a
c) = (i -> Pipe i i o () m a)
-> (() -> Pipe i i o () m a) -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await (Pipe i i o () m a -> Pipe i i o () m a
go (Pipe i i o () m a -> Pipe i i o () m a)
-> (i -> Pipe i i o () m a) -> i -> Pipe i i o () m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. i -> Pipe i i o () m a
p) (Pipe i i o () m a -> Pipe i i o () m a
go (Pipe i i o () m a -> Pipe i i o () m a)
-> (() -> Pipe i i o () m a) -> () -> Pipe i i o () m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. () -> Pipe i i o () m a
c)
go (Yield Pipe i i o () m a
p m ()
m o
o) = Pipe i i o () m a -> m () -> o -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield (Pipe i i o () m a -> Pipe i i o () m a
go Pipe i i o () m a
p) m ()
m o
o
go (Leftover Pipe i i o () m a
p i
i) = Pipe i i o () m a -> i -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> leftOver -> Pipe leftOver input output upstream monad result
Leftover (Pipe i i o () m a -> Pipe i i o () m a
go Pipe i i o () m a
p) i
i
in Pipe i i o () m a -> Pipe i i o () m a
go ((a -> Pipe i i o () m a) -> Pipe i i o () m a
forall a. (a -> Pipe i i o () m a) -> Pipe i i o () m a
c0 a -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done)
await :: Conduit i o m (Maybe i)
await :: Conduit i o m (Maybe i)
await = (forall a. (Maybe i -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m (Maybe i)
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (Maybe i -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m (Maybe i))
-> (forall a. (Maybe i -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m (Maybe i)
forall a b. (a -> b) -> a -> b
$ \Maybe i -> Pipe i i o () m a
f -> (i -> Pipe i i o () m a)
-> (() -> Pipe i i o () m a) -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await (Maybe i -> Pipe i i o () m a
f (Maybe i -> Pipe i i o () m a)
-> (i -> Maybe i) -> i -> Pipe i i o () m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. i -> Maybe i
forall a. a -> Maybe a
Just) (Pipe i i o () m a -> () -> Pipe i i o () m a
forall a b. a -> b -> a
const (Maybe i -> Pipe i i o () m a
f Maybe i
forall a. Maybe a
Nothing))
{-# NOINLINE[1] await #-}
await' :: Conduit i o m r
-> (i -> Conduit i o m r)
-> Conduit i o m r
await' :: Conduit i o m r -> (i -> Conduit i o m r) -> Conduit i o m r
await' Conduit i o m r
f i -> Conduit i o m r
g = (forall a. (r -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m r
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (r -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m r)
-> (forall a. (r -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m r
forall a b. (a -> b) -> a -> b
$ \r -> Pipe i i o () m a
rest -> (i -> Pipe i i o () m a)
-> (() -> Pipe i i o () m a) -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await
(\i
i -> Conduit i o m r -> (r -> Pipe i i o () m a) -> Pipe i i o () m a
forall input output (monad :: * -> *) result.
Conduit input output monad result
-> forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a
unConduit (i -> Conduit i o m r
g i
i) r -> Pipe i i o () m a
rest)
(Pipe i i o () m a -> () -> Pipe i i o () m a
forall a b. a -> b -> a
const (Pipe i i o () m a -> () -> Pipe i i o () m a)
-> Pipe i i o () m a -> () -> Pipe i i o () m a
forall a b. (a -> b) -> a -> b
$ Conduit i o m r -> (r -> Pipe i i o () m a) -> Pipe i i o () m a
forall input output (monad :: * -> *) result.
Conduit input output monad result
-> forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a
unConduit Conduit i o m r
f r -> Pipe i i o () m a
rest)
{-# INLINE await' #-}
{-# RULES "conduit: await >>= maybe" [2] forall x y. await >>= maybe x y = await' x y #-}
awaitForever :: (input -> Conduit input output monad b) -> Conduit input output monad ()
awaitForever :: (input -> Conduit input output monad b)
-> Conduit input output monad ()
awaitForever input -> Conduit input output monad b
f = (forall a.
(() -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad ()
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a.
(() -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad ())
-> (forall a.
(() -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad ()
forall a b. (a -> b) -> a -> b
$ \() -> Pipe input input output () monad a
rest ->
let go :: Pipe input input output () monad a
go = (input -> Pipe input input output () monad a)
-> (() -> Pipe input input output () monad a)
-> Pipe input input output () monad a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await (\input
i -> Conduit input output monad b
-> (b -> Pipe input input output () monad a)
-> Pipe input input output () monad a
forall input output (monad :: * -> *) result.
Conduit input output monad result
-> forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a
unConduit (input -> Conduit input output monad b
f input
i) (Pipe input input output () monad a
-> b -> Pipe input input output () monad a
forall a b. a -> b -> a
const Pipe input input output () monad a
go)) () -> Pipe input input output () monad a
rest
in Pipe input input output () monad a
go
yield :: Monad m => o -> Conduit i o m ()
yield :: o -> Conduit i o m ()
yield o
o = (forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ()
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ())
-> (forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ()
forall a b. (a -> b) -> a -> b
$ \() -> Pipe i i o () m a
f -> Pipe i i o () m a -> m () -> o -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield (() -> Pipe i i o () m a
f ()) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) o
o
yieldOr :: o
-> m ()
-> Conduit i o m ()
yieldOr :: o -> m () -> Conduit i o m ()
yieldOr o
o m ()
m = (forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ()
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ())
-> (forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ()
forall a b. (a -> b) -> a -> b
$ \() -> Pipe i i o () m a
f -> Pipe i i o () m a -> m () -> o -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield (() -> Pipe i i o () m a
f ()) m ()
m o
o
leftover :: i -> Conduit i o m ()
leftover :: i -> Conduit i o m ()
leftover i
i = (forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ()
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ())
-> (forall a. (() -> Pipe i i o () m a) -> Pipe i i o () m a)
-> Conduit i o m ()
forall a b. (a -> b) -> a -> b
$ \() -> Pipe i i o () m a
f -> Pipe i i o () m a -> i -> Pipe i i o () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> leftOver -> Pipe leftOver input output upstream monad result
Leftover (() -> Pipe i i o () m a
f ()) i
i
runConduit :: Monad m => Conduit () () m r -> m r
runConduit :: Conduit () () m r -> m r
runConduit (Conduit forall a. (r -> Pipe () () () () m a) -> Pipe () () () () m a
f) = Pipe () () () () m r -> m r
forall (m :: * -> *) r. Monad m => Pipe () () () () m r -> m r
runPipe ((r -> Pipe () () () () m r) -> Pipe () () () () m r
forall a. (r -> Pipe () () () () m a) -> Pipe () () () () m a
f r -> Pipe () () () () m r
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done)
runConduitPure :: Conduit () () Identity r -> r
runConduitPure :: Conduit () () Identity r -> r
runConduitPure = Identity r -> r
forall a. Identity a -> a
runIdentity (Identity r -> r)
-> (Conduit () () Identity r -> Identity r)
-> Conduit () () Identity r
-> r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Conduit () () Identity r -> Identity r
forall (m :: * -> *) r. Monad m => Conduit () () m r -> m r
runConduit
runConduitRes :: (MonadBracket m, MonadIO m) => Conduit () () (ResourceT m) r -> m r
runConduitRes :: Conduit () () (ResourceT m) r -> m r
runConduitRes = ResourceT m r -> m r
forall (m :: * -> *) a.
(MonadBracket m, MonadIO m) =>
ResourceT m a -> m a
runResourceT (ResourceT m r -> m r)
-> (Conduit () () (ResourceT m) r -> ResourceT m r)
-> Conduit () () (ResourceT m) r
-> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Conduit () () (ResourceT m) r -> ResourceT m r
forall (m :: * -> *) r. Monad m => Conduit () () m r -> m r
runConduit
bracketConduit :: MonadResource m
=> IO a
-> (a -> IO b)
-> (a -> Conduit i o m r)
-> Conduit i o m r
bracketConduit :: IO a -> (a -> IO b) -> (a -> Conduit i o m r) -> Conduit i o m r
bracketConduit IO a
acquire a -> IO b
cleanup a -> Conduit i o m r
inner = do
(a
resource, Conduit i o m ()
release) <- IO a -> (a -> IO b) -> Conduit i o m (a, Conduit i o m ())
forall (m :: * -> *) (n :: * -> *) a b.
(MonadResource m, MonadIO n) =>
IO a -> (a -> IO b) -> m (a, n ())
allocate IO a
acquire a -> IO b
cleanup
r
result <- a -> Conduit i o m r
inner a
resource
Conduit i o m ()
release
r -> Conduit i o m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
result
runPipe :: Monad m => Pipe () () () () m r -> m r
runPipe :: Pipe () () () () m r -> m r
runPipe =
Pipe () () () () m r -> m r
forall (m :: * -> *) input b.
Monad m =>
Pipe () input () () m b -> m b
go
where
go :: Pipe () input () () m b -> m b
go (Yield Pipe () input () () m b
p m ()
_ ()) = Pipe () input () () m b -> m b
go Pipe () input () () m b
p
go (Await input -> Pipe () input () () m b
_ () -> Pipe () input () () m b
p) = Pipe () input () () m b -> m b
go (() -> Pipe () input () () m b
p ())
go (Done b
r) = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
go (PipeM m (Pipe () input () () m b)
mp) = m (Pipe () input () () m b)
mp m (Pipe () input () () m b)
-> (Pipe () input () () m b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pipe () input () () m b -> m b
go
go (Leftover Pipe () input () () m b
p ()) = Pipe () input () () m b -> m b
go Pipe () input () () m b
p
fuse :: Monad m => Conduit a b m () -> Conduit b c m r -> Conduit a c m r
fuse :: Conduit a b m () -> Conduit b c m r -> Conduit a c m r
fuse (Conduit forall a. (() -> Pipe a a b () m a) -> Pipe a a b () m a
left0) (Conduit forall a. (r -> Pipe b b c () m a) -> Pipe b b c () m a
right0) = (forall a. (r -> Pipe a a c () m a) -> Pipe a a c () m a)
-> Conduit a c m r
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (r -> Pipe a a c () m a) -> Pipe a a c () m a)
-> Conduit a c m r)
-> (forall a. (r -> Pipe a a c () m a) -> Pipe a a c () m a)
-> Conduit a c m r
forall a b. (a -> b) -> a -> b
$ \r -> Pipe a a c () m a
rest ->
let goRight :: m ()
-> Pipe a a b () m () -> Pipe b b c () m r -> Pipe a a c () m a
goRight m ()
final Pipe a a b () m ()
left Pipe b b c () m r
right =
case Pipe b b c () m r
right of
Yield Pipe b b c () m r
p m ()
c c
o -> Pipe a a c () m a -> m () -> c -> Pipe a a c () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield (Pipe b b c () m r -> Pipe a a c () m a
recurse Pipe b b c () m r
p) (m ()
c m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
final) c
o
Await b -> Pipe b b c () m r
rp () -> Pipe b b c () m r
rc -> (b -> Pipe b b c () m r)
-> (() -> Pipe b b c () m r)
-> m ()
-> Pipe a a b () m ()
-> Pipe a a c () m a
goLeft b -> Pipe b b c () m r
rp () -> Pipe b b c () m r
rc m ()
final Pipe a a b () m ()
left
Done r
r2 -> m (Pipe a a c () m a) -> Pipe a a c () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM (m ()
final m () -> m (Pipe a a c () m a) -> m (Pipe a a c () m a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pipe a a c () m a -> m (Pipe a a c () m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Pipe a a c () m a
rest r
r2))
PipeM m (Pipe b b c () m r)
mp -> m (Pipe a a c () m a) -> Pipe a a c () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe b b c () m r -> Pipe a a c () m a)
-> m (Pipe b b c () m r) -> m (Pipe a a c () m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Pipe b b c () m r -> Pipe a a c () m a
recurse m (Pipe b b c () m r)
mp)
Leftover Pipe b b c () m r
right' b
i -> m ()
-> Pipe a a b () m () -> Pipe b b c () m r -> Pipe a a c () m a
goRight m ()
final (Pipe a a b () m () -> m () -> b -> Pipe a a b () m ()
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield Pipe a a b () m ()
left m ()
final b
i) Pipe b b c () m r
right'
where
recurse :: Pipe b b c () m r -> Pipe a a c () m a
recurse = m ()
-> Pipe a a b () m () -> Pipe b b c () m r -> Pipe a a c () m a
goRight m ()
final Pipe a a b () m ()
left
goLeft :: (b -> Pipe b b c () m r)
-> (() -> Pipe b b c () m r)
-> m ()
-> Pipe a a b () m ()
-> Pipe a a c () m a
goLeft b -> Pipe b b c () m r
rp () -> Pipe b b c () m r
rc m ()
final Pipe a a b () m ()
left =
case Pipe a a b () m ()
left of
Yield Pipe a a b () m ()
left' m ()
final' b
o -> m ()
-> Pipe a a b () m () -> Pipe b b c () m r -> Pipe a a c () m a
goRight m ()
final' Pipe a a b () m ()
left' (b -> Pipe b b c () m r
rp b
o)
Await a -> Pipe a a b () m ()
left' () -> Pipe a a b () m ()
lc -> (a -> Pipe a a c () m a)
-> (() -> Pipe a a c () m a) -> Pipe a a c () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await (Pipe a a b () m () -> Pipe a a c () m a
recurse (Pipe a a b () m () -> Pipe a a c () m a)
-> (a -> Pipe a a b () m ()) -> a -> Pipe a a c () m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Pipe a a b () m ()
left') (Pipe a a b () m () -> Pipe a a c () m a
recurse (Pipe a a b () m () -> Pipe a a c () m a)
-> (() -> Pipe a a b () m ()) -> () -> Pipe a a c () m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. () -> Pipe a a b () m ()
lc)
Done ()
r1 -> m ()
-> Pipe a a b () m () -> Pipe b b c () m r -> Pipe a a c () m a
goRight (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (() -> Pipe a a b () m ()
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done ()
r1) (() -> Pipe b b c () m r
rc ()
r1)
PipeM m (Pipe a a b () m ())
mp -> m (Pipe a a c () m a) -> Pipe a a c () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe a a b () m () -> Pipe a a c () m a)
-> m (Pipe a a b () m ()) -> m (Pipe a a c () m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Pipe a a b () m () -> Pipe a a c () m a
recurse m (Pipe a a b () m ())
mp)
Leftover Pipe a a b () m ()
left' a
i -> Pipe a a c () m a -> a -> Pipe a a c () m a
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> leftOver -> Pipe leftOver input output upstream monad result
Leftover (Pipe a a b () m () -> Pipe a a c () m a
recurse Pipe a a b () m ()
left') a
i
where
recurse :: Pipe a a b () m () -> Pipe a a c () m a
recurse = (b -> Pipe b b c () m r)
-> (() -> Pipe b b c () m r)
-> m ()
-> Pipe a a b () m ()
-> Pipe a a c () m a
goLeft b -> Pipe b b c () m r
rp () -> Pipe b b c () m r
rc m ()
final
in m ()
-> Pipe a a b () m () -> Pipe b b c () m r -> Pipe a a c () m a
goRight (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((() -> Pipe a a b () m ()) -> Pipe a a b () m ()
forall a. (() -> Pipe a a b () m a) -> Pipe a a b () m a
left0 () -> Pipe a a b () m ()
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done) ((r -> Pipe b b c () m r) -> Pipe b b c () m r
forall a. (r -> Pipe b b c () m a) -> Pipe b b c () m a
right0 r -> Pipe b b c () m r
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done)
newtype ZipSink i m r = ZipSink { ZipSink i m r -> Conduit i () m r
getZipSink :: Conduit i () m r }
instance Monad m => Functor (ZipSink i m) where
fmap :: (a -> b) -> ZipSink i m a -> ZipSink i m b
fmap a -> b
f (ZipSink Conduit i () m a
x) = Conduit i () m b -> ZipSink i m b
forall i (m :: * -> *) r. Conduit i () m r -> ZipSink i m r
ZipSink ((a -> b) -> Conduit i () m a -> Conduit i () m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f Conduit i () m a
x)
instance Monad m => Applicative (ZipSink i m) where
pure :: a -> ZipSink i m a
pure = Conduit i () m a -> ZipSink i m a
forall i (m :: * -> *) r. Conduit i () m r -> ZipSink i m r
ZipSink (Conduit i () m a -> ZipSink i m a)
-> (a -> Conduit i () m a) -> a -> ZipSink i m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Conduit i () m a
forall (m :: * -> *) a. Monad m => a -> m a
return
ZipSink (Conduit forall a. ((a -> b) -> Pipe i i () () m a) -> Pipe i i () () m a
f0) <*> :: ZipSink i m (a -> b) -> ZipSink i m a -> ZipSink i m b
<*> ZipSink (Conduit forall a. (a -> Pipe i i () () m a) -> Pipe i i () () m a
x0) =
Conduit i () m b -> ZipSink i m b
forall i (m :: * -> *) r. Conduit i () m r -> ZipSink i m r
ZipSink (Conduit i () m b -> ZipSink i m b)
-> Conduit i () m b -> ZipSink i m b
forall a b. (a -> b) -> a -> b
$ (forall a. (b -> Pipe i i () () m a) -> Pipe i i () () m a)
-> Conduit i () m b
forall input output (monad :: * -> *) result.
(forall a.
(result -> Pipe input input output () monad a)
-> Pipe input input output () monad a)
-> Conduit input output monad result
Conduit ((forall a. (b -> Pipe i i () () m a) -> Pipe i i () () m a)
-> Conduit i () m b)
-> (forall a. (b -> Pipe i i () () m a) -> Pipe i i () () m a)
-> Conduit i () m b
forall a b. (a -> b) -> a -> b
$ \b -> Pipe i i () () m a
rest -> let
go :: Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go (Leftover Pipe Void i () () m (a -> b)
_ Void
i) Pipe Void i () () m a
_ = Void -> Pipe i i () () m a
forall a. Void -> a
absurd Void
i
go Pipe Void i () () m (a -> b)
_ (Leftover Pipe Void i () () m a
_ Void
i) = Void -> Pipe i i () () m a
forall a. Void -> a
absurd Void
i
go (Yield Pipe Void i () () m (a -> b)
f m ()
_ ()) Pipe Void i () () m a
x = Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go Pipe Void i () () m (a -> b)
f Pipe Void i () () m a
x
go Pipe Void i () () m (a -> b)
f (Yield Pipe Void i () () m a
x m ()
_ ()) = Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go Pipe Void i () () m (a -> b)
f Pipe Void i () () m a
x
go (PipeM m (Pipe Void i () () m (a -> b))
mf) Pipe Void i () () m a
x = m (Pipe i i () () m a) -> Pipe i i () () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe Void i () () m (a -> b) -> Pipe i i () () m a)
-> m (Pipe Void i () () m (a -> b)) -> m (Pipe i i () () m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
`go` Pipe Void i () () m a
x) m (Pipe Void i () () m (a -> b))
mf)
go Pipe Void i () () m (a -> b)
f (PipeM m (Pipe Void i () () m a)
mx) = m (Pipe i i () () m a) -> Pipe i i () () m a
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe Void i () () m a -> Pipe i i () () m a)
-> m (Pipe Void i () () m a) -> m (Pipe i i () () m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go Pipe Void i () () m (a -> b)
f) m (Pipe Void i () () m a)
mx)
go (Done a -> b
f) (Done a
x) = b -> Pipe i i () () m a
rest (a -> b
f a
x)
go (Await i -> Pipe Void i () () m (a -> b)
pf () -> Pipe Void i () () m (a -> b)
cf) (Await i -> Pipe Void i () () m a
px () -> Pipe Void i () () m a
cx) = (i -> Pipe i i () () m a)
-> (() -> Pipe i i () () m a) -> Pipe i i () () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await
(\i
i -> Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go (i -> Pipe Void i () () m (a -> b)
pf i
i) (i -> Pipe Void i () () m a
px i
i))
(\() -> Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go (() -> Pipe Void i () () m (a -> b)
cf ()) (() -> Pipe Void i () () m a
cx ()))
go (Await i -> Pipe Void i () () m (a -> b)
pf () -> Pipe Void i () () m (a -> b)
cf) x :: Pipe Void i () () m a
x@Done{} = (i -> Pipe i i () () m a)
-> (() -> Pipe i i () () m a) -> Pipe i i () () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await
(\i
i -> Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go (i -> Pipe Void i () () m (a -> b)
pf i
i) Pipe Void i () () m a
x)
(\() -> Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go (() -> Pipe Void i () () m (a -> b)
cf ()) Pipe Void i () () m a
x)
go f :: Pipe Void i () () m (a -> b)
f@Done{} (Await i -> Pipe Void i () () m a
px () -> Pipe Void i () () m a
cx) = (i -> Pipe i i () () m a)
-> (() -> Pipe i i () () m a) -> Pipe i i () () m a
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await
(\i
i -> Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go Pipe Void i () () m (a -> b)
f (i -> Pipe Void i () () m a
px i
i))
(\() -> Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go Pipe Void i () () m (a -> b)
f (() -> Pipe Void i () () m a
cx ()))
in Pipe Void i () () m (a -> b)
-> Pipe Void i () () m a -> Pipe i i () () m a
go (Pipe i i () () m (a -> b) -> Pipe Void i () () m (a -> b)
forall (m :: * -> *) i o u r l.
Monad m =>
Pipe i i o u m r -> Pipe l i o u m r
injectLeftovers (((a -> b) -> Pipe i i () () m (a -> b))
-> Pipe i i () () m (a -> b)
forall a. ((a -> b) -> Pipe i i () () m a) -> Pipe i i () () m a
f0 (a -> b) -> Pipe i i () () m (a -> b)
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done)) (Pipe i i () () m a -> Pipe Void i () () m a
forall (m :: * -> *) i o u r l.
Monad m =>
Pipe i i o u m r -> Pipe l i o u m r
injectLeftovers ((a -> Pipe i i () () m a) -> Pipe i i () () m a
forall a. (a -> Pipe i i () () m a) -> Pipe i i () () m a
x0 a -> Pipe i i () () m a
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done))
data Void
absurd :: Void -> a
absurd :: Void -> a
absurd Void
_ = String -> a
forall a. HasCallStack => String -> a
error String
"Foundation.Conduit.Internal.absurd"
injectLeftovers :: Monad m => Pipe i i o u m r -> Pipe l i o u m r
injectLeftovers :: Pipe i i o u m r -> Pipe l i o u m r
injectLeftovers =
[i] -> Pipe i i o u m r -> Pipe l i o u m r
forall (monad :: * -> *) input output upstream result leftOver.
Monad monad =>
[input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go []
where
go :: [input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go [input]
ls (Yield Pipe input input output upstream monad result
p monad ()
c output
o) = Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
forall leftOver input output upstream (monad :: * -> *) result.
Pipe leftOver input output upstream monad result
-> monad ()
-> output
-> Pipe leftOver input output upstream monad result
Yield ([input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go [input]
ls Pipe input input output upstream monad result
p) monad ()
c output
o
go (input
l:[input]
ls) (Await input -> Pipe input input output upstream monad result
p upstream -> Pipe input input output upstream monad result
_) = [input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go [input]
ls (Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result)
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
forall a b. (a -> b) -> a -> b
$ input -> Pipe input input output upstream monad result
p input
l
go [] (Await input -> Pipe input input output upstream monad result
p upstream -> Pipe input input output upstream monad result
c) = (input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
forall leftOver input output upstream (monad :: * -> *) result.
(input -> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
Await ([input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go [] (Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result)
-> (input -> Pipe input input output upstream monad result)
-> input
-> Pipe leftOver input output upstream monad result
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. input -> Pipe input input output upstream monad result
p) ([input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go [] (Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result)
-> (upstream -> Pipe input input output upstream monad result)
-> upstream
-> Pipe leftOver input output upstream monad result
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. upstream -> Pipe input input output upstream monad result
c)
go [input]
_ (Done result
r) = result -> Pipe leftOver input output upstream monad result
forall leftOver input output upstream (monad :: * -> *) result.
result -> Pipe leftOver input output upstream monad result
Done result
r
go [input]
ls (PipeM monad (Pipe input input output upstream monad result)
mp) = monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
forall leftOver input output upstream (monad :: * -> *) result.
monad (Pipe leftOver input output upstream monad result)
-> Pipe leftOver input output upstream monad result
PipeM ((Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result)
-> monad (Pipe input input output upstream monad result)
-> monad (Pipe leftOver input output upstream monad result)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go [input]
ls) monad (Pipe input input output upstream monad result)
mp)
go [input]
ls (Leftover Pipe input input output upstream monad result
p input
l) = [input]
-> Pipe input input output upstream monad result
-> Pipe leftOver input output upstream monad result
go (input
linput -> [input] -> [input]
forall a. a -> [a] -> [a]
:[input]
ls) Pipe input input output upstream monad result
p
newtype ResourceT m a = ResourceT { ResourceT m a -> PrimVar IO ReleaseMap -> m a
unResourceT :: PrimVar IO ReleaseMap -> m a }
instance Functor m => Functor (ResourceT m) where
fmap :: (a -> b) -> ResourceT m a -> ResourceT m b
fmap a -> b
f (ResourceT PrimVar IO ReleaseMap -> m a
m) = (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((PrimVar IO ReleaseMap -> m b) -> ResourceT m b)
-> (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall a b. (a -> b) -> a -> b
$ \PrimVar IO ReleaseMap
r -> (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (PrimVar IO ReleaseMap -> m a
m PrimVar IO ReleaseMap
r)
instance Applicative m => Applicative (ResourceT m) where
pure :: a -> ResourceT m a
pure = (IORef ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m a) -> ResourceT m a)
-> (a -> IORef ReleaseMap -> m a) -> a -> ResourceT m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> IORef ReleaseMap -> m a
forall a b. a -> b -> a
const (m a -> IORef ReleaseMap -> m a)
-> (a -> m a) -> a -> IORef ReleaseMap -> m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ResourceT PrimVar IO ReleaseMap -> m (a -> b)
mf <*> :: ResourceT m (a -> b) -> ResourceT m a -> ResourceT m b
<*> ResourceT PrimVar IO ReleaseMap -> m a
ma = (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((PrimVar IO ReleaseMap -> m b) -> ResourceT m b)
-> (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall a b. (a -> b) -> a -> b
$ \PrimVar IO ReleaseMap
r ->
PrimVar IO ReleaseMap -> m (a -> b)
mf PrimVar IO ReleaseMap
r m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrimVar IO ReleaseMap -> m a
ma PrimVar IO ReleaseMap
r
instance Monad m => Monad (ResourceT m) where
#if !MIN_VERSION_base(4,8,0)
return = ResourceT . const . return
#endif
ResourceT PrimVar IO ReleaseMap -> m a
ma >>= :: ResourceT m a -> (a -> ResourceT m b) -> ResourceT m b
>>= a -> ResourceT m b
f = (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((PrimVar IO ReleaseMap -> m b) -> ResourceT m b)
-> (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall a b. (a -> b) -> a -> b
$ \PrimVar IO ReleaseMap
r -> do
a
a <- PrimVar IO ReleaseMap -> m a
ma PrimVar IO ReleaseMap
r
let ResourceT PrimVar IO ReleaseMap -> m b
f' = a -> ResourceT m b
f a
a
PrimVar IO ReleaseMap -> m b
f' PrimVar IO ReleaseMap
r
instance MonadTrans ResourceT where
lift :: m a -> ResourceT m a
lift = (IORef ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((IORef ReleaseMap -> m a) -> ResourceT m a)
-> (m a -> IORef ReleaseMap -> m a) -> m a -> ResourceT m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> IORef ReleaseMap -> m a
forall a b. a -> b -> a
const
instance MonadIO m => MonadIO (ResourceT m) where
liftIO :: IO a -> ResourceT m a
liftIO = m a -> ResourceT m a
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m a -> ResourceT m a) -> (IO a -> m a) -> IO a -> ResourceT m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadThrow m => MonadThrow (ResourceT m) where
throw :: e -> ResourceT m a
throw = m a -> ResourceT m a
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m a -> ResourceT m a) -> (e -> m a) -> e -> ResourceT m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw
instance MonadCatch m => MonadCatch (ResourceT m) where
catch :: ResourceT m a -> (e -> ResourceT m a) -> ResourceT m a
catch (ResourceT PrimVar IO ReleaseMap -> m a
f) e -> ResourceT m a
g = (PrimVar IO ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((PrimVar IO ReleaseMap -> m a) -> ResourceT m a)
-> (PrimVar IO ReleaseMap -> m a) -> ResourceT m a
forall a b. (a -> b) -> a -> b
$ \PrimVar IO ReleaseMap
env -> PrimVar IO ReleaseMap -> m a
f PrimVar IO ReleaseMap
env m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> ResourceT m a -> PrimVar IO ReleaseMap -> m a
forall (m :: * -> *) a.
ResourceT m a -> PrimVar IO ReleaseMap -> m a
unResourceT (e -> ResourceT m a
g e
e) PrimVar IO ReleaseMap
env
instance MonadBracket m => MonadBracket (ResourceT m) where
generalBracket :: ResourceT m a
-> (a -> b -> ResourceT m ignored1)
-> (a -> SomeException -> ResourceT m ignored2)
-> (a -> ResourceT m b)
-> ResourceT m b
generalBracket ResourceT m a
acquire a -> b -> ResourceT m ignored1
onSuccess a -> SomeException -> ResourceT m ignored2
onExc a -> ResourceT m b
inner = (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((PrimVar IO ReleaseMap -> m b) -> ResourceT m b)
-> (PrimVar IO ReleaseMap -> m b) -> ResourceT m b
forall a b. (a -> b) -> a -> b
$ \PrimVar IO ReleaseMap
env -> m a
-> (a -> b -> m ignored1)
-> (a -> SomeException -> m ignored2)
-> (a -> m b)
-> m b
forall (m :: * -> *) a b ignored1 ignored2.
MonadBracket m =>
m a
-> (a -> b -> m ignored1)
-> (a -> SomeException -> m ignored2)
-> (a -> m b)
-> m b
generalBracket
(ResourceT m a -> PrimVar IO ReleaseMap -> m a
forall (m :: * -> *) a.
ResourceT m a -> PrimVar IO ReleaseMap -> m a
unResourceT ResourceT m a
acquire PrimVar IO ReleaseMap
env)
(\a
x b
y -> ResourceT m ignored1 -> PrimVar IO ReleaseMap -> m ignored1
forall (m :: * -> *) a.
ResourceT m a -> PrimVar IO ReleaseMap -> m a
unResourceT (a -> b -> ResourceT m ignored1
onSuccess a
x b
y) PrimVar IO ReleaseMap
env)
(\a
x SomeException
y -> ResourceT m ignored2 -> PrimVar IO ReleaseMap -> m ignored2
forall (m :: * -> *) a.
ResourceT m a -> PrimVar IO ReleaseMap -> m a
unResourceT (a -> SomeException -> ResourceT m ignored2
onExc a
x SomeException
y) PrimVar IO ReleaseMap
env)
(\a
x -> ResourceT m b -> PrimVar IO ReleaseMap -> m b
forall (m :: * -> *) a.
ResourceT m a -> PrimVar IO ReleaseMap -> m a
unResourceT (a -> ResourceT m b
inner a
x) PrimVar IO ReleaseMap
env)
data ReleaseMap =
ReleaseMap !NextKey !RefCount ![(Word, (ReleaseType -> IO ()))]
| ReleaseMapClosed
data ReleaseType = ReleaseEarly
| ReleaseNormal
| ReleaseException
type RefCount = Word
type NextKey = Word
runResourceT :: (MonadBracket m, MonadIO m) => ResourceT m a -> m a
runResourceT :: ResourceT m a -> m a
runResourceT (ResourceT PrimVar IO ReleaseMap -> m a
inner) = m (IORef ReleaseMap)
-> (IORef ReleaseMap -> a -> m ())
-> (IORef ReleaseMap -> SomeException -> m ())
-> (IORef ReleaseMap -> m a)
-> m a
forall (m :: * -> *) a b ignored1 ignored2.
MonadBracket m =>
m a
-> (a -> b -> m ignored1)
-> (a -> SomeException -> m ignored2)
-> (a -> m b)
-> m b
generalBracket
(IO (IORef ReleaseMap) -> m (IORef ReleaseMap)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef ReleaseMap) -> m (IORef ReleaseMap))
-> IO (IORef ReleaseMap) -> m (IORef ReleaseMap)
forall a b. (a -> b) -> a -> b
$ ReleaseMap -> IO (PrimVar IO ReleaseMap)
forall (m :: * -> *) a. PrimMonad m => a -> m (PrimVar m a)
primVarNew (ReleaseMap -> IO (PrimVar IO ReleaseMap))
-> ReleaseMap -> IO (PrimVar IO ReleaseMap)
forall a b. (a -> b) -> a -> b
$ NextKey
-> NextKey -> [(NextKey, ReleaseType -> IO ())] -> ReleaseMap
ReleaseMap NextKey
forall a. Bounded a => a
maxBound (NextKey
forall a. Bounded a => a
minBound NextKey -> NextKey -> NextKey
forall a. Additive a => a -> a -> a
+ NextKey
1) [])
(\IORef ReleaseMap
state a
_res -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef ReleaseMap -> ReleaseType -> IO ()
cleanup IORef ReleaseMap
state ReleaseType
ReleaseNormal)
(\IORef ReleaseMap
state SomeException
_exc -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef ReleaseMap -> ReleaseType -> IO ()
cleanup IORef ReleaseMap
state ReleaseType
ReleaseException)
IORef ReleaseMap -> m a
PrimVar IO ReleaseMap -> m a
inner
where
cleanup :: IORef ReleaseMap -> ReleaseType -> IO ()
cleanup IORef ReleaseMap
istate ReleaseType
rtype = do
Maybe [(NextKey, ReleaseType -> IO ())]
mm <- IORef ReleaseMap
-> (ReleaseMap
-> (ReleaseMap, Maybe [(NextKey, ReleaseType -> IO ())]))
-> IO (Maybe [(NextKey, ReleaseType -> IO ())])
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ReleaseMap
istate ((ReleaseMap
-> (ReleaseMap, Maybe [(NextKey, ReleaseType -> IO ())]))
-> IO (Maybe [(NextKey, ReleaseType -> IO ())]))
-> (ReleaseMap
-> (ReleaseMap, Maybe [(NextKey, ReleaseType -> IO ())]))
-> IO (Maybe [(NextKey, ReleaseType -> IO ())])
forall a b. (a -> b) -> a -> b
$ \ReleaseMap
rm ->
case ReleaseMap
rm of
ReleaseMap NextKey
nk NextKey
rf [(NextKey, ReleaseType -> IO ())]
m ->
let rf' :: Difference NextKey
rf' = NextKey
rf NextKey -> NextKey -> Difference NextKey
forall a. Subtractive a => a -> a -> Difference a
- NextKey
1
in if NextKey
Difference NextKey
rf' NextKey -> NextKey -> Bool
forall a. Eq a => a -> a -> Bool
== NextKey
forall a. Bounded a => a
minBound
then (ReleaseMap
ReleaseMapClosed, [(NextKey, ReleaseType -> IO ())]
-> Maybe [(NextKey, ReleaseType -> IO ())]
forall a. a -> Maybe a
Just [(NextKey, ReleaseType -> IO ())]
m)
else (NextKey
-> NextKey -> [(NextKey, ReleaseType -> IO ())] -> ReleaseMap
ReleaseMap NextKey
nk NextKey
Difference NextKey
rf' [(NextKey, ReleaseType -> IO ())]
m, Maybe [(NextKey, ReleaseType -> IO ())]
forall a. Maybe a
Nothing)
ReleaseMap
ReleaseMapClosed -> String -> (ReleaseMap, Maybe [(NextKey, ReleaseType -> IO ())])
forall a. HasCallStack => String -> a
error String
"runResourceT: cleanup on ReleaseMapClosed"
case Maybe [(NextKey, ReleaseType -> IO ())]
mm of
Just [(NextKey, ReleaseType -> IO ())]
m -> ((NextKey, ReleaseType -> IO ()) -> IO ())
-> [(NextKey, ReleaseType -> IO ())] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(NextKey
_, ReleaseType -> IO ()
x) -> IO () -> IO ()
forall (m :: * -> *) a. MonadCatch m => m a -> m ()
ignoreExceptions (ReleaseType -> IO ()
x ReleaseType
rtype)) [(NextKey, ReleaseType -> IO ())]
m
Maybe [(NextKey, ReleaseType -> IO ())]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
ignoreExceptions :: m a -> m ()
ignoreExceptions m a
io = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
io m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
_ :: SomeException) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
allocate :: (MonadResource m, MonadIO n) => IO a -> (a -> IO b) -> m (a, n ())
allocate :: IO a -> (a -> IO b) -> m (a, n ())
allocate IO a
acquire a -> IO b
release = ResourceT IO (a, n ()) -> m (a, n ())
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT (ResourceT IO (a, n ()) -> m (a, n ()))
-> ResourceT IO (a, n ()) -> m (a, n ())
forall a b. (a -> b) -> a -> b
$ (PrimVar IO ReleaseMap -> IO (a, n ())) -> ResourceT IO (a, n ())
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT ((PrimVar IO ReleaseMap -> IO (a, n ())) -> ResourceT IO (a, n ()))
-> (PrimVar IO ReleaseMap -> IO (a, n ()))
-> ResourceT IO (a, n ())
forall a b. (a -> b) -> a -> b
$ \PrimVar IO ReleaseMap
istate -> IO (a, n ()) -> IO (a, n ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, n ()) -> IO (a, n ())) -> IO (a, n ()) -> IO (a, n ())
forall a b. (a -> b) -> a -> b
$ IO (a, n ()) -> IO (a, n ())
forall a. IO a -> IO a
mask_ (IO (a, n ()) -> IO (a, n ())) -> IO (a, n ()) -> IO (a, n ())
forall a b. (a -> b) -> a -> b
$ do
a
a <- IO a
acquire
NextKey
key <- IORef ReleaseMap
-> (ReleaseMap -> (ReleaseMap, NextKey)) -> IO NextKey
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ReleaseMap
PrimVar IO ReleaseMap
istate ((ReleaseMap -> (ReleaseMap, NextKey)) -> IO NextKey)
-> (ReleaseMap -> (ReleaseMap, NextKey)) -> IO NextKey
forall a b. (a -> b) -> a -> b
$ \ReleaseMap
rm ->
case ReleaseMap
rm of
ReleaseMap NextKey
key NextKey
rf [(NextKey, ReleaseType -> IO ())]
m ->
( NextKey
-> NextKey -> [(NextKey, ReleaseType -> IO ())] -> ReleaseMap
ReleaseMap (NextKey
key NextKey -> NextKey -> Difference NextKey
forall a. Subtractive a => a -> a -> Difference a
- NextKey
1) NextKey
rf ((NextKey
key, IO () -> ReleaseType -> IO ()
forall a b. a -> b -> a
const (IO () -> ReleaseType -> IO ()) -> IO () -> ReleaseType -> IO ()
forall a b. (a -> b) -> a -> b
$ IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> IO b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO b
release a
a) (NextKey, ReleaseType -> IO ())
-> [(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
forall a. a -> [a] -> [a]
: [(NextKey, ReleaseType -> IO ())]
m)
, NextKey
key
)
ReleaseMap
ReleaseMapClosed -> String -> (ReleaseMap, NextKey)
forall a. HasCallStack => String -> a
error String
"allocate: ReleaseMapClosed"
let release' :: IO ()
release' = IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef ReleaseMap
-> (ReleaseMap -> (ReleaseMap, IO ())) -> IO (IO ())
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ReleaseMap
PrimVar IO ReleaseMap
istate ((ReleaseMap -> (ReleaseMap, IO ())) -> IO (IO ()))
-> (ReleaseMap -> (ReleaseMap, IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \ReleaseMap
rm ->
case ReleaseMap
rm of
ReleaseMap NextKey
nextKey NextKey
rf [(NextKey, ReleaseType -> IO ())]
m ->
let loop :: ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())])
-> [(NextKey, ReleaseType -> IO ())] -> (ReleaseMap, IO ())
loop [(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
front [] = (NextKey
-> NextKey -> [(NextKey, ReleaseType -> IO ())] -> ReleaseMap
ReleaseMap NextKey
nextKey NextKey
rf ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
front []), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
loop [(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
front ((NextKey
key', ReleaseType -> IO ()
action):[(NextKey, ReleaseType -> IO ())]
rest)
| NextKey
key NextKey -> NextKey -> Bool
forall a. Eq a => a -> a -> Bool
== NextKey
key' =
( NextKey
-> NextKey -> [(NextKey, ReleaseType -> IO ())] -> ReleaseMap
ReleaseMap NextKey
nextKey NextKey
rf ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
front [(NextKey, ReleaseType -> IO ())]
rest)
, ReleaseType -> IO ()
action ReleaseType
ReleaseEarly
)
| Bool
otherwise = ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())])
-> [(NextKey, ReleaseType -> IO ())] -> (ReleaseMap, IO ())
loop ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
front ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())])
-> ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())])
-> [(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((NextKey
key', ReleaseType -> IO ()
action)(NextKey, ReleaseType -> IO ())
-> [(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
forall a. a -> [a] -> [a]
:)) [(NextKey, ReleaseType -> IO ())]
rest
in ([(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())])
-> [(NextKey, ReleaseType -> IO ())] -> (ReleaseMap, IO ())
loop [(NextKey, ReleaseType -> IO ())]
-> [(NextKey, ReleaseType -> IO ())]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id [(NextKey, ReleaseType -> IO ())]
m
ReleaseMap
ReleaseMapClosed -> String -> (ReleaseMap, IO ())
forall a. HasCallStack => String -> a
error String
"allocate: ReleaseMapClosed (2)"
(a, n ()) -> IO (a, n ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
release')
class MonadIO m => MonadResource m where
liftResourceT :: ResourceT IO a -> m a
instance MonadIO m => MonadResource (ResourceT m) where
liftResourceT :: ResourceT IO a -> ResourceT m a
liftResourceT (ResourceT PrimVar IO ReleaseMap -> IO a
f) = (PrimVar IO ReleaseMap -> m a) -> ResourceT m a
forall (m :: * -> *) a.
(PrimVar IO ReleaseMap -> m a) -> ResourceT m a
ResourceT (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a)
-> (IORef ReleaseMap -> IO a) -> IORef ReleaseMap -> m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IORef ReleaseMap -> IO a
PrimVar IO ReleaseMap -> IO a
f)
instance MonadResource m => MonadResource (Conduit i o m) where
liftResourceT :: ResourceT IO a -> Conduit i o m a
liftResourceT = m a -> Conduit i o m a
forall (trans :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans trans, Monad m) =>
m a -> trans m a
lift (m a -> Conduit i o m a)
-> (ResourceT IO a -> m a) -> ResourceT IO a -> Conduit i o m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ResourceT IO a -> m a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT