module Database.Schema.Migrations.Store
( MigrationStore(..)
, MapValidationError(..)
, StoreData(..)
, MigrationMap
, loadMigrations
, storeMigrations
, storeLookup
, depGraphFromMapping
)
where
import Data.Maybe ( catMaybes, isJust )
import Control.Monad ( mzero )
import Control.Applicative ( (<$>) )
import qualified Data.Map as Map
import Database.Schema.Migrations.Migration
( Migration(..)
)
import Database.Schema.Migrations.Dependencies
( DependencyGraph(..)
, mkDepGraph
, depsOf
)
type MigrationMap = Map.Map String Migration
data StoreData = StoreData { storeDataMapping :: MigrationMap
, storeDataGraph :: DependencyGraph Migration
}
class (Monad m) => MigrationStore s m where
loadMigration :: s -> String -> m (Maybe Migration)
saveMigration :: s -> Migration -> m ()
getMigrations :: s -> m [String]
fullMigrationName :: s -> String -> m String
fullMigrationName _ name = return name
data MapValidationError = DependencyReferenceError String String
| DependencyGraphError String
instance Show MapValidationError where
show (DependencyReferenceError from to) =
"Migration " ++ (show from) ++ " references nonexistent dependency " ++ show to
show (DependencyGraphError msg) =
"There was an error constructing the dependency graph: " ++ msg
storeMigrations :: StoreData -> [Migration]
storeMigrations storeData =
Map.elems $ storeDataMapping storeData
storeLookup :: StoreData -> String -> Maybe Migration
storeLookup storeData migrationName =
Map.lookup migrationName $ storeDataMapping storeData
loadMigrations :: (MigrationStore s m) => s -> m (Either [MapValidationError] StoreData)
loadMigrations store = do
migrations <- getMigrations store
loaded <- mapM (\name -> loadMigration store name) migrations
let mMap = Map.fromList $ [ (mId e, e) | e <- catMaybes $ loaded ]
validationErrors = validateMigrationMap mMap
case null validationErrors of
False -> return $ Left validationErrors
True -> do
case depGraphFromMapping mMap of
Left e -> return $ Left [DependencyGraphError e]
Right gr -> return $ Right StoreData { storeDataMapping = mMap
, storeDataGraph = gr
}
validateMigrationMap :: MigrationMap -> [MapValidationError]
validateMigrationMap mMap = do
validateSingleMigration mMap =<< snd <$> Map.toList mMap
validateSingleMigration :: MigrationMap -> Migration -> [MapValidationError]
validateSingleMigration mMap m = do
depId <- depsOf m
if isJust $ Map.lookup depId mMap then
mzero else
return $ DependencyReferenceError (mId m) depId
depGraphFromMapping :: MigrationMap -> Either String (DependencyGraph Migration)
depGraphFromMapping mapping = mkDepGraph $ Map.elems mapping