{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Simpoole.Monad.Class (MonadPool (..)) where
import Control.Monad.Catch.Pure (CatchT (..))
import qualified Control.Monad.Conc.Class as Conc
import Control.Monad.Identity (IdentityT (..))
import qualified Control.Monad.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.RWS.Strict as RWS
import qualified Control.Monad.Reader as Reader
import qualified Control.Monad.State.Lazy as State.Lazy
import qualified Control.Monad.State.Strict as State
import qualified Control.Monad.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Writer.Strict as Writer
import Data.Functor.Product (Product (..))
class MonadPool resource m where
withResource :: (resource -> m a) -> m a
instance MonadPool resource m => MonadPool resource (State.StateT s m) where
withResource :: (resource -> StateT s m a) -> StateT s m a
withResource resource -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
state ->
(resource -> m (a, s)) -> m (a, s)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (a, s)) -> m (a, s))
-> (resource -> m (a, s)) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ \resource
resource -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT (resource -> StateT s m a
f resource
resource) s
state
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (State.Lazy.StateT s m) where
withResource :: (resource -> StateT s m a) -> StateT s m a
withResource resource -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
state ->
(resource -> m (a, s)) -> m (a, s)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (a, s)) -> m (a, s))
-> (resource -> m (a, s)) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ \resource
resource -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.Lazy.runStateT (resource -> StateT s m a
f resource
resource) s
state
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (Writer.WriterT w m) where
withResource :: (resource -> WriterT w m a) -> WriterT w m a
withResource resource -> WriterT w m a
f = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Writer.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
(resource -> m (a, w)) -> m (a, w)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (a, w)) -> m (a, w))
-> (resource -> m (a, w)) -> m (a, w)
forall a b. (a -> b) -> a -> b
$ \resource
resource -> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Writer.runWriterT (WriterT w m a -> m (a, w)) -> WriterT w m a -> m (a, w)
forall a b. (a -> b) -> a -> b
$ resource -> WriterT w m a
f resource
resource
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (Writer.Lazy.WriterT w m) where
withResource :: (resource -> WriterT w m a) -> WriterT w m a
withResource resource -> WriterT w m a
f = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Writer.Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
(resource -> m (a, w)) -> m (a, w)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (a, w)) -> m (a, w))
-> (resource -> m (a, w)) -> m (a, w)
forall a b. (a -> b) -> a -> b
$ \resource
resource -> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Writer.Lazy.runWriterT (WriterT w m a -> m (a, w)) -> WriterT w m a -> m (a, w)
forall a b. (a -> b) -> a -> b
$ resource -> WriterT w m a
f resource
resource
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (Reader.ReaderT r m) where
withResource :: (resource -> ReaderT r m a) -> ReaderT r m a
withResource resource -> ReaderT r m a
f = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
state ->
(resource -> m a) -> m a
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m a) -> m a) -> (resource -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \resource
resource -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (resource -> ReaderT r m a
f resource
resource) r
state
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (RWS.RWST r s w m) where
withResource :: (resource -> RWST r s w m a) -> RWST r s w m a
withResource resource -> RWST r s w m a
f = (r -> w -> m (a, w, s)) -> RWST r s w m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.RWST ((r -> w -> m (a, w, s)) -> RWST r s w m a)
-> (r -> w -> m (a, w, s)) -> RWST r s w m a
forall a b. (a -> b) -> a -> b
$ \r
env w
state ->
(resource -> m (a, w, s)) -> m (a, w, s)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (a, w, s)) -> m (a, w, s))
-> (resource -> m (a, w, s)) -> m (a, w, s)
forall a b. (a -> b) -> a -> b
$ \resource
resource -> RWST r s w m a -> r -> w -> m (a, w, s)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWS.runRWST (resource -> RWST r s w m a
f resource
resource) r
env w
state
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (RWS.Lazy.RWST r s w m) where
withResource :: (resource -> RWST r s w m a) -> RWST r s w m a
withResource resource -> RWST r s w m a
f = (r -> w -> m (a, w, s)) -> RWST r s w m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.Lazy.RWST ((r -> w -> m (a, w, s)) -> RWST r s w m a)
-> (r -> w -> m (a, w, s)) -> RWST r s w m a
forall a b. (a -> b) -> a -> b
$ \r
env w
state ->
(resource -> m (a, w, s)) -> m (a, w, s)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (a, w, s)) -> m (a, w, s))
-> (resource -> m (a, w, s)) -> m (a, w, s)
forall a b. (a -> b) -> a -> b
$ \resource
resource -> RWST r s w m a -> r -> w -> m (a, w, s)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWS.Lazy.runRWST (resource -> RWST r s w m a
f resource
resource) r
env w
state
{-# INLINE withResource #-}
instance (MonadPool resource f, MonadPool resource g) => MonadPool resource (Product f g) where
withResource :: (resource -> Product f g a) -> Product f g a
withResource resource -> Product f g a
f =
f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((resource -> f a) -> f a
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource (Product f g a -> f a
forall (f :: * -> *) (g :: * -> *) a. Product f g a -> f a
getLeft (Product f g a -> f a)
-> (resource -> Product f g a) -> resource -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. resource -> Product f g a
f)) ((resource -> g a) -> g a
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource (Product f g a -> g a
forall (f :: * -> *) (g :: * -> *) a. Product f g a -> g a
getRight (Product f g a -> g a)
-> (resource -> Product f g a) -> resource -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. resource -> Product f g a
f))
where
getLeft :: Product f g a -> f a
getLeft (Pair f a
l g a
_) = f a
l
getRight :: Product f g a -> g a
getRight (Pair f a
_ g a
r) = g a
r
{-# INLINE withResource #-}
instance (MonadPool resource m, Conc.MonadConc m) => MonadPool resource (Conc.IsConc m) where
withResource :: (resource -> IsConc m a) -> IsConc m a
withResource resource -> IsConc m a
f = m a -> IsConc m a
forall (m :: * -> *) a. MonadConc m => m a -> IsConc m a
Conc.toIsConc (m a -> IsConc m a) -> m a -> IsConc m a
forall a b. (a -> b) -> a -> b
$ (resource -> m a) -> m a
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m a) -> m a) -> (resource -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ IsConc m a -> m a
forall (m :: * -> *) a. MonadConc m => IsConc m a -> m a
Conc.fromIsConc (IsConc m a -> m a) -> (resource -> IsConc m a) -> resource -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. resource -> IsConc m a
f
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (CatchT m) where
withResource :: (resource -> CatchT m a) -> CatchT m a
withResource resource -> CatchT m a
f = m (Either SomeException a) -> CatchT m a
forall (m :: * -> *) a. m (Either SomeException a) -> CatchT m a
CatchT (m (Either SomeException a) -> CatchT m a)
-> m (Either SomeException a) -> CatchT m a
forall a b. (a -> b) -> a -> b
$ (resource -> m (Either SomeException a))
-> m (Either SomeException a)
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m (Either SomeException a))
-> m (Either SomeException a))
-> (resource -> m (Either SomeException a))
-> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ CatchT m a -> m (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT m a -> m (Either SomeException a))
-> (resource -> CatchT m a)
-> resource
-> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. resource -> CatchT m a
f
{-# INLINE withResource #-}
instance MonadPool resource m => MonadPool resource (IdentityT m) where
withResource :: (resource -> IdentityT m a) -> IdentityT m a
withResource resource -> IdentityT m a
f = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ (resource -> m a) -> m a
forall resource (m :: * -> *) a.
MonadPool resource m =>
(resource -> m a) -> m a
withResource ((resource -> m a) -> m a) -> (resource -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT m a -> m a)
-> (resource -> IdentityT m a) -> resource -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. resource -> IdentityT m a
f
{-# INLINE withResource #-}