{-# LANGUAGE TemplateHaskell #-}

module Effectful.PostgreSQL.Connection
  ( -- * Effect
    WithConnection (..)
  , withConnection

    -- * Interpret with a single Connection
  , runWithConnection
  , runWithConnectInfo
  )
where

import qualified Database.PostgreSQL.Simple as PSQL
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.TH

{- | A dynamic effect that lets us use a database 'PSQL.Connection',
without specifying __how__ that connection is supplied.

For example, we might want to just provide a connection and let the interpreter
use that for the whole procedure (see 'Effectful.PostgreSQL.Connection.runWithConnection').

Or, we might want to create a connection pool which provides connections when
the interpreter asks for them (see "Effectful.PostgreSQL.Connection.Pool").
-}
data WithConnection :: Effect where
  -- | Use a 'PSQL.Connection' provided by an interpreter.
  WithConnection :: (PSQL.Connection -> m a) -> WithConnection m a

makeEffect ''WithConnection

{- | Run a t'WithConnection' effect by simply supplying a 'PSQL.Connection'.
The connection will be kept alive for the whole duration of the procedure,
which might not be want you want for long-running processes. If so, see
"Effectful.PostgreSQL.Connection.Pool".
-}
runWithConnection ::
  (HasCallStack) => PSQL.Connection -> Eff (WithConnection : es) a -> Eff es a
runWithConnection :: forall (es :: [Effect]) a.
HasCallStack =>
Connection -> Eff (WithConnection : es) a -> Eff es a
runWithConnection Connection
conn = 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 -> Eff localEs a -> Eff es a
forall {r}. Eff localEs r -> Eff es r
unlift (Eff localEs a -> Eff es a) -> Eff localEs a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Eff localEs a
f Connection
conn

{- | Run a t'WithConnection' effect using a 'PSQL.ConnectInfo'.

'PSQL.withConnect' will handle opening and closing the 'Connection'.
-}
runWithConnectInfo ::
  (HasCallStack, IOE :> es) => PSQL.ConnectInfo -> Eff (WithConnection : es) a -> Eff es a
runWithConnectInfo :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
ConnectInfo -> Eff (WithConnection : es) a -> Eff es a
runWithConnectInfo ConnectInfo
connInfo Eff (WithConnection : es) a
eff =
  ((forall a. Eff es a -> IO a) -> IO a) -> Eff es a
forall b. ((forall a. Eff es a -> IO a) -> IO b) -> Eff es b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Eff es a -> IO a) -> IO a) -> Eff es a)
-> ((forall a. Eff es a -> IO a) -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall a. Eff es a -> IO a
unlift ->
    IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a)
-> ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectInfo -> (Connection -> IO a) -> IO a
forall c. ConnectInfo -> (Connection -> IO c) -> IO c
PSQL.withConnect ConnectInfo
connInfo ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
      Eff es a -> IO a
forall a. Eff es a -> IO a
unlift (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ Connection -> Eff (WithConnection : es) a -> Eff es a
forall (es :: [Effect]) a.
HasCallStack =>
Connection -> Eff (WithConnection : es) a -> Eff es a
runWithConnection Connection
conn Eff (WithConnection : es) a
eff