Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE ScopedTypeVariables #-}
- module Util.Migration (upgradeDatabase) where
- import qualified Util.Config as Config
- import Control.Monad (forM_)
- import Database.Schema.Migrations
- import Database.Schema.Migrations.Backend
- import Database.Schema.Migrations.Filesystem (FilesystemStoreSettings (..),
- filesystemStore)
- import Database.Schema.Migrations.Store (loadMigrations)
- import qualified Moo.CommandUtils as MooUtils
- import qualified Moo.Core as MooCore
- import System.Exit (exitFailure)
- upgradeDatabase :: Config.DbConfig -> IO ()
- upgradeDatabase dbConfig = do
- dbMigrationsConfig <- MooCore.loadConfiguration Nothing
- case dbMigrationsConfig of
- Left err -> putStrLn err >> exitFailure
- Right configuration -> upgradeWithConfig dbConfig configuration
- upgradeWithConfig :: Config.DbConfig -> MooCore.Configuration -> IO ()
- upgradeWithConfig dbConfig dbMigrationsConfig = do
- let migrationsPath :: FilePath =
- MooCore._migrationStorePath dbMigrationsConfig
- store = filesystemStore $ FSStore { storePath = migrationsPath }
- dbConnDescriptor = MooCore.DbConnDescriptor
- ( "host=" ++ (Config.dbHost dbConfig) ++ " " ++
- "dbname=" ++ (Config.db dbConfig) ++ " " ++
- "user=" ++ (Config.dbUser dbConfig) ++ " " ++
- "password=" ++ (Config.dbPassword dbConfig)
- )
- backend :: Backend <- MooUtils.makeBackend "postgresql" dbConnDescriptor
- loadedStoreData <- loadMigrations store
- case loadedStoreData of
- Left es -> do
- putStrLn "dbmigrations: There were errors in the migration store:"
- forM_ es $ \err -> putStrLn $ " " ++ show err
- exitFailure
- Right storeData -> do
- ensureBootstrappedBackend backend >> commitBackend backend
- migrationNames <- missingMigrations backend storeData
- if (null migrationNames)
- then do
- putStrLn "dbmigrations: Database is up to date."
- else do
- forM_ migrationNames $ \migrationName -> do
- m <- MooUtils.lookupMigration storeData migrationName
- MooUtils.apply m storeData backend False
- commitBackend backend
- putStrLn "dbmigrations: Database successfully upgraded."
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement