{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_HADDOCK hide #-}

module Simpoole.Monad.Internal
  ( PoolEnv (..)
  , PoolT (..)
  , runPoolT
  , hoistPoolT
  , metricsPoolT
  )
where

import qualified Control.Monad.Catch as Catch
import qualified Control.Monad.Conc.Class as Conc
import           Control.Monad.Error.Class (MonadError)
import           Control.Monad.IO.Class (MonadIO)
import qualified Control.Monad.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.Reader as Reader
import           Control.Monad.State.Class (MonadState)
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 (..))

data PoolEnv m resource = PoolEnv
  { PoolEnv m resource -> Maybe resource
poolEnv_resource :: Maybe resource
  , PoolEnv m resource -> Pool m resource
poolEnv_pool :: Pool.Pool m resource
  }

-- | Monad transformer for operations on pools
--
-- This transformer can help you if you have problems with re-entrance (e.g. nested
-- 'Pool.withResource' calls).
--
-- > withResource $ \x -> withResource $ \y -> ...
--
-- In the above example @x@ and @y@ are the same resource.
--
-- Note, this does not apply when spawning new threads in the outer 'withResource' scope using
-- 'Conc.MonadConc'.
--
-- > withResource $ \x -> async $ withResource $ \y -> ...
--
-- In the special case above, @x@ and @y@ are not the same resource because the closure given to
-- 'async' does not inherit the associated resource from the outer 'withResource' closure.
--
-- @since 0.3.0
newtype PoolT resource m a = PoolT
  { PoolT resource m a -> ReaderT (PoolEnv m resource) m a
unPoolT :: Reader.ReaderT (PoolEnv m resource) m a }
  deriving newtype
    ( 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 :: (resource -> PoolT resource m a) -> PoolT resource m a
withResource resource -> PoolT resource m a
f = ReaderT (PoolEnv m resource) m a -> PoolT resource m a
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m a -> PoolT resource m a)
-> ReaderT (PoolEnv m resource) m a -> PoolT resource m a
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m a) -> ReaderT (PoolEnv m resource) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m a) -> ReaderT (PoolEnv m resource) m a)
-> (PoolEnv m resource -> m a) -> ReaderT (PoolEnv m resource) m a
forall a b. (a -> b) -> a -> b
$ \PoolEnv m resource
poolEnv ->
    case PoolEnv m resource -> Maybe resource
forall (m :: * -> *) resource. PoolEnv m resource -> Maybe resource
poolEnv_resource PoolEnv m resource
poolEnv of
      Maybe resource
Nothing ->
        Pool m resource -> (resource -> m a) -> m a
forall (m :: * -> *) a r.
MonadMask m =>
Pool m a -> (a -> m r) -> m r
Pool.withResource (PoolEnv m resource -> Pool m resource
forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool PoolEnv m resource
poolEnv) ((resource -> m a) -> m a) -> (resource -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \resource
resource ->
          ReaderT (PoolEnv m resource) m a -> PoolEnv m resource -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (PoolT resource m a -> ReaderT (PoolEnv m resource) m a
forall resource (m :: * -> *) a.
PoolT resource m a -> ReaderT (PoolEnv m resource) m a
unPoolT (resource -> PoolT resource m a
f resource
resource)) PoolEnv m resource
poolEnv { poolEnv_resource :: Maybe resource
poolEnv_resource = resource -> Maybe resource
forall a. a -> Maybe a
Just resource
resource }

      Just resource
resource ->
        ReaderT (PoolEnv m resource) m a -> PoolEnv m resource -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (PoolT resource m a -> ReaderT (PoolEnv m resource) m a
forall resource (m :: * -> *) a.
PoolT resource m a -> ReaderT (PoolEnv m resource) m a
unPoolT (resource -> PoolT resource m a
f resource
resource)) PoolEnv m resource
poolEnv

  {-# INLINE withResource #-}

-- | @since 0.3.0
instance MonadTrans (PoolT resource) where
  lift :: m a -> PoolT resource m a
lift = ReaderT (PoolEnv m resource) m a -> PoolT resource m a
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m a -> PoolT resource m a)
-> (m a -> ReaderT (PoolEnv m resource) m a)
-> m a
-> PoolT resource m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolEnv m resource -> m a) -> ReaderT (PoolEnv m resource) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m a) -> ReaderT (PoolEnv m resource) m a)
-> (m a -> PoolEnv m resource -> m a)
-> m a
-> ReaderT (PoolEnv m resource) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> PoolEnv m resource -> m a
forall a b. a -> b -> a
const

  {-# INLINE lift #-}

-- | @since 0.3.0
instance Reader.MonadReader r m => Reader.MonadReader r (PoolT resource m) where
  ask :: PoolT resource m r
ask = m r -> PoolT resource m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
Reader.ask

  {-# INLINE ask #-}

  local :: (r -> r) -> PoolT resource m a -> PoolT resource m a
local r -> r
f (PoolT ReaderT (PoolEnv m resource) m a
inner) = ReaderT (PoolEnv m resource) m a -> PoolT resource m a
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT ((m a -> m a)
-> ReaderT (PoolEnv m resource) m a
-> ReaderT (PoolEnv m resource) m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
Reader.mapReaderT ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
Reader.local r -> r
f) ReaderT (PoolEnv m resource) m a
inner)

  {-# INLINE local #-}

  reader :: (r -> a) -> PoolT resource m a
reader r -> a
f = m a -> PoolT resource m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
Reader.reader r -> a
f)

  {-# INLINE reader #-}

-- | @since 0.3.0
instance Conc.MonadConc m => Conc.MonadConc (PoolT resource m) where
  type STM (PoolT resource m) = Conc.STM m

  type MVar (PoolT resource m) = Conc.MVar m

  type IORef (PoolT resource m) = Conc.IORef m

  type Ticket (PoolT resource m) = Conc.Ticket m

  type ThreadId (PoolT resource m) = Conc.ThreadId m

  forkWithUnmask :: ((forall a. PoolT resource m a -> PoolT resource m a)
 -> PoolT resource m ())
-> PoolT resource m (ThreadId (PoolT resource m))
forkWithUnmask (forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f = ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (ThreadId m)
 -> PoolT resource m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (ThreadId m))
 -> ReaderT (PoolEnv m resource) m (ThreadId m))
-> (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \PoolEnv {Pool m resource
poolEnv_pool :: Pool m resource
poolEnv_pool :: forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool} ->
    ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
Conc.forkWithUnmask (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      Pool m resource -> PoolT resource m () -> m ()
forall (m :: * -> *) resource a.
Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
poolEnv_pool ((forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f ((m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall a. m a -> m a
unmask))

  {-# INLINE forkWithUnmask #-}

  forkWithUnmaskN :: String
-> ((forall a. PoolT resource m a -> PoolT resource m a)
    -> PoolT resource m ())
-> PoolT resource m (ThreadId (PoolT resource m))
forkWithUnmaskN String
name (forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f = ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (ThreadId m)
 -> PoolT resource m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (ThreadId m))
 -> ReaderT (PoolEnv m resource) m (ThreadId m))
-> (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \PoolEnv {Pool m resource
poolEnv_pool :: Pool m resource
poolEnv_pool :: forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool} ->
    String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
Conc.forkWithUnmaskN String
name (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      Pool m resource -> PoolT resource m () -> m ()
forall (m :: * -> *) resource a.
Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
poolEnv_pool ((forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f ((m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall a. m a -> m a
unmask))

  {-# INLINE forkWithUnmaskN #-}

  forkOnWithUnmask :: Int
-> ((forall a. PoolT resource m a -> PoolT resource m a)
    -> PoolT resource m ())
-> PoolT resource m (ThreadId (PoolT resource m))
forkOnWithUnmask Int
num (forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f = ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (ThreadId m)
 -> PoolT resource m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (ThreadId m))
 -> ReaderT (PoolEnv m resource) m (ThreadId m))
-> (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \PoolEnv {Pool m resource
poolEnv_pool :: Pool m resource
poolEnv_pool :: forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool} ->
    Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
Conc.forkOnWithUnmask Int
num (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      Pool m resource -> PoolT resource m () -> m ()
forall (m :: * -> *) resource a.
Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
poolEnv_pool ((forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f ((m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall a. m a -> m a
unmask))

  {-# INLINE forkOnWithUnmask #-}

  forkOnWithUnmaskN :: String
-> Int
-> ((forall a. PoolT resource m a -> PoolT resource m a)
    -> PoolT resource m ())
-> PoolT resource m (ThreadId (PoolT resource m))
forkOnWithUnmaskN String
name Int
num (forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f = ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (ThreadId m)
 -> PoolT resource m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (ThreadId m))
 -> ReaderT (PoolEnv m resource) m (ThreadId m))
-> (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \PoolEnv {Pool m resource
poolEnv_pool :: Pool m resource
poolEnv_pool :: forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool} ->
    String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
String -> Int -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
Conc.forkOnWithUnmaskN String
name Int
num (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      Pool m resource -> PoolT resource m () -> m ()
forall (m :: * -> *) resource a.
Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
poolEnv_pool ((forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f ((m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall a. m a -> m a
unmask))

  {-# INLINE forkOnWithUnmaskN #-}

  forkOSWithUnmask :: ((forall a. PoolT resource m a -> PoolT resource m a)
 -> PoolT resource m ())
-> PoolT resource m (ThreadId (PoolT resource m))
forkOSWithUnmask (forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f = ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (ThreadId m)
 -> PoolT resource m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (ThreadId m))
 -> ReaderT (PoolEnv m resource) m (ThreadId m))
-> (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \PoolEnv {Pool m resource
poolEnv_pool :: Pool m resource
poolEnv_pool :: forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool} ->
    ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
Conc.forkOSWithUnmask (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      Pool m resource -> PoolT resource m () -> m ()
forall (m :: * -> *) resource a.
Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
poolEnv_pool ((forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f ((m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall a. m a -> m a
unmask))

  {-# INLINE forkOSWithUnmask #-}

  forkOSWithUnmaskN :: String
-> ((forall a. PoolT resource m a -> PoolT resource m a)
    -> PoolT resource m ())
-> PoolT resource m (ThreadId (PoolT resource m))
forkOSWithUnmaskN String
name (forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f = ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (ThreadId m)
 -> PoolT resource m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
-> PoolT resource m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (ThreadId m))
 -> ReaderT (PoolEnv m resource) m (ThreadId m))
-> (PoolEnv m resource -> m (ThreadId m))
-> ReaderT (PoolEnv m resource) m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \PoolEnv {Pool m resource
poolEnv_pool :: Pool m resource
poolEnv_pool :: forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool} ->
    String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall (m :: * -> *).
MonadConc m =>
String -> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
Conc.forkOSWithUnmaskN String
name (((forall a. m a -> m a) -> m ()) -> m (ThreadId m))
-> ((forall a. m a -> m a) -> m ()) -> m (ThreadId m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
      Pool m resource -> PoolT resource m () -> m ()
forall (m :: * -> *) resource a.
Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
poolEnv_pool ((forall a. PoolT resource m a -> PoolT resource m a)
-> PoolT resource m ()
f ((m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall a. m a -> m a
unmask))

  {-# INLINE forkOSWithUnmaskN #-}

  supportsBoundThreads :: PoolT resource m Bool
supportsBoundThreads = m Bool -> PoolT resource m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadConc m => m Bool
Conc.supportsBoundThreads

  {-# INLINE supportsBoundThreads #-}

  isCurrentThreadBound :: PoolT resource m Bool
isCurrentThreadBound = m Bool -> PoolT resource m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
forall (m :: * -> *). MonadConc m => m Bool
Conc.isCurrentThreadBound

  {-# INLINE isCurrentThreadBound #-}

  getNumCapabilities :: PoolT resource m Int
getNumCapabilities = m Int -> PoolT resource m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). MonadConc m => m Int
Conc.getNumCapabilities

  {-# INLINE getNumCapabilities #-}

  setNumCapabilities :: Int -> PoolT resource m ()
setNumCapabilities Int
x = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> m ()
forall (m :: * -> *). MonadConc m => Int -> m ()
Conc.setNumCapabilities Int
x)

  {-# INLINE setNumCapabilities #-}

  myThreadId :: PoolT resource m (ThreadId (PoolT resource m))
myThreadId = m (ThreadId m) -> PoolT resource m (ThreadId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (ThreadId m)
forall (m :: * -> *). MonadConc m => m (ThreadId m)
Conc.myThreadId

  {-# INLINE myThreadId #-}

  yield :: PoolT resource m ()
yield = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadConc m => m ()
Conc.yield

  {-# INLINE yield #-}

  threadDelay :: Int -> PoolT resource m ()
threadDelay Int
x = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> m ()
forall (m :: * -> *). MonadConc m => Int -> m ()
Conc.threadDelay Int
x)

  {-# INLINE threadDelay #-}

  newEmptyMVar :: PoolT resource m (MVar (PoolT resource m) a)
newEmptyMVar = m (MVar m a) -> PoolT resource m (MVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (MVar m a)
forall (m :: * -> *) a. MonadConc m => m (MVar m a)
Conc.newEmptyMVar

  {-# INLINE newEmptyMVar #-}

  newEmptyMVarN :: String -> PoolT resource m (MVar (PoolT resource m) a)
newEmptyMVarN String
x = m (MVar m a) -> PoolT resource m (MVar m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m (MVar m a)
forall (m :: * -> *) a. MonadConc m => String -> m (MVar m a)
Conc.newEmptyMVarN String
x)

  {-# INLINE newEmptyMVarN #-}

  putMVar :: MVar (PoolT resource m) a -> a -> PoolT resource m ()
putMVar MVar (PoolT resource m) a
x a
y = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m ()
Conc.putMVar MVar m a
MVar (PoolT resource m) a
x a
y)

  {-# INLINE putMVar #-}

  tryPutMVar :: MVar (PoolT resource m) a -> a -> PoolT resource m Bool
tryPutMVar MVar (PoolT resource m) a
x a
y = m Bool -> PoolT resource m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar m a -> a -> m Bool
forall (m :: * -> *) a. MonadConc m => MVar m a -> a -> m Bool
Conc.tryPutMVar MVar m a
MVar (PoolT resource m) a
x a
y)

  {-# INLINE tryPutMVar #-}

  readMVar :: MVar (PoolT resource m) a -> PoolT resource m a
readMVar MVar (PoolT resource m) a
x = m a -> PoolT resource m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
Conc.readMVar MVar m a
MVar (PoolT resource m) a
x)

  {-# INLINE readMVar #-}

  tryReadMVar :: MVar (PoolT resource m) a -> PoolT resource m (Maybe a)
tryReadMVar MVar (PoolT resource m) a
x = m (Maybe a) -> PoolT resource m (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
Conc.tryReadMVar MVar m a
MVar (PoolT resource m) a
x)

  {-# INLINE tryReadMVar #-}

  takeMVar :: MVar (PoolT resource m) a -> PoolT resource m a
takeMVar MVar (PoolT resource m) a
x = m a -> PoolT resource m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar m a -> m a
forall (m :: * -> *) a. MonadConc m => MVar m a -> m a
Conc.takeMVar MVar m a
MVar (PoolT resource m) a
x)

  {-# INLINE takeMVar #-}

  tryTakeMVar :: MVar (PoolT resource m) a -> PoolT resource m (Maybe a)
tryTakeMVar MVar (PoolT resource m) a
x = m (Maybe a) -> PoolT resource m (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MVar m a -> m (Maybe a)
forall (m :: * -> *) a. MonadConc m => MVar m a -> m (Maybe a)
Conc.tryTakeMVar MVar m a
MVar (PoolT resource m) a
x)

  {-# INLINE tryTakeMVar #-}

  newIORef :: a -> PoolT resource m (IORef (PoolT resource m) a)
newIORef a
x = m (IORef m a) -> PoolT resource m (IORef m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m (IORef m a)
forall (m :: * -> *) a. MonadConc m => a -> m (IORef m a)
Conc.newIORef a
x)

  {-# INLINE newIORef #-}

  newIORefN :: String -> a -> PoolT resource m (IORef (PoolT resource m) a)
newIORefN String
x a
y = m (IORef m a) -> PoolT resource m (IORef m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> a -> m (IORef m a)
forall (m :: * -> *) a. MonadConc m => String -> a -> m (IORef m a)
Conc.newIORefN String
x a
y)

  {-# INLINE newIORefN #-}

  readIORef :: IORef (PoolT resource m) a -> PoolT resource m a
readIORef IORef (PoolT resource m) a
x = m a -> PoolT resource m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> m a
forall (m :: * -> *) a. MonadConc m => IORef m a -> m a
Conc.readIORef IORef m a
IORef (PoolT resource m) a
x)

  {-# INLINE readIORef #-}

  atomicModifyIORef :: IORef (PoolT resource m) a -> (a -> (a, b)) -> PoolT resource m b
atomicModifyIORef IORef (PoolT resource m) a
x a -> (a, b)
y = m b -> PoolT resource m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
Conc.atomicModifyIORef IORef m a
IORef (PoolT resource m) a
x a -> (a, b)
y)

  {-# INLINE atomicModifyIORef #-}

  writeIORef :: IORef (PoolT resource m) a -> a -> PoolT resource m ()
writeIORef IORef (PoolT resource m) a
x a
y = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => IORef m a -> a -> m ()
Conc.writeIORef IORef m a
IORef (PoolT resource m) a
x a
y)

  {-# INLINE writeIORef #-}

  atomicWriteIORef :: IORef (PoolT resource m) a -> a -> PoolT resource m ()
atomicWriteIORef IORef (PoolT resource m) a
x a
y = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> a -> m ()
forall (m :: * -> *) a. MonadConc m => IORef m a -> a -> m ()
Conc.atomicWriteIORef IORef m a
IORef (PoolT resource m) a
x a
y)

  {-# INLINE atomicWriteIORef #-}

  readForCAS :: IORef (PoolT resource m) a
-> PoolT resource m (Ticket (PoolT resource m) a)
readForCAS IORef (PoolT resource m) a
x = m (Ticket m a) -> PoolT resource m (Ticket m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> m (Ticket m a)
forall (m :: * -> *) a. MonadConc m => IORef m a -> m (Ticket m a)
Conc.readForCAS IORef m a
IORef (PoolT resource m) a
x)

  {-# INLINE readForCAS #-}

  peekTicket' :: Proxy (PoolT resource m) -> Ticket (PoolT resource m) a -> a
peekTicket' Proxy (PoolT resource m)
_ = Proxy m -> Ticket m a -> a
forall (m :: * -> *) a. MonadConc m => Proxy m -> Ticket m a -> a
Conc.peekTicket' @m Proxy m
forall k (t :: k). Proxy t
Proxy

  {-# INLINE peekTicket' #-}

  casIORef :: IORef (PoolT resource m) a
-> Ticket (PoolT resource m) a
-> a
-> PoolT resource m (Bool, Ticket (PoolT resource m) a)
casIORef IORef (PoolT resource m) a
x Ticket (PoolT resource m) a
y a
z = m (Bool, Ticket m a) -> PoolT resource m (Bool, Ticket m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> Ticket m a -> a -> m (Bool, Ticket m a)
Conc.casIORef IORef m a
IORef (PoolT resource m) a
x Ticket m a
Ticket (PoolT resource m) a
y a
z)

  {-# INLINE casIORef #-}

  modifyIORefCAS :: IORef (PoolT resource m) a -> (a -> (a, b)) -> PoolT resource m b
modifyIORefCAS IORef (PoolT resource m) a
x a -> (a, b)
y = m b -> PoolT resource m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadConc m =>
IORef m a -> (a -> (a, b)) -> m b
Conc.modifyIORefCAS IORef m a
IORef (PoolT resource m) a
x a -> (a, b)
y)

  {-# INLINE modifyIORefCAS #-}

  modifyIORefCAS_ :: IORef (PoolT resource m) a -> (a -> a) -> PoolT resource m ()
modifyIORefCAS_ IORef (PoolT resource m) a
x a -> a
y = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef m a -> (a -> a) -> m ()
forall (m :: * -> *) a.
MonadConc m =>
IORef m a -> (a -> a) -> m ()
Conc.modifyIORefCAS_ IORef m a
IORef (PoolT resource m) a
x a -> a
y)

  {-# INLINE modifyIORefCAS_ #-}

  atomically :: STM (PoolT resource m) a -> PoolT resource m a
atomically STM (PoolT resource m) a
x = m a -> PoolT resource m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM m a -> m a
forall (m :: * -> *) a. MonadConc m => STM m a -> m a
Conc.atomically STM m a
STM (PoolT resource m) a
x)

  {-# INLINE atomically #-}

  newTVarConc :: a -> PoolT resource m (TVar (STM (PoolT resource m)) a)
newTVarConc a
x = m (TVar (STM m) a) -> PoolT resource m (TVar (STM m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m (TVar (STM m) a)
forall (m :: * -> *) a. MonadConc m => a -> m (TVar (STM m) a)
Conc.newTVarConc a
x)

  {-# INLINE newTVarConc #-}

  readTVarConc :: TVar (STM (PoolT resource m)) a -> PoolT resource m a
readTVarConc TVar (STM (PoolT resource m)) a
x = m a -> PoolT resource m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TVar (STM m) a -> m a
forall (m :: * -> *) a. MonadConc m => TVar (STM m) a -> m a
Conc.readTVarConc TVar (STM m) a
TVar (STM (PoolT resource m)) a
x)

  {-# INLINE readTVarConc #-}

  throwTo :: ThreadId (PoolT resource m) -> e -> PoolT resource m ()
throwTo ThreadId (PoolT resource m)
x e
y = m () -> PoolT resource m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ThreadId m -> e -> m ()
forall (m :: * -> *) e.
(MonadConc m, Exception e) =>
ThreadId m -> e -> m ()
Conc.throwTo ThreadId m
ThreadId (PoolT resource m)
x e
y)

  {-# INLINE throwTo #-}

  getMaskingState :: PoolT resource m MaskingState
getMaskingState = m MaskingState -> PoolT resource m MaskingState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m MaskingState
forall (m :: * -> *). MonadConc m => m MaskingState
Conc.getMaskingState

  {-# INLINE getMaskingState #-}

  unsafeUnmask :: PoolT resource m a -> PoolT resource m a
unsafeUnmask = (m a -> m a) -> PoolT resource m a -> PoolT resource m a
forall (m :: * -> *) a b resource.
(m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m a
forall (m :: * -> *) a. MonadConc m => m a -> m a
Conc.unsafeUnmask

  {-# INLINE unsafeUnmask #-}

-- | Run the monad transformer against the given pool.
--
-- @since 0.3.0
runPoolT :: Pool.Pool m resource -> PoolT resource m a -> m a
runPoolT :: Pool m resource -> PoolT resource m a -> m a
runPoolT Pool m resource
pool (PoolT ReaderT (PoolEnv m resource) m a
inner) =
  ReaderT (PoolEnv m resource) m a -> PoolEnv m resource -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT ReaderT (PoolEnv m resource) m a
inner PoolEnv :: forall (m :: * -> *) resource.
Maybe resource -> Pool m resource -> PoolEnv m resource
PoolEnv
    { poolEnv_resource :: Maybe resource
poolEnv_resource = Maybe resource
forall a. Maybe a
Nothing
    , poolEnv_pool :: Pool m resource
poolEnv_pool = Pool m resource
pool
    }

{-# INLINE runPoolT #-}

-- | Lift an operation on the underlying functor.
--
-- @since 0.3.0
hoistPoolT :: (m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT :: (m a -> m b) -> PoolT resource m a -> PoolT resource m b
hoistPoolT m a -> m b
f PoolT resource m a
action = ReaderT (PoolEnv m resource) m b -> PoolT resource m b
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m b -> PoolT resource m b)
-> ReaderT (PoolEnv m resource) m b -> PoolT resource m b
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m b) -> ReaderT (PoolEnv m resource) m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m b) -> ReaderT (PoolEnv m resource) m b)
-> (PoolEnv m resource -> m b) -> ReaderT (PoolEnv m resource) m b
forall a b. (a -> b) -> a -> b
$ \PoolEnv m resource
env ->
  m a -> m b
f (ReaderT (PoolEnv m resource) m a -> PoolEnv m resource -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT (PoolT resource m a -> ReaderT (PoolEnv m resource) m a
forall resource (m :: * -> *) a.
PoolT resource m a -> ReaderT (PoolEnv m resource) m a
unPoolT PoolT resource m a
action) PoolEnv m resource
env)

{-# INLINE hoistPoolT #-}

-- | Retrieve the internal pool metrics.
--
-- See 'Pool.poolMetrics'.
--
-- @since 0.4.0
metricsPoolT :: PoolT resource m (Pool.Metrics Natural)
metricsPoolT :: PoolT resource m (Metrics Natural)
metricsPoolT = ReaderT (PoolEnv m resource) m (Metrics Natural)
-> PoolT resource m (Metrics Natural)
forall resource (m :: * -> *) a.
ReaderT (PoolEnv m resource) m a -> PoolT resource m a
PoolT (ReaderT (PoolEnv m resource) m (Metrics Natural)
 -> PoolT resource m (Metrics Natural))
-> ReaderT (PoolEnv m resource) m (Metrics Natural)
-> PoolT resource m (Metrics Natural)
forall a b. (a -> b) -> a -> b
$ (PoolEnv m resource -> m (Metrics Natural))
-> ReaderT (PoolEnv m resource) m (Metrics Natural)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((PoolEnv m resource -> m (Metrics Natural))
 -> ReaderT (PoolEnv m resource) m (Metrics Natural))
-> (PoolEnv m resource -> m (Metrics Natural))
-> ReaderT (PoolEnv m resource) m (Metrics Natural)
forall a b. (a -> b) -> a -> b
$ \PoolEnv m resource
env ->
  Pool m resource -> m (Metrics Natural)
forall (m :: * -> *) a. Pool m a -> m (Metrics Natural)
Pool.poolMetrics (PoolEnv m resource -> Pool m resource
forall (m :: * -> *) resource.
PoolEnv m resource -> Pool m resource
poolEnv_pool PoolEnv m resource
env)