Merge pull request #9 from anttih/transactions

Transactions

Author: epost

MODULE.md

@@ -196,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
+```
+
+
+
 

src/Database/Postgres.purs

@@ -17,6 +17,7 @@ module Database.Postgres
   ) where
 
 import Control.Alt
+import Control.Apply ((*>))
 import Control.Monad.Eff
 import Control.Monad.Trans
 import Data.Either
@@ -28,7 +29,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

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")

test/Main.purs

@@ -1,12 +1,12 @@
 module Test.Main where
 
-import Database.Postgres
-import Database.Postgres.SqlValue
 import Debug.Trace
 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
@@ -16,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
@@ -26,6 +30,8 @@ main = runAff (trace <<< show) (const $ trace "All ok") $ do
 
   exampleQueries
 
+  exampleTransaction
+
   liftEff $ disconnect
 
 data Artist = Artist
@@ -74,6 +80,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"