mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-11-22 01:52:45 +03:00
83 lines
3.2 KiB
Haskell
83 lines
3.2 KiB
Haskell
module Hasql.Session.Core where
|
|
|
|
import Hasql.Connection.Core qualified as Connection
|
|
import Hasql.Decoders.All qualified as Decoders
|
|
import Hasql.Decoders.Result qualified as Decoders.Result
|
|
import Hasql.Decoders.Results qualified as Decoders.Results
|
|
import Hasql.Encoders.All qualified as Encoders
|
|
import Hasql.Encoders.Params qualified as Encoders.Params
|
|
import Hasql.Errors
|
|
import Hasql.IO qualified as IO
|
|
import Hasql.LibPq14 qualified as Pq
|
|
import Hasql.Pipeline.Core qualified as Pipeline
|
|
import Hasql.Prelude
|
|
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry
|
|
import Hasql.Statement qualified as Statement
|
|
|
|
-- |
|
|
-- A batch of actions to be executed in the context of a database connection.
|
|
newtype Session a
|
|
= Session (ReaderT Connection.Connection (ExceptT SessionError IO) a)
|
|
deriving (Functor, Applicative, Monad, MonadError SessionError, MonadIO, MonadReader Connection.Connection)
|
|
|
|
-- |
|
|
-- Executes a bunch of commands on the provided connection.
|
|
run :: Session a -> Connection.Connection -> IO (Either SessionError a)
|
|
run (Session impl) connection =
|
|
mask $ \restore -> onException (restore main) handler
|
|
where
|
|
main =
|
|
runExceptT $ runReaderT impl connection
|
|
handler =
|
|
case connection of
|
|
Connection.Connection pqConnVar _ registry ->
|
|
withMVar pqConnVar \pqConn ->
|
|
Pq.transactionStatus pqConn >>= \case
|
|
Pq.TransIdle -> pure ()
|
|
_ -> do
|
|
PreparedStatementRegistry.reset registry
|
|
Pq.reset pqConn
|
|
|
|
-- |
|
|
-- Possibly a multi-statement query,
|
|
-- which however cannot be parameterized or prepared,
|
|
-- nor can any results of it be collected.
|
|
sql :: ByteString -> Session ()
|
|
sql sql =
|
|
Session
|
|
$ ReaderT
|
|
$ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
|
|
ExceptT
|
|
$ fmap (first (QueryError sql []))
|
|
$ withMVar pqConnectionRef
|
|
$ \pqConnection -> do
|
|
r1 <- IO.sendNonparametricStatement pqConnection sql
|
|
r2 <- IO.getResults pqConnection integerDatetimes decoder
|
|
return $ r1 *> r2
|
|
where
|
|
decoder =
|
|
Decoders.Results.single Decoders.Result.noResult
|
|
|
|
-- |
|
|
-- Execute a statement by providing parameters to it.
|
|
statement :: params -> Statement.Statement params result -> Session result
|
|
statement input (Statement.Statement template (Encoders.Params paramsEncoder) (Decoders.Result decoder) preparable) =
|
|
Session
|
|
$ ReaderT
|
|
$ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
|
|
ExceptT
|
|
$ fmap (first (QueryError template (Encoders.Params.renderReadable paramsEncoder input)))
|
|
$ withMVar pqConnectionRef
|
|
$ \pqConnection -> do
|
|
r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input
|
|
r2 <- IO.getResults pqConnection integerDatetimes decoder
|
|
return $ r1 *> r2
|
|
|
|
-- |
|
|
-- Execute a pipeline.
|
|
pipeline :: Pipeline.Pipeline result -> Session result
|
|
pipeline pipeline =
|
|
Session $ ReaderT \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
|
|
ExceptT $ withMVar pqConnectionRef \pqConnection ->
|
|
Pipeline.run pipeline pqConnection registry integerDatetimes
|