-- |
-- 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 -> IO (MigrationResult [Char])
runMigration (MigrationContext MigrationCommand
cmd Bool
verbose Connection
con) = Bool
-> Connection -> [MigrationCommand] -> IO (MigrationResult [Char])
runMigrations Bool
verbose Connection
con [MigrationCommand
cmd]


runMigrations
    :: Bool
       -- ^ Run in verbose mode
    -> Connection
       -- ^ The postgres connection to use
    -> [V2.MigrationCommand]
       -- ^ The commands to run
    -> IO (V2.MigrationResult String)
runMigrations :: Bool
-> Connection -> [MigrationCommand] -> IO (MigrationResult [Char])
runMigrations Bool
verbose Connection
con [MigrationCommand]
commands = do
  let opts :: MigrationOptions
opts = MigrationOptions
V2.defaultOptions
       { optVerbose :: Verbosity
V2.optVerbose = if Bool
verbose then Verbosity
V2.Verbose else Verbosity
V2.Quiet
       , optTableName :: ByteString
V2.optTableName = ByteString
"schema_migrations"
       , optTransactionControl :: TransactionControl
V2.optTransactionControl = TransactionControl
V2.NoNewTransaction
       }
  Connection
-> MigrationOptions
-> [MigrationCommand]
-> IO (MigrationResult [Char])
V2.runMigrations Connection
con MigrationOptions
opts [MigrationCommand]
commands


-- | The 'MigrationContext' provides an execution context for migrations.
data MigrationContext = MigrationContext
  { MigrationContext -> MigrationCommand
migrationContextCommand :: V2.MigrationCommand
  -- ^ The action that will be performed by 'runMigration'
  , MigrationContext -> Bool
migrationContextVerbose :: Bool
  -- ^ Verbosity of the library.
  , MigrationContext -> Connection
migrationContextConnection :: Connection
  -- ^ The PostgreSQL connection to use for migrations.
  }