{-# LANGUAGE RankNTypes #-}
module Notmuch.Util where
import Control.Exception (bracket)
import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, asks)
import Data.Foldable (traverse_)
import Data.Functor.Identity (Identity(..))
import Data.Profunctor (Choice)
import Data.Profunctor.Unsafe ((#.), (.#))
import Data.Tagged (Tagged(..))
type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type Prism' s a = Prism s s a a
type Lens' a b = forall f. Functor f => (b -> f b) -> (a -> f a)
review :: MonadReader b m => Prism' t b -> m t
review :: forall b (m :: * -> *) t. MonadReader b m => Prism' t b -> m t
review Prism' t b
p = (b -> t) -> m t
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t)
-> (Tagged b (Identity b) -> Identity t)
-> Tagged b (Identity b)
-> t
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Tagged t (Identity t) -> Identity t
forall {k} (s :: k) b. Tagged s b -> b
unTagged (Tagged t (Identity t) -> Identity t)
-> (Tagged b (Identity b) -> Tagged t (Identity t))
-> Tagged b (Identity b)
-> Identity t
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Tagged b (Identity b) -> Tagged t (Identity t)
Prism' t b
p (Tagged b (Identity b) -> t)
-> (Identity b -> Tagged b (Identity b)) -> Identity b -> t
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Identity b -> Tagged b (Identity b)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Identity b -> t) -> (b -> Identity b) -> b -> t
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# b -> Identity b
forall a. a -> Identity a
Identity)
{-# INLINE review #-}
bracketT
:: (MonadError e m, MonadIO m)
=> ExceptT e IO a
-> (a -> ExceptT e IO b)
-> (a -> ExceptT e IO c)
-> m c
bracketT :: forall e (m :: * -> *) a b c.
(MonadError e m, MonadIO m) =>
ExceptT e IO a
-> (a -> ExceptT e IO b) -> (a -> ExceptT e IO c) -> m c
bracketT ExceptT e IO a
acq a -> ExceptT e IO b
rel a -> ExceptT e IO c
go = IO (Either e c) -> m (Either e c)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (
IO (Either e a)
-> (Either e a -> IO (Either e ()))
-> (Either e a -> IO (Either e c))
-> IO (Either e c)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(ExceptT e IO a -> IO (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e IO a
acq)
(ExceptT e IO () -> IO (Either e ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e IO () -> IO (Either e ()))
-> (Either e a -> ExceptT e IO ())
-> Either e a
-> IO (Either e ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ExceptT e IO b) -> Either e a -> ExceptT e IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ a -> ExceptT e IO b
rel)
(ExceptT e IO c -> IO (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e IO c -> IO (Either e c))
-> (Either e a -> ExceptT e IO c) -> Either e a -> IO (Either e c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> ExceptT e IO c)
-> (a -> ExceptT e IO c) -> Either e a -> ExceptT e IO c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> ExceptT e IO c
forall a. e -> ExceptT e IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> ExceptT e IO c
go)
) m (Either e c) -> (Either e c -> m c) -> m c
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (e -> m c) -> (c -> m c) -> Either e c -> m c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m c
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError c -> m c
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure