hasql-transaction 0.7.2 → 0.8

raw patch · 19 files changed

+493/−532 lines, 19 filesdep +bytestring-strict-builderdep +profunctorsdep +semigroupoidsdep −asyncdep −bytestring-tree-builderdep −hasql-transactiondep ~hasqlPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring-strict-builder, profunctors, semigroupoids

Dependencies removed: async, bytestring-tree-builder, hasql-transaction, rebase

Dependency ranges changed: hasql

API changes (from Hackage documentation)

Files

• conflicts-test/Main.hs +0/−100
• conflicts-test/Main/Statements.hs +0/−47
• conflicts-test/Main/Transactions.hs +0/−30
• hasql-transaction.cabal +13/−30
• library/Hasql/Transaction.hs +40/−7
• library/Hasql/Transaction/Prelude.hs +123/−0
• library/Hasql/Transaction/Private/Model.hs +0/−25
• library/Hasql/Transaction/Private/Prelude.hs +0/−103
• library/Hasql/Transaction/Private/SQL.hs +0/−29
• library/Hasql/Transaction/Private/Sessions.hs +0/−34
• library/Hasql/Transaction/Private/Statements.hs +0/−50
• library/Hasql/Transaction/Private/Transaction.hs +0/−57
• library/Hasql/Transaction/Requisites/Builders.hs +22/−0
• library/Hasql/Transaction/Requisites/Model.hs +36/−0
• library/Hasql/Transaction/Requisites/Sessions.hs +60/−0
• library/Hasql/Transaction/Requisites/Statements.hs +23/−0
• library/Hasql/Transaction/Session.hs +21/−0
• library/Hasql/Transaction/Sessions.hs +0/−20
• library/Hasql/Transaction/Transaction.hs +155/−0

@@ -1,100 +0,0 @@-module Main where--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---main =-  bracket acquire release use-  where-    acquire =-      (,) <$> acquire <*> acquire-      where-        acquire =-          join $-          fmap (either (fail . show) return) $-          A.acquire connectionSettings-          where-            connectionSettings =-              A.settings "localhost" 5432 "postgres" "" "postgres"-    release (connection1, connection2) =-      do-        transaction connection1 E.dropSchema-        A.release connection1-        A.release connection2-    use (connection1, connection2) =-      do-        try (transaction connection1 E.dropSchema) :: IO (Either SomeException ())-        transaction connection1 E.createSchema-        success <- fmap and (traverse runTest tests)-        if success-          then exitSuccess-          else exitFailure-      where-        runTest test =-          test connection1 connection2-        tests =-          [readAndWriteTransactionsTest, transactionsTest, transactionAndQueryTest]---session connection session =-  B.run session connection >>=-  either (fail . show) return--transaction connection transaction =-  session connection (G.transaction G.RepeatableRead G.Write transaction)---type Test =-  A.Connection -> A.Connection -> IO Bool--transactionsTest :: Test-transactionsTest connection1 connection2 =-  do-    id1 <- session connection1 (B.statement 0 D.createAccount)-    id2 <- session connection1 (B.statement 0 D.createAccount)-    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)-    balance2 <- session connection1 (B.statement id2 D.getBalance)-    traceShowM balance1-    traceShowM balance2-    return (balance1 == Just 2000 && balance2 == Just (-2000))--readAndWriteTransactionsTest :: Test-readAndWriteTransactionsTest connection1 connection2 =-  do-    id1 <- session connection1 (B.statement 0 D.createAccount)-    id2 <- session connection1 (B.statement 0 D.createAccount)-    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)-    balance2 <- session connection1 (B.statement id2 D.getBalance)-    traceShowM balance1-    traceShowM balance2-    return (balance1 == Just 1000 && balance2 == Just (-1000))--transactionAndQueryTest :: Test-transactionAndQueryTest connection1 connection2 =-  do-    id1 <- session connection1 (B.statement 0 D.createAccount)-    id2 <- session connection1 (B.statement 0 D.createAccount)-    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-    balance1 <- session connection1 (B.statement id1 D.getBalance)-    balance2 <- session connection1 (B.statement id2 D.getBalance)-    traceShowM balance1-    traceShowM balance2-    return (balance1 == Just 400 && balance2 == Just (-200))

@@ -1,47 +0,0 @@-module Main.Statements where--import Rebase.Prelude-import Hasql.Statement-import qualified Hasql.Encoders as E-import qualified Hasql.Decoders as D---createAccountTable :: Statement () ()-createAccountTable =-  Statement sql E.noParams D.noResult False-  where-    sql =-      "create table account (id serial not null, balance numeric not null, primary key (id))"--dropAccountTable :: Statement () ()-dropAccountTable =-  Statement-    "drop table account"-    E.noParams-    D.noResult-    False--createAccount :: Statement Scientific Int64-createAccount =-  Statement-    "insert into account (balance) values ($1) returning id"-    ((E.param . E.nonNullable) E.numeric)-    (D.singleRow ((D.column . D.nonNullable) D.int8))-    True--modifyBalance :: Statement (Int64, Scientific) Bool-modifyBalance =-  Statement-    "update account set balance = balance + $2 where id = $1"-    (contrazip2 ((E.param . E.nonNullable) E.int8) ((E.param . E.nonNullable) E.numeric))-    (fmap (> 0) D.rowsAffected)-    True--getBalance :: Statement Int64 (Maybe Scientific)-getBalance =-  Statement-    "select balance from account where id = $1"-    ((E.param . E.nonNullable) E.int8)-    (D.rowMaybe ((D.column . D.nonNullable) D.numeric))-    True-

@@ -1,30 +0,0 @@-module Main.Transactions where--import Rebase.Prelude-import Hasql.Transaction-import qualified Main.Statements as A---createSchema :: Transaction ()-createSchema =-  do-    statement () A.createAccountTable--dropSchema :: Transaction ()-dropSchema =-  do-    statement () A.dropAccountTable--transfer :: Int64 -> Int64 -> Scientific -> Transaction Bool-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)

@@ -1,5 +1,5 @@ name: hasql-transaction-version: 0.7.2+version: 0.8 category: Hasql, Database, PostgreSQL synopsis: A composable abstraction over the retryable transactions for Hasql homepage: https://github.com/nikita-volkov/hasql-transaction@@ -20,41 +20,24 @@   hs-source-dirs: library   default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language: Haskell2010-  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   exposed-modules:     Hasql.Transaction-    Hasql.Transaction.Sessions+  other-modules:+    Hasql.Transaction.Prelude+    Hasql.Transaction.Requisites.Model+    Hasql.Transaction.Requisites.Builders+    Hasql.Transaction.Requisites.Statements+    Hasql.Transaction.Requisites.Sessions+    Hasql.Transaction.Session+    Hasql.Transaction.Transaction   build-depends:     base >=4.9 && <5,     bytestring >=0.10 && <0.11,-    bytestring-tree-builder >=0.1 && <0.3,+    bytestring-strict-builder >=0.4.5.3 && <0.5,     contravariant >=1.3 && <2,     contravariant-extras >=0.3 && <0.4,     hasql >=1.4 && <1.5,     mtl >=2 && <3,-    transformers >=0.3 && <0.6--test-suite conflicts-test-  type: exitcode-stdio-1.0-  hs-source-dirs: conflicts-test-  default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples-  default-language: Haskell2010-  main-is: Main.hs-  other-modules:-    Main.Statements-    Main.Transactions-  ghc-options:-    -O2-    -threaded-    "-with-rtsopts=-N"-  build-depends:-    hasql-transaction,-    hasql,-    async >=2.1 && <3,-    rebase <2+    profunctors >=5 && <6,+    transformers >=0.3 && <0.6,+    semigroupoids >=5.3.2 && <6

@@ -1,14 +1,47 @@--- |--- An API for declaration of transactions.+{-|+Arrow DSL for composition of transactions with automated conflict resolution.+-} module Hasql.Transaction (-  -- * Transaction monad+  {-* Session -}+  Session.transact,+  {-* Transaction -}   Transaction,-  condemn,-  sql,   statement,+  sql,+  session,+  condemn,+  retry,+  {-* Settings -}+  Mode(..),+  Level(..),+  {-* Reexports -}+  {-|+  This module also reexports the following types for you to require lesser imports:+  +  * `Reexports.Session`+  * `Reexports.Statement`+  -}+  module Reexports,+  {-* FAQ -}+  {-|+  == Why does transaction have to be an arrow, why is monad or applicative not enough?++  Arrow allows us to determine the read mode and isolation level,+  while composing transactions in such a way that one can depend on the result of the other.+  +  A monadic interface wouldn't allow us to do the first, namely:+  to compose the modes and levels. +  +  An applicative interface wouldn't allow the second:+  to make a transaction depend on the result of the other.+  For details see the docs on the `Transaction` type.+  -} ) where -import Hasql.Transaction.Private.Transaction-import Hasql.Transaction.Private.Model+import Hasql.Transaction.Requisites.Model+import Hasql.Transaction.Transaction+import qualified Hasql.Session as Reexports (Session)+import qualified Hasql.Statement as Reexports (Statement)+import qualified Hasql.Transaction.Session as Session

@@ -0,0 +1,123 @@+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 (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)++-- 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)

@@ -1,25 +0,0 @@-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)

@@ -1,103 +0,0 @@-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)

@@ -1,29 +0,0 @@-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

@@ -1,34 +0,0 @@-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

@@ -1,50 +0,0 @@-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

@@ -1,57 +0,0 @@-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

@@ -0,0 +1,22 @@+module Hasql.Transaction.Requisites.Builders+where++import Hasql.Transaction.Prelude+import Hasql.Transaction.Requisites.Model+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"

@@ -0,0 +1,36 @@+module Hasql.Transaction.Requisites.Model+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)

@@ -0,0 +1,60 @@+{-|++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.Requisites.Sessions+where++import Hasql.Transaction.Prelude+import Hasql.Transaction.Requisites.Model+import Hasql.Session+import qualified Hasql.Transaction.Requisites.Statements as Statements+++inRetryingTransaction :: Mode -> Level -> Session (a, Condemnation) -> Session a+inRetryingTransaction mode isolation session =+  fix $ \ recur -> catchError normal (onError recur)+  where+    normal =+      do+        statement () (Statements.beginTransaction mode isolation)+        (result, condemnation) <- session+        case condemnation of+          Uncondemned -> statement () Statements.commitTransaction+          Condemned -> statement () Statements.abortTransaction+        return result+    onError continue error =+      do+        statement () Statements.abortTransaction+        case error of+          QueryError _ _ (ResultError (ServerError "40001" _ _ _)) -> continue+          _ -> throwError error++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 session = do+  statement () (Statements.beginTransaction mode level)+  catchError+    (do+      (result, condemnation) <- session+      case condemnation of+        Uncondemned -> statement () Statements.commitTransaction+        Condemned -> statement () Statements.abortTransaction+      return (Just result))+    (\ error -> do+      statement () Statements.abortTransaction+      case error of+        QueryError _ _ (ResultError (ServerError "40001" _ _ _)) -> return Nothing+        error -> throwError error)

@@ -0,0 +1,23 @@+module Hasql.Transaction.Requisites.Statements+where++import Hasql.Transaction.Prelude+import Hasql.Transaction.Requisites.Model+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.Requisites.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

@@ -0,0 +1,21 @@+{-|+Extensions to Session.+Can be used imported in the same namespace as @Hasql.Session@ without conflicts.+-}+module Hasql.Transaction.Session+where++import Hasql.Transaction.Prelude+import Hasql.Transaction.Requisites.Model+import Hasql.Transaction.Requisites.Sessions+import Hasql.Session+import qualified Hasql.Transaction.Transaction as Transaction+import qualified Hasql.Transaction.Transaction as Reexports (Transaction)+++{-|+Execute an alternating transaction arrow providing an input for it.+-}+transact :: Transaction.Transaction i o -> i -> Session o+transact (Transaction.Transaction mode level list) i =+  inAlternatingTransaction mode level (fmap (\ fn -> runStateT (fn i) Uncondemned) list)

@@ -1,20 +0,0 @@-module Hasql.Transaction.Sessions-(-  transaction,-  -- * Transaction settings-  C.Mode(..),-  C.IsolationLevel(..),-)-where--import qualified Hasql.Transaction.Private.Transaction as A-import qualified Hasql.Session as B-import qualified Hasql.Transaction.Private.Model as C----- |--- 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

@@ -0,0 +1,155 @@+module Hasql.Transaction.Transaction where++import Hasql.Transaction.Prelude hiding (map, retry)+import Hasql.Transaction.Requisites.Model+import Hasql.Session (Session)+import Hasql.Statement (Statement)+import qualified Hasql.Session as Session+++{-|+Composable transaction providing for automated conflict resolution+with input @i@ and output @o@. Supports alternative branching.++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.+-}+data Transaction i o =+  Transaction Mode Level [i -> StateT Condemnation Session o]++deriving instance Functor (Transaction i)++instance Applicative (Transaction i) where+  pure = Transaction Read ReadCommitted . pure . const . pure+  (<*>) = binOp $ \ lSession rSession i -> lSession i <*> rSession i++instance Alternative (Transaction i) where+  empty = retry+  (<|>) (Transaction lMode lLevel lList) (Transaction rMode rLevel rList) =+    Transaction (max lMode rMode) (max lLevel rLevel) (lList <> rList)++instance Profunctor Transaction where+  dimap fn1 fn2 = map $ \ session -> fmap fn2 . session . fn1++instance Strong Transaction where+  first' = first+  second' = second++instance Choice Transaction where+  left' = left+  right' = right++instance Semigroupoid Transaction where+  o = binOp (<=<)++instance Category Transaction where+  id = Transaction Read ReadCommitted []+  (.) = o++instance Arrow Transaction where+  arr fn = Transaction Read ReadCommitted (return (return . fn))+  (***) = binOp $ \ lSession rSession (li, ri) -> (,) <$> lSession li <*> rSession ri++instance ArrowChoice Transaction where+  (+++) = binOp $ \ lSession rSession -> either (fmap Left . lSession) (fmap Right . rSession)++instance ArrowZero Transaction where+  zeroArrow = retry++instance ArrowPlus Transaction where+  (<+>) = (<|>)++{-|+Because mode and isolation are always composed the same way,+we can focus on composing just the sessions.+-}+{-# INLINE binOp #-}+binOp ::+  (+    (li -> StateT Condemnation Session lo) ->+    (ri -> StateT Condemnation Session ro) ->+    (i -> StateT Condemnation Session o)+  ) ->+  Transaction li lo -> Transaction ri ro -> Transaction i o+binOp composeSessions (Transaction lMode lLevel lList) (Transaction rMode rLevel rList) = let+  mode = max lMode rMode+  level = max lLevel rLevel+  list = composeSessions <$> lList <*> rList+  in Transaction mode level list++{-# INLINE map #-}+map ::+  ((i1 -> StateT Condemnation Session o1) -> (i2 -> StateT Condemnation Session o2)) ->+  Transaction i1 o1 -> Transaction i2 o2+map sessionFn (Transaction mode isolation list) = Transaction mode isolation (fmap sessionFn list)++{-|+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 Read ReadCommitted [\ _ -> put Condemned]++{-|+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 single statement under a 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 i o -> Transaction i o+statement mode level statement = session mode level $ \ i -> Session.statement i statement++{-|+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 -> (i -> Session o) -> Transaction i o+session mode level sessionFn = Transaction mode level [lift . sessionFn]++{-|+Fail the alternation branch, retrying with the other. Same as `empty` and `zeroArrow`.++Beware that if all your alternatives end up being a retry,+you'll get yourself a perfect infinite loop.+-}+retry :: Transaction i o+retry = Transaction Read ReadCommitted []