module Database.Schema.Migrations
( createNewMigration
, ensureBootstrappedBackend
, migrationsToApply
, migrationsToRevert
, missingMigrations
)
where
import qualified Data.Set as Set
import Data.Maybe ( catMaybes )
import Database.Schema.Migrations.Dependencies
( dependencies
, reverseDependencies
)
import qualified Database.Schema.Migrations.Backend as B
import qualified Database.Schema.Migrations.Store as S
import Database.Schema.Migrations.Migration
( Migration(..)
, newMigration
, MonadMigration
)
missingMigrations :: (B.Backend b m) => b -> S.StoreData -> m [String]
missingMigrations backend storeData = do
let storeMigrationNames = map mId $ S.storeMigrations storeData
backendMigrations <- B.getMigrations backend
return $ Set.toList $ Set.difference
(Set.fromList storeMigrationNames)
(Set.fromList backendMigrations)
createNewMigration :: (MonadMigration m, S.MigrationStore s m)
=> s
-> String
-> [String]
-> m (Either String Migration)
createNewMigration store name deps = do
available <- S.getMigrations store
case name `elem` available of
True -> do
fullPath <- S.fullMigrationName store name
return $ Left $ "Migration " ++ (show fullPath) ++ " already exists"
False -> do
new <- newMigration name
let newWithDefaults = new { mDesc = Just "(Description here.)"
, mApply = "(Apply SQL here.)"
, mRevert = Just "(Revert SQL here.)"
, mDeps = deps
}
S.saveMigration store newWithDefaults
return $ Right newWithDefaults
ensureBootstrappedBackend :: (B.Backend b m) => b -> m ()
ensureBootstrappedBackend backend = do
bsStatus <- B.isBootstrapped backend
case bsStatus of
True -> return ()
False -> B.getBootstrapMigration backend >>= B.applyMigration backend
migrationsToApply :: (B.Backend b m) => S.StoreData -> b
-> Migration -> m [Migration]
migrationsToApply storeData backend migration = do
let graph = S.storeDataGraph storeData
allMissing <- missingMigrations backend storeData
let deps = (dependencies graph $ mId migration) ++ [mId migration]
namesToInstall = [ e | e <- deps, e `elem` allMissing ]
loadedMigrations = catMaybes $ map (S.storeLookup storeData) namesToInstall
return loadedMigrations
migrationsToRevert :: (B.Backend b m) => S.StoreData -> b
-> Migration -> m [Migration]
migrationsToRevert storeData backend migration = do
let graph = S.storeDataGraph storeData
allInstalled <- B.getMigrations backend
let rDeps = (reverseDependencies graph $ mId migration) ++ [mId migration]
namesToRevert = [ e | e <- rDeps, e `elem` allInstalled ]
loadedMigrations = catMaybes $ map (S.storeLookup storeData) namesToRevert
return loadedMigrations