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
)
missingMigrations :: B.Backend -> S.StoreData -> IO [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 :: S.MigrationStore
-> Migration
-> IO (Either String Migration)
createNewMigration store newM = do
available <- S.getMigrations store
case mId newM `elem` available of
True -> do
fullPath <- S.fullMigrationName store (mId newM)
return $ Left $ "Migration " ++ (show fullPath) ++ " already exists"
False -> do
S.saveMigration store newM
return $ Right newM
ensureBootstrappedBackend :: B.Backend -> IO ()
ensureBootstrappedBackend backend = do
bsStatus <- B.isBootstrapped backend
case bsStatus of
True -> return ()
False -> B.getBootstrapMigration backend >>= B.applyMigration backend
migrationsToApply :: S.StoreData -> B.Backend
-> Migration -> IO [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 :: S.StoreData -> B.Backend
-> Migration -> IO [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