{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Effectful.HPQTypes
(
DB (..)
, runDB
, 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
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
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
runDB
:: forall es a
. IOE :> es
=> PQ.ConnectionSourceM (Eff es)
-> TransactionSettings
-> 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 =
if TransactionSettings -> Bool
tsAutoTransaction TransactionSettings
transactionSettings
then TransactionSettings -> m a -> m a
doWithTransaction (TransactionSettings
transactionSettings {tsAutoTransaction = False}) m a
action
else m a
action
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)
type DBState es = PQ.DBState (Eff es)
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