-- |This module provides a high-level interface for the rest of this
-- library.
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(..)
    )

-- |Given a 'B.Backend' and a 'S.MigrationMap', query the backend and
-- return a list of migration names which are available in the
-- 'S.MigrationMap' but which are not installed in the 'B.Backend'.
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)

-- |Create a new migration and store it in the 'S.MigrationStore'.
createNewMigration :: S.MigrationStore -- ^ The 'S.MigrationStore' in which to create a new migration
                   -> Migration -- ^ The new 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

-- |Given a 'B.Backend', ensure that the backend is ready for use by
-- bootstrapping it.  This entails installing the appropriate database
-- elements to track installed migrations.  If the backend is already
-- bootstrapped, this has no effect.
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

-- |Given a migration mapping computed from a MigrationStore, a
-- backend, and a migration to apply, return a list of migrations to
-- apply, in order.
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

-- |Given a migration mapping computed from a MigrationStore, a
-- backend, and a migration to revert, return a list of migrations to
-- revert, in order.
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