packages feed

postgresql-migration (empty) → 0.2.1.2

raw patch · 16 files changed

+1560/−0 lines, 16 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed

Dependencies added: base, base64-bytestring, bytestring, cryptohash, directory, filepath, hspec, postgresql-migration, postgresql-simple, text, time

Files

+ Changelog.markdown view
@@ -0,0 +1,68 @@+# Changelog++## 0.2.1.0+ * Forked & renamed to postgresql-migration+ * Support for changing the schema_migration table name + * Support custom logging+ * API option to control how transactions are used+ * Support for older GHC versions dropped++## 0.1.15.0+* Bumped dependencies++## 0.1.14.0+* Bumped dependencies++## 0.1.13.1+* Bumped dependencies++## 0.1.13.0+* Bumped dependencies++## 0.1.12.0+* Support for GHC 8.4++## 0.1.11.0+* Improved documentation+* Fixed exists_table++## 0.1.10.1+* Fixed hackage warnings++## 0.1.10.0+* Relaxed time bounds++## 0.1.9.0+* Bumped dependencies++## 0.1.8.0+* Added MigrationCommands allowing sequencing of migrations in the Haskell API+* Derived more datatypes for MigrationResult+* Bumped dependencies++## 0.1.7.0+* Propagate migration and validation result to application exit code++## 0.1.6.0+* Support for GHC 8++## 0.1.5.0+* Bumped dependencies++## 0.1.4.0+* Improved error logging in standalone binary++## 0.1.3.0+* Better transaction handling+* Improved documentation++## 0.1.2.0+* Moved Util module+* Improved documentation++## 0.1.1.0+* Support for schema validations.+* Improved Haskell API++## 0.1.0.0+* Support for file-based and Haskell migrations.
+ License view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Andreas Meingast <ameingast@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Readme.markdown view
@@ -0,0 +1,236 @@+# PostgreSQL Migrations for Haskell++Forked from [postgresql-simple-migration](https://github.com/ameingast/postgresql-simple-migration) created by [Andreas Meingast](https://github.com/ameingast/postgresql-simple-migration)++[![Haskell-CI](https://github.com/andrevdm/postgresql-simple-migration/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/andrevdm/postgresql-simple-migration/actions/workflows/haskell-ci.yml)+++Welcome to postgresql-migrations, a tool for helping you with+PostgreSQL schema migrations.++This project is an open-source database migration tool. It favors simplicity+over configuration.++It is implemented in Haskell and uses the (excellent) postgresql-simple+library to communicate with PostgreSQL.++It comes in two flavors: a library that features an easy to use Haskell+API and as a standalone application.++Database migrations can be written in SQL (in this case PostgreSQL-sql)+or in Haskell.++## Why?+Database migrations should not be hard. They should be under version control+and documented both in your production systems and in your project files.++## What?+This library executes SQL/Haskell migration scripts and keeps track of their+meta information.++Scripts are be executed exactly once and any changes to scripts will cause+a run-time error notifying you of a corrupted database.++The meta information consists of:+* an MD5 checksum of the executed script to make sure already existing+  scripts cannot be modified in your production system.+* a time-stamp of the date of execution so you can easily track when a change+  happened.++This library also supports migration validation so you can ensure (some)+correctness before your application logic kicks in.++## How?+This utility can be used in two ways: embedded in your Haskell program or as+a standalone binary.++### Standalone+The standalone program supports file-based migrations. To execute all SQL-files+in a directory $BASE\_DIR, execute the following command to initialize the database+in a first step.++```bash+CON="host=$host dbname=$db user=$user password=$pw"+cabal run migrate -- init $CON+cabal run migrate -- migrate $CON $BASE_DIR+```++To validate already executed scripts, execute the following:+```bash+CON="host=$host dbname=$db user=$user password=$pw"+cabal run migrate -- init $CON+cabal run migrate -- validate $CON $BASE_DIR+```++For more information about the PostgreSQL connection string, see:+[libpq-connect](http://www.postgresql.org/docs/9.3/static/libpq-connect.html).++### Library+The library supports more actions than the standalone program.++Initializing the database:++```haskell+main :: IO ()+main = do+    let url = "host=$host dbname=$db user=$user password=$pw"+    con <- connectPostgreSQL (BS8.pack url)+    runMigration con defaultOptions MigrationInitialization+```++For file-based migrations, the following snippet can be used:++```haskell+main :: IO ()+main = do+    let url = "host=$host dbname=$db user=$user password=$pw"+    let dir = "."+    con <- connectPostgreSQL (BS8.pack url)+    runMigration con defaltOptions $ MigrationDirectory dir+```++To run Haskell-based migrations, use this:++```haskell+main :: IO ()+main = do+    let url = "host=$host dbname=$db user=$user password=$pw"+    let name = "my script"+    let script = "create table users (email varchar not null)";+    con <- connectPostgreSQL (BS8.pack url)+    runMigration con defaultOptions $ MigrationScript name script+```++Validations wrap _MigrationCommands_. This means that you can re-use all+MigrationCommands to perform a read-only validation of your migrations.++To perform a validation on a directory-based migration, you can use the+following code:++```haskell+main :: IO ()+main = do+    let url = "host=$host dbname=$db user=$user password=$pw"+    con <- connectPostgreSQL (BS8.pack url)+    runMigration con default Options $ MigrationValidation (MigrationDirectory dir)+```++### Transactions++Database migrations should always be performed in a transactional context.++The standalone binary and the API default to using a new transaction for the +entire set of migrations.++Using the `-t` argument to the binary will change this to using a new transaction+per migration step (script).++When using the library you have full control over the behaviour of transactions+by setting `optTransactionControl` on the `MigrationOptions` record.++There are three options++ 1) No new transaction: you manage the transaction, e.g. if you want to run multiple migrations in a single transaction+ 2) Transaction per run: This is the default. New transaction for the entire migration+ 3) Transaction per step++The tests make use `TransactionPerRun`, after executing all migration-tests, the+transaction is rolled back.+++### Options++The `runMigration` and `runMigration` functions take an options record that let you+set the following++ - `optVerbose`: Is verbose logging enabled or not+ - `optLogWriter`: The function used to write log messages. Defaults to `stdout` for info and `stderr` for errors+ - `optTableName`: The name for the migrations table. This defaults to `schema_migrations`.+ - `optTransactionControl`: How transactions should be hanbled+++## Compilation and Tests+The program can be built with _cabal_ or _stack_ build systems. ++The following command builds the library, the standalone binary and the test package with _cabal_++```bash+cabal configure --enable-tests && cabal build -j+```++To execute the tests, you need a running PostgreSQL server with an empty+database called _test_. Tests are executed through cabal as follows:++```bash+cabal configure --enable-tests && cabal test+```++To build with stack use the following command++```bash+stack build+```++To run the tests with stack use the following command++```bash+stack test+```+++# Changes from the original postgresql-simple-migration (version 0.1)++**postgresql-migration** is fork of *postgresql-simple-migration* created when the original *postgresql-simple-migration* project was archived.++**postgresql-migration** version 0.2.x introduces some new features that will require some minor changes if you were using a 0.1.x version before++The new features are++ - Support for custom logging (original PR from https://github.com/ameingast/postgresql-simple-migration/pull/36. Thanks @unclechu)+ - Custom migrations table name (original PR from https://github.com/ameingast/postgresql-simple-migration/pull/30)+ - Transaction control from the API (original request from https://github.com/ameingast/postgresql-simple-migration/issues/40) +++There are two ways to move to **postgresql-migration**+++## Compatability layer - the simple way, but no new features++ 1) Replace `postgresql-simple-migration` with `postgresql-migration` in your .cabal file+ 2) Import `Database.PostgreSQL.Simple.Migration.V1Compat` rather than `Database.PostgreSQL.Simple.Migration`++All your existing code should work as is+++## Porting to version 2++The most obvious code change is that you now use a `MigrationOptions` rather than a `MigrationContext`. +++_Version 0.1.x_++This what you would have had++```haskell+ withTransaction con . runMigration $ MigrationContext Pgm.MigrationInitialization True con+```+++_Version 0.2.x_++Version 2 with the defaultOptions++```haskell+ runMigration con defaultOptions Pgm.MigrationInitialization+```++or if you want to change the default options++```haskell+ let options = defaultOptions { optTransactionControl = TransactionPerRun, optVerbosity = Verbose }+ runMigration con options Pgm.MigrationInitialization+```++That is all that needs to change. Your migrations scripts etc all remain as is.++
+ Setup.lhs view
@@ -0,0 +1,2 @@+> import Distribution.Simple+> main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,174 @@+-- |+-- Module      : Main+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A standalone program for the postgresql-migration library.++{-# LANGUAGE OverloadedStrings #-}++module Main+  ( main+  ) where++import           Control.Exception+import           Control.Monad (when)+import qualified Data.ByteString as BS (ByteString)+import qualified Data.ByteString.Char8 as BS8 (pack)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import           Database.PostgreSQL.Simple ( SqlError (..)+                                            , connectPostgreSQL+                                            )+import           Database.PostgreSQL.Simple.Migration ( MigrationCommand (..)+                                                      , MigrationOptions (..)+                                                      , MigrationResult (..)+                                                      , TransactionControl (..)+                                                      , Verbosity (..)+                                                      , defaultOptions+                                                      , runMigration+                                                      )+import           Data.Version (showVersion)+import           System.Environment (getArgs)+import           System.Exit (exitFailure, exitSuccess)+import           System.IO (Handle, hPutStrLn, stdout, stderr)++import qualified Paths_postgresql_migration as P++main :: IO ()+main =  do+  args <- getArgs+  case collectArgs args (Verbose, TransactionPerRun) of+    ArgPrintUsage -> printUsage stdout+    ArgCommand (verbose, trn, rest) -> ppException $ run (parseCommand rest) verbose trn+++data ArgAction+  = ArgPrintUsage+  | ArgCommand (Verbosity, TransactionControl, [[Char]])+++collectArgs :: [[Char]] -> (Verbosity, TransactionControl) -> ArgAction+collectArgs [] (v, t) = ArgCommand (v, t, [])+collectArgs (x:xs) (v, t) =+  case x of+    "-h" -> ArgPrintUsage+    "-q" -> collectArgs xs (Quiet, t)+    "-t" -> collectArgs xs (v, TransactionPerStep)+    _ -> ArgCommand (v, t, x:xs)+++-- | Pretty print postgresql-simple exceptions to see whats going on+ppException :: IO a -> IO a+ppException a = catch a ehandler+  where+    ehandler e = maybe (throw e) (*> exitFailure) (pSqlError <$> fromException e)+    bsToString = T.unpack . T.decodeUtf8+    pSqlError e = mapM_ (hPutStrLn stderr)+                  [ "SqlError:"+                  , "  sqlState: ", bsToString $ sqlState e+                  , "  sqlExecStatus: ", show $ sqlExecStatus e+                  , "  sqlErrorMsg: ", bsToString $ sqlErrorMsg e+                  , "  sqlErrorDetail: ", bsToString $ sqlErrorDetail e+                  , "  sqlErrorHint: ", bsToString $ sqlErrorHint e+                  ]++run+  :: Maybe Command+  -> Verbosity+  -> TransactionControl+  -> IO ()+run Nothing _ _ = printUsage stderr >> exitFailure+run (Just cmd) verbose trnControl = do+  when (verbose == Verbose) $ do+    putStrLn $ "postgresql-migration Version: " <> showVersion P.version+    putStrLn $ "Verbosity: " <> show verbose+    putStrLn $ "Transactions: " <> show trnControl++  handleResult =<< case cmd of+    Initialize url tableName -> do+      con <- connectPostgreSQL (BS8.pack url)+      let opts = defaultOptions+           { optTableName = tableName+           , optVerbose = verbose+           , optTransactionControl = trnControl+           }+      runMigration con opts MigrationInitialization++    Migrate url dir tableName -> do+      con <- connectPostgreSQL (BS8.pack url)+      let opts = defaultOptions+           { optTableName = tableName+           , optVerbose = verbose+           , optTransactionControl = trnControl+           }+      runMigration con opts $ MigrationDirectory dir++    Validate url dir tableName -> do+      con <- connectPostgreSQL $ BS8.pack url+      let opts = defaultOptions+           { optTableName = tableName+           , optVerbose = verbose+           , optTransactionControl = trnControl+           }+      runMigration con opts $ MigrationValidation (MigrationDirectory dir)++  where+    handleResult MigrationSuccess = exitSuccess+    handleResult (MigrationError _) = exitFailure+++parseCommand :: [String] -> Maybe Command+parseCommand ("init":url:tableName:_) = Just (Initialize url (BS8.pack tableName))+parseCommand ("migrate":url:dir:tableName:_) = Just (Migrate url dir (BS8.pack tableName))+parseCommand ("validate":url:dir:tableName:_) = Just (Validate url dir (BS8.pack tableName))+parseCommand ("init":url:_) = Just (Initialize url "schema_migrations")+parseCommand ("migrate":url:dir:_) = Just (Migrate url dir "schema_migrations")+parseCommand ("validate":url:dir:_) = Just (Validate url dir "schema_migrations")+parseCommand _ = Nothing+++printUsage :: Handle -> IO ()+printUsage h = do+    hPutStrLn h "migrate [options] <command>"+    hPutStrLn h "  Options:"+    hPutStrLn h "      -h          Print help text"+    hPutStrLn h "      -q          Enable quiet mode"+    hPutStrLn h "      -t          Enable transaction per script"+    hPutStrLn h "                   defauts to a single transaction for the entire migration(s)"+    hPutStrLn h "  Commands:"+    hPutStrLn h "      init <con> {migrations table name}"+    hPutStrLn h "                  Initialize the database. Required to be run"+    hPutStrLn h "                  at least once."+    hPutStrLn h "                  {migrations table name} is the optiona name."+    hPutStrLn h "                  for the migrations table. This defaults to"+    hPutStrLn h "                  `schema_migrations`."+    hPutStrLn h "      migrate <con> <directory> {migrations table name}"+    hPutStrLn h "                  Execute all SQL scripts in the provided"+    hPutStrLn h "                  directory in alphabetical order."+    hPutStrLn h "                  Scripts that have already been executed are"+    hPutStrLn h "                  ignored. If a script was changed since the"+    hPutStrLn h "                  time of its last execution, an error is"+    hPutStrLn h "                  raised."+    hPutStrLn h "                  {migrations table name} is the optiona name."+    hPutStrLn h "                  for the migrations table. This defaults to"+    hPutStrLn h "                  `schema_migrations`."+    hPutStrLn h "      validate <con> <directory> {migrations table name}"+    hPutStrLn h "                  Validate all SQL scripts in the provided"+    hPutStrLn h "                  directory."+    hPutStrLn h "                  {migrations table name} is the optiona name."+    hPutStrLn h "                  for the migrations table. This defaults to"+    hPutStrLn h "                  `schema_migrations`."+    hPutStrLn h "      The <con> parameter is based on libpq connection string"+    hPutStrLn h "      syntax. Detailled information is available here:"+    hPutStrLn h "      <http://www.postgresql.org/docs/9.3/static/libpq-connect.html>"+++data Command+  = Initialize String BS.ByteString+  | Migrate String FilePath BS.ByteString+  | Validate String FilePath BS.ByteString
+ postgresql-migration.cabal view
@@ -0,0 +1,106 @@+cabal-version:              3.0+name:                       postgresql-migration+version:                    0.2.1.2+synopsis:                   PostgreSQL Schema Migrations+homepage:                   https://github.com/andrevdm/postgresql-migration+Bug-reports:                https://github.com/andrevdm/postgresql-migration/issues+license:                    BSD-3-Clause+license-file:               License+author:                     Andreas Meingast <ameingast@gmail.com>+maintainer:                 Andre Van Der Merwe <andre@andrevdm.com>+copyright:                  2014-2021, Andreas Meingast+category:                   Database+build-type:                 Simple+description:                A PostgreSQL-simple schema migration utility+tested-with:                GHC==9.0.1, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4++extra-source-files:         License+                            Readme.markdown+                            Changelog.markdown++                            share/test/*.sql+                            share/test/scripts/*.sql++source-repository head+  type:                   git+  location:               git://github.com/andrevdm/postgresql-migration++common common-options+  build-depends:+    base >=4.9 && <5+  default-language:+    Haskell2010+++common common-ghc-options-ide+  ghc-options: -fwrite-ide-info -hiedir=.hie++common common-ghc-options+  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wredundant-constraints -Wnoncanonical-monad-instances -Widentities -fhide-source-paths -Wpartial-fields -fhide-source-paths -freverse-errors+++library+  import:                 common-options+  import:                 common-ghc-options++  if impl(ghc >= 8.8.1)+    import:                common-ghc-options-ide++  exposed-modules:        Database.PostgreSQL.Simple.Migration+                        , Database.PostgreSQL.Simple.Migration.V1Compat+                        , Database.PostgreSQL.Simple.Util+  other-modules:          Paths_postgresql_migration+  autogen-modules:        Paths_postgresql_migration+  hs-source-dirs:         src+  default-language:       Haskell2010+  build-depends:          base                        >= 4.9      && < 5.0+                        , base64-bytestring           >= 1.0      && < 1.3+                        , bytestring                  >= 0.10     && < 0.11+                        , cryptohash                  >= 0.11     && < 0.12+                        , directory                   >= 1.2      && < 1.4+                        , filepath                    >= 1.4.1.0  && < 1.4.3.0+                        , postgresql-simple           >= 0.4      && < 0.7+                        , time                        >= 1.4      && < 1.10+                        , text                        >= 1.2      && < 1.3++executable migrate+  import:                 common-options+  import:                 common-ghc-options+  if impl(ghc >= 8.8.1)+    import:                common-ghc-options-ide++  ghc-options:            -threaded+  main-is:                Main.hs+  other-modules:          Paths_postgresql_migration+  autogen-modules:        Paths_postgresql_migration+  hs-source-dirs:         app+  default-language:       Haskell2010+  build-depends:          postgresql-migration+                        , base                        >= 4.9      && < 5.0+                        , base64-bytestring           >= 1.0      && < 1.3+                        , bytestring                  >= 0.10     && < 0.11+                        , cryptohash                  >= 0.11     && < 0.12+                        , directory                   >= 1.2      && < 1.4+                        , postgresql-simple           >= 0.4      && < 0.7+                        , time                        >= 1.4      && < 1.10+                        , text                        >= 1.2      && < 1.3++test-suite tests+  import:                 common-options+  import:                 common-ghc-options+  if impl(ghc >= 8.8.1)+    import:               common-ghc-options-ide++  main-is:                Main.hs+  hs-source-dirs:         test+  other-modules:          Database.PostgreSQL.Simple.MigrationTest+                       ,  Database.PostgreSQL.Simple.MigrationTestV1Compat+                       ,  Database.PostgreSQL.Simple.TransactionPerRunTest+                       ,  Database.PostgreSQL.Simple.TransactionPerStepTest+  default-language:       Haskell2010+  type:                   exitcode-stdio-1.0+  build-depends:          postgresql-migration+                        , base                        >= 4.9      && < 5.0+                        , bytestring                  >= 0.10     && < 0.11+                        , postgresql-simple           >= 0.4      && < 0.7+                        , hspec                       >= 2.2      && < 2.8
+ share/test/script.sql view
@@ -0,0 +1,1 @@+create table t3 (c3 varchar);
+ share/test/scripts/1.sql view
@@ -0,0 +1,1 @@+create table t2 (c2 varchar);
+ src/Database/PostgreSQL/Simple/Migration.hs view
@@ -0,0 +1,426 @@+-- |+-- Module      : Database.PostgreSQL.Simple.Migration+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A migration library for postgresql-simple.+--+-- For usage, see Readme.markdown.++{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.Migration+    (+    -- * Migration actions+      defaultOptions+    , runMigration+    , runMigrations+    , sequenceMigrations++    -- * Migration types+    , Checksum+    , MigrationOptions(..)+    , MigrationCommand(..)+    , MigrationResult(..)+    , ScriptName+    , TransactionControl(..)+    , Verbosity(..)++    -- * Migration result actions+    , getMigrations+    , getMigrations'++    -- * Migration result types+    , SchemaMigration(..)+    ) where++import           Control.Monad (void, when)+import qualified Crypto.Hash.MD5 as MD5 (hash)+import qualified Data.ByteString as BS (ByteString, readFile)+import qualified Data.ByteString.Char8 as BS8 (unpack)+import qualified Data.ByteString.Base64 as B64 (encode)+import           Data.Functor ((<&>))+import           Data.List (isPrefixOf, sort)+import           Data.Time (LocalTime)+import qualified Data.Text as T+import qualified Data.Text.IO as T (putStrLn, hPutStrLn)+import           Data.String (fromString)+import           Database.PostgreSQL.Simple ( Connection+                                            , Only (..)+                                            , execute+                                            , execute_+                                            , query+                                            , query_+                                            , withTransaction+                                            )+import           Database.PostgreSQL.Simple.FromRow (FromRow (..), field)+import           Database.PostgreSQL.Simple.ToField (ToField (..))+import           Database.PostgreSQL.Simple.ToRow (ToRow (..))+import           Database.PostgreSQL.Simple.Types (Query (..))+import           Database.PostgreSQL.Simple.Util (existsTable)+import           System.Directory (getDirectoryContents)+import           System.FilePath ((</>))+import           System.IO (stderr)++-- | 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.+runMigration :: Connection -> MigrationOptions -> MigrationCommand -> IO (MigrationResult String)+runMigration con opts cmd = runMigrations' True con opts [cmd]+++-- | Execute a sequence of migrations+--+-- Returns 'MigrationSuccess' if all of the provided 'MigrationCommand's+-- execute without error. If an error occurs, execution is stopped and the+-- 'MigrationError' is returned.+runMigrations+  :: Connection -- ^ The postgres connection to use+  -> MigrationOptions -- ^ The options for this migration+  -> [MigrationCommand] -- ^ The commands to run+  -> IO (MigrationResult String)+runMigrations = runMigrations' True++++-- | Implements runMigration. Ensure that 'doRunTransaction' is only called on the first run+runMigration' :: Connection -> MigrationOptions -> MigrationCommand -> IO (MigrationResult String)+runMigration' con opts cmd =+  case cmd of+    MigrationInitialization ->+      initializeSchema con opts >> pure MigrationSuccess+    MigrationDirectory path ->+      executeDirectoryMigration con opts path+    MigrationScript name contents ->+      executeMigration con opts name contents+    MigrationFile name path ->+      executeMigration con opts name =<< BS.readFile path+    MigrationValidation validationCmd ->+      executeValidation con opts validationCmd+    MigrationCommands commands ->+      runMigrations' False con opts commands+++-- | Implements runMigrations+runMigrations'+  :: Bool -- ^ Is this the first/top-level call+  -> Connection -- ^ The postgres connection to use+  -> MigrationOptions -- ^ The options for this migration+  -> [MigrationCommand] -- ^ The commands to run+  -> IO (MigrationResult String)+runMigrations' isFirst con opts commands =+  if isFirst+    then doRunTransaction opts con go+    else go+  where+    go = sequenceMigrations [runMigration' con opts c | c <- commands]++++-- | Run a sequence of contexts, stopping on the first failure+sequenceMigrations+    :: Monad m+    => [m (MigrationResult e)]+    -> m (MigrationResult e)+sequenceMigrations = \case+  [] -> pure MigrationSuccess+  c:cs -> do+    r <- c+    case r of+      MigrationError s -> pure (MigrationError s)+      MigrationSuccess -> sequenceMigrations cs++-- | Executes all SQL-file based migrations located in the provided 'dir'+-- in alphabetical order.+executeDirectoryMigration+  :: Connection+  -> MigrationOptions+  -> FilePath+  -> IO (MigrationResult String)+executeDirectoryMigration con opts dir =+  scriptsInDirectory dir >>= go+  where+    go fs = sequenceMigrations (executeMigrationFile <$> fs)+    executeMigrationFile f =+      BS.readFile (dir </> f) >>= executeMigration con opts f+++-- | Lists all files in the given 'FilePath' 'dir' in alphabetical order.+scriptsInDirectory :: FilePath -> IO [String]+scriptsInDirectory dir =+  getDirectoryContents dir <&> (sort . filter (\x -> not $ "." `isPrefixOf` x))+++-- | Executes a generic SQL migration for the provided script 'name' with content 'contents'.+executeMigration+  :: Connection+  -> MigrationOptions+  -> ScriptName+  -> BS.ByteString+  -> IO (MigrationResult String)+executeMigration con opts name contents = doStepTransaction opts con $ do+  let checksum = md5Hash contents+  checkScript con opts name checksum >>= \case+    ScriptOk -> do+      when (verbose opts) $ optLogWriter opts $ Right $ "Ok:\t" <> fromString name+      pure MigrationSuccess+    ScriptNotExecuted -> do+      void $ execute_ con (Query contents)+      void $ execute con q (name, checksum)+      when (verbose opts) $ optLogWriter opts $ Right ("Execute:\t" <> fromString name)+      pure MigrationSuccess+    ScriptModified eva -> do+      when (verbose opts) $ optLogWriter opts $ Left ("Fail:\t" <> fromString name <> "\n" <> scriptModifiedErrorMessage eva)+      pure (MigrationError name)+  where+    q = "insert into " <> Query (optTableName opts) <> "(filename, checksum) values(?, ?)"++-- | Initializes the database schema with a helper table containing+-- meta-information about executed migrations.+initializeSchema :: Connection -> MigrationOptions -> IO ()+initializeSchema con opts = do+  when (verbose opts) $ optLogWriter opts $ Right "Initializing schema"+  void . doStepTransaction opts con . execute_ con $ mconcat+      [ "create table if not exists " <> Query (optTableName opts) <> " "+      , "( filename varchar(512) not null"+      , ", checksum varchar(32) not null"+      , ", executed_at timestamp without time zone not null default now() "+      , ");"+      ]+++-- | Validates a 'MigrationCommand'. Validation is defined as follows for these types:+--+-- * 'MigrationInitialization': validate the presence of the meta-information table.+-- * 'MigrationDirectory': validate the presence and checksum of all scripts found in the given directory.+-- * 'MigrationScript': validate the presence and checksum of the given script.+-- * 'MigrationFile': validate the presence and checksum of the given file.+-- * 'MigrationValidation': always succeeds.+-- * 'MigrationCommands': validates all the sub-commands stopping at the first failure.+executeValidation+  :: Connection+  -> MigrationOptions+  -> MigrationCommand+  -> IO (MigrationResult String)+executeValidation con opts cmd = doStepTransaction opts con $+  case cmd of+    MigrationInitialization ->+      existsTable con (BS8.unpack $ optTableName opts) >>= \r -> pure $ if r+        then MigrationSuccess+        else MigrationError ("No such table: " <> BS8.unpack (optTableName opts))+    MigrationDirectory path ->+      scriptsInDirectory path >>= goScripts path+    MigrationScript name contents ->+      validate name contents+    MigrationFile name path ->+      validate name =<< BS.readFile path+    MigrationValidation _ ->+      pure MigrationSuccess+    MigrationCommands cs ->+      sequenceMigrations (executeValidation con opts <$> cs)+  where+    validate name contents =+      checkScript con opts name (md5Hash contents) >>= \case+        ScriptOk -> do+          when (verbose opts) $ optLogWriter opts (Right $ "Ok:\t" <> fromString name)+          pure MigrationSuccess+        ScriptNotExecuted -> do+          when (verbose opts) $ optLogWriter opts (Left $ "Missing:\t" <> fromString name)+          pure (MigrationError $ "Missing: " <> name)+        ScriptModified eva -> do+          when (verbose opts) $ optLogWriter opts (Left $ "Checksum mismatch:\t" <> fromString name <> "\n" <> scriptModifiedErrorMessage eva)+          pure (MigrationError $ "Checksum mismatch: " <> name)++    goScripts path xs = sequenceMigrations (goScript path <$> xs)+    goScript path x = validate x =<< BS.readFile (path </> x)+++-- | Checks the status of the script with the given name 'name'.+-- If the script has already been executed, the checksum of the script+-- is compared against the one that was executed.+-- If there is no matching script entry in the database, the script+-- will be executed and its meta-information will be recorded.+checkScript :: Connection -> MigrationOptions -> ScriptName -> Checksum -> IO CheckScriptResult+checkScript con opts name fileChecksum =+  query con q (Only name) >>= \case+    [] ->+      pure ScriptNotExecuted+    Only dbChecksum:_ | fileChecksum == dbChecksum ->+      pure ScriptOk+    Only dbChecksum:_ ->+      pure $ ScriptModified (ExpectedVsActual {evaExpected = dbChecksum, evaActual = fileChecksum})+  where+    q = mconcat+        [ "select checksum from " <> Query (optTableName opts) <> " "+        , "where filename = ? limit 1"+        ]++-- | Calculates the MD5 checksum of the provided bytestring in base64+-- encoding.+md5Hash :: BS.ByteString -> Checksum+md5Hash = B64.encode . MD5.hash++-- | The checksum type of a migration script.+type Checksum = BS.ByteString++-- | The name of a script. Typically the filename or a custom name+-- when using Haskell migrations.+type ScriptName = String++-- | 'MigrationCommand' determines the action of the 'runMigration' script.+data MigrationCommand+  = MigrationInitialization+  -- ^ Initializes the database with a helper table containing meta+  -- information.+  | MigrationDirectory FilePath+  -- ^ Executes migrations based on SQL scripts in the provided 'FilePath'+  -- in alphabetical order.+  | MigrationFile ScriptName FilePath+  -- ^ Executes a migration based on script located at the provided+  -- 'FilePath'.+  | MigrationScript ScriptName BS.ByteString+  -- ^ Executes a migration based on the provided bytestring.+  | MigrationValidation MigrationCommand+  -- ^ Validates that the provided MigrationCommand has been executed.+  | MigrationCommands [MigrationCommand]+  -- ^ Performs a series of 'MigrationCommand's in sequence.+  deriving (Show, Eq, Read, Ord)++instance Semigroup MigrationCommand where+  (<>) (MigrationCommands xs) (MigrationCommands ys) = MigrationCommands (xs <> ys)+  (<>) (MigrationCommands xs) y = MigrationCommands (xs <> [y])+  (<>) x (MigrationCommands ys) = MigrationCommands (x : ys)+  (<>) x y = MigrationCommands [x, y]++instance Monoid MigrationCommand where+  mempty = MigrationCommands []+  mappend = (<>)++data ExpectedVsActual a = ExpectedVsActual+  { evaExpected :: !a+  , evaActual :: !a+  } deriving (Show)++-- | A sum-type denoting the result of a single migration.+data CheckScriptResult+  = ScriptOk+  -- ^ The script has already been executed and the checksums match.+  -- This is good.+  | ScriptModified (ExpectedVsActual Checksum)+  -- ^ The script has already been executed and there is a checksum+  -- mismatch. This is bad.+  | ScriptNotExecuted+  -- ^ The script has not been executed, yet. This is good.+  deriving (Show)++scriptModifiedErrorMessage :: ExpectedVsActual Checksum -> T.Text+scriptModifiedErrorMessage (ExpectedVsActual expected actual) =+  "expected: " <> fromString (show expected) <> "\nhash was: " <> fromString (show actual)++-- | A sum-type denoting the result of a migration.+data MigrationResult a+  = MigrationError a+  -- ^ There was an error in script migration.+  | MigrationSuccess+  -- ^ All scripts have been executed successfully.+  deriving (Show, Eq, Read, Ord, Functor, Foldable, Traversable)++data Verbosity+  = Verbose+  | Quiet+  deriving (Show, Eq)++-- | Determines how transactions are handled+-- Its is recommened to use transaction when running migrations+-- Certain actions require a transaction per script, if you are doing this use TransactionPerStep+-- If you want a single transaction for all migrations use TransactionPerRun+-- If you do not want a transaction, or are using an existing transaction then use NoNewTransaction+data TransactionControl+  = NoNewTransaction -- ^ No new transaction will be started. Up to the caller to decide if the run is in a transaction or not+  | TransactionPerRun -- ^ Call 'withTransaction' once for the entire 'MigrationCommand'+  | TransactionPerStep -- ^ Call 'withTransaction' once for each step in a 'MigrationCommand' (i.e. new transaction per script)+  deriving (Show)+++data MigrationOptions = MigrationOptions+  { optVerbose :: !Verbosity+  -- ^ Verbosity of the library.+  , optTableName :: !BS.ByteString+  -- ^ The name of the table that stores the migrations, usually "schema_migrations"+  , optLogWriter :: !(Either T.Text T.Text -> IO ())+  -- ^ Logger. 'Either' indicates log level,+  -- 'Left' for an error message and 'Right' for an info message.+  , optTransactionControl :: !TransactionControl+  -- ^ If/when transactions should be started+  }++defaultOptions :: MigrationOptions+defaultOptions =+  MigrationOptions+    { optVerbose = Quiet+    , optTableName = "schema_migrations"+    , optLogWriter = either (T.hPutStrLn stderr) T.putStrLn+    , optTransactionControl = TransactionPerRun+    }++verbose :: MigrationOptions -> Bool+verbose o = optVerbose o == Verbose+++doRunTransaction :: MigrationOptions -> Connection -> IO a -> IO a+doRunTransaction opts con act =+  case optTransactionControl opts of+    NoNewTransaction -> act+    TransactionPerRun -> withTransaction con act+    TransactionPerStep -> act+++doStepTransaction :: MigrationOptions -> Connection -> IO a -> IO a+doStepTransaction opts con act =+  case optTransactionControl opts of+    NoNewTransaction -> act+    TransactionPerRun -> act+    TransactionPerStep -> withTransaction con act+++-- | Produces a list of all executed 'SchemaMigration's in the default schema_migrations table+getMigrations :: Connection -> IO [SchemaMigration]+getMigrations con = getMigrations' con "schema_migrations"++-- | Produces a list of all executed 'SchemaMigration's.+getMigrations' :: Connection -> BS.ByteString -> IO [SchemaMigration]+getMigrations' con tableName = query_ con q+  where q = mconcat+          [ "select filename, checksum, executed_at "+          , "from " <> Query tableName <> " order by executed_at asc"+          ]++-- | A product type representing a single, executed 'SchemaMigration'.+data SchemaMigration = SchemaMigration+  { schemaMigrationName       :: BS.ByteString+  -- ^ The name of the executed migration.+  , schemaMigrationChecksum   :: Checksum+  -- ^ The calculated MD5 checksum of the executed script.+  , schemaMigrationExecutedAt :: LocalTime+  -- ^ A timestamp without timezone of the date of execution of the script.+  } deriving (Show, Eq, Read)++instance Ord SchemaMigration where+  compare (SchemaMigration nameLeft _ _) (SchemaMigration nameRight _ _) =+    compare nameLeft nameRight++instance FromRow SchemaMigration where+  fromRow = SchemaMigration <$>+    field <*> field <*> field++instance ToRow SchemaMigration where+  toRow (SchemaMigration name checksum executedAt) =+   [toField name, toField checksum, toField executedAt]
+ src/Database/PostgreSQL/Simple/Migration/V1Compat.hs view
@@ -0,0 +1,72 @@+-- |+-- Module      : Database.PostgreSQL.Simple.Migration+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A migration library for postgresql-simple.+--+-- For usage, see Readme.markdown.++{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.Migration.V1Compat+    (+    -- * Migration actions+      runMigration+    , runMigrations+    , V2.sequenceMigrations++    -- * Migration types+    , MigrationContext(..)++    , V2.MigrationCommand(..)+    , V2.MigrationResult(..)+    , V2.ScriptName+    , V2.Checksum++    -- * Migration result actions+    , V2.getMigrations++    -- * Migration result types+    , V2.SchemaMigration(..)+    ) where+++import           Database.PostgreSQL.Simple (Connection)+import qualified Database.PostgreSQL.Simple.Migration as V2+++runMigration :: MigrationContext -> IO (V2.MigrationResult [Char])+runMigration (MigrationContext cmd verbose con) = runMigrations verbose con [cmd]+++runMigrations+    :: Bool+       -- ^ Run in verbose mode+    -> Connection+       -- ^ The postgres connection to use+    -> [V2.MigrationCommand]+       -- ^ The commands to run+    -> IO (V2.MigrationResult String)+runMigrations verbose con commands = do+  let opts = V2.defaultOptions+       { V2.optVerbose = if verbose then V2.Verbose else V2.Quiet+       , V2.optTableName = "schema_migrations"+       , V2.optTransactionControl = V2.NoNewTransaction+       }+  V2.runMigrations con opts commands+++-- | The 'MigrationContext' provides an execution context for migrations.+data MigrationContext = MigrationContext+  { migrationContextCommand :: V2.MigrationCommand+  -- ^ The action that will be performed by 'runMigration'+  , migrationContextVerbose :: Bool+  -- ^ Verbosity of the library.+  , migrationContextConnection :: Connection+  -- ^ The PostgreSQL connection to use for migrations.+  }
+ src/Database/PostgreSQL/Simple/Util.hs view
@@ -0,0 +1,43 @@+-- |+-- Module      : Database.PostgreSQL.Simple.Util+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A collection of utilites for database migrations.++{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.Util+    ( existsTable+    , withTransactionRolledBack+    ) where++import           Control.Exception ( finally )+import           Database.PostgreSQL.Simple ( Connection+                                            , Only (..)+                                            , begin+                                            , query+                                            , rollback+                                            )+import           GHC.Int (Int64)++-- | Checks if the table with the given name exists in the database.+existsTable :: Connection -> String -> IO Bool+existsTable con table =+  checkRowCount <$> (query con q (Only table) :: IO [[Int64]])+  where+    q = "select count(relname) from pg_class where relname = ?"++    checkRowCount :: [[Int64]] -> Bool+    checkRowCount ((1:_):_) = True+    checkRowCount _ = False++-- | 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)
+ test/Database/PostgreSQL/Simple/MigrationTest.hs view
@@ -0,0 +1,117 @@+-- |+-- Module      : Database.PostgreSQL.Simple.MigrationTest+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A collection of postgresql-migration specifications.++{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.MigrationTest where++import           Data.IORef+import           Database.PostgreSQL.Simple           (Connection)+import           Database.PostgreSQL.Simple.Migration (MigrationCommand (..),+                                                       MigrationOptions (..),+                                                       MigrationResult (..),+                                                       SchemaMigration (..),+                                                       TransactionControl (..),+                                                       Verbosity(..),+                                                       getMigrations,+                                                       runMigration,+                                                       defaultOptions)+import           Database.PostgreSQL.Simple.Util      (existsTable)+import           Test.Hspec                           (Spec, describe, it, shouldBe)++migrationSpec :: Connection -> Spec+migrationSpec con = describe "Migrations" $ do+  let+    migrationScript = MigrationScript "test.sql" q+    migrationScriptAltered = MigrationScript "test.sql" ""+    migrationDir = MigrationDirectory "share/test/scripts"+    migrationFile = MigrationFile "s.sql" "share/test/script.sql"++  it "asserts that the schema_migrations table does not exist" $ do+    r <- existsTable con "schema_migrations"+    r `shouldBe` False++  it "validates an initialization on an empty database" $ do+    r <- runMigration' (MigrationValidation MigrationInitialization)+    r `shouldBe` MigrationError "No such table: schema_migrations"++  it "initializes a database" $ do+    r <- runMigration' MigrationInitialization+    r `shouldBe` MigrationSuccess++  it "creates the schema_migrations table" $ do+    r <- existsTable con "schema_migrations"+    r `shouldBe` True++  it "executes a migration script" $ do+    r <- runMigration' migrationScript+    r `shouldBe` MigrationSuccess++  it "creates the table from the executed script" $ do+    r <- existsTable con "t1"+    r `shouldBe` True++  it "skips execution of the same migration script" $ do+    r <- runMigration' migrationScript+    r `shouldBe` MigrationSuccess++  it "reports an error on a different checksum for the same script" $ do+    r <- runMigration' migrationScriptAltered+    r `shouldBe` MigrationError "test.sql"++  it "executes migration scripts inside a folder" $ do+    r <- runMigration' migrationDir+    r `shouldBe` MigrationSuccess++  it "creates the table from the executed scripts" $ do+    r <- existsTable con "t2"+    r `shouldBe` True++  it "executes a file based migration script" $ do+    r <- runMigration' migrationFile+    r `shouldBe` MigrationSuccess++  it "creates the table from the executed scripts" $ do+    r <- existsTable con "t3"+    r `shouldBe` True++  it "validates initialization" $ do+    r <- runMigration' $ MigrationValidation MigrationInitialization+    r `shouldBe` MigrationSuccess++  it "validates an executed migration script" $ do+    r <- runMigration' $ MigrationValidation migrationScript+    r `shouldBe` MigrationSuccess++  it "validates all scripts inside a folder" $ do+    r <- runMigration' $ MigrationValidation migrationDir+    r `shouldBe` MigrationSuccess++  it "validates an executed migration file" $ do+    r <- runMigration' $ MigrationValidation migrationFile+    r `shouldBe` MigrationSuccess++  it "gets a list of executed migrations" $ do+    r <- getMigrations con+    map schemaMigrationName r `shouldBe` ["test.sql", "1.sql", "s.sql"]++  it "log can be redirected" $ do+    ref <- newIORef mempty+    let logWrite = modifyIORef ref . (<>) . show+    let opts = defaultOptions{ optLogWriter = logWrite, optVerbose = Verbose, optTransactionControl = NoNewTransaction }+    _ <- runMigration con opts MigrationInitialization+    readIORef ref >>= (`shouldBe` "Right \"Initializing schema\"")++  where+    q = "create table t1 (c1 varchar);"+    runMigration' =+      runMigration con defaultOptions{optTransactionControl = NoNewTransaction}+
+ test/Database/PostgreSQL/Simple/MigrationTestV1Compat.hs view
@@ -0,0 +1,109 @@+-- |+-- Module      : Database.PostgreSQL.Simple.MigrationTest+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A collection of postgresql-migration specifications.++{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.MigrationTestV1Compat where++import           Database.PostgreSQL.Simple (Connection)+import           Database.PostgreSQL.Simple.Migration.V1Compat (MigrationCommand (..),+                                                                MigrationContext (..),+                                                                MigrationResult (..),+                                                                SchemaMigration (..),+                                                                getMigrations,+                                                                runMigration)+import           Database.PostgreSQL.Simple.Util (existsTable)+import           Test.Hspec (Spec, describe, it,+                            shouldBe)++migrationSpec:: Connection -> Spec+migrationSpec con = describe "Migrations" $ do+    let migrationScript = MigrationScript "test.sql" q+    let migrationScriptAltered = MigrationScript "test.sql" ""+    let migrationDir = MigrationDirectory "share/test/scripts"+    let migrationFile = MigrationFile "s.sql" "share/test/script.sql"++    it "asserts that the schema_migrations table does not exist" $ do+        r <- existsTable con "schema_migrations"+        r `shouldBe` False++    it "validates an initialization on an empty database" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation MigrationInitialization) False con+        r `shouldBe` MigrationError "No such table: schema_migrations"++    it "initializes a database" $ do+        r <- runMigration $ MigrationContext MigrationInitialization False con+        r `shouldBe` MigrationSuccess++    it "creates the schema_migrations table" $ do+        r <- existsTable con "schema_migrations"+        r `shouldBe` True++    it "executes a migration script" $ do+        r <- runMigration $ MigrationContext migrationScript False con+        r `shouldBe` MigrationSuccess++    it "creates the table from the executed script" $ do+        r <- existsTable con "t1"+        r `shouldBe` True++    it "skips execution of the same migration script" $ do+        r <- runMigration $+            MigrationContext migrationScript False con+        r `shouldBe` MigrationSuccess++    it "reports an error on a different checksum for the same script" $ do+        r <- runMigration $ MigrationContext migrationScriptAltered False con+        r `shouldBe` MigrationError "test.sql"++    it "executes migration scripts inside a folder" $ do+        r <- runMigration $ MigrationContext migrationDir False con+        r `shouldBe` MigrationSuccess++    it "creates the table from the executed scripts" $ do+        r <- existsTable con "t2"+        r `shouldBe` True++    it "executes a file based migration script" $ do+        r <- runMigration $ MigrationContext migrationFile False con+        r `shouldBe` MigrationSuccess++    it "creates the table from the executed scripts" $ do+        r <- existsTable con "t3"+        r `shouldBe` True++    it "validates initialization" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation MigrationInitialization) False con+        r `shouldBe` MigrationSuccess++    it "validates an executed migration script" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation migrationScript) False con+        r `shouldBe` MigrationSuccess++    it "validates all scripts inside a folder" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation migrationDir) False con+        r `shouldBe` MigrationSuccess++    it "validates an executed migration file" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation migrationFile) False con+        r `shouldBe` MigrationSuccess++    it "gets a list of executed migrations" $ do+        r <- getMigrations con+        map schemaMigrationName r `shouldBe` ["test.sql", "1.sql", "s.sql"]++    where+        q = "create table t1 (c1 varchar);"
+ test/Database/PostgreSQL/Simple/TransactionPerRunTest.hs view
@@ -0,0 +1,66 @@+-- |+-- Module      : Database.PostgreSQL.Simple.MigrationTest+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A collection of postgresql-migration specifications.++{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.TransactionPerRunTest where++import           Database.PostgreSQL.Simple           (Connection)+import           Database.PostgreSQL.Simple.Migration (MigrationCommand (..),+                                                       MigrationOptions (..),+                                                       MigrationResult (..),+                                                       TransactionControl (..),+                                                       runMigration,+                                                       runMigrations,+                                                       defaultOptions)+import           Database.PostgreSQL.Simple.Util      (existsTable)+import           Test.Hspec                           (Spec, describe, it, shouldBe, shouldThrow, anyException)++migrationSpec :: Connection -> Spec+migrationSpec con = describe "Migrations" $ do+  let+    scriptCreate1 = MigrationScript "create1.sql" "create table trn1 (c2 varchar);"+    scriptError1 = MigrationScript "errorScript.sql" "NOT SQL!"++  it "asserts that the test table does not exist" $ do+    r <- existsTable con "trn1"+    r `shouldBe` False++  it "asserts that the test table does not exist" $ do+    r <- existsTable con "trn2"+    r `shouldBe` False++  it "validates an initialization on an empty database" $ do+    r <- runMigration' (MigrationValidation MigrationInitialization)+    r `shouldBe` MigrationError "No such table: schema_migrations"++  it "initializes a database" $ do+    r <- runMigration' MigrationInitialization+    r `shouldBe` MigrationSuccess++  it "creates the schema_migrations table" $ do+    r <- existsTable con "schema_migrations"+    r `shouldBe` True++  -- This test shoud thow an exception since the second migration script is invalid SQL+  it "executes a migration script" $ (`shouldThrow` anyException) $ do+    let opts = defaultOptions{optTransactionControl = TransactionPerRun}+    runMigrations con opts [scriptCreate1, scriptError1]++  -- The second migration script failed, so the changes from the first should be rolled back (TransactionPerRun)+  it "creates the table from the executed script" $ do+    r <- existsTable con "trn1"+    r `shouldBe` False+++  where+    runMigration' =+      runMigration con defaultOptions{optTransactionControl = NoNewTransaction}
+ test/Database/PostgreSQL/Simple/TransactionPerStepTest.hs view
@@ -0,0 +1,75 @@+-- |+-- Module      : Database.PostgreSQL.Simple.MigrationTest+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- A collection of postgresql-migration specifications.++{-# LANGUAGE OverloadedStrings #-}++module Database.PostgreSQL.Simple.TransactionPerStepTest where++import           Database.PostgreSQL.Simple           (Connection, execute_)+import           Database.PostgreSQL.Simple.Migration (MigrationCommand (..),+                                                       MigrationOptions (..),+                                                       MigrationResult (..),+                                                       TransactionControl (..),+                                                       runMigration,+                                                       runMigrations,+                                                       defaultOptions)+import           Database.PostgreSQL.Simple.Util      (existsTable)+import           Test.Hspec                           (Spec, describe, it, shouldBe, shouldThrow, anyException, afterAll_)++migrationSpec :: Connection -> Spec+migrationSpec con = afterAll_ cleanup $ describe "Migrations" $ do+  let+    scriptCreate2 = MigrationScript "create2.sql" "create table trn2 (c2 varchar);"+    scriptError2 = MigrationScript "errorScript.sql" "ALSO NOT SQL!"++  it "asserts that the test table does not exist" $ do+    r <- existsTable con "trn1"+    r `shouldBe` False++  it "asserts that the test table does not exist" $ do+    r <- existsTable con "trn2"+    r `shouldBe` False++  it "validates an initialization on an empty database" $ do+    r <- runMigration' (MigrationValidation MigrationInitialization)+    r `shouldBe` MigrationError "No such table: schema_migrations"++  it "initializes a database" $ do+    r <- runMigration' MigrationInitialization+    r `shouldBe` MigrationSuccess++  it "creates the schema_migrations table" $ do+    r <- existsTable con "schema_migrations"+    r `shouldBe` True++  -- This test shoud thow an exception since the second migration script is invalid SQL+  it "executes a migration script" $ (`shouldThrow` anyException) $ do+    let opts = defaultOptions{optTransactionControl = TransactionPerStep}+    r <- runMigrations con opts [scriptCreate2, scriptError2]+    r `shouldBe` MigrationSuccess++  -- Since TransactionPerStep was used the first migration should have been committed even though the second one failed+  it "creates the table from the executed script" $ do+    r <- existsTable con "trn2"+    r `shouldBe` True+++  where+    runMigration' =+      runMigration con defaultOptions{optTransactionControl = NoNewTransaction}++    -- Cleanup+    cleanup = do+      _ <- execute_ con "drop table if exists trn2"+      _ <- execute_ con "drop table if exists schema_migrations"+      pure ()++
+ test/Main.hs view
@@ -0,0 +1,34 @@+-- |+-- Module      : Main+-- Copyright   : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License     : BSD-style+-- Maintainer  : andre@andrevdm.com+-- Stability   : experimental+-- Portability : GHC+--+-- The test entry-point for postgresql-migration.++{-# LANGUAGE OverloadedStrings #-}++module Main+    ( main+    ) where++import           Database.PostgreSQL.Simple               (connectPostgreSQL)+import qualified Database.PostgreSQL.Simple.MigrationTestV1Compat as V1+import qualified Database.PostgreSQL.Simple.MigrationTest as V2+import qualified Database.PostgreSQL.Simple.TransactionPerRunTest as V2TrnRun+import qualified Database.PostgreSQL.Simple.TransactionPerStepTest as V2TrnStep+import           Database.PostgreSQL.Simple.Util          (withTransactionRolledBack)+import           Test.Hspec                               (hspec)++main :: IO ()+main = do+    conRollback <- connectPostgreSQL ""+    withTransactionRolledBack conRollback (hspec (V2.migrationSpec conRollback))+    withTransactionRolledBack conRollback (hspec (V1.migrationSpec conRollback))+    withTransactionRolledBack conRollback (hspec (V2TrnRun.migrationSpec conRollback))++    conPerStep <- connectPostgreSQL ""+    hspec (V2TrnStep.migrationSpec conPerStep)