{-# 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.Query 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
data DB :: Effect where
RunQuery :: IsSQL sql => sql -> DB m Int
GetQueryResult :: FromRow row => DB m (Maybe (QueryResult row))
ClearQueryResult :: DB m ()
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. IsSQL sql => sql -> Eff es Int
runQuery = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql (m :: Type -> Type). IsSQL sql => sql -> DB m Int
RunQuery
getQueryResult :: forall row. FromRow row => Eff es (Maybe (QueryResult row))
getQueryResult = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall sql (m :: Type -> Type).
FromRow sql =>
DB m (Maybe (QueryResult sql))
GetQueryResult
clearQueryResult :: Eff es ()
clearQueryResult = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall (m :: Type -> Type). DB m ()
ClearQueryResult
getConnectionStats :: Eff es ConnectionStats
getConnectionStats = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall (m :: Type -> Type). DB m ConnectionStats
GetConnectionStats
runPreparedQuery :: forall sql. IsSQL sql => QueryName -> sql -> Eff es Int
runPreparedQuery QueryName
qn = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sql (m :: Type -> Type).
IsSQL sql =>
QueryName -> sql -> DB m Int
RunPreparedQuery QueryName
qn
getLastQuery :: Eff es SomeSQL
getLastQuery = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall (m :: Type -> Type). DB m SomeSQL
GetLastQuery
getTransactionSettings :: Eff es TransactionSettings
getTransactionSettings = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall (m :: Type -> Type). DB m TransactionSettings
GetTransactionSettings
setTransactionSettings :: TransactionSettings -> Eff es ()
setTransactionSettings = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type). TransactionSettings -> DB m ()
SetTransactionSettings
withFrozenLastQuery :: forall a. Eff es a -> Eff es a
withFrozenLastQuery = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a. m a -> DB m a
WithFrozenLastQuery
withNewConnection :: forall a. Eff es a -> Eff es a
withNewConnection = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a. m a -> DB m a
WithNewConnection
getNotification :: Int -> Eff es (Maybe Notification)
getNotification = forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
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 b. (a -> b) -> a -> b
$ \LocalEnv localEs (State (DBState es) : es)
env -> \case
RunQuery sql
sql -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) sql.
(MonadDB m, IsSQL sql) =>
sql -> m Int
runQuery sql
sql
DB (Eff localEs) a
GetQueryResult -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall (m :: Type -> Type) row.
(MonadDB m, FromRow row) =>
m (Maybe (QueryResult row))
getQueryResult
DB (Eff localEs) a
ClearQueryResult -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall (m :: Type -> Type). MonadDB m => m ()
clearQueryResult
DB (Eff localEs) a
GetConnectionStats -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall (m :: Type -> Type). MonadDB m => m ConnectionStats
getConnectionStats
RunPreparedQuery QueryName
queryName sql
sql -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) sql.
(MonadDB m, IsSQL sql) =>
QueryName -> sql -> m Int
runPreparedQuery QueryName
queryName sql
sql
DB (Eff localEs) a
GetLastQuery -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall (m :: Type -> Type). MonadDB m => m SomeSQL
getLastQuery
DB (Eff localEs) a
GetTransactionSettings -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall (m :: Type -> Type). MonadDB m => m TransactionSettings
getTransactionSettings
SetTransactionSettings TransactionSettings
settings -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
MonadDB m =>
TransactionSettings -> m ()
setTransactionSettings TransactionSettings
settings
WithFrozenLastQuery (Eff localEs a
action :: Eff localEs b) -> do
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 a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (State (DBState es) : es) r
unlift -> do
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a. MonadDB m => m a -> m a
withFrozenLastQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff forall a b. (a -> b) -> a -> b
$ 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
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 a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (State (DBState es) : es) r
unlift -> do
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a. MonadDB m => m a -> m a
withNewConnection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff forall a b. (a -> b) -> a -> b
$ forall r. Eff localEs r -> Eff (State (DBState es) : es) r
unlift Eff localEs a
action
GetNotification Int
time -> forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: Type -> Type).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
PQ.withConnection ConnectionSourceM (Eff es)
connectionSource forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
let dbState0 :: DBState es
dbState0 = forall (m :: Type -> Type).
ConnectionSourceM m
-> Connection -> TransactionSettings -> DBState m
mkDBState ConnectionSourceM (Eff es)
connectionSource Connection
conn TransactionSettings
transactionSettings
forall s (es :: [Effect]) a. s -> Eff (State s : es) a -> Eff es a
evalState DBState es
dbState0 forall a b. (a -> b) -> a -> b
$ do
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 = forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a.
(MonadDB m, MonadMask m) =>
TransactionSettings -> m a -> m a
withTransaction' TransactionSettings
ts forall a b. (a -> b) -> a -> b
$ 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 = forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL (forall a. Monoid a => a
mempty :: SQL)
, dbRecordLastQuery :: Bool
PQ.dbRecordLastQuery = Bool
True
, dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
PQ.dbQueryResult = forall a. Maybe a
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 :: Bool
tsAutoTransaction = Bool
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 (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
<$ :: forall a b. a -> DBEff es b -> DBEff es a
$c<$ :: forall (es :: [Effect]) a b. a -> DBEff es b -> DBEff es a
fmap :: forall a b. (a -> b) -> DBEff es a -> DBEff es b
$cfmap :: forall (es :: [Effect]) a b. (a -> b) -> DBEff es a -> DBEff es b
Functor, 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
<* :: forall a b. DBEff es a -> DBEff es b -> DBEff es a
$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 b
$c*> :: forall (es :: [Effect]) a b. DBEff es a -> DBEff es b -> DBEff es b
liftA2 :: forall a b c.
(a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c
$cliftA2 :: forall (es :: [Effect]) a b c.
(a -> b -> c) -> DBEff es a -> DBEff es b -> DBEff es c
<*> :: forall a b. DBEff es (a -> b) -> DBEff es a -> DBEff es b
$c<*> :: forall (es :: [Effect]) a b.
DBEff es (a -> b) -> DBEff es a -> DBEff es b
pure :: forall a. a -> DBEff es a
$cpure :: forall (es :: [Effect]) a. a -> DBEff es a
Applicative, 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
return :: forall a. a -> DBEff es a
$creturn :: forall (es :: [Effect]) a. a -> DBEff es a
>> :: 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 b
>>= :: forall a b. DBEff es a -> (a -> DBEff es b) -> DBEff es b
$c>>= :: forall (es :: [Effect]) a b.
DBEff es a -> (a -> DBEff es b) -> DBEff es b
Monad, forall (es :: [Effect]). Monad (DBEff es)
forall (es :: [Effect]) e a. Exception e => e -> DBEff es a
forall e a. Exception e => e -> DBEff es a
forall (m :: Type -> Type).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> DBEff es a
$cthrowM :: forall (es :: [Effect]) e a. Exception e => e -> DBEff es a
MonadThrow, forall (es :: [Effect]). MonadThrow (DBEff es)
forall (es :: [Effect]) e a.
Exception e =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
forall e a.
Exception e =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
forall (m :: Type -> Type).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
$ccatch :: forall (es :: [Effect]) e a.
Exception e =>
DBEff es a -> (e -> DBEff es a) -> DBEff es a
MonadCatch, forall (es :: [Effect]). MonadCatch (DBEff es)
forall (es :: [Effect]) b.
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
forall (es :: [Effect]) a b c.
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
forall b.
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
forall a b c.
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. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
$cgeneralBracket :: forall (es :: [Effect]) a b c.
DBEff es a
-> (a -> ExitCase b -> DBEff es c)
-> (a -> DBEff es b)
-> DBEff es (b, c)
uninterruptibleMask :: forall b.
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
$cuninterruptibleMask :: forall (es :: [Effect]) b.
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
mask :: forall b.
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
$cmask :: forall (es :: [Effect]) b.
((forall a. DBEff es a -> DBEff es a) -> DBEff es b) -> DBEff es b
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 = forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff forall a b. (a -> b) -> a -> b
$ 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 = forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff 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 = forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: [Effect]). (State s :> es) => (s -> s) -> Eff es ()
State.modify
instance (IOE :> es) => MonadDB (DBEff es) where
runQuery :: forall sql. IsSQL sql => sql -> DBEff es Int
runQuery sql
sql = do
DBState es
dbState <- forall (es :: [Effect]). DBEff es (DBState es)
get
(Int
result, DBState es
dbState') <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall sql (m :: Type -> Type).
IsSQL sql =>
sql -> DBState m -> IO (Int, DBState m)
PQ.runQueryIO sql
sql DBState es
dbState
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
dbState'
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
result
getQueryResult :: forall row. FromRow row => DBEff es (Maybe (QueryResult row))
getQueryResult =
forall (es :: [Effect]). DBEff es (DBState es)
get forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DBState es
dbState -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
DBState m -> forall row. FromRow row => Maybe (QueryResult row)
PQ.dbQueryResult DBState es
dbState
clearQueryResult :: DBEff es ()
clearQueryResult =
forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify forall a b. (a -> b) -> a -> b
$ \DBState es
st -> DBState es
st {dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
PQ.dbQueryResult = forall a. Maybe a
Nothing}
getConnectionStats :: DBEff es ConnectionStats
getConnectionStats = do
DBState es
dbState <- forall (es :: [Effect]). DBEff es (DBState es)
get
Maybe ConnectionData
mconn <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
readMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> MVar (Maybe ConnectionData)
PQ.unConnection forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). DBState m -> Connection
PQ.dbConnection DBState es
dbState
case Maybe ConnectionData
mconn of
Maybe ConnectionData
Nothing -> forall e (m :: Type -> Type) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB forall a b. (a -> b) -> a -> b
$ String -> HPQTypesError
HPQTypesError String
"getConnectionStats: no connection"
Just ConnectionData
cd -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ConnectionData -> ConnectionStats
PQ.cdStats ConnectionData
cd
runPreparedQuery :: forall sql. IsSQL sql => QueryName -> sql -> DBEff es Int
runPreparedQuery QueryName
queryName sql
sql = do
DBState es
dbState <- forall (es :: [Effect]). DBEff es (DBState es)
get
(Int
result, DBState es
dbState') <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall sql (m :: Type -> Type).
IsSQL sql =>
QueryName -> sql -> DBState m -> IO (Int, DBState m)
PQ.runPreparedQueryIO QueryName
queryName sql
sql DBState es
dbState
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
dbState'
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
result
getLastQuery :: DBEff es SomeSQL
getLastQuery = forall (m :: Type -> Type). DBState m -> SomeSQL
PQ.dbLastQuery forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (es :: [Effect]). DBEff es (DBState es)
get
getTransactionSettings :: DBEff es TransactionSettings
getTransactionSettings = forall (m :: Type -> Type). DBState m -> TransactionSettings
PQ.dbTransactionSettings forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (es :: [Effect]). DBEff es (DBState es)
get
setTransactionSettings :: TransactionSettings -> DBEff es ()
setTransactionSettings TransactionSettings
settings = forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify forall a b. (a -> b) -> a -> b
$ \DBState es
st' ->
DBState es
st' {dbTransactionSettings :: TransactionSettings
PQ.dbTransactionSettings = TransactionSettings
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 =
forall (es :: [Effect]). (DBState es -> DBState es) -> DBEff es ()
modify forall a b. (a -> b) -> a -> b
$ \DBState es
st' ->
DBState es
st' {dbRecordLastQuery :: Bool
PQ.dbRecordLastQuery = forall (m :: Type -> Type). DBState m -> Bool
PQ.dbRecordLastQuery DBState m
st}
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket forall (es :: [Effect]). DBEff es (DBState es)
get forall {m :: Type -> Type} {es :: [Effect]}.
DBState m -> DBEff es ()
restoreRecordLastQuery forall a b. (a -> b) -> a -> b
$ \DBState es
st -> do
forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
st {dbRecordLastQuery :: Bool
PQ.dbRecordLastQuery = Bool
False}
DBEff es a
action
withNewConnection :: forall a. DBEff es a -> DBEff es a
withNewConnection DBEff es a
action = forall (es :: [Effect]) a.
Eff (State (DBState es) : es) a -> DBEff es a
DBEff forall a b. (a -> b) -> a -> b
$ do
DBState es
dbState0 <- forall s (es :: [Effect]). (State s :> es) => Eff es s
State.get
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 a b. (a -> b) -> a -> b
$ \forall r. Eff (State (DBState es) : es) r -> Eff es r
lower -> do
forall (m :: Type -> Type).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
PQ.withConnection (forall (m :: Type -> Type). DBState m -> ConnectionSourceM m
PQ.dbConnectionSource DBState es
dbState0) forall a b. (a -> b) -> a -> b
$ \Connection
newConn -> forall r. Eff (State (DBState es) : es) r -> Eff es r
lower forall a b. (a -> b) -> a -> b
$ do
let transactionSettings :: TransactionSettings
transactionSettings = forall (m :: Type -> Type). DBState m -> TransactionSettings
PQ.dbTransactionSettings DBState es
dbState0
dbState :: DBState es
dbState = forall (m :: Type -> Type).
ConnectionSourceM m
-> Connection -> TransactionSettings -> DBState m
mkDBState (forall (m :: Type -> Type). DBState m -> ConnectionSourceM m
PQ.dbConnectionSource DBState es
dbState0) Connection
newConn TransactionSettings
transactionSettings
forall (es :: [Effect]) a.
DBEff es a -> Eff (State (DBState es) : es) a
unDBEff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> m c -> m b -> m b
bracket_ (forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
dbState) (forall (es :: [Effect]). DBState es -> DBEff es ()
put DBState es
dbState0) forall a b. (a -> b) -> a -> b
$ do
forall (m :: Type -> Type) a.
TransactionSettings
-> (TransactionSettings -> m a -> m a) -> m a -> m a
handleAutoTransaction TransactionSettings
transactionSettings forall (m :: Type -> Type) a.
(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 <- forall (es :: [Effect]). DBEff es (DBState es)
get
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
DBState m -> Int -> IO (Maybe Notification)
PQ.getNotificationIO DBState es
dbState Int
time