module Database.Migrant.Run
( migrate
, unsafeMigrate
, executePlan
, plan
, makePlan
, MigrationDirection (..)
)
where

import Database.Migrant.Driver.Class
import Database.Migrant.MigrationName

import Control.Monad (forM_)

data MigrationDirection
  = MigrateUp
  | MigrateDown
  deriving (Int -> MigrationDirection -> ShowS
[MigrationDirection] -> ShowS
MigrationDirection -> String
(Int -> MigrationDirection -> ShowS)
-> (MigrationDirection -> String)
-> ([MigrationDirection] -> ShowS)
-> Show MigrationDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationDirection] -> ShowS
$cshowList :: [MigrationDirection] -> ShowS
show :: MigrationDirection -> String
$cshow :: MigrationDirection -> String
showsPrec :: Int -> MigrationDirection -> ShowS
$cshowsPrec :: Int -> MigrationDirection -> ShowS
Show, MigrationDirection -> MigrationDirection -> Bool
(MigrationDirection -> MigrationDirection -> Bool)
-> (MigrationDirection -> MigrationDirection -> Bool)
-> Eq MigrationDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationDirection -> MigrationDirection -> Bool
$c/= :: MigrationDirection -> MigrationDirection -> Bool
== :: MigrationDirection -> MigrationDirection -> Bool
$c== :: MigrationDirection -> MigrationDirection -> Bool
Eq, Eq MigrationDirection
Eq MigrationDirection
-> (MigrationDirection -> MigrationDirection -> Ordering)
-> (MigrationDirection -> MigrationDirection -> Bool)
-> (MigrationDirection -> MigrationDirection -> Bool)
-> (MigrationDirection -> MigrationDirection -> Bool)
-> (MigrationDirection -> MigrationDirection -> Bool)
-> (MigrationDirection -> MigrationDirection -> MigrationDirection)
-> (MigrationDirection -> MigrationDirection -> MigrationDirection)
-> Ord MigrationDirection
MigrationDirection -> MigrationDirection -> Bool
MigrationDirection -> MigrationDirection -> Ordering
MigrationDirection -> MigrationDirection -> MigrationDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MigrationDirection -> MigrationDirection -> MigrationDirection
$cmin :: MigrationDirection -> MigrationDirection -> MigrationDirection
max :: MigrationDirection -> MigrationDirection -> MigrationDirection
$cmax :: MigrationDirection -> MigrationDirection -> MigrationDirection
>= :: MigrationDirection -> MigrationDirection -> Bool
$c>= :: MigrationDirection -> MigrationDirection -> Bool
> :: MigrationDirection -> MigrationDirection -> Bool
$c> :: MigrationDirection -> MigrationDirection -> Bool
<= :: MigrationDirection -> MigrationDirection -> Bool
$c<= :: MigrationDirection -> MigrationDirection -> Bool
< :: MigrationDirection -> MigrationDirection -> Bool
$c< :: MigrationDirection -> MigrationDirection -> Bool
compare :: MigrationDirection -> MigrationDirection -> Ordering
$ccompare :: MigrationDirection -> MigrationDirection -> Ordering
$cp1Ord :: Eq MigrationDirection
Ord, Int -> MigrationDirection
MigrationDirection -> Int
MigrationDirection -> [MigrationDirection]
MigrationDirection -> MigrationDirection
MigrationDirection -> MigrationDirection -> [MigrationDirection]
MigrationDirection
-> MigrationDirection -> MigrationDirection -> [MigrationDirection]
(MigrationDirection -> MigrationDirection)
-> (MigrationDirection -> MigrationDirection)
-> (Int -> MigrationDirection)
-> (MigrationDirection -> Int)
-> (MigrationDirection -> [MigrationDirection])
-> (MigrationDirection
    -> MigrationDirection -> [MigrationDirection])
-> (MigrationDirection
    -> MigrationDirection -> [MigrationDirection])
-> (MigrationDirection
    -> MigrationDirection
    -> MigrationDirection
    -> [MigrationDirection])
-> Enum MigrationDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MigrationDirection
-> MigrationDirection -> MigrationDirection -> [MigrationDirection]
$cenumFromThenTo :: MigrationDirection
-> MigrationDirection -> MigrationDirection -> [MigrationDirection]
enumFromTo :: MigrationDirection -> MigrationDirection -> [MigrationDirection]
$cenumFromTo :: MigrationDirection -> MigrationDirection -> [MigrationDirection]
enumFromThen :: MigrationDirection -> MigrationDirection -> [MigrationDirection]
$cenumFromThen :: MigrationDirection -> MigrationDirection -> [MigrationDirection]
enumFrom :: MigrationDirection -> [MigrationDirection]
$cenumFrom :: MigrationDirection -> [MigrationDirection]
fromEnum :: MigrationDirection -> Int
$cfromEnum :: MigrationDirection -> Int
toEnum :: Int -> MigrationDirection
$ctoEnum :: Int -> MigrationDirection
pred :: MigrationDirection -> MigrationDirection
$cpred :: MigrationDirection -> MigrationDirection
succ :: MigrationDirection -> MigrationDirection
$csucc :: MigrationDirection -> MigrationDirection
Enum, MigrationDirection
MigrationDirection
-> MigrationDirection -> Bounded MigrationDirection
forall a. a -> a -> Bounded a
maxBound :: MigrationDirection
$cmaxBound :: MigrationDirection
minBound :: MigrationDirection
$cminBound :: MigrationDirection
Bounded)

-- | Create a migration plan based on the current situation on the database,
-- and the specified target.
plan :: Driver d
     => [MigrationName]
     -> d
     -> IO [(MigrationDirection, MigrationName)]
plan :: [MigrationName] -> d -> IO [(MigrationDirection, MigrationName)]
plan [MigrationName]
target d
driver = do
  [MigrationName]
current <- d -> IO [MigrationName]
forall d. Driver d => d -> IO [MigrationName]
getMigrations d
driver
  [(MigrationDirection, MigrationName)]
-> IO [(MigrationDirection, MigrationName)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MigrationDirection, MigrationName)]
 -> IO [(MigrationDirection, MigrationName)])
-> [(MigrationDirection, MigrationName)]
-> IO [(MigrationDirection, MigrationName)]
forall a b. (a -> b) -> a -> b
$ [MigrationName]
-> [MigrationName] -> [(MigrationDirection, MigrationName)]
makePlan [MigrationName]
target [MigrationName]
current

-- | Make a plan from a previously loaded current situation and the specified
-- target.
makePlan :: [MigrationName]
            -- ^ target
         -> [MigrationName]
            -- ^ current
         -> [(MigrationDirection, MigrationName)]
makePlan :: [MigrationName]
-> [MigrationName] -> [(MigrationDirection, MigrationName)]
makePlan [] []
  -- Situation 0: nothing left to do
  = []
makePlan [] [MigrationName]
xs
  -- Situation 1: no more "up" targets left, but more migrations exist, so
  -- we need to roll those back.
  = [(MigrationDirection
MigrateDown, MigrationName
n) | MigrationName
n <- [MigrationName]
xs]
makePlan [MigrationName]
xs []
  -- Situation 2: only "up" targets left, run them.
  = [(MigrationDirection
MigrateUp, MigrationName
n) | MigrationName
n <- [MigrationName]
xs]
makePlan (MigrationName
t:[MigrationName]
ts) (MigrationName
c:[MigrationName]
cs)
  -- Situation 3: "up" targets exist, and we also have existing migrations
  -- left. The same migration exists on both ends, so we can just skip
  -- forward.
  | MigrationName
t MigrationName -> MigrationName -> Bool
forall a. Eq a => a -> a -> Bool
== MigrationName
c
  = [MigrationName]
-> [MigrationName] -> [(MigrationDirection, MigrationName)]
makePlan [MigrationName]
ts [MigrationName]
cs
  -- Situation 4: both "up" targets and existing migrations are present but the
  -- do not match, so we need to roll back existing migrations until a
  -- consistent situation is restored.
  | Bool
otherwise
  = (MigrationDirection
MigrateDown, MigrationName
c)(MigrationDirection, MigrationName)
-> [(MigrationDirection, MigrationName)]
-> [(MigrationDirection, MigrationName)]
forall a. a -> [a] -> [a]
:[MigrationName]
-> [MigrationName] -> [(MigrationDirection, MigrationName)]
makePlan (MigrationName
tMigrationName -> [MigrationName] -> [MigrationName]
forall a. a -> [a] -> [a]
:[MigrationName]
ts) [MigrationName]
cs

-- | Apply a migration plan to a database.
-- This should generally be done within the same transaction as loading the
-- current situation from the database and creating a migration plan. Running
-- this action outside of a transaction may leave the database and migration
-- tracking in an inconsistent state.
executePlan :: Driver d
            => [(MigrationDirection, MigrationName)]
            -> (MigrationName -> d -> IO ())
            -> (MigrationName -> d -> IO ())
            -> d
            -> IO ()
executePlan :: [(MigrationDirection, MigrationName)]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
executePlan [(MigrationDirection, MigrationName)]
migrationPlan MigrationName -> d -> IO ()
up MigrationName -> d -> IO ()
down d
driver = do
  [(MigrationDirection, MigrationName)]
-> ((MigrationDirection, MigrationName) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(MigrationDirection, MigrationName)]
migrationPlan (((MigrationDirection, MigrationName) -> IO ()) -> IO ())
-> ((MigrationDirection, MigrationName) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(MigrationDirection
direction, MigrationName
name) -> do
    let (MigrationName -> d -> IO ()
run, MigrationName -> d -> IO ()
mark) = case MigrationDirection
direction of
          MigrationDirection
MigrateUp -> (MigrationName -> d -> IO ()
up, MigrationName -> d -> IO ()
forall d. Driver d => MigrationName -> d -> IO ()
markUp)
          MigrationDirection
MigrateDown -> (MigrationName -> d -> IO ()
down, MigrationName -> d -> IO ()
forall d. Driver d => MigrationName -> d -> IO ()
markDown)
    MigrationName -> d -> IO ()
run MigrationName
name d
driver
    MigrationName -> d -> IO ()
mark MigrationName
name d
driver

-- | Safely (transactionally) infer and execute a migration.
migrate :: Driver d
        => [MigrationName]
           -- ^ Target situation
        -> (MigrationName -> d -> IO ())
           -- ^ Factory for \'up\' migration actions
        -> (MigrationName -> d -> IO ())
           -- ^ Factory for \'down\' migration actions
        -> d
        -> IO ()
migrate :: [MigrationName]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
migrate [MigrationName]
target MigrationName -> d -> IO ()
up MigrationName -> d -> IO ()
down d
driver =
  (d -> IO ()) -> d -> IO ()
forall d a. Driver d => (d -> IO a) -> d -> IO a
withTransaction ([MigrationName]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
forall d.
Driver d =>
[MigrationName]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
unsafeMigrate [MigrationName]
target MigrationName -> d -> IO ()
up MigrationName -> d -> IO ()
down) d
driver

-- | Infer and execute a migration in a non-transactional fashion. This means
-- that migration failures may leave the database and migration tracking in
-- an inconsistent state, so you should never call this outside of a
-- transaction.
unsafeMigrate :: Driver d
              => [MigrationName]
                 -- ^ Target situation
              -> (MigrationName -> d -> IO ())
                 -- ^ Factory for \'up\' migration actions
              -> (MigrationName -> d -> IO ())
                 -- ^ Factory for \'down\' migration actions
              -> d
              -> IO ()
unsafeMigrate :: [MigrationName]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
unsafeMigrate [MigrationName]
target MigrationName -> d -> IO ()
up MigrationName -> d -> IO ()
down d
driver = do
  d -> IO ()
forall d. Driver d => d -> IO ()
initMigrations d
driver
  [(MigrationDirection, MigrationName)]
migrationPlan <- [MigrationName] -> d -> IO [(MigrationDirection, MigrationName)]
forall d.
Driver d =>
[MigrationName] -> d -> IO [(MigrationDirection, MigrationName)]
plan [MigrationName]
target d
driver
  [(MigrationDirection, MigrationName)]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
forall d.
Driver d =>
[(MigrationDirection, MigrationName)]
-> (MigrationName -> d -> IO ())
-> (MigrationName -> d -> IO ())
-> d
-> IO ()
executePlan [(MigrationDirection, MigrationName)]
migrationPlan MigrationName -> d -> IO ()
up MigrationName -> d -> IO ()
down d
driver