module Database.Schema.Migrations
( createNewMigration
, ensureBootstrappedBackend
, migrationsToApply
, migrationsToRevert
, missingMigrations
)
where
import Data.Text ( Text )
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(..)
)
missingMigrations :: B.Backend -> S.StoreData -> IO [Text]
missingMigrations :: Backend -> StoreData -> IO [Text]
missingMigrations Backend
backend StoreData
storeData = do
let storeMigrationNames :: [Text]
storeMigrationNames = (Migration -> Text) -> [Migration] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Migration -> Text
mId ([Migration] -> [Text]) -> [Migration] -> [Text]
forall a b. (a -> b) -> a -> b
$ StoreData -> [Migration]
S.storeMigrations StoreData
storeData
[Text]
backendMigrations <- Backend -> IO [Text]
B.getMigrations Backend
backend
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text]
storeMigrationNames)
([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text]
backendMigrations)
createNewMigration :: S.MigrationStore
-> Migration
-> IO (Either String Migration)
createNewMigration :: MigrationStore -> Migration -> IO (Either String Migration)
createNewMigration MigrationStore
store Migration
newM = do
[Text]
available <- MigrationStore -> IO [Text]
S.getMigrations MigrationStore
store
case Migration -> Text
mId Migration
newM Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
available of
Bool
True -> do
String
fullPath <- MigrationStore -> Text -> IO String
S.fullMigrationName MigrationStore
store (Migration -> Text
mId Migration
newM)
Either String Migration -> IO (Either String Migration)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Migration -> IO (Either String Migration))
-> Either String Migration -> IO (Either String Migration)
forall a b. (a -> b) -> a -> b
$ String -> Either String Migration
forall a b. a -> Either a b
Left (String -> Either String Migration)
-> String -> Either String Migration
forall a b. (a -> b) -> a -> b
$ String
"Migration " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
fullPath) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" already exists"
Bool
False -> do
MigrationStore -> Migration -> IO ()
S.saveMigration MigrationStore
store Migration
newM
Either String Migration -> IO (Either String Migration)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Migration -> IO (Either String Migration))
-> Either String Migration -> IO (Either String Migration)
forall a b. (a -> b) -> a -> b
$ Migration -> Either String Migration
forall a b. b -> Either a b
Right Migration
newM
ensureBootstrappedBackend :: B.Backend -> IO ()
ensureBootstrappedBackend :: Backend -> IO ()
ensureBootstrappedBackend Backend
backend = do
Bool
bsStatus <- Backend -> IO Bool
B.isBootstrapped Backend
backend
case Bool
bsStatus of
Bool
True -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> Backend -> IO Migration
B.getBootstrapMigration Backend
backend IO Migration -> (Migration -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Backend -> Migration -> IO ()
B.applyMigration Backend
backend
migrationsToApply :: S.StoreData -> B.Backend
-> Migration -> IO [Migration]
migrationsToApply :: StoreData -> Backend -> Migration -> IO [Migration]
migrationsToApply StoreData
storeData Backend
backend Migration
migration = do
let graph :: DependencyGraph Migration
graph = StoreData -> DependencyGraph Migration
S.storeDataGraph StoreData
storeData
[Text]
allMissing <- Backend -> StoreData -> IO [Text]
missingMigrations Backend
backend StoreData
storeData
let deps :: [Text]
deps = (DependencyGraph Migration -> Text -> [Text]
forall d. Dependable d => DependencyGraph d -> Text -> [Text]
dependencies DependencyGraph Migration
graph (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Migration -> Text
mId Migration
migration) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Migration -> Text
mId Migration
migration]
namesToInstall :: [Text]
namesToInstall = [ Text
e | Text
e <- [Text]
deps, Text
e Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
allMissing ]
loadedMigrations :: [Migration]
loadedMigrations = [Maybe Migration] -> [Migration]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Migration] -> [Migration])
-> [Maybe Migration] -> [Migration]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Migration) -> [Text] -> [Maybe Migration]
forall a b. (a -> b) -> [a] -> [b]
map (StoreData -> Text -> Maybe Migration
S.storeLookup StoreData
storeData) [Text]
namesToInstall
[Migration] -> IO [Migration]
forall (m :: * -> *) a. Monad m => a -> m a
return [Migration]
loadedMigrations
migrationsToRevert :: S.StoreData -> B.Backend
-> Migration -> IO [Migration]
migrationsToRevert :: StoreData -> Backend -> Migration -> IO [Migration]
migrationsToRevert StoreData
storeData Backend
backend Migration
migration = do
let graph :: DependencyGraph Migration
graph = StoreData -> DependencyGraph Migration
S.storeDataGraph StoreData
storeData
[Text]
allInstalled <- Backend -> IO [Text]
B.getMigrations Backend
backend
let rDeps :: [Text]
rDeps = (DependencyGraph Migration -> Text -> [Text]
forall d. Dependable d => DependencyGraph d -> Text -> [Text]
reverseDependencies DependencyGraph Migration
graph (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Migration -> Text
mId Migration
migration) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Migration -> Text
mId Migration
migration]
namesToRevert :: [Text]
namesToRevert = [ Text
e | Text
e <- [Text]
rDeps, Text
e Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
allInstalled ]
loadedMigrations :: [Migration]
loadedMigrations = [Maybe Migration] -> [Migration]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Migration] -> [Migration])
-> [Maybe Migration] -> [Migration]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Migration) -> [Text] -> [Maybe Migration]
forall a b. (a -> b) -> [a] -> [b]
map (StoreData -> Text -> Maybe Migration
S.storeLookup StoreData
storeData) [Text]
namesToRevert
[Migration] -> IO [Migration]
forall (m :: * -> *) a. Monad m => a -> m a
return [Migration]
loadedMigrations