packages feed

hasql-transaction 0.4.5 → 0.4.5.1

raw patch · 6 files changed

+204/−25 lines, 6 filesdep +asyncdep +hasql-transactiondep +rebasedep −eitherdep −postgresql-error-codesdep ~hasqlPVP ok

version bump matches the API change (PVP)

Dependencies added: async, hasql-transaction, rebase

Dependencies removed: either, postgresql-error-codes

Dependency ranges changed: hasql

API changes (from Hackage documentation)

Files

+ conflicts-test/Main.hs view
@@ -0,0 +1,84 @@+module Main where++import Rebase.Prelude+import qualified Hasql.Connection as Connection+import qualified Hasql.Session as Session+import qualified Hasql.Transaction as Transaction+import qualified Main.Queries as Queries+import qualified Main.Transactions as Transactions+import qualified Control.Concurrent.Async as Async+++main =+  bracket acquire release use+  where+    acquire =+      (,) <$> acquire <*> acquire+      where+        acquire =+          join $+          fmap (either (fail . show) return) $+          Connection.acquire connectionSettings+          where+            connectionSettings =+              Connection.settings "localhost" 5432 "postgres" "" "postgres"+    release (connection1, connection2) =+      do+        transaction connection1 Transactions.dropSchema+        Connection.release connection1+        Connection.release connection2+    use (connection1, connection2) =+      do+        try (transaction connection1 Transactions.dropSchema) :: IO (Either SomeException ())+        transaction connection1 Transactions.createSchema+        success <- fmap and (traverse runTest tests)+        if success+          then exitSuccess+          else exitFailure+      where+        runTest test =+          test connection1 connection2+        tests =+          [transactionsTest, transactionAndQueryTest]+++session connection session =+  Session.run session connection >>=+  either (fail . show) return++transaction connection transaction =+  session connection (Transaction.run transaction Transaction.RepeatableRead Transaction.Write)+++type Test =+  Connection.Connection -> Connection.Connection -> IO Bool++transactionsTest :: Test+transactionsTest connection1 connection2 =+  do+    id1 <- session connection1 (Session.query 0 Queries.createAccount)+    id2 <- session connection1 (Session.query 0 Queries.createAccount)+    async1 <- Async.async (replicateM_ 1000 (transaction connection1 (Transactions.transfer id1 id2 1)))+    async2 <- Async.async (replicateM_ 1000 (transaction connection2 (Transactions.transfer id1 id2 1)))+    Async.wait async1+    Async.wait async2+    balance1 <- session connection1 (Session.query id1 Queries.getBalance)+    balance2 <- session connection1 (Session.query id2 Queries.getBalance)+    traceShowM balance1+    traceShowM balance2+    return (balance1 == Just 2000 && balance2 == Just (-2000))++transactionAndQueryTest :: Test+transactionAndQueryTest connection1 connection2 =+  do+    id1 <- session connection1 (Session.query 0 Queries.createAccount)+    id2 <- session connection1 (Session.query 0 Queries.createAccount)+    async1 <- Async.async (transaction connection1 (Transactions.transferTimes 200 id1 id2 1))+    async2 <- Async.async (session connection2 (replicateM_ 200 (Session.query (id1, 1) Queries.modifyBalance)))+    Async.wait async1+    Async.wait async2+    balance1 <- session connection1 (Session.query id1 Queries.getBalance)+    balance2 <- session connection1 (Session.query id2 Queries.getBalance)+    traceShowM balance1+    traceShowM balance2+    return (balance1 == Just 400 && balance2 == Just (-200))
+ conflicts-test/Main/Queries.hs view
@@ -0,0 +1,47 @@+module Main.Queries where++import Rebase.Prelude+import Hasql.Query+import qualified Hasql.Encoders as E+import qualified Hasql.Decoders as D+++createAccountTable :: Query () ()+createAccountTable =+  statement sql E.unit D.unit False+  where+    sql =+      "create table account (id serial not null, balance numeric not null, primary key (id))"++dropAccountTable :: Query () ()+dropAccountTable =+  statement+    "drop table account"+    E.unit+    D.unit+    False++createAccount :: Query Scientific Int64+createAccount =+  statement+    "insert into account (balance) values ($1) returning id"+    (E.value E.numeric)+    (D.singleRow (D.value D.int8))+    True++modifyBalance :: Query (Int64, Scientific) Bool+modifyBalance =+  statement+    "update account set balance = balance + $2 where id = $1"+    (contrazip2 (E.value E.int8) (E.value E.numeric))+    (fmap (> 0) D.rowsAffected)+    True++getBalance :: Query Int64 (Maybe Scientific)+getBalance =+  statement+    "select balance from account where id = $1"+    (E.value E.int8)+    (D.maybeRow (D.value D.numeric))+    True+
+ conflicts-test/Main/Transactions.hs view
@@ -0,0 +1,27 @@+module Main.Transactions where++import Rebase.Prelude+import Hasql.Transaction+import qualified Main.Queries as Queries+++createSchema :: Transaction ()+createSchema =+  do+    query () Queries.createAccountTable++dropSchema :: Transaction ()+dropSchema =+  do+    query () Queries.dropAccountTable++transfer :: Int64 -> Int64 -> Scientific -> Transaction ()+transfer id1 id2 amount =+  do+    query (id1, amount) Queries.modifyBalance+    query (id2, negate amount) Queries.modifyBalance+    return ()++transferTimes :: Int -> Int64 -> Int64 -> Scientific -> Transaction ()+transferTimes times id1 id2 amount =+  replicateM_ times (transfer id1 id2 amount)
hasql-transaction.cabal view
@@ -1,7 +1,7 @@ name:   hasql-transaction version:-  0.4.5+  0.4.5.1 category:   Hasql, Database, PostgreSQL synopsis:@@ -47,18 +47,41 @@   exposed-modules:     Hasql.Transaction   build-depends:-    hasql >= 0.17 && < 0.20,     -- database:-    postgresql-error-codes >= 1 && < 2,+    hasql >= 0.17 && < 0.20,     -- data:     bytestring-tree-builder >= 0.1 && < 0.3,     bytestring >= 0.10 && < 0.11,     -- control:     contravariant >= 1.3 && < 2,     contravariant-extras >= 0.3 && < 0.4,-    either >= 4.4.1 && < 5,     mtl >= 2 && < 3,     transformers >= 0.3 && < 0.6,     -- general:     base-prelude >= 0.1.19 && < 2,     base >= 4.6 && < 5+++test-suite conflicts-test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    conflicts-test+  main-is:+    Main.hs+  other-modules:+    Main.Queries+    Main.Transactions+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+  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+  build-depends:+    hasql-transaction,+    hasql,+    async >= 2.1 && < 3,+    rebase < 2
library/Hasql/Transaction.hs view
@@ -15,7 +15,6 @@ import qualified Hasql.Query as Query import qualified Hasql.Session as Session import qualified Hasql.Transaction.Queries as Queries-import qualified PostgreSQL.ErrorCodes as ErrorCodes   -- |@@ -61,21 +60,25 @@ {-# INLINABLE run #-} run :: Transaction a -> IsolationLevel -> Mode -> Session.Session a run (Transaction session) isolation mode =-  do-    resultEither <- do-      Session.query () (Queries.beginTransaction mode')-      tryError session-    case resultEither of-      Left error -> do-        Session.query () Queries.abortTransaction-        case error of-          Session.ResultError (Session.ServerError code _ _ _) | code == ErrorCodes.serialization_failure ->-            run (Transaction session) isolation mode-          _ -> -            throwError error-      Right result -> do-        Session.query () $ bool Queries.abortTransaction Queries.commitTransaction commit-        pure result+  fix $+  \ recur ->+    do+      resultEither <- do+        Session.query () (Queries.beginTransaction mode')+        tryError $ do+          result <- session+          Session.query () (bool Queries.abortTransaction Queries.commitTransaction commit)+          return result+      case resultEither of+        Left error -> do+          Session.query () Queries.abortTransaction+          case error of+            Session.ResultError (Session.ServerError "40001" _ _ _) ->+              recur+            _ -> +              throwError error+        Right result -> do+          pure result   where     mode' =       (unsafeCoerce isolation, write)
library/Hasql/Transaction/Prelude.hs view
@@ -31,11 +31,6 @@ ------------------------- import Contravariant.Extras as Exports --- either---------------------------import Control.Monad.Trans.Either as Exports-import Data.Either.Combinators as Exports- -- bytestring ------------------------- import Data.ByteString as Exports (ByteString)