Advertisement
Guest User

Untitled

a guest
Oct 27th, 2016
88
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.46 KB | None | 0 0
  1. {-# LANGUAGE ScopedTypeVariables #-}
  2.  
  3. module Util.Migration (upgradeDatabase) where
  4.  
  5. import qualified Util.Config as Config
  6.  
  7. import Control.Monad (forM_)
  8. import Database.Schema.Migrations
  9. import Database.Schema.Migrations.Backend
  10. import Database.Schema.Migrations.Filesystem (FilesystemStoreSettings (..),
  11. filesystemStore)
  12. import Database.Schema.Migrations.Store (loadMigrations)
  13. import qualified Moo.CommandUtils as MooUtils
  14. import qualified Moo.Core as MooCore
  15. import System.Exit (exitFailure)
  16.  
  17.  
  18. upgradeDatabase :: Config.DbConfig -> IO ()
  19. upgradeDatabase dbConfig = do
  20. dbMigrationsConfig <- MooCore.loadConfiguration Nothing
  21. case dbMigrationsConfig of
  22. Left err -> putStrLn err >> exitFailure
  23. Right configuration -> upgradeWithConfig dbConfig configuration
  24.  
  25.  
  26. upgradeWithConfig :: Config.DbConfig -> MooCore.Configuration -> IO ()
  27. upgradeWithConfig dbConfig dbMigrationsConfig = do
  28. let migrationsPath :: FilePath =
  29. MooCore._migrationStorePath dbMigrationsConfig
  30. store = filesystemStore $ FSStore { storePath = migrationsPath }
  31. dbConnDescriptor = MooCore.DbConnDescriptor
  32. ( "host=" ++ (Config.dbHost dbConfig) ++ " " ++
  33. "dbname=" ++ (Config.db dbConfig) ++ " " ++
  34. "user=" ++ (Config.dbUser dbConfig) ++ " " ++
  35. "password=" ++ (Config.dbPassword dbConfig)
  36. )
  37. backend :: Backend <- MooUtils.makeBackend "postgresql" dbConnDescriptor
  38. loadedStoreData <- loadMigrations store
  39. case loadedStoreData of
  40. Left es -> do
  41. putStrLn "dbmigrations: There were errors in the migration store:"
  42. forM_ es $ \err -> putStrLn $ " " ++ show err
  43. exitFailure
  44. Right storeData -> do
  45. ensureBootstrappedBackend backend >> commitBackend backend
  46. migrationNames <- missingMigrations backend storeData
  47. if (null migrationNames)
  48. then do
  49. putStrLn "dbmigrations: Database is up to date."
  50. else do
  51. forM_ migrationNames $ \migrationName -> do
  52. m <- MooUtils.lookupMigration storeData migrationName
  53. MooUtils.apply m storeData backend False
  54. commitBackend backend
  55. putStrLn "dbmigrations: Database successfully upgraded."
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement