nikita-volkov/hasql
1
1
Fork 0
mirror of https://github.com/nikita-volkov/hasql.git synced 2024-12-24 18:53:24 +03:00
Code Issues Projects Releases Wiki Activity

Repurpose QueryError as a more general SessionError

Browse Source
This commit is contained in:
Nikita Volkov 2024-04-21 12:34:19 +03:00
parent e76af7c559
commit 3c831284bd
5 changed files with 32 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
library/Hasql/Errors.hs
View File

@ -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"

20
library/Hasql/Pipeline/Core.hs
View File

@ -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)

10
library/Hasql/Session/Core.hs
View File

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

4
tasty/Main.hs
View File

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

12
testing-utils/Hasql/TestingUtils/TestingDsl.hs
View File

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