hasql-transaction 0.8 → 0.9

raw patch · 16 files changed

+458/−347 lines, 16 filesdep +asyncdep +hasql-transactiondep +rerebasedep ~hasqlPVP ok

version bump matches the API change (PVP)

Dependencies added: async, hasql-transaction, rerebase, selective

Dependency ranges changed: hasql

API changes (from Hackage documentation)

Files

• conflicts-test/Main.hs +99/−0
• conflicts-test/Main/Statements.hs +47/−0
• conflicts-test/Main/Transactions.hs +25/−0
• hasql-transaction.cabal +26/−8
• library/Hasql/Transaction.hs +115/−21
• library/Hasql/Transaction/Builders.hs +22/−0
• library/Hasql/Transaction/Prelude.hs +5/−1
• library/Hasql/Transaction/Requisites/Builders.hs +0/−22
• library/Hasql/Transaction/Requisites/Model.hs +0/−36
• library/Hasql/Transaction/Requisites/Sessions.hs +0/−60
• library/Hasql/Transaction/Requisites/Statements.hs +0/−23
• library/Hasql/Transaction/Session.hs +0/−21
• library/Hasql/Transaction/Sessions.hs +60/−0
• library/Hasql/Transaction/Statements.hs +23/−0
• library/Hasql/Transaction/Transaction.hs +0/−155
• library/Hasql/Transaction/Types.hs +36/−0

@@ -0,0 +1,99 @@+module Main where++import Prelude+import qualified Hasql.Connection as A+import qualified Hasql.Session as B+import qualified Hasql.Transaction as C+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+        transact 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+        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++transact connection transaction =+  session connection (C.transact 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 (transact connection1 (E.transfer id1 id2 1)))+    async2 <- F.async (replicateM_ 1000 (transact 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 (transact connection1 (E.transfer id1 id2 1)))+    async2 <- F.async (replicateM_ 1000 (transact connection2 (E.getBalance id1)))+    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 (transact 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))

@@ -0,0 +1,47 @@+module Main.Statements where++import 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+

@@ -0,0 +1,25 @@+module Main.Transactions where++import Prelude+import Hasql.Transaction+import qualified Main.Statements as A+++createSchema :: Transaction ()+createSchema = statement Write Serializable A.createAccountTable ()++dropSchema :: Transaction ()+dropSchema = statement Write Serializable 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)++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

@@ -1,7 +1,7 @@ name: hasql-transaction-version: 0.8+version: 0.9 category: Hasql, Database, PostgreSQL-synopsis: A composable abstraction over the retryable transactions for Hasql+synopsis: Composable abstraction over 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>@@ -23,13 +23,11 @@   exposed-modules:     Hasql.Transaction   other-modules:+    Hasql.Transaction.Builders     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+    Hasql.Transaction.Sessions+    Hasql.Transaction.Statements+    Hasql.Transaction.Types   build-depends:     base >=4.9 && <5,     bytestring >=0.10 && <0.11,@@ -40,4 +38,24 @@     mtl >=2 && <3,     profunctors >=5 && <6,     transformers >=0.3 && <0.6,+    selective >=0.3 && <0.4,     semigroupoids >=5.3.2 && <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:+    async >=2.1 && <3,+    hasql-transaction,+    hasql,+    rerebase >=1.4 && <2

@@ -1,17 +1,16 @@ {-|-Arrow DSL for composition of transactions with automated conflict resolution.+DSL for composition of transactions with automated conflict resolution. -} module Hasql.Transaction (-  {-* Session -}-  Session.transact,+  {-* Sessions -}+  transact,   {-* Transaction -}   Transaction,   statement,   sql,   session,   condemn,-  retry,   {-* Settings -}   Mode(..),   Level(..),@@ -23,25 +22,120 @@   * `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.Requisites.Model-import Hasql.Transaction.Transaction+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.Transaction.Session as Session+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 consituent 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 Alternative Transaction where+  empty = Transaction minBound minBound []+  (<|>) (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]

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

@@ -53,7 +53,7 @@ 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.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@@ -72,6 +72,10 @@ 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 -------------------------

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

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

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

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

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

@@ -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.Sessions+where++import Hasql.Transaction.Prelude+import Hasql.Transaction.Types+import Hasql.Session+import qualified Hasql.Transaction.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.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,155 +0,0 @@-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 []

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