Better transaction handling in the standalone binary and more documentation

Author: ameingast

Readme.markdown

@@ -72,7 +72,8 @@ main :: IO ()
 main = do
     let url = "host=$host dbname=$db user=$user password=$pw"
     con <- connectPostgreSQL (BS8.pack url)
-    void $ runMigration $ MigrationContext MigrationInitialization True con
+    withTransaction con $ runMigration $ 
+        MigrationContext MigrationInitialization True con
 ```
 
 For file-based migrations, the following snippet can be used:
@@ -83,7 +84,8 @@ main = do
     let url = "host=$host dbname=$db user=$user password=$pw"
     let dir = "."
     con <- connectPostgreSQL (BS8.pack url)
-    void $ runMigration $ MigrationContext (MigrationDirectory dir) True con
+    withTransaction con $ runMigration $ 
+        MigrationContext (MigrationDirectory dir) True con
 ```
 
 To run Haskell-based migrations, use this:
@@ -95,8 +97,8 @@ main = do
     let name = "my script"
     let script = "create table users (email varchar not null)";
     con <- connectPostgreSQL (BS8.pack url)
-    void $ runMigration $ MigrationContext 
-        (MigrationScript name script) True con
+    withTransaction con $ runMigration $ 
+        MigrationContext (MigrationScript name script) True con
 ```
 
 Validations wrap _MigrationCommands_. This means that you can re-use all
@@ -110,10 +112,21 @@ main :: IO ()
 main = do
     let url = "host=$host dbname=$db user=$user password=$pw"
     con <- connectPostgreSQL (BS8.pack url)
-    void $ runMigration $ MigrationContext 
-        (MigrationValidation (MigrationDirectory dir)) verbose con
+    withTransaction con $ runMigration $ MigrationContext 
+        (MigrationValidation (MigrationDirectory dir)) True con
 ```
 
+Database migrations should always be performed in a transactional context. 
+
+The standalone binary takes care of proper transaction handling automatically.
+
+The library does not make any assumptions about the current transactional state
+of the system. This way you can execute multiple migration-commands or
+validations in sequence while still staying in the same transaction.
+
+The tests work in a similar way. After executing all migration-tests, the 
+transaction is rolled back.
+
 ## Compilation and Tests
 The program is built with the _cabal_ build system. The following command
 builds the library, the standalone binary and the test package.

src/Database/PostgreSQL/Simple/Migration.hs

@@ -49,7 +49,7 @@ import           Database.PostgreSQL.Simple.Util    (existsTable)
 import           System.Directory                   (getDirectoryContents)
 
 -- | Executes migrations inside the provided 'MigrationContext'.
--- 
+--
 -- Returns 'MigrationSuccess' if the provided 'MigrationCommand' executes
 -- without error. If an error occurs, execution is stopped and
 -- a 'MigrationError' is returned.

src/Database/PostgreSQL/Simple/Util.hs

@@ -11,14 +11,23 @@
 
 module Database.PostgreSQL.Simple.Util
     ( existsTable
+    , withTransactionRolledBack
     ) where
 
+import           Control.Exception          (finally)
 import           Control.Monad              (liftM)
-import           Database.PostgreSQL.Simple (Connection, Only (..), query)
+import           Database.PostgreSQL.Simple (Connection, Only (..), begin,
+                                             query, rollback)
 
 -- | Checks if the table with the given name exists in the database.
 existsTable :: Connection -> String -> IO Bool
 existsTable con table =
     liftM (not . null) (query con q (Only table) :: IO [[Int]])
     where
         q = "select count(relname) from pg_class where relname = ?"
+
+-- | Executes the given IO monad inside a transaction and performs a roll-back
+-- afterwards (even if exceptions occur).
+withTransactionRolledBack :: Connection -> IO a -> IO a
+withTransactionRolledBack con f =
+    begin con >> finally f (rollback con)

src/Main.hs

@@ -15,7 +15,8 @@ module Main (
 
 import           Control.Monad                        (void)
 import qualified Data.ByteString.Char8                as BS8 (pack)
-import           Database.PostgreSQL.Simple           (connectPostgreSQL)
+import           Database.PostgreSQL.Simple           (connectPostgreSQL,
+                                                       withTransaction)
 import           Database.PostgreSQL.Simple.Migration (MigrationCommand (..),
                                                        MigrationContext (..),
                                                        runMigration)
@@ -37,15 +38,15 @@ run (Just cmd) verbose =
     void $ case cmd of
         Initialize url -> do
             con <- connectPostgreSQL (BS8.pack url)
-            runMigration $ MigrationContext
+            withTransaction con $ runMigration $ MigrationContext
                 MigrationInitialization verbose con
         Migrate url dir -> do
             con <- connectPostgreSQL (BS8.pack url)
-            runMigration $ MigrationContext
+            withTransaction con $ runMigration $ MigrationContext
                 (MigrationDirectory dir) verbose con
         Validate url dir -> do
             con <- connectPostgreSQL (BS8.pack url)
-            runMigration $ MigrationContext
+            withTransaction con $ runMigration $ MigrationContext
                 (MigrationValidation (MigrationDirectory dir)) verbose con
 
 parseCommand :: [String] -> Maybe Command

test/Main.hs

@@ -13,19 +13,12 @@ module Main
     ( main
     ) where
 
-import           Control.Exception                        (finally)
-import           Database.PostgreSQL.Simple               (begin,
-                                                           connectPostgreSQL,
-                                                           rollback)
+import           Database.PostgreSQL.Simple               (connectPostgreSQL)
 import           Database.PostgreSQL.Simple.MigrationTest (migrationSpec)
+import           Database.PostgreSQL.Simple.Util          (withTransactionRolledBack)
 import           Test.Hspec                               (hspec)
 
 main :: IO ()
 main = do
     con <- connectPostgreSQL "dbname=test"
-    begin con
-    finally
-        (hspec (migrationSpec con))
-        (rollback con)
-
-
+    withTransactionRolledBack con (hspec (migrationSpec con))