diff --git a/hasql-transaction-io.cabal b/hasql-transaction-io.cabal --- a/hasql-transaction-io.cabal +++ b/hasql-transaction-io.cabal @@ -1,18 +1,19 @@ cabal-version: 2.4 name: hasql-transaction-io -version: 0.2.0.0 -synopsis: Perform IO actions during transactions for Hasql -description: - Perform IO actions during transactions for Hasql. If you need transactions in hasql but do not need to perform IO in the middle of the transaction, use haslq-transaction. This packages differs from hasql-transaction in that it sacrifices invisible retries for the ability to perform arbitrary IO in the middle of a transaction. This is beneficial when your transaction is long-lived (e.g. when using cursors) and you wish to perform IO with requested data. See for an example use case. +version: 0.2.1.0 +license: MIT +license-file: LICENSE +copyright: (c) 2022, 2023 Andre Marianiello +maintainer: andremarianiello@users.noreply.github.com +author: Andre Marianiello homepage: https://github.com/andremarianiello/hasql-transaction-io bug-reports: https://github.com/andremarianiello/hasql-transaction-io/issues -license: MIT -license-file: LICENSE -author: Andre Marianiello -maintainer: andremarianiello@users.noreply.github.com -copyright: (c) 2022, Andre Marianiello +synopsis: Perform IO actions during transactions for Hasql +description: + Perform IO actions during transactions for Hasql. If you need transactions in hasql but do not need to perform IO in the middle of the transaction, use haslq-transaction. This packages differs from hasql-transaction in that it sacrifices invisible retries for the ability to perform arbitrary IO in the middle of a transaction. This is beneficial when your transaction is long-lived (e.g. when using cursors) and you wish to perform IO with requested data. See for an example use case. + category: Database, PostgreSQL, Hasql source-repository head @@ -27,13 +28,16 @@ Hasql.TransactionIO Hasql.TransactionIO.Sessions + hs-source-dirs: library other-modules: Hasql.Private.CursorTransactionIO + Hasql.Private.Session.MonadThrow Hasql.Private.Session.UnliftIO Hasql.Private.Statements Hasql.Private.TransactionIO Hasql.Private.Types + default-language: Haskell2010 default-extensions: DeriveFunctor FlexibleContexts @@ -45,14 +49,12 @@ other-extensions: OverloadedStrings build-depends: , base >=4.14 && <4.17 - , bytestring >=0.10 + , bytestring >=0.10 && <0.12 , bytestring-tree-builder ^>=0.2 + , exceptions ^>=0.10 , hasql ^>=1.6 , mtl ^>=2.2 , resourcet ^>=1.2 , safe-exceptions ^>=0.1 , transformers ^>=0.5 , unliftio-core ^>=0.2 - - hs-source-dirs: library - default-language: Haskell2010 diff --git a/library/Hasql/Private/Session/MonadThrow.hs b/library/Hasql/Private/Session/MonadThrow.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Private/Session/MonadThrow.hs @@ -0,0 +1,16 @@ +module Hasql.Private.Session.MonadThrow where + +-- base +import Control.Exception + +-- transformers +import Control.Monad.IO.Class + +-- exceptions +import Control.Monad.Catch (MonadThrow (..)) + +--hasql +import Hasql.Session + +instance MonadThrow Session where + throwM = liftIO . throwIO diff --git a/library/Hasql/Private/TransactionIO.hs b/library/Hasql/Private/TransactionIO.hs --- a/library/Hasql/Private/TransactionIO.hs +++ b/library/Hasql/Private/TransactionIO.hs @@ -3,41 +3,45 @@ module Hasql.Private.TransactionIO where -- base -import Control.Applicative +import Control.Applicative -- bytestring -import Data.ByteString (ByteString) +import Data.ByteString (ByteString) -- bytestring-tree-builder -import ByteString.TreeBuilder +import ByteString.TreeBuilder -- transformers -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader -- mtl -import Control.Monad.Error.Class +import Control.Monad.Error.Class -- unliftio-core -import Control.Monad.IO.Unlift +import Control.Monad.IO.Unlift +-- safe-exceptions +import Control.Exception.Safe + -- resourcet -import Data.Acquire -import Control.Monad.Trans.Resource +import Control.Monad.Trans.Resource +import Data.Acquire -- hasql -import Hasql.Statement -import Hasql.Session -import qualified Hasql.Session as Session +import Hasql.Session +import qualified Hasql.Session as Session +import Hasql.Statement -- hasql-streaming -import Hasql.Private.Session.UnliftIO -import Hasql.Private.Types -import qualified Hasql.Private.Statements as Statements +import Hasql.Private.Session.MonadThrow +import Hasql.Private.Session.UnliftIO +import qualified Hasql.Private.Statements as Statements +import Hasql.Private.Types -- | A mixture of Hasql statements and arbitrary IO that is all performed during a single transaction newtype TransactionIO a = TransactionIO (ReaderT Transaction Session a) - deriving (Functor, Applicative, Monad, MonadIO, MonadError QueryError, MonadUnliftIO) + deriving (Functor, Applicative, Monad, MonadIO, MonadError QueryError, MonadUnliftIO, MonadThrow) data Transaction = Transaction @@ -69,8 +73,8 @@ endTransaction :: Bool -> Transaction -> ReleaseType -> Session () endTransaction prepare tx = \case - ReleaseEarly -> commitTransaction prepare tx - ReleaseNormal -> commitTransaction prepare tx + ReleaseEarly -> commitTransaction prepare tx + ReleaseNormal -> commitTransaction prepare tx ReleaseException -> rollbackTransaction prepare tx commitTransaction :: Bool -> Transaction -> Session () @@ -80,3 +84,14 @@ rollbackTransaction :: Bool -> Transaction -> Session () rollbackTransaction prepare Transaction = do Session.statement () (Statements.rollbackTransaction prepare) + + + +data CondemnTransactionException = CondemnTransactionException + deriving (Show) + +instance Exception CondemnTransactionException + +-- | Throw an internal exception that causes the transaction to be rolled back. If you wish to rollback a transaction with a more useful exception use `throwIO` +condemn :: TransactionIO () +condemn = throwIO CondemnTransactionException diff --git a/library/Hasql/TransactionIO.hs b/library/Hasql/TransactionIO.hs --- a/library/Hasql/TransactionIO.hs +++ b/library/Hasql/TransactionIO.hs @@ -1,8 +1,9 @@ module Hasql.TransactionIO ( TransactionIO, - statement, + condemn, sql, + statement, ) where -- hasql-transaction-io -import Hasql.Private.TransactionIO +import Hasql.Private.TransactionIO