{-# 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.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

-- | 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 ()
  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. 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

-- | 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 =
  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 =
  -- 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 :: Bool
tsAutoTransaction = Bool
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 (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)

-- | 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 = 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