{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Access to a PostgreSQL database via 'MonadDB'.
module Effectful.HPQTypes
  ( -- * Effect
    DB (..)

    -- ** Handlers
  , runDB

    -- * Re-exports
  , module Database.PostgreSQL.PQTypes
  )
where

import Control.Concurrent.MVar (readMVar)
import Control.Monad.Catch
import Database.PostgreSQL.PQTypes
import qualified Database.PostgreSQL.PQTypes.Internal.Connection as PQ
import qualified Database.PostgreSQL.PQTypes.Internal.Notification as PQ
import qualified Database.PostgreSQL.PQTypes.Internal.State as PQ
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.State.Static.Local (State, evalState)
import qualified Effectful.State.Static.Local as State
import GHC.Stack

-- | Provide the ability to access a PostgreSQL database via 'MonadDB'.
data DB :: Effect where
  RunQuery :: IsSQL sql => sql -> DB m Int
  GetQueryResult :: FromRow row => DB m (Maybe (QueryResult row))
  ClearQueryResult :: DB m ()
  GetBackendPid :: DB m BackendPid
  GetConnectionStats :: DB m PQ.ConnectionStats
  RunPreparedQuery :: IsSQL sql => PQ.QueryName -> sql -> DB m Int
  GetLastQuery :: DB m SomeSQL
  GetTransactionSettings :: DB m TransactionSettings
  SetTransactionSettings :: TransactionSettings -> DB m ()
  WithFrozenLastQuery :: m a -> DB m a
  WithNewConnection :: m a -> DB m a
  GetNotification :: Int -> DB m (Maybe PQ.Notification)

type instance DispatchOf DB = Dynamic

-- | Orphan, canonical instance.
instance DB :> es => MonadDB (Eff es) where
  runQuery :: forall sql. (HasCallStack, IsSQL sql) => sql -> Eff es Int
runQuery = (HasCallStack => sql -> Eff es Int) -> sql -> Eff es Int
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => sql -> Eff es Int) -> sql -> Eff es Int)
-> (HasCallStack => sql -> Eff es Int) -> sql -> Eff es Int
forall a b. (a -> b) -> a -> b
$ DB (Eff es) Int -> Eff es Int
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (DB (Eff es) Int -> Eff es Int)
-> (sql -> DB (Eff es) Int) -> sql -> Eff es Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sql -> DB (Eff es) Int
forall sql (m :: Type -> Type). IsSQL sql => sql -> DB m Int
RunQuery
  getQueryResult :: forall row. FromRow row => Eff es (Maybe (QueryResult row))
getQueryResult = DB (Eff es) (Maybe (QueryResult row))
-> Eff es (Maybe (QueryResult row))
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send DB (Eff es) (Maybe (QueryResult row))
forall sql (m :: Type -> Type).
FromRow sql =>
DB m (Maybe (QueryResult sql))
GetQueryResult
  clearQueryResult :: Eff es ()
clearQueryResult = DB (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send DB (Eff es) ()
forall (m :: Type -> Type). DB m ()
ClearQueryResult
  getBackendPid :: Eff es BackendPid
getBackendPid = DB (Eff es) BackendPid -> Eff es BackendPid
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send DB (Eff es) BackendPid
forall (m :: Type -> Type). DB m BackendPid
GetBackendPid
  getConnectionStats :: HasCallStack => Eff es ConnectionStats
getConnectionStats = (HasCallStack => Eff es ConnectionStats) -> Eff es ConnectionStats
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Eff es ConnectionStats)
 -> Eff es ConnectionStats)
-> (HasCallStack => Eff es ConnectionStats)
-> Eff es ConnectionStats
forall a b. (a -> b) -> a -> b
$ DB (Eff es) ConnectionStats -> Eff es ConnectionStats
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send DB (Eff es) ConnectionStats
forall (m :: Type -> Type). DB m ConnectionStats
GetConnectionStats
  runPreparedQuery :: forall sql.
(HasCallStack, IsSQL sql) =>
QueryName -> sql -> Eff es Int
runPreparedQuery QueryName
qn = (HasCallStack => sql -> Eff es Int) -> sql -> Eff es Int
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => sql -> Eff es Int) -> sql -> Eff es Int)
-> (HasCallStack => sql -> Eff es Int) -> sql -> Eff es Int
forall a b. (a -> b) -> a -> b
$ DB (Eff es) Int -> Eff es Int
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (DB (Eff es) Int -> Eff es Int)
-> (sql -> DB (Eff es) Int) -> sql -> Eff es Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryName -> sql -> DB (Eff es) Int
forall sql (m :: Type -> Type).
IsSQL sql =>
QueryName -> sql -> DB m Int
RunPreparedQuery QueryName
qn
  getLastQuery :: Eff es SomeSQL
getLastQuery = DB (Eff es) SomeSQL -> Eff es SomeSQL
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send DB (Eff es) SomeSQL
forall (m :: Type -> Type). DB m SomeSQL
GetLastQuery
  getTransactionSettings :: Eff es TransactionSettings
getTransactionSettings = DB (Eff es) TransactionSettings -> Eff es TransactionSettings
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send DB (Eff es) TransactionSettings
forall (m :: Type -> Type). DB m TransactionSettings
GetTransactionSettings
  setTransactionSettings :: TransactionSettings -> Eff es ()
setTransactionSettings = DB (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (DB (Eff es) () -> Eff es ())
-> (TransactionSettings -> DB (Eff es) ())
-> TransactionSettings
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionSettings -> DB (Eff es) ()
forall (m :: Type -> Type). TransactionSettings -> DB m ()
SetTransactionSettings
  withFrozenLastQuery :: forall a. Eff es a -> Eff es a
withFrozenLastQuery = DB (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (DB (Eff es) a -> Eff es a)
-> (Eff es a -> DB (Eff es) a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> DB (Eff es) a
forall (m :: Type -> Type) a. m a -> DB m a
WithFrozenLastQuery
  withNewConnection :: forall a. Eff es a -> Eff es a
withNewConnection = DB (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (DB (Eff es) a -> Eff es a)
-> (Eff es a -> DB (Eff es) a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> DB (Eff es) a
forall (m :: Type -> Type) a. m a -> DB m a
WithNewConnection
  getNotification :: Int -> Eff es (Maybe Notification)
getNotification = DB (Eff es) (Maybe Notification) -> Eff es (Maybe Notification)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (DB (Eff es) (Maybe Notification) -> Eff es (Maybe Notification))
-> (Int -> DB (Eff es) (Maybe Notification))
-> Int
-> Eff es (Maybe Notification)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DB (Eff es) (Maybe Notification)
forall (m :: Type -> Type). Int -> DB m (Maybe Notification)
GetNotification

-- | Run the 'DB' effect with the given connection source and transaction
-- settings.
--
-- /Note:/ this is the @effectful@ version of 'runDBT'.
runDB
  :: forall es a
   . IOE :> es
  => PQ.ConnectionSourceM (Eff es)
  -- ^ Connection source.
  -> TransactionSettings
  -- ^ Transaction settings.
  -> Eff (DB : es) a
  -> Eff es a
runDB :: forall (es :: [Effect]) a.
(IOE :> es) =>
ConnectionSourceM (Eff es)
-> TransactionSettings -> Eff (DB : es) a -> Eff es a
runDB ConnectionSourceM (Eff es)
connectionSource TransactionSettings
transactionSettings =
  (Eff (State (DBState es) : es) a -> Eff es a)
-> (forall {a} {localEs :: [Effect]}.
    (HasCallStack, DB :> localEs) =>
    LocalEnv localEs (State (DBState es) : es)
    -> DB (Eff localEs) a -> Eff (State (DBState es) : es) a)
-> Eff (DB : es) a
-> Eff es a
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (State (DBState es) : es) a -> Eff es a
runWithState ((forall {a} {localEs :: [Effect]}.
  (HasCallStack, DB :> localEs) =>
  LocalEnv localEs (State (DBState es) : es)
  -> DB (Eff localEs) a -> Eff (State (DBState es) : es) a)
 -> Eff (DB : es) a -> Eff es a)
-> (forall {a} {localEs :: [Effect]}.
    (HasCallStack, DB :> localEs) =>
    LocalEnv localEs (State (DBState es) : es)
    -> DB (Eff localEs) a -> Eff (State (DBState es) : es) a)
-> Eff (DB : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (State (DBState es) : es)
env -> \case
    RunQuery sql
sql -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> DBEff es a -> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ sql -> DBEff es Int
forall sql. (HasCallStack, IsSQL sql) => sql -> DBEff es Int
forall (m :: Type -> Type) sql.
(MonadDB m, HasCallStack, IsSQL sql) =>
sql -> m Int
runQuery sql
sql
    DB (Eff localEs) a
GetQueryResult -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff DBEff es a
DBEff es (Maybe (QueryResult row))
forall row. FromRow row => DBEff es (Maybe (QueryResult row))
forall (m :: Type -> Type) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult
    DB (Eff localEs) a
ClearQueryResult -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff DBEff es a
DBEff es ()
forall (m :: Type -> Type). MonadDB m => m ()
clearQueryResult
    DB (Eff localEs) a
GetBackendPid -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff DBEff es a
DBEff es BackendPid
forall (m :: Type -> Type). MonadDB m => m BackendPid
getBackendPid
    DB (Eff localEs) a
GetConnectionStats -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff DBEff es a
DBEff es ConnectionStats
forall (m :: Type -> Type).
(MonadDB m, HasCallStack) =>
m ConnectionStats
getConnectionStats
    RunPreparedQuery QueryName
queryName sql
sql -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> DBEff es a -> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ QueryName -> sql -> DBEff es Int
forall sql.
(HasCallStack, IsSQL sql) =>
QueryName -> sql -> DBEff es Int
forall (m :: Type -> Type) sql.
(MonadDB m, HasCallStack, IsSQL sql) =>
QueryName -> sql -> m Int
runPreparedQuery QueryName
queryName sql
sql
    DB (Eff localEs) a
GetLastQuery -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff DBEff es a
DBEff es SomeSQL
forall (m :: Type -> Type). MonadDB m => m SomeSQL
getLastQuery
    DB (Eff localEs) a
GetTransactionSettings -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff DBEff es a
DBEff es TransactionSettings
forall (m :: Type -> Type). MonadDB m => m TransactionSettings
getTransactionSettings
    SetTransactionSettings TransactionSettings
settings -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> DBEff es a -> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ TransactionSettings -> DBEff es ()
forall (m :: Type -> Type).
MonadDB m =>
TransactionSettings -> m ()
setTransactionSettings TransactionSettings
settings
    WithFrozenLastQuery (Eff localEs a
action :: Eff localEs b) -> do
      LocalEnv localEs (State (DBState es) : es)
-> ((forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r)
    -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : 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 (State (DBState es) : es)
env (((forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r)
  -> Eff (State (DBState es) : es) a)
 -> Eff (State (DBState es) : es) a)
-> ((forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r)
    -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r
unlift -> do
        DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> (Eff (State (DBState es) : es) a -> DBEff es a)
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBEff es a -> DBEff es a
forall a. DBEff es a -> DBEff es a
forall (m :: Type -> Type) a. MonadDB m => m a -> m a
withFrozenLastQuery (DBEff es a -> DBEff es a)
-> (Eff (State (DBState es) : es) a -> DBEff es a)
-> Eff (State (DBState es) : es) a
-> DBEff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (State (DBState es) : es) a -> DBEff es a
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff (Eff (State (DBState es) : es) a
 -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ Eff localEs a -> Eff (State (DBState es) : es) a
forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r
unlift Eff localEs a
action
    WithNewConnection (Eff localEs a
action :: Eff localEs b) -> do
      LocalEnv localEs (State (DBState es) : es)
-> ((forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r)
    -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : 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 (State (DBState es) : es)
env (((forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r)
  -> Eff (State (DBState es) : es) a)
 -> Eff (State (DBState es) : es) a)
-> ((forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r)
    -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r
unlift -> do
        DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> (Eff (State (DBState es) : es) a -> DBEff es a)
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBEff es a -> DBEff es a
forall a. DBEff es a -> DBEff es a
forall (m :: Type -> Type) a. MonadDB m => m a -> m a
withNewConnection (DBEff es a -> DBEff es a)
-> (Eff (State (DBState es) : es) a -> DBEff es a)
-> Eff (State (DBState es) : es) a
-> DBEff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (State (DBState es) : es) a -> DBEff es a
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff (Eff (State (DBState es) : es) a
 -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ Eff localEs a -> Eff (State (DBState es) : es) a
forall {r}. Eff localEs r -> Eff (State (DBState es) : es) r
unlift Eff localEs a
action
    GetNotification Int
time -> DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> DBEff es a -> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ Int -> DBEff es (Maybe Notification)
forall (m :: Type -> Type).
MonadDB m =>
Int -> m (Maybe Notification)
getNotification Int
time
  where
    runWithState :: Eff (State (DBState es) : es) a -> Eff es a
    runWithState :: Eff (State (DBState es) : es) a -> Eff es a
runWithState Eff (State (DBState es) : es) a
eff =
      ConnectionSourceM (Eff es)
-> forall r. (Connection -> Eff es r) -> Eff es r
forall (m :: Type -> Type).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
PQ.withConnection ConnectionSourceM (Eff es)
connectionSource ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
        let dbState0 :: DBState es
dbState0 = ConnectionSourceM (Eff es)
-> Connection -> TransactionSettings -> DBState es
forall (m :: Type -> Type).
ConnectionSourceM m
-> Connection -> TransactionSettings -> DBState m
mkDBState ConnectionSourceM (Eff es)
connectionSource Connection
conn TransactionSettings
transactionSettings
        DBState es -> Eff (State (DBState es) : es) a -> Eff es a
forall s (es :: [Effect]) a. s -> Eff (State s : es) a -> Eff es a
evalState DBState es
dbState0 (Eff (State (DBState es) : es) a -> Eff es a)
-> Eff (State (DBState es) : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ do
          TransactionSettings
-> (TransactionSettings
    -> Eff (State (DBState es) : es) a
    -> Eff (State (DBState es) : es) a)
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
forall (m :: Type -> Type) a.
TransactionSettings
-> (TransactionSettings -> m a -> m a) -> m a -> m a
handleAutoTransaction TransactionSettings
transactionSettings TransactionSettings
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
doWithTransaction Eff (State (DBState es) : es) a
eff

    doWithTransaction
      :: TransactionSettings
      -> Eff (State (DBState es) : es) a
      -> Eff (State (DBState es) : es) a
    doWithTransaction :: TransactionSettings
-> Eff (State (DBState es) : es) a
-> Eff (State (DBState es) : es) a
doWithTransaction TransactionSettings
ts Eff (State (DBState es) : es) a
eff = DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> (DBEff es a -> DBEff es a)
-> DBEff es a
-> Eff (State (DBState es) : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionSettings -> DBEff es a -> DBEff es a
forall (m :: Type -> Type) a.
(HasCallStack, MonadDB m, MonadMask m) =>
TransactionSettings -> m a -> m a
withTransaction' TransactionSettings
ts (DBEff es a -> Eff (State (DBState es) : es) a)
-> DBEff es a -> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ Eff (State (DBState es) : es) a -> DBEff es a
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff Eff (State (DBState es) : es) a
eff

mkDBState
  :: PQ.ConnectionSourceM m
  -> PQ.Connection
  -> TransactionSettings
  -> PQ.DBState m
mkDBState :: forall (m :: Type -> Type).
ConnectionSourceM m
-> Connection -> TransactionSettings -> DBState m
mkDBState ConnectionSourceM m
connectionSource Connection
conn TransactionSettings
ts =
  PQ.DBState
    { dbConnection :: Connection
PQ.dbConnection = Connection
conn
    , dbConnectionSource :: ConnectionSourceM m
PQ.dbConnectionSource = ConnectionSourceM m
connectionSource
    , dbTransactionSettings :: TransactionSettings
PQ.dbTransactionSettings = TransactionSettings
ts
    , dbLastQuery :: SomeSQL
PQ.dbLastQuery = SQL -> SomeSQL
forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL (SQL
forall a. Monoid a => a
mempty :: SQL)
    , dbRecordLastQuery :: Bool
PQ.dbRecordLastQuery = Bool
True
    , dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
PQ.dbQueryResult = Maybe (QueryResult row)
forall a. Maybe a
forall row. FromRow row => Maybe (QueryResult row)
Nothing
    }

handleAutoTransaction
  :: TransactionSettings
  -> (TransactionSettings -> m a -> m a)
  -> m a
  -> m a
handleAutoTransaction :: forall (m :: Type -> Type) a.
TransactionSettings
-> (TransactionSettings -> m a -> m a) -> m a -> m a
handleAutoTransaction TransactionSettings
transactionSettings TransactionSettings -> m a -> m a
doWithTransaction m a
action =
  -- We don't set tsAutoTransaction to False in the context of the action
  -- because if the action calls commit inside, then with tsAutoTransaction
  -- another transaction should be started automatically and if it's not set, it
  -- won't happen (see source of the commit' function).  On the other hand,
  -- withTransaction itself uses commit' and there we don't want to start
  -- another transaction.
  if TransactionSettings -> Bool
tsAutoTransaction TransactionSettings
transactionSettings
    then TransactionSettings -> m a -> m a
doWithTransaction (TransactionSettings
transactionSettings {tsAutoTransaction = False}) m a
action
    else m a
action

---------------------------------------------------
-- Internal effect stack
---------------------------------------------------

-- | Newtype wrapper over the internal DB effect stack
newtype DBEff es a = DBEff
  { forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff :: Eff (State (DBState es) : es) a
  }
  deriving newtype ((forall a b. (a -> b) -> DBEff es a -> DBEff es b)
-> (forall a b. a -> DBEff es b -> DBEff es a)
-> Functor (DBEff es)
forall (es :: [Effect]) a b. a -> DBEff es b -> DBEff es a
forall (es :: [Effect]) a b. (a -> b) -> DBEff es a -> DBEff es b
forall a b. a -> DBEff es b -> DBEff es a
forall a b. (a -> b) -> DBEff es a -> DBEff es b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (es :: [Effect]) a b. (a -> b) -> DBEff es a -> DBEff es b
fmap :: forall a b. (a -> b) -> DBEff es a -> DBEff es b
$c<$ :: forall (es :: [Effect]) a b. a -> DBEff es b -> DBEff es a
<$ :: forall a b. a -> DBEff es b -> DBEff es a
Functor, Functor (DBEff es)
Functor (DBEff es) =>
(forall a. a -> DBEff es a)
-> (forall a b. DBEff es (a -> b) -> DBEff es a -> DBEff es b)
-> (forall a b c.
    (a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c)
-> (forall a b. DBEff es a -> DBEff es b -> DBEff es b)
-> (forall a b. DBEff es a -> DBEff es b -> DBEff es a)
-> Applicative (DBEff es)
forall (es :: [Effect]). Functor (DBEff es)
forall (es :: [Effect]) a. a -> DBEff es a
forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es a
forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es b
forall (es :: [Effect]) a b.
DBEff es (a -> b) -> DBEff es a -> DBEff es b
forall (es :: [Effect]) a b c.
(a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c
forall a. a -> DBEff es a
forall a b. DBEff es a -> DBEff es b -> DBEff es a
forall a b. DBEff es a -> DBEff es b -> DBEff es b
forall a b. DBEff es (a -> b) -> DBEff es a -> DBEff es b
forall a b c.
(a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (es :: [Effect]) a. a -> DBEff es a
pure :: forall a. a -> DBEff es a
$c<*> :: forall (es :: [Effect]) a b.
DBEff es (a -> b) -> DBEff es a -> DBEff es b
<*> :: forall a b. DBEff es (a -> b) -> DBEff es a -> DBEff es b
$cliftA2 :: forall (es :: [Effect]) a b c.
(a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c
liftA2 :: forall a b c.
(a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c
$c*> :: forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es b
*> :: forall a b. DBEff es a -> DBEff es b -> DBEff es b
$c<* :: forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es a
<* :: forall a b. DBEff es a -> DBEff es b -> DBEff es a
Applicative, Applicative (DBEff es)
Applicative (DBEff es) =>
(forall a b. DBEff es a -> (a -> DBEff es b) -> DBEff es b)
-> (forall a b. DBEff es a -> DBEff es b -> DBEff es b)
-> (forall a. a -> DBEff es a)
-> Monad (DBEff es)
forall (es :: [Effect]). Applicative (DBEff es)
forall (es :: [Effect]) a. a -> DBEff es a
forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es b
forall (es :: [Effect]) a b.
DBEff es a -> (a -> DBEff es b) -> DBEff es b
forall a. a -> DBEff es a
forall a b. DBEff es a -> DBEff es b -> DBEff es b
forall a b. DBEff es a -> (a -> DBEff es b) -> DBEff es b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (es :: [Effect]) a b.
DBEff es a -> (a -> DBEff es b) -> DBEff es b
>>= :: forall a b. DBEff es a -> (a -> DBEff es b) -> DBEff es b
$c>> :: forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es b
>> :: forall a b. DBEff es a -> DBEff es b -> DBEff es b
$creturn :: forall (es :: [Effect]) a. a -> DBEff es a
return :: forall a. a -> DBEff es a
Monad, Monad (DBEff es)
Monad (DBEff es) =>
(forall e a. (HasCallStack, Exception e) => e -> DBEff es a)
-> MonadThrow (DBEff es)
forall (es :: [Effect]). Monad (DBEff es)
forall (es :: [Effect]) e a.
(HasCallStack, Exception e) =>
e -> DBEff es a
forall e a. (HasCallStack, Exception e) => e -> DBEff es a
forall (m :: Type -> Type).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall (es :: [Effect]) e a.
(HasCallStack, Exception e) =>
e -> DBEff es a
throwM :: forall e a. (HasCallStack, Exception e) => e -> DBEff es a
MonadThrow, MonadThrow (DBEff es)
MonadThrow (DBEff es) =>
(forall e a.
 (HasCallStack, Exception e) =>
 DBEff es a -> (e -> DBEff es a) -> DBEff es a)
-> MonadCatch (DBEff es)
forall (es :: [Effect]). MonadThrow (DBEff es)
forall (es :: [Effect]) e a.
(HasCallStack, Exception e) =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
forall e a.
(HasCallStack, Exception e) =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
forall (m :: Type -> Type).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (es :: [Effect]) e a.
(HasCallStack, Exception e) =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
catch :: forall e a.
(HasCallStack, Exception e) =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
MonadCatch, MonadCatch (DBEff es)
MonadCatch (DBEff es) =>
(forall b.
 HasCallStack =>
 ((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b)
-> (forall b.
    HasCallStack =>
    ((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b)
-> (forall a b c.
    HasCallStack =>
    DBEff es a
    -> (a -> ExitCase b -> DBEff es c)
    -> (a -> DBEff es b)
    -> DBEff es (b, c))
-> MonadMask (DBEff es)
forall (es :: [Effect]). MonadCatch (DBEff es)
forall (es :: [Effect]) b.
HasCallStack =>
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
forall (es :: [Effect]) a b c.
HasCallStack =>
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
forall b.
HasCallStack =>
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
forall a b c.
HasCallStack =>
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
forall (m :: Type -> Type).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (es :: [Effect]) b.
HasCallStack =>
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
mask :: forall b.
HasCallStack =>
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
$cuninterruptibleMask :: forall (es :: [Effect]) b.
HasCallStack =>
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
$cgeneralBracket :: forall (es :: [Effect]) a b c.
HasCallStack =>
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
generalBracket :: forall a b c.
HasCallStack =>
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
MonadMask)

-- | Internal state used to reinterpret the `DB` effect
type DBState es = PQ.DBState (Eff es)

-- Convenience `MonadIO` instance
instance IOE :> es => MonadIO (DBEff es) where
  liftIO :: forall a. IO a -> DBEff es a
liftIO IO a
b = Eff (State (DBState es) : es) a -> DBEff es a
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff (Eff (State (DBState es) : es) a -> DBEff es a)
-> Eff (State (DBState es) : es) a -> DBEff es a
forall a b. (a -> b) -> a -> b
$ IO a -> Eff (State (DBState es) : es) a
forall a. IO a -> Eff (State (DBState es) : es) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO a
b

get :: DBEff es (DBState es)
get :: forall (es :: [Effect]). DBEff es (DBState es)
get = Eff (State (DBState es) : es) (DBState es) -> DBEff es (DBState es)
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff Eff (State (DBState es) : es) (DBState es)
forall s (es :: [Effect]). (State s :> es) => Eff es s
State.get

put :: DBState es -> DBEff es ()
put :: forall (es :: [Effect]). DBState es -> DBEff es ()
put = Eff (State (DBState es) : es) () -> DBEff es ()
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff (Eff (State (DBState es) : es) () -> DBEff es ())
-> (DBState es -> Eff (State (DBState es) : es) ())
-> DBState es
-> DBEff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBState es -> Eff (State (DBState es) : es) ()
forall s (es :: [Effect]). (State s :> es) => s -> Eff es ()
State.put

modify :: (DBState es -> DBState es) -> DBEff es ()
modify :: forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify = Eff (State (DBState es) : es) () -> DBEff es ()
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff (Eff (State (DBState es) : es) () -> DBEff es ())
-> ((DBState es -> DBState es) -> Eff (State (DBState es) : es) ())
-> (DBState es -> DBState es)
-> DBEff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState es -> DBState es) -> Eff (State (DBState es) : es) ()
forall s (es :: [Effect]). (State s :> es) => (s -> s) -> Eff es ()
State.modify

instance IOE :> es => MonadDB (DBEff es) where
  runQuery :: forall sql. (HasCallStack, IsSQL sql) => sql -> DBEff es Int
runQuery sql
sql = do
    DBState es
dbState <- DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get
    (Int
rows, DBState es
newDbState) <- IO (Int, DBState es) -> DBEff es (Int, DBState es)
forall a. IO a -> DBEff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Int, DBState es) -> DBEff es (Int, DBState es))
-> IO (Int, DBState es) -> DBEff es (Int, DBState es)
forall a b. (a -> b) -> a -> b
$ do
      DBState es
-> sql -> (Int, ForeignPtr PGresult) -> IO (Int, DBState es)
forall sql (m :: Type -> Type) r.
IsSQL sql =>
DBState m -> sql -> (r, ForeignPtr PGresult) -> IO (r, DBState m)
PQ.updateStateWith DBState es
dbState sql
sql
        ((Int, ForeignPtr PGresult) -> IO (Int, DBState es))
-> IO (Int, ForeignPtr PGresult) -> IO (Int, DBState es)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> sql -> IO (Int, ForeignPtr PGresult)
forall sql.
(HasCallStack, IsSQL sql) =>
Connection -> sql -> IO (Int, ForeignPtr PGresult)
PQ.runQueryIO (DBState es -> Connection
forall (m :: Type -> Type). DBState m -> Connection
PQ.dbConnection DBState es
dbState) sql
sql
    DBState es -> DBEff es ()
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
newDbState
    Int -> DBEff es Int
forall a. a -> DBEff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
rows

  getQueryResult :: forall row. FromRow row => DBEff es (Maybe (QueryResult row))
getQueryResult =
    DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get DBEff es (DBState es)
-> (DBState es -> DBEff es (Maybe (QueryResult row)))
-> DBEff es (Maybe (QueryResult row))
forall a b. DBEff es a -> (a -> DBEff es b) -> DBEff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DBState es
dbState -> Maybe (QueryResult row) -> DBEff es (Maybe (QueryResult row))
forall a. a -> DBEff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (QueryResult row) -> DBEff es (Maybe (QueryResult row)))
-> Maybe (QueryResult row) -> DBEff es (Maybe (QueryResult row))
forall a b. (a -> b) -> a -> b
$ DBState es -> forall row. FromRow row => Maybe (QueryResult row)
forall (m :: Type -> Type).
DBState m -> forall row. FromRow row => Maybe (QueryResult row)
PQ.dbQueryResult DBState es
dbState

  clearQueryResult :: DBEff es ()
clearQueryResult =
    (DBState es -> DBState es) -> DBEff es ()
forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify ((DBState es -> DBState es) -> DBEff es ())
-> (DBState es -> DBState es) -> DBEff es ()
forall a b. (a -> b) -> a -> b
$ \DBState es
st -> DBState es
st {PQ.dbQueryResult = Nothing}

  getBackendPid :: DBEff es BackendPid
getBackendPid = IO BackendPid -> DBEff es BackendPid
forall a. IO a -> DBEff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO BackendPid -> DBEff es BackendPid)
-> (DBState es -> IO BackendPid)
-> DBState es
-> DBEff es BackendPid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO BackendPid
PQ.getBackendPidIO (Connection -> IO BackendPid)
-> (DBState es -> Connection) -> DBState es -> IO BackendPid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBState es -> Connection
forall (m :: Type -> Type). DBState m -> Connection
PQ.dbConnection (DBState es -> DBEff es BackendPid)
-> DBEff es (DBState es) -> DBEff es BackendPid
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get

  getConnectionStats :: HasCallStack => DBEff es ConnectionStats
getConnectionStats = do
    DBState es
dbState <- DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get
    Maybe ConnectionData
mconn <- IO (Maybe ConnectionData) -> DBEff es (Maybe ConnectionData)
forall a. IO a -> DBEff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ConnectionData) -> DBEff es (Maybe ConnectionData))
-> (Connection -> IO (Maybe ConnectionData))
-> Connection
-> DBEff es (Maybe ConnectionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe ConnectionData) -> IO (Maybe ConnectionData)
forall a. MVar a -> IO a
readMVar (MVar (Maybe ConnectionData) -> IO (Maybe ConnectionData))
-> (Connection -> MVar (Maybe ConnectionData))
-> Connection
-> IO (Maybe ConnectionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> MVar (Maybe ConnectionData)
PQ.unConnection (Connection -> DBEff es (Maybe ConnectionData))
-> Connection -> DBEff es (Maybe ConnectionData)
forall a b. (a -> b) -> a -> b
$ DBState es -> Connection
forall (m :: Type -> Type). DBState m -> Connection
PQ.dbConnection DBState es
dbState
    case Maybe ConnectionData
mconn of
      Maybe ConnectionData
Nothing -> HPQTypesError -> DBEff es ConnectionStats
forall e (m :: Type -> Type) a.
(HasCallStack, Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB (HPQTypesError -> DBEff es ConnectionStats)
-> HPQTypesError -> DBEff es ConnectionStats
forall a b. (a -> b) -> a -> b
$ String -> HPQTypesError
HPQTypesError String
"getConnectionStats: no connection"
      Just ConnectionData
cd -> ConnectionStats -> DBEff es ConnectionStats
forall a. a -> DBEff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ConnectionStats -> DBEff es ConnectionStats)
-> ConnectionStats -> DBEff es ConnectionStats
forall a b. (a -> b) -> a -> b
$ ConnectionData -> ConnectionStats
PQ.cdStats ConnectionData
cd

  runPreparedQuery :: forall sql.
(HasCallStack, IsSQL sql) =>
QueryName -> sql -> DBEff es Int
runPreparedQuery QueryName
queryName sql
sql = do
    DBState es
dbState <- DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get
    (Int
rows, DBState es
newDbState) <- IO (Int, DBState es) -> DBEff es (Int, DBState es)
forall a. IO a -> DBEff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Int, DBState es) -> DBEff es (Int, DBState es))
-> IO (Int, DBState es) -> DBEff es (Int, DBState es)
forall a b. (a -> b) -> a -> b
$ do
      DBState es
-> sql -> (Int, ForeignPtr PGresult) -> IO (Int, DBState es)
forall sql (m :: Type -> Type) r.
IsSQL sql =>
DBState m -> sql -> (r, ForeignPtr PGresult) -> IO (r, DBState m)
PQ.updateStateWith DBState es
dbState sql
sql
        ((Int, ForeignPtr PGresult) -> IO (Int, DBState es))
-> IO (Int, ForeignPtr PGresult) -> IO (Int, DBState es)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> QueryName -> sql -> IO (Int, ForeignPtr PGresult)
forall sql.
(HasCallStack, IsSQL sql) =>
Connection -> QueryName -> sql -> IO (Int, ForeignPtr PGresult)
PQ.runPreparedQueryIO (DBState es -> Connection
forall (m :: Type -> Type). DBState m -> Connection
PQ.dbConnection DBState es
dbState) QueryName
queryName sql
sql
    DBState es -> DBEff es ()
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
newDbState
    Int -> DBEff es Int
forall a. a -> DBEff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
rows

  getLastQuery :: DBEff es SomeSQL
getLastQuery = DBState es -> SomeSQL
forall (m :: Type -> Type). DBState m -> SomeSQL
PQ.dbLastQuery (DBState es -> SomeSQL)
-> DBEff es (DBState es) -> DBEff es SomeSQL
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get

  getTransactionSettings :: DBEff es TransactionSettings
getTransactionSettings = DBState es -> TransactionSettings
forall (m :: Type -> Type). DBState m -> TransactionSettings
PQ.dbTransactionSettings (DBState es -> TransactionSettings)
-> DBEff es (DBState es) -> DBEff es TransactionSettings
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get

  setTransactionSettings :: TransactionSettings -> DBEff es ()
setTransactionSettings TransactionSettings
settings = (DBState es -> DBState es) -> DBEff es ()
forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify ((DBState es -> DBState es) -> DBEff es ())
-> (DBState es -> DBState es) -> DBEff es ()
forall a b. (a -> b) -> a -> b
$ \DBState es
st' ->
    DBState es
st' {PQ.dbTransactionSettings = settings}

  withFrozenLastQuery :: forall a. DBEff es a -> DBEff es a
withFrozenLastQuery DBEff es a
action = do
    let restoreRecordLastQuery :: DBState m -> DBEff es ()
restoreRecordLastQuery DBState m
st =
          (DBState es -> DBState es) -> DBEff es ()
forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify ((DBState es -> DBState es) -> DBEff es ())
-> (DBState es -> DBState es) -> DBEff es ()
forall a b. (a -> b) -> a -> b
$ \DBState es
st' ->
            DBState es
st' {PQ.dbRecordLastQuery = PQ.dbRecordLastQuery st}
    DBEff es (DBState es)
-> (DBState es -> DBEff es ())
-> (DBState es -> DBEff es a)
-> DBEff es a
forall (m :: Type -> Type) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get DBState es -> DBEff es ()
forall {m :: Type -> Type} {es :: [Effect]}.
DBState m -> DBEff es ()
restoreRecordLastQuery ((DBState es -> DBEff es a) -> DBEff es a)
-> (DBState es -> DBEff es a) -> DBEff es a
forall a b. (a -> b) -> a -> b
$ \DBState es
st -> do
      DBState es -> DBEff es ()
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
st {PQ.dbRecordLastQuery = False}
      DBEff es a
action

  withNewConnection :: forall a. DBEff es a -> DBEff es a
withNewConnection DBEff es a
action = Eff (State (DBState es) : es) a -> DBEff es a
forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff (Eff (State (DBState es) : es) a -> DBEff es a)
-> Eff (State (DBState es) : es) a -> DBEff es a
forall a b. (a -> b) -> a -> b
$ do
    DBState es
dbState0 <- Eff (State (DBState es) : es) (DBState es)
forall s (es :: [Effect]). (State s :> es) => Eff es s
State.get
    UnliftStrategy
-> ((forall {r}. Eff (State (DBState es) : es) r -> Eff es r)
    -> Eff es a)
-> Eff (State (DBState es) : es) a
forall (e :: Effect) (es :: [Effect]) a.
HasCallStack =>
UnliftStrategy
-> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)
-> Eff (e : es) a
raiseWith UnliftStrategy
SeqUnlift (((forall {r}. Eff (State (DBState es) : es) r -> Eff es r)
  -> Eff es a)
 -> Eff (State (DBState es) : es) a)
-> ((forall {r}. Eff (State (DBState es) : es) r -> Eff es r)
    -> Eff es a)
-> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff (State (DBState es) : es) r -> Eff es r
lower -> do
      ConnectionSourceM (Eff es)
-> forall r. (Connection -> Eff es r) -> Eff es r
forall (m :: Type -> Type).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
PQ.withConnection (DBState es -> ConnectionSourceM (Eff es)
forall (m :: Type -> Type). DBState m -> ConnectionSourceM m
PQ.dbConnectionSource DBState es
dbState0) ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
newConn -> Eff (State (DBState es) : es) a -> Eff es a
forall {r}. Eff (State (DBState es) : es) r -> Eff es r
lower (Eff (State (DBState es) : es) a -> Eff es a)
-> Eff (State (DBState es) : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ do
        let transactionSettings :: TransactionSettings
transactionSettings = DBState es -> TransactionSettings
forall (m :: Type -> Type). DBState m -> TransactionSettings
PQ.dbTransactionSettings DBState es
dbState0
            dbState :: DBState es
dbState = ConnectionSourceM (Eff es)
-> Connection -> TransactionSettings -> DBState es
forall (m :: Type -> Type).
ConnectionSourceM m
-> Connection -> TransactionSettings -> DBState m
mkDBState (DBState es -> ConnectionSourceM (Eff es)
forall (m :: Type -> Type). DBState m -> ConnectionSourceM m
PQ.dbConnectionSource DBState es
dbState0) Connection
newConn TransactionSettings
transactionSettings
        DBEff es a -> Eff (State (DBState es) : es) a
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff (DBEff es a -> Eff (State (DBState es) : es) a)
-> (DBEff es a -> DBEff es a)
-> DBEff es a
-> Eff (State (DBState es) : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBEff es () -> DBEff es () -> DBEff es a -> DBEff es a
forall (m :: Type -> Type) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (DBState es -> DBEff es ()
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
dbState) (DBState es -> DBEff es ()
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
dbState0) (DBEff es a -> Eff (State (DBState es) : es) a)
-> DBEff es a -> Eff (State (DBState es) : es) a
forall a b. (a -> b) -> a -> b
$ do
          TransactionSettings
-> (TransactionSettings -> DBEff es a -> DBEff es a)
-> DBEff es a
-> DBEff es a
forall (m :: Type -> Type) a.
TransactionSettings
-> (TransactionSettings -> m a -> m a) -> m a -> m a
handleAutoTransaction TransactionSettings
transactionSettings TransactionSettings -> DBEff es a -> DBEff es a
forall (m :: Type -> Type) a.
(HasCallStack, MonadDB m, MonadMask m) =>
TransactionSettings -> m a -> m a
withTransaction' DBEff es a
action

  getNotification :: Int -> DBEff es (Maybe Notification)
getNotification Int
time = do
    DBState es
dbState <- DBEff es (DBState es)
forall (es :: [Effect]). DBEff es (DBState es)
get
    IO (Maybe Notification) -> DBEff es (Maybe Notification)
forall a. IO a -> DBEff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Notification) -> DBEff es (Maybe Notification))
-> IO (Maybe Notification) -> DBEff es (Maybe Notification)
forall a b. (a -> b) -> a -> b
$ DBState es -> Int -> IO (Maybe Notification)
forall (m :: Type -> Type).
DBState m -> Int -> IO (Maybe Notification)
PQ.getNotificationIO DBState es
dbState Int
time