module Effectful.PostgreSQL.Connection.Pool
  ( -- * Interpret with a Connection pool
    runWithConnectionPool

    -- * Re-export
  , module Pool
  )
where

import qualified Database.PostgreSQL.Simple as PSQL
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.PostgreSQL.Connection
import UnliftIO.Pool as Pool

{- | Rather than keeping one connection alive and re-using it for the whole
process, we might want to create a 'Pool' of connections and only "ask" for
one when we need it. This function uses "UnliftIO.Pool" to do just that.
-}
runWithConnectionPool ::
  (HasCallStack, IOE :> es) =>
  Pool.Pool PSQL.Connection ->
  Eff (WithConnection : es) a ->
  Eff es a
runWithConnectionPool :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Pool Connection -> Eff (WithConnection : es) a -> Eff es a
runWithConnectionPool Pool Connection
pool = EffectHandler WithConnection es
-> Eff (WithConnection : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler WithConnection es
 -> Eff (WithConnection : es) a -> Eff es a)
-> EffectHandler WithConnection es
-> Eff (WithConnection : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
env -> \case
  WithConnection Connection -> Eff localEs a
f ->
    LocalEnv localEs es
-> ((forall {r}. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
forall (es :: [Effect]) (handlerEs :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs es
env (((forall {r}. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a)
-> ((forall {r}. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff es r
unlift -> do
      Pool Connection -> (Connection -> Eff es a) -> Eff es a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Pool a -> (a -> m b) -> m b
Pool.withResource Pool Connection
pool ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ Eff localEs a -> Eff es a
forall {r}. Eff localEs r -> Eff es r
unlift (Eff localEs a -> Eff es a)
-> (Connection -> Eff localEs a) -> Connection -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Eff localEs a
f