simpoole 0.3.0 → 0.4.0

raw patch · 5 files changed

+74/−13 lines, 5 files

Files

• ChangeLog.md +5/−0
• lib/Simpoole/Monad.hs +2/−1
• lib/Simpoole/Monad/Class.hs +40/−0
• lib/Simpoole/Monad/Internal.hs +26/−11
• simpoole.cabal +1/−1

@@ -1,5 +1,10 @@ # simpoole +## 0.4.0++* Expose pool metrics from PoolT+* Add MonadPool instances for Product, IsConc, CatchT and IdentityT+ ## 0.3.0  * Introduce Simpoole.Monad module

@@ -3,8 +3,9 @@   , PoolT   , runPoolT   , hoistPoolT+  , metricsPoolT   ) where  import Simpoole.Monad.Class (MonadPool (..))-import Simpoole.Monad.Internal (PoolT (..), hoistPoolT, runPoolT)+import Simpoole.Monad.Internal (PoolT (..), hoistPoolT, metricsPoolT, runPoolT)

@@ -3,6 +3,9 @@  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@@ -10,6 +13,7 @@ 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 (..))  -- | A pooled resource is available through @m@ --@@ -20,44 +24,80 @@   -- @since 0.3.0   withResource :: (resource -> m a) -> m a +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (State.StateT s m) where   withResource f = State.StateT $ \state ->     withResource $ \resource -> State.runStateT (f resource) state    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (State.Lazy.StateT s m) where   withResource f = State.Lazy.StateT $ \state ->     withResource $ \resource -> State.Lazy.runStateT (f resource) state    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (Writer.WriterT w m) where   withResource f = Writer.WriterT $     withResource $ \resource -> Writer.runWriterT $ f resource    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (Writer.Lazy.WriterT w m) where   withResource f = Writer.Lazy.WriterT $     withResource $ \resource -> Writer.Lazy.runWriterT $ f resource    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (Reader.ReaderT r m) where   withResource f = Reader.ReaderT $ \state ->     withResource $ \resource -> Reader.runReaderT (f resource) state    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (RWS.RWST r s w m) where   withResource f = RWS.RWST $ \env state ->     withResource $ \resource -> RWS.runRWST (f resource) env state    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadPool resource m => MonadPool resource (RWS.Lazy.RWST r s w m) where   withResource f = RWS.Lazy.RWST $ \env state ->     withResource $ \resource -> RWS.Lazy.runRWST (f resource) env state++  {-# INLINE withResource #-}++-- | @since 0.4.0+instance (MonadPool resource f, MonadPool resource g) => MonadPool resource (Product f g) where+  withResource f =+    Pair (withResource (getLeft . f)) (withResource (getRight . f))+    where+      getLeft (Pair l _) = l++      getRight (Pair _ r) = r++  {-# INLINE withResource #-}++-- | @since 0.4.0+instance (MonadPool resource m, Conc.MonadConc m) => MonadPool resource (Conc.IsConc m) where+  withResource f = Conc.toIsConc $ withResource $ Conc.fromIsConc . f++  {-# INLINE withResource #-}++-- | @since 0.4.0+instance MonadPool resource m => MonadPool resource (CatchT m) where+  withResource f = CatchT $ withResource $ runCatchT . f++  {-# INLINE withResource #-}++-- | @since 0.4.0+instance MonadPool resource m => MonadPool resource (IdentityT m) where+  withResource f = IdentityT $ withResource $ runIdentityT . f    {-# INLINE withResource #-}

@@ -15,6 +15,7 @@   , PoolT (..)   , runPoolT   , hoistPoolT+  , metricsPoolT   ) where @@ -28,6 +29,7 @@ import           Control.Monad.Trans (MonadTrans (..)) import           Control.Monad.Writer.Class (MonadWriter) import           Data.Proxy (Proxy (Proxy))+import           Numeric.Natural (Natural) import qualified Simpoole as Pool import           Simpoole.Monad.Class (MonadPool (..)) @@ -57,19 +59,20 @@ newtype PoolT resource m a = PoolT   { unPoolT :: Reader.ReaderT (PoolEnv m resource) m a }   deriving newtype-    ( Functor-    , Applicative-    , Monad-    , MonadFail-    , MonadIO-    , Catch.MonadThrow-    , Catch.MonadCatch-    , Catch.MonadMask-    , MonadState s-    , MonadError e-    , MonadWriter w+    ( Functor -- ^ @since 0.3.0+    , Applicative -- ^ @since 0.3.0+    , Monad -- ^ @since 0.3.0+    , MonadFail -- ^ @since 0.3.0+    , MonadIO -- ^ @since 0.3.0+    , Catch.MonadThrow -- ^ @since 0.3.0+    , Catch.MonadCatch -- ^ @since 0.3.0+    , Catch.MonadMask -- ^ @since 0.3.0+    , MonadState s -- ^ @since 0.3.0+    , MonadError e -- ^ @since 0.3.0+    , MonadWriter w -- ^ @since 0.3.0     ) +-- | @since 0.3.0 instance Catch.MonadMask m => MonadPool resource (PoolT resource m) where   withResource f = PoolT $ Reader.ReaderT $ \poolEnv ->     case poolEnv_resource poolEnv of@@ -82,11 +85,13 @@    {-# INLINE withResource #-} +-- | @since 0.3.0 instance MonadTrans (PoolT resource) where   lift = PoolT . Reader.ReaderT . const    {-# INLINE lift #-} +-- | @since 0.3.0 instance Reader.MonadReader r m => Reader.MonadReader r (PoolT resource m) where   ask = lift Reader.ask @@ -100,6 +105,7 @@    {-# INLINE reader #-} +-- | @since 0.3.0 instance Conc.MonadConc m => Conc.MonadConc (PoolT resource m) where   type STM (PoolT resource m) = Conc.STM m @@ -295,3 +301,12 @@   f (Reader.runReaderT (unPoolT action) env)  {-# INLINE hoistPoolT #-}++-- | Retrieve the internal pool metrics.+--+-- See 'Pool.poolMetrics'.+--+-- @since 0.4.0+metricsPoolT :: PoolT resource m (Pool.Metrics Natural)+metricsPoolT = PoolT $ Reader.ReaderT $ \env ->+  Pool.poolMetrics (poolEnv_pool env)

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               simpoole-version:            0.3.0+version:            0.4.0 category:           Data, Resources synopsis:           Simple pool description:        Provides a simple pool implementation.