mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-12-26 20:12:09 +03:00
118 lines
3.6 KiB
Haskell
118 lines
3.6 KiB
Haskell
module Hasql.Private.Session
|
|
where
|
|
|
|
import Hasql.Prelude
|
|
import qualified Database.PostgreSQL.LibPQ as LibPQ
|
|
import qualified Hasql.Decoders.Results as Decoders.Results
|
|
import qualified Hasql.Decoders.Result as Decoders.Result
|
|
import qualified Hasql.Settings as Settings
|
|
import qualified Hasql.Private.IO as IO
|
|
import qualified Hasql.Private.Query as Query
|
|
import qualified Hasql.Private.Connection as Connection
|
|
|
|
|
|
-- |
|
|
-- A batch of actions to be executed in the context of a database connection.
|
|
newtype Session a =
|
|
Session (ReaderT Connection.Connection (EitherT Error IO) a)
|
|
deriving (Functor, Applicative, Monad, MonadError Error, MonadIO)
|
|
|
|
-- |
|
|
-- Executes a bunch of commands on the provided connection.
|
|
run :: Session a -> Connection.Connection -> IO (Either Error a)
|
|
run (Session impl) connection =
|
|
runEitherT $
|
|
runReaderT impl connection
|
|
|
|
-- |
|
|
-- 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) ->
|
|
EitherT $ fmap (mapLeft unsafeCoerce) $ withMVar pqConnectionRef $ \pqConnection -> do
|
|
r1 <- IO.sendNonparametricQuery pqConnection sql
|
|
r2 <- IO.getResults pqConnection integerDatetimes decoder
|
|
return $ r1 *> r2
|
|
where
|
|
decoder =
|
|
Decoders.Results.single $
|
|
Decoders.Result.unit
|
|
|
|
-- |
|
|
-- Parameters and a specification of the parametric query to apply them to.
|
|
query :: a -> Query.Query a b -> Session b
|
|
query input (Query.Query (Kleisli impl)) =
|
|
Session $ unsafeCoerce $ impl input
|
|
|
|
|
|
-- * Error
|
|
-------------------------
|
|
|
|
-- |
|
|
-- An error of some command in the session.
|
|
data Error =
|
|
-- |
|
|
-- An error on the client-side,
|
|
-- with a message generated by the \"libpq\" library.
|
|
-- Usually indicates problems with connection.
|
|
ClientError !(Maybe ByteString) |
|
|
-- |
|
|
-- Some error with a command result.
|
|
ResultError !ResultError
|
|
deriving (Show, Eq)
|
|
|
|
-- |
|
|
-- An error with a command result.
|
|
data ResultError =
|
|
-- |
|
|
-- An error reported by the DB.
|
|
-- Consists of the following: Code, message, details, hint.
|
|
--
|
|
-- * __Code__.
|
|
-- The SQLSTATE code for the error.
|
|
-- It's recommended to use
|
|
-- <http://hackage.haskell.org/package/postgresql-error-codes the "postgresql-error-codes" package>
|
|
-- to work with those.
|
|
--
|
|
-- * __Message__.
|
|
-- The primary human-readable error message (typically one line). Always present.
|
|
--
|
|
-- * __Details__.
|
|
-- An optional secondary error message carrying more detail about the problem.
|
|
-- Might run to multiple lines.
|
|
--
|
|
-- * __Hint__.
|
|
-- An optional suggestion on what to do about the problem.
|
|
-- This is intended to differ from detail in that it offers advice (potentially inappropriate)
|
|
-- rather than hard facts.
|
|
-- Might run to multiple lines.
|
|
ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |
|
|
-- |
|
|
-- The database returned an unexpected result.
|
|
-- Indicates an improper statement or a schema mismatch.
|
|
UnexpectedResult !Text |
|
|
-- |
|
|
-- An error of the row reader, preceded by the index of the row.
|
|
RowError !Int !RowError |
|
|
-- |
|
|
-- An unexpected amount of rows.
|
|
UnexpectedAmountOfRows !Int
|
|
deriving (Show, Eq)
|
|
|
|
-- |
|
|
-- An error during the decoding of a specific row.
|
|
data RowError =
|
|
-- |
|
|
-- Appears on the attempt to parse more columns than there are in the result.
|
|
EndOfInput |
|
|
-- |
|
|
-- Appears on the attempt to parse a @NULL@ as some value.
|
|
UnexpectedNull |
|
|
-- |
|
|
-- Appears when a wrong value parser is used.
|
|
-- Comes with the error details.
|
|
ValueError !Text
|
|
deriving (Show, Eq)
|