{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Simpoole.Monad.Class (MonadPool (..)) where

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

-- | A pooled resource is available through @m@
--
-- @since 0.3.0
class MonadPool resource m where
  -- | Grab a resource and do something with it.
  --
  -- @since 0.3.0
  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 #-}