mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-12-25 11:11:36 +03:00
Repurpose QueryError as a more general SessionError
This commit is contained in:
parent
e76af7c559
commit
3c831284bd
@ -13,15 +13,16 @@ module Hasql.Errors where
|
||||
import Data.ByteString.Char8 qualified as BC
|
||||
import Hasql.Prelude
|
||||
|
||||
-- |
|
||||
-- An error during the execution of a query.
|
||||
-- Comes packed with the query template and a textual representation of the provided params.
|
||||
data QueryError
|
||||
= QueryError ByteString [Text] CommandError
|
||||
-- | Error during execution of a session.
|
||||
data SessionError
|
||||
= -- |
|
||||
-- An error during the execution of a query.
|
||||
-- Comes packed with the query template and a textual representation of the provided params.
|
||||
QuerySessionError ByteString [Text] CommandError
|
||||
deriving (Show, Eq, Typeable)
|
||||
|
||||
instance Exception QueryError where
|
||||
displayException (QueryError query params commandError) =
|
||||
instance Exception SessionError where
|
||||
displayException (QuerySessionError query params commandError) =
|
||||
let queryContext :: Maybe (ByteString, Int)
|
||||
queryContext = case commandError of
|
||||
ClientError _ -> Nothing
|
||||
@ -59,7 +60,7 @@ instance Exception QueryError where
|
||||
prettyQuery = case queryContext of
|
||||
Nothing -> query
|
||||
Just (message, pos) -> formatErrorContext query message pos
|
||||
in "QueryError!\n"
|
||||
in "QuerySessionError!\n"
|
||||
<> "\n Query:\n"
|
||||
<> BC.unpack prettyQuery
|
||||
<> "\n"
|
||||
|
@ -15,7 +15,7 @@ import Hasql.Prelude
|
||||
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry
|
||||
import Hasql.Statement qualified as Statement
|
||||
|
||||
run :: Pipeline a -> Connection.Connection -> IO (Either QueryError a)
|
||||
run :: Pipeline a -> Connection.Connection -> IO (Either SessionError a)
|
||||
run (Pipeline send) (Connection.Connection pqConnectionRef integerDatetimes registry) =
|
||||
withMVar pqConnectionRef \pqConnection -> do
|
||||
runCommandFailing pqConnection $ Pq.enterPipelineMode pqConnection
|
||||
@ -42,7 +42,7 @@ newtype Pipeline a
|
||||
( Pq.Connection ->
|
||||
PreparedStatementRegistry.PreparedStatementRegistry ->
|
||||
Bool ->
|
||||
IO (Either QueryError (IO (Either QueryError a)))
|
||||
IO (Either SessionError (IO (Either SessionError a)))
|
||||
)
|
||||
deriving (Functor)
|
||||
|
||||
@ -89,10 +89,10 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Re
|
||||
sent <- Pq.sendPrepare connection key sql (mfilter (not . null) (Just oidList))
|
||||
if sent
|
||||
then pure (True, Right (key, recv))
|
||||
else (False,) . Left . commandToQueryError . ClientError <$> Pq.errorMessage connection
|
||||
else (False,) . Left . commandToSessionError . ClientError <$> Pq.errorMessage connection
|
||||
where
|
||||
recv =
|
||||
fmap (mapLeft commandToQueryError)
|
||||
fmap (mapLeft commandToSessionError)
|
||||
$ (<*)
|
||||
<$> Decoders.Results.run (Decoders.Results.single Decoders.Result.noResult) connection integerDatetimes
|
||||
<*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes
|
||||
@ -101,25 +101,25 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Re
|
||||
|
||||
sendQuery key =
|
||||
Pq.sendQueryPrepared connection key valueAndFormatList Pq.Binary >>= \case
|
||||
False -> Left . commandToQueryError . ClientError <$> Pq.errorMessage connection
|
||||
False -> Left . commandToSessionError . ClientError <$> Pq.errorMessage connection
|
||||
True -> pure (Right recv)
|
||||
where
|
||||
recv =
|
||||
fmap (mapLeft commandToQueryError)
|
||||
fmap (mapLeft commandToSessionError)
|
||||
$ (<*)
|
||||
<$> Decoders.Results.run decoder connection integerDatetimes
|
||||
<*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes
|
||||
|
||||
runUnprepared =
|
||||
Pq.sendQueryParams connection sql (Encoders.Params.compileUnpreparedStatementData encoder integerDatetimes params) Pq.Binary >>= \case
|
||||
False -> Left . commandToQueryError . ClientError <$> Pq.errorMessage connection
|
||||
False -> Left . commandToSessionError . ClientError <$> Pq.errorMessage connection
|
||||
True -> pure (Right recv)
|
||||
where
|
||||
recv =
|
||||
fmap (mapLeft commandToQueryError)
|
||||
fmap (mapLeft commandToSessionError)
|
||||
$ (<*)
|
||||
<$> Decoders.Results.run decoder connection integerDatetimes
|
||||
<*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes
|
||||
|
||||
commandToQueryError =
|
||||
QueryError sql (Encoders.Params.renderReadable encoder params)
|
||||
commandToSessionError =
|
||||
QuerySessionError sql (Encoders.Params.renderReadable encoder params)
|
||||
|
@ -15,12 +15,12 @@ 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 QueryError IO) a)
|
||||
deriving (Functor, Applicative, Monad, MonadError QueryError, MonadIO, MonadReader Connection.Connection)
|
||||
= 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 QueryError a)
|
||||
run :: Session a -> Connection.Connection -> IO (Either SessionError a)
|
||||
run (Session impl) connection =
|
||||
runExceptT
|
||||
$ runReaderT impl connection
|
||||
@ -35,7 +35,7 @@ sql sql =
|
||||
$ ReaderT
|
||||
$ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
|
||||
ExceptT
|
||||
$ fmap (mapLeft (QueryError sql []))
|
||||
$ fmap (mapLeft (QuerySessionError sql []))
|
||||
$ withMVar pqConnectionRef
|
||||
$ \pqConnection -> do
|
||||
r1 <- IO.sendNonparametricStatement pqConnection sql
|
||||
@ -53,7 +53,7 @@ statement input (Statement.Statement template (Encoders.Params paramsEncoder) (D
|
||||
$ ReaderT
|
||||
$ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->
|
||||
ExceptT
|
||||
$ fmap (mapLeft (QueryError template (Encoders.Params.renderReadable paramsEncoder input)))
|
||||
$ fmap (mapLeft (QuerySessionError template (Encoders.Params.renderReadable paramsEncoder input)))
|
||||
$ withMVar pqConnectionRef
|
||||
$ \pqConnection -> do
|
||||
r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input
|
||||
|
@ -56,7 +56,7 @@ tree =
|
||||
in do
|
||||
x <- Connection.with (Session.run session)
|
||||
assertBool (show x) $ case x of
|
||||
Right (Left (Session.QueryError "select true where 1 = any ($1) and $2" ["[3, 7]", "\"a\""] _)) -> True
|
||||
Right (Left (Session.QuerySessionError "select true where 1 = any ($1) and $2" ["[3, 7]", "\"a\""] _)) -> True
|
||||
_ -> False,
|
||||
testCase "IN simulation"
|
||||
$ let statement =
|
||||
@ -218,7 +218,7 @@ tree =
|
||||
where
|
||||
resultTest =
|
||||
\case
|
||||
Right (Left (Session.QueryError _ _ (Session.ResultError (Session.ServerError "26000" _ _ _ _)))) -> False
|
||||
Right (Left (Session.QuerySessionError _ _ (Session.ResultError (Session.ServerError "26000" _ _ _ _)))) -> False
|
||||
_ -> True
|
||||
session =
|
||||
catchError session (const (pure ())) *> session
|
||||
|
@ -1,7 +1,7 @@
|
||||
module Hasql.TestingUtils.TestingDsl
|
||||
( Session.Session,
|
||||
SessionError (..),
|
||||
Session.QueryError (..),
|
||||
Error (..),
|
||||
Session.SessionError (..),
|
||||
Session.CommandError (..),
|
||||
Pipeline.Pipeline,
|
||||
Statement.Statement (..),
|
||||
@ -19,12 +19,12 @@ import Hasql.Statement qualified as Statement
|
||||
import Hasql.TestingUtils.Constants qualified as Constants
|
||||
import Prelude
|
||||
|
||||
data SessionError
|
||||
data Error
|
||||
= ConnectionError (Connection.ConnectionError)
|
||||
| SessionError (Session.QueryError)
|
||||
| SessionError (Session.SessionError)
|
||||
deriving (Show, Eq)
|
||||
|
||||
runSessionOnLocalDb :: Session.Session a -> IO (Either SessionError a)
|
||||
runSessionOnLocalDb :: Session.Session a -> IO (Either Error a)
|
||||
runSessionOnLocalDb session =
|
||||
runExceptT $ acquire >>= \connection -> use connection <* release connection
|
||||
where
|
||||
@ -37,7 +37,7 @@ runSessionOnLocalDb session =
|
||||
release connection =
|
||||
lift $ Connection.release connection
|
||||
|
||||
runPipelineOnLocalDb :: Pipeline.Pipeline a -> IO (Either SessionError a)
|
||||
runPipelineOnLocalDb :: Pipeline.Pipeline a -> IO (Either Error a)
|
||||
runPipelineOnLocalDb =
|
||||
runSessionOnLocalDb . Session.pipeline
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user