mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-12-28 21:14:55 +03:00
TxError -> SessionError
This commit is contained in:
parent
ed11b5e48d
commit
84d11c5606
@ -124,7 +124,7 @@ newBatchGate amount =
|
|||||||
type Session m =
|
type Session m =
|
||||||
H.Session HP.Postgres m
|
H.Session HP.Postgres m
|
||||||
|
|
||||||
session :: MonadBaseControl IO m => Session m r -> m (Either (H.TxError HP.Postgres) r)
|
session :: MonadBaseControl IO m => Session m r -> m (Either (H.SessionError HP.Postgres) r)
|
||||||
session m =
|
session m =
|
||||||
control $ \unlift -> do
|
control $ \unlift -> do
|
||||||
p <- H.acquirePool backendSettings poolSettings
|
p <- H.acquirePool backendSettings poolSettings
|
||||||
|
@ -23,6 +23,9 @@ module Hasql
|
|||||||
Session,
|
Session,
|
||||||
session,
|
session,
|
||||||
|
|
||||||
|
-- ** Session Error
|
||||||
|
SessionError(..),
|
||||||
|
|
||||||
-- * Statement
|
-- * Statement
|
||||||
Bknd.Stmt,
|
Bknd.Stmt,
|
||||||
stmt,
|
stmt,
|
||||||
@ -43,9 +46,6 @@ module Hasql
|
|||||||
Bknd.TxIsolationLevel(..),
|
Bknd.TxIsolationLevel(..),
|
||||||
Bknd.TxWriteMode(..),
|
Bknd.TxWriteMode(..),
|
||||||
|
|
||||||
-- ** Transaction Error
|
|
||||||
TxError(..),
|
|
||||||
|
|
||||||
-- ** Result Stream
|
-- ** Result Stream
|
||||||
TxListT,
|
TxListT,
|
||||||
|
|
||||||
@ -144,14 +144,14 @@ poolSettings size timeout =
|
|||||||
-- A convenience wrapper around 'ReaderT',
|
-- A convenience wrapper around 'ReaderT',
|
||||||
-- which provides a shared context for execution and error-handling of transactions.
|
-- which provides a shared context for execution and error-handling of transactions.
|
||||||
newtype Session c m r =
|
newtype Session c m r =
|
||||||
Session (ReaderT (Pool c) (EitherT (TxError c) m) r)
|
Session (ReaderT (Pool c) (EitherT (SessionError c) m) r)
|
||||||
deriving (Functor, Applicative, Monad, MonadIO, MonadError (TxError c))
|
deriving (Functor, Applicative, Monad, MonadIO, MonadError (SessionError c))
|
||||||
|
|
||||||
instance MonadTrans (Session c) where
|
instance MonadTrans (Session c) where
|
||||||
lift = Session . lift . lift
|
lift = Session . lift . lift
|
||||||
|
|
||||||
instance MonadTransControl (Session c) where
|
instance MonadTransControl (Session c) where
|
||||||
type StT (Session c) a = Either (TxError c) a
|
type StT (Session c) a = Either (SessionError c) a
|
||||||
liftWith onUnlift =
|
liftWith onUnlift =
|
||||||
Session $ ReaderT $ \e ->
|
Session $ ReaderT $ \e ->
|
||||||
lift $ onUnlift $ \(Session m) ->
|
lift $ onUnlift $ \(Session m) ->
|
||||||
@ -177,7 +177,7 @@ instance MFunctor (Session c) where
|
|||||||
-- This is merely a wrapper around 'runReaderT',
|
-- This is merely a wrapper around 'runReaderT',
|
||||||
-- so you can run it around every transaction,
|
-- so you can run it around every transaction,
|
||||||
-- if you want.
|
-- if you want.
|
||||||
session :: Pool c -> Session c m a -> m (Either (TxError c) a)
|
session :: Pool c -> Session c m a -> m (Either (SessionError c) a)
|
||||||
session pool m =
|
session pool m =
|
||||||
runEitherT $ flip runReaderT pool $ case m of Session m -> m
|
runEitherT $ flip runReaderT pool $ case m of Session m -> m
|
||||||
|
|
||||||
@ -197,27 +197,27 @@ session pool m =
|
|||||||
-- an unpredictable amount of times as well,
|
-- an unpredictable amount of times as well,
|
||||||
-- which, chances are, is not what you want.
|
-- which, chances are, is not what you want.
|
||||||
newtype Tx c s r =
|
newtype Tx c s r =
|
||||||
Tx { unwrapTx :: EitherT (TxError c) (Bknd.Tx c) r }
|
Tx { unwrapTx :: EitherT (SessionError c) (Bknd.Tx c) r }
|
||||||
deriving (Functor, Applicative, Monad)
|
deriving (Functor, Applicative, Monad)
|
||||||
|
|
||||||
|
|
||||||
data TxError c =
|
data SessionError c =
|
||||||
-- |
|
-- |
|
||||||
-- A backend-specific connection acquisition error.
|
-- A backend-specific connection acquisition error.
|
||||||
-- E.g., a failure to establish a connection.
|
-- E.g., a failure to establish a connection.
|
||||||
BackendCxError (Bknd.CxError c) |
|
CxError (Bknd.CxError c) |
|
||||||
-- |
|
-- |
|
||||||
-- A backend-specific transaction error.
|
-- A backend-specific transaction error.
|
||||||
-- It should cover all possible failures related to an established connection,
|
-- It should cover all possible failures related to an established connection,
|
||||||
-- including the loss of connection, query errors and database failures.
|
-- including the loss of connection, query errors and database failures.
|
||||||
BackendTxError (Bknd.TxError c) |
|
TxError (Bknd.TxError c) |
|
||||||
-- |
|
-- |
|
||||||
-- Attempt to parse a result into an incompatible type.
|
-- Attempt to parse a result into an incompatible type.
|
||||||
-- Indicates either a mismatching schema or an incorrect query.
|
-- Indicates either a mismatching schema or an incorrect query.
|
||||||
UnparsableResult Text
|
UnparsableResult Text
|
||||||
|
|
||||||
deriving instance (Show (Bknd.CxError c), Show (Bknd.TxError c)) => Show (TxError c)
|
deriving instance (Show (Bknd.CxError c), Show (Bknd.TxError c)) => Show (SessionError c)
|
||||||
deriving instance (Eq (Bknd.CxError c), Eq (Bknd.TxError c)) => Eq (TxError c)
|
deriving instance (Eq (Bknd.CxError c), Eq (Bknd.TxError c)) => Eq (SessionError c)
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Execute a transaction in a session.
|
-- Execute a transaction in a session.
|
||||||
@ -228,11 +228,11 @@ tx :: (Bknd.CxTx c, MonadBaseControl IO m) => Bknd.TxMode -> (forall s. Tx c s r
|
|||||||
tx mode (Tx m) =
|
tx mode (Tx m) =
|
||||||
Session $ ReaderT $ \(Pool pool) ->
|
Session $ ReaderT $ \(Pool pool) ->
|
||||||
Pool.withResource pool $ \e -> do
|
Pool.withResource pool $ \e -> do
|
||||||
c <- hoistEither $ mapLeft BackendCxError e
|
c <- hoistEither $ mapLeft CxError e
|
||||||
let
|
let
|
||||||
attempt =
|
attempt =
|
||||||
do
|
do
|
||||||
r <- EitherT $ liftBase $ fmap (either (Left . BackendTxError) Right) $
|
r <- EitherT $ liftBase $ fmap (either (Left . TxError) Right) $
|
||||||
Bknd.runTx c mode $ runEitherT m
|
Bknd.runTx c mode $ runEitherT m
|
||||||
maybe attempt hoistEither r
|
maybe attempt hoistEither r
|
||||||
in attempt
|
in attempt
|
||||||
|
@ -28,7 +28,7 @@ import Control.Monad.Trans.Control as Exports hiding (embed, embed_)
|
|||||||
|
|
||||||
-- mtl
|
-- mtl
|
||||||
-------------------------
|
-------------------------
|
||||||
import Control.Monad.Error.Class as Exports
|
import Control.Monad.Error.Class as Exports hiding (Error)
|
||||||
|
|
||||||
-- mmorph
|
-- mmorph
|
||||||
-------------------------
|
-------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user