module Streamly.Internal.Data.Fold.Exception
(
before
, bracketIO
, finallyIO
, onException
)
where
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Catch (MonadCatch)
import Streamly.Internal.Data.IOFinalizer (newIOFinalizer, runIOFinalizer)
import qualified Control.Monad.Catch as MC
import Streamly.Internal.Data.Fold.Step
import Streamly.Internal.Data.Fold.Type
{-# INLINE onException #-}
onException :: MonadCatch m => m x -> Fold m a b -> Fold m a b
onException :: forall (m :: * -> *) x a b.
MonadCatch m =>
m x -> Fold m a b -> Fold m a b
onException m x
action (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract s -> m b
final
where
initial :: m (Step s b)
initial = m (Step s b)
initial1 m (Step s b) -> m x -> m (Step s b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` m x
action
step :: s -> a -> m (Step s b)
step s
s a
a = s -> a -> m (Step s b)
step1 s
s a
a m (Step s b) -> m x -> m (Step s b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` m x
action
extract :: s -> m b
extract s
s = s -> m b
extract1 s
s m b -> m x -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` m x
action
final :: s -> m b
final s
s = s -> m b
final1 s
s m b -> m x -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` m x
action
{-# INLINE bracketIO #-}
bracketIO :: (MonadIO m, MonadCatch m)
=> IO x -> (x -> IO c) -> (x -> Fold m a b) -> Fold m a b
bracketIO :: forall (m :: * -> *) x c a b.
(MonadIO m, MonadCatch m) =>
IO x -> (x -> IO c) -> (x -> Fold m a b) -> Fold m a b
bracketIO IO x
bef x -> IO c
aft x -> Fold m a b
bet = (Tuple' IOFinalizer (Fold m a b)
-> a -> m (Step (Tuple' IOFinalizer (Fold m a b)) b))
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
-> (Tuple' IOFinalizer (Fold m a b) -> m b)
-> (Tuple' IOFinalizer (Fold m a b) -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple' IOFinalizer (Fold m a b)
-> a -> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall {m :: * -> *} {a} {b}.
(MonadCatch m, MonadIO m) =>
Tuple' IOFinalizer (Fold m a b)
-> a -> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
step m (Step (Tuple' IOFinalizer (Fold m a b)) b)
initial Tuple' IOFinalizer (Fold m a b) -> m b
forall {m :: * -> *} {a} {b}.
(MonadCatch m, MonadIO m) =>
Tuple' IOFinalizer (Fold m a b) -> m b
extract Tuple' IOFinalizer (Fold m a b) -> m b
forall {m :: * -> *} {a} {b}.
(MonadCatch m, MonadIO m) =>
Tuple' IOFinalizer (Fold m a b) -> m b
final
where
initial :: m (Step (Tuple' IOFinalizer (Fold m a b)) b)
initial = do
x
r <- IO x -> m x
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO x
bef
IOFinalizer
ref <- IO IOFinalizer -> m IOFinalizer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOFinalizer -> m IOFinalizer)
-> IO IOFinalizer -> m IOFinalizer
forall a b. (a -> b) -> a -> b
$ IO c -> IO IOFinalizer
forall (m :: * -> *) a. MonadIO m => IO a -> m IOFinalizer
newIOFinalizer (x -> IO c
aft x
r)
case x -> Fold m a b
bet x
r of
Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1 -> do
Step s b
res <- m (Step s b)
initial1 m (Step s b) -> m () -> m (Step s b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
case Step s b
res of
Partial s
s -> do
let fld1 :: Fold m a b
fld1 = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Step s b
forall s b. s -> Step s b
Partial s
s)) s -> m b
extract1 s -> m b
final1
Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b))
-> Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a b. (a -> b) -> a -> b
$ Tuple' IOFinalizer (Fold m a b)
-> Step (Tuple' IOFinalizer (Fold m a b)) b
forall s b. s -> Step s b
Partial (Tuple' IOFinalizer (Fold m a b)
-> Step (Tuple' IOFinalizer (Fold m a b)) b)
-> Tuple' IOFinalizer (Fold m a b)
-> Step (Tuple' IOFinalizer (Fold m a b)) b
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> Fold m a b -> Tuple' IOFinalizer (Fold m a b)
forall a b. a -> b -> Tuple' a b
Tuple' IOFinalizer
ref Fold m a b
fld1
Done b
b -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b))
-> Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (Tuple' IOFinalizer (Fold m a b)) b
forall s b. b -> Step s b
Done b
b
step :: Tuple' IOFinalizer (Fold m a b)
-> a -> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
step (Tuple' IOFinalizer
ref (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1)) a
a = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
Step s b
s1 <- s -> a -> m (Step s b)
step1 s
s a
a m (Step s b) -> m () -> m (Step s b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
let fld1 :: Fold m a b
fld1 = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step s b
s1) s -> m b
extract1 s -> m b
final1
Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b))
-> Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a b. (a -> b) -> a -> b
$ Tuple' IOFinalizer (Fold m a b)
-> Step (Tuple' IOFinalizer (Fold m a b)) b
forall s b. s -> Step s b
Partial (Tuple' IOFinalizer (Fold m a b)
-> Step (Tuple' IOFinalizer (Fold m a b)) b)
-> Tuple' IOFinalizer (Fold m a b)
-> Step (Tuple' IOFinalizer (Fold m a b)) b
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> Fold m a b -> Tuple' IOFinalizer (Fold m a b)
forall a b. a -> b -> Tuple' a b
Tuple' IOFinalizer
ref Fold m a b
fld1
Done b
b -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b))
-> Step (Tuple' IOFinalizer (Fold m a b)) b
-> m (Step (Tuple' IOFinalizer (Fold m a b)) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (Tuple' IOFinalizer (Fold m a b)) b
forall s b. b -> Step s b
Done b
b
extract :: Tuple' IOFinalizer (Fold m a b) -> m b
extract (Tuple' IOFinalizer
ref (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial1 s -> m b
extract1 s -> m b
_)) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> s -> m b
extract1 s
s m b -> m () -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
Done b
b -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
final :: Tuple' IOFinalizer (Fold m a b) -> m b
final (Tuple' IOFinalizer
ref (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial1 s -> m b
_ s -> m b
final1)) = do
Step s b
res <- m (Step s b)
initial1
case Step s b
res of
Partial s
s -> do
b
val <- s -> m b
final1 s
s m b -> m () -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
IOFinalizer -> m ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
val
Done b
b -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
{-# INLINE finallyIO #-}
finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Fold m a b -> Fold m a b
finallyIO :: forall (m :: * -> *) b a.
(MonadIO m, MonadCatch m) =>
IO b -> Fold m a b -> Fold m a b
finallyIO IO b
aft (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(Tuple' IOFinalizer s -> a -> m (Step (Tuple' IOFinalizer s) b))
-> m (Step (Tuple' IOFinalizer s) b)
-> (Tuple' IOFinalizer s -> m b)
-> (Tuple' IOFinalizer s -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple' IOFinalizer s -> a -> m (Step (Tuple' IOFinalizer s) b)
step m (Step (Tuple' IOFinalizer s) b)
initial Tuple' IOFinalizer s -> m b
extract Tuple' IOFinalizer s -> m b
final
where
initial :: m (Step (Tuple' IOFinalizer s) b)
initial = do
IOFinalizer
ref <- IO IOFinalizer -> m IOFinalizer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IOFinalizer -> m IOFinalizer)
-> IO IOFinalizer -> m IOFinalizer
forall a b. (a -> b) -> a -> b
$ IO b -> IO IOFinalizer
forall (m :: * -> *) a. MonadIO m => IO a -> m IOFinalizer
newIOFinalizer IO b
aft
Step s b
res <- m (Step s b)
initial1 m (Step s b) -> m () -> m (Step s b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
Step (Tuple' IOFinalizer s) b -> m (Step (Tuple' IOFinalizer s) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (Tuple' IOFinalizer s) b
-> m (Step (Tuple' IOFinalizer s) b))
-> Step (Tuple' IOFinalizer s) b
-> m (Step (Tuple' IOFinalizer s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
Done b
b -> b -> Step (Tuple' IOFinalizer s) b
forall s b. b -> Step s b
Done b
b
Partial s
s -> Tuple' IOFinalizer s -> Step (Tuple' IOFinalizer s) b
forall s b. s -> Step s b
Partial (Tuple' IOFinalizer s -> Step (Tuple' IOFinalizer s) b)
-> Tuple' IOFinalizer s -> Step (Tuple' IOFinalizer s) b
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> s -> Tuple' IOFinalizer s
forall a b. a -> b -> Tuple' a b
Tuple' IOFinalizer
ref s
s
step :: Tuple' IOFinalizer s -> a -> m (Step (Tuple' IOFinalizer s) b)
step (Tuple' IOFinalizer
ref s
s) a
a = do
Step s b
res <- s -> a -> m (Step s b)
step1 s
s a
a m (Step s b) -> m () -> m (Step s b)
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
Step (Tuple' IOFinalizer s) b -> m (Step (Tuple' IOFinalizer s) b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (Tuple' IOFinalizer s) b
-> m (Step (Tuple' IOFinalizer s) b))
-> Step (Tuple' IOFinalizer s) b
-> m (Step (Tuple' IOFinalizer s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
Done b
b -> b -> Step (Tuple' IOFinalizer s) b
forall s b. b -> Step s b
Done b
b
Partial s
s1 -> Tuple' IOFinalizer s -> Step (Tuple' IOFinalizer s) b
forall s b. s -> Step s b
Partial (Tuple' IOFinalizer s -> Step (Tuple' IOFinalizer s) b)
-> Tuple' IOFinalizer s -> Step (Tuple' IOFinalizer s) b
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> s -> Tuple' IOFinalizer s
forall a b. a -> b -> Tuple' a b
Tuple' IOFinalizer
ref s
s1
extract :: Tuple' IOFinalizer s -> m b
extract (Tuple' IOFinalizer
ref s
s) =
s -> m b
extract1 s
s m b -> m () -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
final :: Tuple' IOFinalizer s -> m b
final (Tuple' IOFinalizer
ref s
s) = do
b
res <- s -> m b
final1 s
s m b -> m () -> m b
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref)
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
res
{-# INLINE before #-}
before :: Monad m => m x -> Fold m a b -> Fold m a b
before :: forall (m :: * -> *) x a b.
Monad m =>
m x -> Fold m a b -> Fold m a b
before m x
effect (Fold s -> a -> m (Step s b)
s m (Step s b)
i s -> m b
e s -> m b
f) = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
s (m x
effect m x -> m (Step s b) -> m (Step s b)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Step s b)
i) s -> m b
e s -> m b
f