hasql-transaction 0.10.0.3 → 1

raw patch · 16 files changed

+363/−431 lines, 16 filesdep +bytestring-tree-builderdep +rebasedep −bytestring-strict-builderdep −profunctorsdep −rerebasePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring-tree-builder, rebase

Dependencies removed: bytestring-strict-builder, profunctors, rerebase, selective, semigroupoids

API changes (from Hackage documentation)

Files

• conflicts-test/Main.hs +12/−11
• conflicts-test/Main/Statements.hs +1/−1
• conflicts-test/Main/Transactions.hs +17/−12
• hasql-transaction.cabal +13/−14
• library/Hasql/Transaction.hs +7/−143
• library/Hasql/Transaction/Builders.hs +0/−22
• library/Hasql/Transaction/Prelude.hs +0/−127
• library/Hasql/Transaction/Private/Model.hs +25/−0
• library/Hasql/Transaction/Private/Prelude.hs +103/−0
• library/Hasql/Transaction/Private/SQL.hs +29/−0
• library/Hasql/Transaction/Private/Sessions.hs +34/−0
• library/Hasql/Transaction/Private/Statements.hs +50/−0
• library/Hasql/Transaction/Private/Transaction.hs +57/−0
• library/Hasql/Transaction/Sessions.hs +15/−42
• library/Hasql/Transaction/Statements.hs +0/−23
• library/Hasql/Transaction/Types.hs +0/−36

@@ -1,9 +1,10 @@ module Main where -import Prelude+import Rebase.Prelude import qualified Hasql.Connection as A import qualified Hasql.Session as B import qualified Hasql.Transaction as C+import qualified Hasql.Transaction.Sessions as G import qualified Main.Statements as D import qualified Main.Transactions as E import qualified Control.Concurrent.Async as F@@ -24,13 +25,13 @@               A.settings "localhost" 5432 "postgres" "" "postgres"     release (connection1, connection2) =       do-        transact connection1 E.dropSchema+        transaction connection1 E.dropSchema         A.release connection1         A.release connection2     use (connection1, connection2) =       do-        try (transact connection1 E.dropSchema) :: IO (Either SomeException ())-        transact connection1 E.createSchema+        try (transaction connection1 E.dropSchema) :: IO (Either SomeException ())+        transaction connection1 E.createSchema         success <- fmap and (traverse runTest tests)         if success           then exitSuccess@@ -46,8 +47,8 @@   B.run session connection >>=   either (fail . show) return -transact connection transaction =-  session connection (C.transact transaction)+transaction connection transaction =+  session connection (G.transaction G.RepeatableRead G.Write transaction)   type Test =@@ -58,8 +59,8 @@   do     id1 <- session connection1 (B.statement 0 D.createAccount)     id2 <- session connection1 (B.statement 0 D.createAccount)-    async1 <- F.async (replicateM_ 1000 (transact connection1 (E.transfer id1 id2 1)))-    async2 <- F.async (replicateM_ 1000 (transact connection2 (E.transfer id1 id2 1)))+    async1 <- F.async (replicateM_ 1000 (transaction connection1 (E.transfer id1 id2 1)))+    async2 <- F.async (replicateM_ 1000 (transaction connection2 (E.transfer id1 id2 1)))     F.wait async1     F.wait async2     balance1 <- session connection1 (B.statement id1 D.getBalance)@@ -73,8 +74,8 @@   do     id1 <- session connection1 (B.statement 0 D.createAccount)     id2 <- session connection1 (B.statement 0 D.createAccount)-    async1 <- F.async (replicateM_ 1000 (transact connection1 (E.transfer id1 id2 1)))-    async2 <- F.async (replicateM_ 1000 (transact connection2 (E.getBalance id1)))+    async1 <- F.async (replicateM_ 1000 (transaction connection1 (E.transfer id1 id2 1)))+    async2 <- F.async (replicateM_ 1000 (transaction connection2 (C.statement id1 D.getBalance)))     F.wait async1     F.wait async2     balance1 <- session connection1 (B.statement id1 D.getBalance)@@ -88,7 +89,7 @@   do     id1 <- session connection1 (B.statement 0 D.createAccount)     id2 <- session connection1 (B.statement 0 D.createAccount)-    async1 <- F.async (transact connection1 (E.transferTimes 200 id1 id2 1))+    async1 <- F.async (transaction connection1 (E.transferTimes 200 id1 id2 1))     async2 <- F.async (session connection2 (replicateM_ 200 (B.statement (id1, 1) D.modifyBalance)))     F.wait async1     F.wait async2

@@ -1,6 +1,6 @@ module Main.Statements where -import Prelude+import Rebase.Prelude import Hasql.Statement import qualified Hasql.Encoders as E import qualified Hasql.Decoders as D

@@ -1,25 +1,30 @@ module Main.Transactions where -import Prelude+import Rebase.Prelude import Hasql.Transaction import qualified Main.Statements as A   createSchema :: Transaction ()-createSchema = statement Write Serializable A.createAccountTable ()+createSchema =+  do+    statement () A.createAccountTable  dropSchema :: Transaction ()-dropSchema = statement Write Serializable A.dropAccountTable ()+dropSchema =+  do+    statement () A.dropAccountTable  transfer :: Int64 -> Int64 -> Scientific -> Transaction Bool-transfer id1 id2 amount = do-  ifS-    (statement Write Serializable A.modifyBalance (id1, amount))-    (statement Write Serializable A.modifyBalance (id2, negate amount))-    (pure False)+transfer id1 id2 amount =+  do+    success <- statement (id1, amount) A.modifyBalance+    if success+      then+        statement (id2, negate amount) A.modifyBalance+      else+        return False  transferTimes :: Int -> Int64 -> Int64 -> Scientific -> Transaction ()-transferTimes times id1 id2 amount = replicateM_ times (transfer id1 id2 amount)--getBalance :: Int64 -> Transaction (Maybe Scientific)-getBalance id = statement Read ReadCommitted A.getBalance id+transferTimes times id1 id2 amount =+  replicateM_ times (transfer id1 id2 amount)

@@ -1,7 +1,7 @@ name: hasql-transaction-version: 0.10.0.3+version: 1 category: Hasql, Database, PostgreSQL-synopsis: Composable abstraction over retryable transactions for Hasql+synopsis: A composable abstraction over the retryable transactions for Hasql homepage: https://github.com/nikita-volkov/hasql-transaction bug-reports: https://github.com/nikita-volkov/hasql-transaction/issues author: Nikita Volkov <nikita.y.volkov@mail.ru>@@ -22,24 +22,23 @@   default-language: Haskell2010   exposed-modules:     Hasql.Transaction-  other-modules:-    Hasql.Transaction.Builders-    Hasql.Transaction.Prelude     Hasql.Transaction.Sessions-    Hasql.Transaction.Statements-    Hasql.Transaction.Types+  other-modules:+    Hasql.Transaction.Private.Prelude+    Hasql.Transaction.Private.Model+    Hasql.Transaction.Private.SQL+    Hasql.Transaction.Private.Statements+    Hasql.Transaction.Private.Sessions+    Hasql.Transaction.Private.Transaction   build-depends:     base >=4.9 && <5,     bytestring >=0.10 && <0.11,-    bytestring-strict-builder >=0.4.5.3 && <0.5,+    bytestring-tree-builder >=0.1 && <0.3,     contravariant >=1.3 && <2,     contravariant-extras >=0.3 && <0.4,     hasql >=1.4 && <1.5,     mtl >=2 && <3,-    profunctors >=5 && <6,-    transformers >=0.3 && <0.6,-    selective >=0.4 && <0.5,-    semigroupoids >=5.3.2 && <6+    transformers >=0.3 && <0.6  test-suite conflicts-test   type: exitcode-stdio-1.0@@ -55,7 +54,7 @@     -threaded     "-with-rtsopts=-N"   build-depends:-    async >=2.1 && <3,     hasql-transaction,     hasql,-    rerebase >=1.4 && <2+    async >=2.1 && <3,+    rebase <2

@@ -1,150 +1,14 @@-{-|-DSL for composition of transactions with automated conflict resolution.--}+-- |+-- An API for declaration of transactions. module Hasql.Transaction (-  {-* Sessions -}-  transact,-  {-* Transaction -}+  -- * Transaction monad   Transaction,-  statement,-  sql,-  session,   condemn,-  restrict,-  {-* Settings -}-  Mode(..),-  Level(..),-  {-* Reexports -}-  {-|-  This module also reexports the following types for you to require lesser imports:-  -  * `Reexports.Session`-  * `Reexports.Statement`-  -}-  module Reexports,+  sql,+  statement, ) where -import Hasql.Transaction.Prelude-import Hasql.Transaction.Types-import qualified Hasql.Session as Reexports (Session)-import qualified Hasql.Statement as Reexports (Statement)-import qualified Hasql.Session as Session-import qualified Hasql.Statement as Statement-import qualified Hasql.Transaction.Sessions as Sessions---{-|-Execute transaction in session.--}-transact :: Transaction a -> Session.Session a-transact (Transaction mode level list) =-  Sessions.inAlternatingTransaction mode level $-  fmap (flip runStateT Uncondemned) list---{-|-Composable transaction providing for automated conflict resolution.--Mode and level is associated with the transaction,-which makes them participate in composition.-In a composed transaction they become the strictest of the ones-associated with the transactions that constitute it.-This allows you to safely compose transactions with different-ACID guarantees.--It cannot have an instance of Monad,-because it makes it impossible to implement composition of-mode and level associated with constituent transactions.-It still however is possible to compose transactions-in such a way that the result of a transaction is used-to decide which transaction to execute next,-thanks to the recently discovered `Selective` interface.--Supports alternative branching,-where the alternative gets executed in case of a transaction conflict.--}-data Transaction a = Transaction Mode Level [StateT Condemnation Session.Session a]--deriving instance Functor Transaction--instance Applicative Transaction where-  pure = Transaction minBound minBound . pure . pure-  (<*>) (Transaction mode1 level1 list1) (Transaction mode2 level2 list2) =-    Transaction (max mode1 mode2) (max level1 level2) ((<*>) <$> list1 <*> list2)--instance Selective Transaction where-  select (Transaction mode1 level1 list1) (Transaction mode2 level2 list2) =-    Transaction (max mode1 mode2) (max level1 level2) (select <$> list1 <*> list2)--instance Alt Transaction where-  (<!>) (Transaction mode1 level1 list1) (Transaction mode2 level2 list2) =-    Transaction (max mode1 mode2) (max level1 level2) (list1 <> list2)--{-|-Execute a single statement under mode and level.--__Warning:__ The statement must not be transaction-related-like @BEGIN@, @COMMIT@ or @ABORT@, otherwise you'll break the abstraction.--}-statement :: Mode -> Level -> Statement.Statement i o -> i -> Transaction o-statement mode level statement i = session mode level $ Session.statement i statement--{-|-Execute a possibly multistatement SQL string under a mode and level.-SQL strings cannot be dynamically parameterized or produce a result.--__Warning:__ SQL must not be transaction-related-like @BEGIN@, @COMMIT@ or @ABORT@, otherwise you'll break the abstraction.--}-sql :: Mode -> Level -> ByteString -> Transaction ()-sql mode level sql = session mode level $ Session.sql sql--{-|-Execute a composition of statements under the same mode and level.--__Warning:__--1. You must know that it is possible to break the abstraction,-if you execute statements such as @BEGIN@ inside of the session.--1. For the same reason you cannot execute other transactions inside of that session.--1. You must beware that in case of conflicts any IO code that you may lift-into session will get executed multiple times.-This is the way the automatic conflict resolution works:-the transaction gets retried, when a conflict arises.-So be cautious about doing any mutations or rocket launches in that IO!-Simply pinging for things such as current time is totally fine though.-Still it's not recommended because it's often a symptom of bad application design.--Due to the mentioned it's highly advised to keep all the session code-inside of the definition of a transaction.-Thus you'll be guaranteed to have control over what's going on inside of the-executed session and it will not be possible for this code-to be affected by any outside changes or used elsewhere.--}-session :: Mode -> Level -> Session.Session a -> Transaction a-session mode level session = Transaction mode level [lift session]--{-|-Cause transaction to eventually roll back.--This allows to perform some transactional actions,-collecting their results, and decide,-whether to commit the introduced changes to the DB-based on those results,-as well as emit those results outside of the transaction.--}-condemn :: Transaction ()-condemn = Transaction minBound minBound [put Condemned]--{-|-Restrict the transaction isolation level.--Will pick up the strictest level among the one you've specified and-the one already associated with the transaction being updated.--}-restrict :: Level -> Transaction a -> Transaction a-restrict newLevel (Transaction mode oldLevel sessions) = Transaction mode (max newLevel oldLevel) sessions+import Hasql.Transaction.Private.Transaction+import Hasql.Transaction.Private.Model

@@ -1,22 +0,0 @@-module Hasql.Transaction.Builders-where--import Hasql.Transaction.Prelude-import Hasql.Transaction.Types-import ByteString.StrictBuilder---beginTransaction :: Mode -> Level -> Builder-beginTransaction mode_ level_ =-  "begin " <> level level_ <> " " <> mode mode_--level :: Level -> Builder-level = \ case-  ReadCommitted -> "isolation level read committed"-  RepeatableRead -> "isolation level repeatable read"-  Serializable -> "isolation level serializable"--mode :: Mode -> Builder-mode = \ case-  Write -> "read write"-  Read -> "read only"

@@ -1,127 +0,0 @@-module Hasql.Transaction.Prelude-( -  module Exports,-  tryError,-)-where----- base---------------------------import Control.Applicative as Exports-import Control.Arrow as Exports-import Control.Category as Exports-import Control.Concurrent as Exports-import Control.Exception as Exports-import Control.Monad as Exports hiding (join, fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports-import Control.Monad.Fail as Exports-import Control.Monad.Fix as Exports hiding (fix)-import Control.Monad.ST as Exports-import Data.Bits as Exports-import Data.Bool as Exports-import Data.Char as Exports-import Data.Coerce as Exports-import Data.Complex as Exports-import Data.Data as Exports-import Data.Dynamic as Exports-import Data.Either as Exports-import Data.Fixed as Exports-import Data.Foldable as Exports hiding (toList)-import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports-import Data.Functor.Identity as Exports-import Data.Int as Exports-import Data.IORef as Exports-import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Last(..), First(..), (<>), Alt)-import Data.Ord as Exports-import Data.Proxy as Exports-import Data.Ratio as Exports-import Data.Semigroup as Exports-import Data.STRef as Exports-import Data.String as Exports-import Data.Traversable as Exports-import Data.Tuple as Exports-import Data.Unique as Exports-import Data.Version as Exports-import Data.Word as Exports-import Debug.Trace as Exports-import Foreign.ForeignPtr as Exports-import Foreign.Ptr as Exports-import Foreign.StablePtr as Exports-import Foreign.Storable as Exports hiding (sizeOf, alignment)-import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..))-import GHC.Generics as Exports (Generic, Generic1)-import GHC.IO.Exception as Exports-import Numeric as Exports-import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))-import System.Environment as Exports-import System.Exit as Exports-import System.IO as Exports-import System.IO.Error as Exports-import System.IO.Unsafe as Exports-import System.Mem as Exports-import System.Mem.StableName as Exports-import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)-import Unsafe.Coerce as Exports---- selective---------------------------import Control.Selective as Exports---- transformers---------------------------import Control.Monad.IO.Class as Exports-import Control.Monad.Trans.Class as Exports-import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)-import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)-import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)---- semigroupoids---------------------------import Data.Bifunctor.Apply as Exports hiding (first, second)-import Data.Functor.Alt as Exports hiding (($>), many, some, optional)-import Data.Functor.Apply as Exports hiding (($>))-import Data.Functor.Bind as Exports hiding (join, ($>))-import Data.Functor.Extend as Exports-import Data.Functor.Plus as Exports hiding (($>), some, many, optional)-import Data.Semigroup.Bifoldable as Exports-import Data.Semigroup.Bitraversable as Exports-import Data.Semigroup.Foldable as Exports-import Data.Semigroup.Traversable as Exports-import Data.Semigroupoid as Exports (Semigroupoid(..))---- mtl---------------------------import Control.Monad.Error.Class as Exports (MonadError (..))---- profunctors---------------------------import Data.Profunctor.Unsafe as Exports-import Data.Profunctor.Choice as Exports-import Data.Profunctor.Strong as Exports---- contravariant---------------------------import Data.Functor.Contravariant as Exports-import Data.Functor.Contravariant.Divisible as Exports---- contravariant-extras---------------------------import Contravariant.Extras as Exports---- bytestring---------------------------import Data.ByteString as Exports (ByteString)--tryError :: MonadError e m => m a -> m (Either e a)-tryError m =-  catchError (liftM Right m) (return . Left)

@@ -0,0 +1,25 @@+module Hasql.Transaction.Private.Model+where++import Hasql.Transaction.Private.Prelude++-- |+--+data Mode =+  -- |+  -- Read-only. No writes possible.+  Read |+  -- |+  -- Write and commit.+  Write+  deriving (Show, Eq, Ord, Enum, Bounded)++-- |+-- For reference see+-- <http://www.postgresql.org/docs/current/static/transaction-iso.html the Postgres' documentation>.+--+data IsolationLevel =+  ReadCommitted |+  RepeatableRead |+  Serializable+  deriving (Show, Eq, Ord, Enum, Bounded)

@@ -0,0 +1,103 @@+module Hasql.Transaction.Private.Prelude+( +  module Exports,+  tryError,+)+where+++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (join, fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Functor.Identity as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Last(..), First(..), (<>), Alt)+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.Semigroup as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (sizeOf, alignment)+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..))+import GHC.Generics as Exports (Generic, Generic1)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- transformers+-------------------------+import Control.Monad.IO.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)++-- mtl+-------------------------+import Control.Monad.Error.Class as Exports (MonadError (..))++-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports++-- contravariant-extras+-------------------------+import Contravariant.Extras as Exports++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++tryError :: MonadError e m => m a -> m (Either e a)+tryError m =+  catchError (liftM Right m) (return . Left)

@@ -0,0 +1,29 @@+module Hasql.Transaction.Private.SQL+where++import Hasql.Transaction.Private.Prelude+import Hasql.Transaction.Private.Model+import qualified ByteString.TreeBuilder as D+++beginTransaction :: IsolationLevel -> Mode -> ByteString+beginTransaction isolation mode =+  D.toByteString builder+  where+    builder =+      "BEGIN " <> isolationBuilder <> " " <> modeBuilder+      where+        isolationBuilder =+          case isolation of+            ReadCommitted -> "ISOLATION LEVEL READ COMMITTED"+            RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ"+            Serializable -> "ISOLATION LEVEL SERIALIZABLE"+        modeBuilder =+          case mode of+            Write -> "READ WRITE"+            Read -> "READ ONLY"++declareCursor :: ByteString -> ByteString -> ByteString+declareCursor name sql =+  D.toByteString $+  "DECLARE " <> D.byteString name <> " NO SCROLL CURSOR FOR " <> D.byteString sql

@@ -0,0 +1,34 @@+module Hasql.Transaction.Private.Sessions+where++import Hasql.Transaction.Private.Prelude+import Hasql.Transaction.Private.Model+import qualified Hasql.Session as A+import qualified Hasql.Transaction.Private.Statements as B+++{-+We may want to+do one transaction retry in case of the 23505 error, and fail if an identical+error is seen.+-}+inRetryingTransaction :: IsolationLevel -> Mode -> A.Session (a, Bool) -> A.Session a+inRetryingTransaction isolation mode session =+  fix $ \recur -> catchError normal (onError recur)+  where+    normal =+      do+        A.statement () (B.beginTransaction isolation mode)+        (result, commit) <- session+        if commit+          then A.statement () B.commitTransaction+          else A.statement () B.abortTransaction+        return result+    onError continue error =+      do+        A.statement () B.abortTransaction+        case error of+          A.QueryError _ _ (A.ResultError (A.ServerError "40001" _ _ _)) ->+            continue+          _ ->+            throwError error

@@ -0,0 +1,50 @@+module Hasql.Transaction.Private.Statements+where++import Hasql.Transaction.Private.Prelude+import Hasql.Transaction.Private.Model+import qualified Hasql.Statement as A+import qualified Hasql.Encoders as B+import qualified Hasql.Decoders as C+import qualified Hasql.Transaction.Private.SQL as D+++-- * Transactions+-------------------------++beginTransaction :: IsolationLevel -> Mode -> A.Statement () ()+beginTransaction isolation mode =+  A.Statement (D.beginTransaction isolation mode) B.noParams C.noResult True++commitTransaction :: A.Statement () ()+commitTransaction =+  A.Statement "COMMIT" B.noParams C.noResult True++abortTransaction :: A.Statement () ()+abortTransaction =+  A.Statement "ABORT" B.noParams C.noResult True+++-- * Streaming+-------------------------++declareCursor :: ByteString -> ByteString -> B.Params a -> A.Statement a ()+declareCursor name sql encoder =+  A.Statement (D.declareCursor name sql) encoder C.noResult False++closeCursor :: A.Statement ByteString ()+closeCursor =+  A.Statement "CLOSE $1" ((B.param . B.nonNullable) B.bytea) C.noResult True++fetchFromCursor :: (b -> a -> b) -> b -> C.Row a -> A.Statement (Int64, ByteString) b+fetchFromCursor step init rowDec =+  A.Statement sql encoder decoder True+  where+    sql =+      "FETCH FORWARD $1 FROM $2"+    encoder =+      contrazip2+        ((B.param . B.nonNullable) B.int8)+        ((B.param . B.nonNullable) B.bytea)+    decoder =+      C.foldlRows step init rowDec

@@ -0,0 +1,57 @@+module Hasql.Transaction.Private.Transaction+where++import Hasql.Transaction.Private.Prelude+import Hasql.Transaction.Private.Model+import qualified Hasql.Statement as A+import qualified Hasql.Session as B+import qualified Hasql.Transaction.Private.Statements as C+import qualified Hasql.Transaction.Private.Sessions as D+++-- |+-- A composable abstraction over the retryable transactions.+--+-- Executes multiple queries under the specified mode and isolation level,+-- while automatically retrying the transaction in case of conflicts.+-- Thus this abstraction closely reproduces the behaviour of 'STM'.+newtype Transaction a =+  Transaction (StateT Bool B.Session a)+  deriving (Functor, Applicative, Monad)++instance Semigroup a => Semigroup (Transaction a) where+  (<>) = liftA2 (<>)++instance Monoid a => Monoid (Transaction a) where+  mempty = pure mempty+  mappend = liftA2 mappend++-- |+-- Execute the transaction using the provided isolation level and mode.+{-# INLINE run #-}+run :: Transaction a -> IsolationLevel -> Mode -> B.Session a+run (Transaction session) isolation mode =+  D.inRetryingTransaction isolation mode (runStateT session True)++-- |+-- Possibly a multi-statement query,+-- which however cannot be parameterized or prepared,+-- nor can any results of it be collected.+{-# INLINE sql #-}+sql :: ByteString -> Transaction ()+sql =+  Transaction . lift . B.sql++-- |+-- Parameters and a specification of the parametric query to apply them to.+{-# INLINE statement #-}+statement :: a -> A.Statement a b -> Transaction b+statement params statement =+  Transaction . lift $ B.statement params statement++-- |+-- Cause transaction to eventually roll back.+{-# INLINE condemn #-}+condemn :: Transaction ()+condemn =+  Transaction $ put False

@@ -1,47 +1,20 @@-{-|--TODO:-We may want to-do one transaction retry in case of the 23505 error, and fail if an identical-error is seen.--} module Hasql.Transaction.Sessions+(+  transaction,+  -- * Transaction settings+  C.Mode(..),+  C.IsolationLevel(..),+) where -import Hasql.Transaction.Prelude-import Hasql.Transaction.Types-import Hasql.Session-import qualified Hasql.Transaction.Statements as Statements+import qualified Hasql.Transaction.Private.Transaction as A+import qualified Hasql.Session as B+import qualified Hasql.Transaction.Private.Model as C  -inAlternatingTransaction :: Mode -> Level -> [Session (a, Condemnation)] -> Session a-inAlternatingTransaction mode level sessions =-  let-    loop = \ case-      session : sessionsTail -> tryTransaction mode level session >>= \ case-        Just a -> return a-        Nothing -> loop sessionsTail-      _ -> loop sessions-    in loop sessions--tryTransaction :: Mode -> Level -> Session (a, Condemnation) -> Session (Maybe a)-tryTransaction mode level body = do--  statement () (Statements.beginTransaction mode level)--  bodyRes <- catchError (fmap Just body) $ \ error -> do-    statement () Statements.abortTransaction-    handleTransactionError error $ return Nothing--  case bodyRes of-    Just (res, commit) -> catchError (commitOrAbort commit $> Just res) $ \ error -> do-      handleTransactionError error $ return Nothing-    Nothing -> return Nothing--commitOrAbort = \ case-  Uncondemned -> statement () Statements.commitTransaction-  Condemned -> statement () Statements.abortTransaction--handleTransactionError error onTransactionError = case error of-  QueryError _ _ (ResultError (ServerError "40001" _ _ _)) -> onTransactionError-  error -> throwError error+-- |+-- Execute the transaction using the provided isolation level and mode.+{-# INLINE transaction #-}+transaction :: C.IsolationLevel -> C.Mode -> A.Transaction a -> B.Session a+transaction isolation mode transaction =+  A.run transaction isolation mode

@@ -1,23 +0,0 @@-module Hasql.Transaction.Statements-where--import Hasql.Transaction.Prelude-import Hasql.Transaction.Types-import Hasql.Statement-import qualified ByteString.StrictBuilder as Builder-import qualified Hasql.Encoders as B-import qualified Hasql.Decoders as C-import qualified Hasql.Transaction.Builders as Builders---beginTransaction :: Mode -> Level -> Statement () ()-beginTransaction mode level =-  Statement (Builder.builderBytes (Builders.beginTransaction mode level)) B.noParams C.noResult True--commitTransaction :: Statement () ()-commitTransaction =-  Statement "commit" B.noParams C.noResult True--abortTransaction :: Statement () ()-abortTransaction =-  Statement "abort" B.noParams C.noResult True

@@ -1,36 +0,0 @@-module Hasql.Transaction.Types-where--import Hasql.Transaction.Prelude---{-|-Execution mode: either read or write.--}-data Mode =-  {-|-  Read-only. No writes possible.-  -}-  Read |-  {-|-  Write and commit.-  -}-  Write-  deriving (Show, Eq, Ord, Enum, Bounded)--{-|-Transaction isolation level.--For reference see-<http://www.postgresql.org/docs/current/static/transaction-iso.html the Postgres' documentation>.--}-data Level =-  ReadCommitted |-  RepeatableRead |-  Serializable-  deriving (Show, Eq, Ord, Enum, Bounded)--data Condemnation =-  Condemned |-  Uncondemned-  deriving (Show, Eq, Ord, Enum, Bounded)