From 5d3be54df9655fc79fd50d37b9f1ec0f2cab1739 Mon Sep 17 00:00:00 2001
From: Antti Holvikari <antti.holvikari@reaktor.com>
Date: Sun, 3 May 2015 18:44:24 +0300
Subject: [PATCH 1/2] Add `withTransaction`

---
 MODULE.md                  | 19 +++++++++++++++++++
 src/Database/Postgres.purs | 25 ++++++++++++++++++++++++-
 test/Main.purs             | 15 +++++++++++++++
 3 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/MODULE.md b/MODULE.md
index 9ff6518..815441c 100644
--- a/MODULE.md
+++ b/MODULE.md
@@ -135,6 +135,25 @@ withClient :: forall eff a. ConnectionInfo -> (Client -> Aff (db :: DB | eff) a)
 Takes a Client from the connection pool, runs the given function with
 the client and returns the results.
 
+#### `withTransaction`
+
+``` purescript
+withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
+```
+
+Runs an asynchronous action in a database transaction. The transaction
+will be rolled back if the computation fails and committed otherwise.
+
+Here the first insert will be rolled back:
+
+```purescript
+moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit
+moneyTransfer = withTransaction $ \c -> do
+  execute_ (Query "insert into accounts ...") c
+  throwError $ error "Something went wrong"
+  execute_ (Query "insert into accounts ...") c
+```
+
 #### `end`
 
 ``` purescript
diff --git a/src/Database/Postgres.purs b/src/Database/Postgres.purs
index aa3c0bf..76c7f28 100644
--- a/src/Database/Postgres.purs
+++ b/src/Database/Postgres.purs
@@ -14,9 +14,11 @@ module Database.Postgres
   , queryOne, queryOne_
   , withConnection
   , withClient
+  , withTransaction
   ) where
 
 import Control.Alt
+import Control.Apply ((*>))
 import Control.Monad.Eff
 import Control.Monad.Trans
 import Data.Either
@@ -28,7 +30,7 @@ import Data.Maybe
 import Control.Monad.Aff
 import Control.Monad.Eff.Class
 import Control.Monad.Eff.Exception(Error(), error)
-import Control.Monad.Error.Class (throwError)
+import Control.Monad.Error.Class (throwError, catchError)
 import Data.Traversable (sequence)
 
 import Database.Postgres.SqlValue
@@ -130,6 +132,27 @@ withClient :: forall eff a
   -> Aff (db :: DB | eff) a
 withClient info p = runFn2 _withClient (mkConnectionString info) p
 
+-- | Runs an asynchronous action in a database transaction. The transaction
+-- | will be rolled back if the computation fails and committed otherwise.
+-- |
+-- | Here the first insert will be rolled back:
+-- |
+-- | ```purescript
+-- | moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit
+-- | moneyTransfer = withTransaction $ \c -> do
+-- |   execute_ (Query "insert into accounts ...") c
+-- |   throwError $ error "Something went wrong"
+-- |   execute_ (Query "insert into accounts ...") c
+-- | ```
+withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
+withTransaction act client = do
+  execute_ (Query "BEGIN TRANSACTION") client
+  res <- attempt (act client)
+  either rollback commit res
+    where
+    rollback err = execute_ (Query "ROLLBACK") client *> throwError err
+    commit v = execute_ (Query "COMMIT") client *> pure v
+
 liftError :: forall e a. ForeignError -> Aff e a
 liftError err = throwError $ error (show err)
 
diff --git a/test/Main.purs b/test/Main.purs
index 7cc2d2e..3b1190a 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -7,6 +7,8 @@ import Control.Monad.Eff
 import Control.Monad.Eff.Class
 import Control.Monad.Cont.Trans
 import Control.Monad.Trans
+import Control.Monad.Error.Class (throwError)
+import Control.Monad.Eff.Exception (error)
 import Data.Array
 import Data.Foldable
 import Data.Either
@@ -26,6 +28,8 @@ main = runAff (trace <<< show) (const $ trace "All ok") $ do
 
   exampleQueries
 
+  exampleTransaction
+
   liftEff $ disconnect
 
 data Artist = Artist
@@ -74,6 +78,17 @@ exampleQueries = withClient connectionInfo $ \c -> do
   artists <- query (Query "select * from artist where name = $1" :: Query Artist) [toSql "Toto"] c
   liftEff $ printRows artists
 
+exampleTransaction :: forall eff. Aff (db :: DB | eff) Unit
+exampleTransaction = withConnection connectionInfo $ \c -> do
+  execute_ (Query "delete from artist") c
+  apathize $ tryInsert c
+  one <- queryOne_ (Query "select * from artist" :: Query Artist) c
+  liftEff $ trace $ show one
+    where
+    tryInsert = withTransaction $ \c -> do
+      execute_ (Query "insert into artist values ('Not there', 1999)") c
+      throwError $ error "fail"
+
 printRows :: forall a eff. (Show a) => [a] -> Eff (trace :: Trace | eff) Unit
 printRows rows = trace $ "result:\n" <> foldMap stringify rows
   where stringify = show >>> flip (<>) "\n"

From 044d9549cba89a6a06f2a2f71b0f3d5ceeeed18f Mon Sep 17 00:00:00 2001
From: Antti Holvikari <anttih@gmail.com>
Date: Mon, 11 May 2015 09:26:15 +0300
Subject: [PATCH 2/2] Move transaction related functions to a separate module

Extract `begin`, `commit` and `rollback` that can be used separately from
`withTransaction`.
---
 MODULE.md                              | 62 ++++++++++++++++++--------
 src/Database/Postgres.purs             | 22 ---------
 src/Database/Postgres/Transaction.purs | 39 ++++++++++++++++
 test/Main.purs                         |  6 ++-
 4 files changed, 86 insertions(+), 43 deletions(-)
 create mode 100644 src/Database/Postgres/Transaction.purs

diff --git a/MODULE.md b/MODULE.md
index 815441c..fa84b62 100644
--- a/MODULE.md
+++ b/MODULE.md
@@ -135,25 +135,6 @@ withClient :: forall eff a. ConnectionInfo -> (Client -> Aff (db :: DB | eff) a)
 Takes a Client from the connection pool, runs the given function with
 the client and returns the results.
 
-#### `withTransaction`
-
-``` purescript
-withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
-```
-
-Runs an asynchronous action in a database transaction. The transaction
-will be rolled back if the computation fails and committed otherwise.
-
-Here the first insert will be rolled back:
-
-```purescript
-moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit
-moneyTransfer = withTransaction $ \c -> do
-  execute_ (Query "insert into accounts ...") c
-  throwError $ error "Something went wrong"
-  execute_ (Query "insert into accounts ...") c
-```
-
 #### `end`
 
 ``` purescript
@@ -215,4 +196,47 @@ instance isSqlValueMaybe :: (IsSqlValue a) => IsSqlValue (Maybe a)
 
 
 
+## Module Database.Postgres.Transaction
+
+#### `withTransaction`
+
+``` purescript
+withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
+```
+
+Runs an asynchronous action in a database transaction. The transaction
+will be rolled back if the computation fails and committed otherwise.
+
+Here the first insert will be rolled back:
+
+```purescript
+moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit
+moneyTransfer = withTransaction $ \c -> do
+  execute_ (Query "insert into accounts ...") c
+  throwError $ error "Something went wrong"
+  execute_ (Query "insert into accounts ...") c
+```
+
+#### `begin`
+
+``` purescript
+begin :: forall eff. Client -> Aff (db :: DB | eff) Unit
+```
+
+
+#### `commit`
+
+``` purescript
+commit :: forall eff. Client -> Aff (db :: DB | eff) Unit
+```
+
+
+#### `rollback`
+
+``` purescript
+rollback :: forall eff. Client -> Aff (db :: DB | eff) Unit
+```
+
+
+
 
diff --git a/src/Database/Postgres.purs b/src/Database/Postgres.purs
index 76c7f28..432590d 100644
--- a/src/Database/Postgres.purs
+++ b/src/Database/Postgres.purs
@@ -14,7 +14,6 @@ module Database.Postgres
   , queryOne, queryOne_
   , withConnection
   , withClient
-  , withTransaction
   ) where
 
 import Control.Alt
@@ -132,27 +131,6 @@ withClient :: forall eff a
   -> Aff (db :: DB | eff) a
 withClient info p = runFn2 _withClient (mkConnectionString info) p
 
--- | Runs an asynchronous action in a database transaction. The transaction
--- | will be rolled back if the computation fails and committed otherwise.
--- |
--- | Here the first insert will be rolled back:
--- |
--- | ```purescript
--- | moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit
--- | moneyTransfer = withTransaction $ \c -> do
--- |   execute_ (Query "insert into accounts ...") c
--- |   throwError $ error "Something went wrong"
--- |   execute_ (Query "insert into accounts ...") c
--- | ```
-withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
-withTransaction act client = do
-  execute_ (Query "BEGIN TRANSACTION") client
-  res <- attempt (act client)
-  either rollback commit res
-    where
-    rollback err = execute_ (Query "ROLLBACK") client *> throwError err
-    commit v = execute_ (Query "COMMIT") client *> pure v
-
 liftError :: forall e a. ForeignError -> Aff e a
 liftError err = throwError $ error (show err)
 
diff --git a/src/Database/Postgres/Transaction.purs b/src/Database/Postgres/Transaction.purs
new file mode 100644
index 0000000..757b6ae
--- /dev/null
+++ b/src/Database/Postgres/Transaction.purs
@@ -0,0 +1,39 @@
+module Database.Postgres.Transaction where
+
+import Control.Apply ((*>))
+import Control.Monad.Aff
+import Control.Monad.Error.Class (throwError)
+import Data.Either
+
+import Database.Postgres
+import Database.Postgres.SqlValue
+
+-- | Runs an asynchronous action in a database transaction. The transaction
+-- | will be rolled back if the computation fails and committed otherwise.
+-- |
+-- | Here the first insert will be rolled back:
+-- |
+-- | ```purescript
+-- | moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit
+-- | moneyTransfer = withTransaction $ \c -> do
+-- |   execute_ (Query "insert into accounts ...") c
+-- |   throwError $ error "Something went wrong"
+-- |   execute_ (Query "insert into accounts ...") c
+-- | ```
+withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a
+withTransaction act client = do
+  begin client
+  res <- attempt (act client)
+  either rollback_ commit_ res
+    where
+    rollback_ err = rollback client *> throwError err
+    commit_ v = commit client *> pure v
+
+begin :: forall eff. Client -> Aff (db :: DB | eff) Unit
+begin = execute_ (Query "BEGIN TRANSACTION")
+
+commit :: forall eff. Client -> Aff (db :: DB | eff) Unit
+commit = execute_ (Query "COMMIT")
+
+rollback :: forall eff. Client -> Aff (db :: DB | eff) Unit
+rollback = execute_ (Query "ROLLBACK")
diff --git a/test/Main.purs b/test/Main.purs
index 3b1190a..1ae8b80 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -1,7 +1,5 @@
 module Test.Main where
 
-import Database.Postgres
-import Database.Postgres.SqlValue
 import Debug.Trace
 import Control.Monad.Eff
 import Control.Monad.Eff.Class
@@ -18,6 +16,10 @@ import Data.Foreign.Class
 import Data.Foreign.Index
 import Control.Monad.Aff
 
+import Database.Postgres
+import Database.Postgres.SqlValue
+import Database.Postgres.Transaction
+
 main = runAff (trace <<< show) (const $ trace "All ok") $ do
   liftEff <<< trace $ "connecting to " <> mkConnectionString connectionInfo <> "..."
   exampleUsingWithConnection