refurb 0.2.3.0 → 0.3.0.0
raw patch · 6 files changed
+36/−36 lines, 6 filesnew-uploader
Files
- refurb.cabal +3/−3
- src/Refurb/MigrationUtils.hs +10/−10
- src/Refurb/Run/Info.hs +2/−3
- src/Refurb/Run/Internal.hs +2/−1
- src/Refurb/Run/Migrate.hs +2/−2
- src/Refurb/Store.hs +17/−17
refurb.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack ----- hash: 303cc00ec1aa1ac86c703c9836382d92da8bacf61b4c4bbb124b5ba6f9343df8+-- hash: 3ea333a27f3e783a20b2e2b007638d883e0d237d3a5cd67e51e81e63bd9d46c8 name: refurb-version: 0.2.3.0+version: 0.3.0.0 synopsis: Tools for maintaining a database description: Tools for maintaining a database category: Database
src/Refurb/MigrationUtils.hs view
@@ -126,38 +126,38 @@ liftBase $ PG.query_ conn q -- |Run an Opaleye query against the database connection.--- Wraps 'Opaleye.runQuery' using the 'MonadMigration' reader to get the connection.+-- Wraps 'Opaleye.runSelect' using the 'MonadMigration' reader to get the connection. runQuery :: ( MonadMigration m , Default Opaleye.Unpackspec columns columns- , Default Opaleye.QueryRunner columns haskells+ , Default Opaleye.FromFields columns haskells )- => Opaleye.Query columns -> m [haskells]+ => Opaleye.Select columns -> m [haskells] runQuery q = do conn <- ask for_ (Opaleye.showSql q) ($logDebug . pack)- liftBase $ Opaleye.runQuery conn q+ liftBase $ Opaleye.runSelect conn q --- |Run an Opaleye 'Opaleye.runInsertMany' against the database connection.+-- |Run an Opaleye 'Opaleye.runInsert' against the database connection. runInsertMany :: MonadMigration m => Opaleye.Table columns columns' -> [columns] -> m Int64 runInsertMany table rows = do conn <- ask $logDebug $ "inserting " <> tshow (length rows) <> " rows into " <> tshow (tableIdentifier table)- liftBase $ Opaleye.runInsertMany conn table rows+ liftBase $ Opaleye.runInsert conn (Opaleye.Insert table rows Opaleye.rCount Nothing) -- |Run an Opaleye 'Opaleye.runUpdate' against the database connection.-runUpdate :: MonadMigration m => Opaleye.Table columnsW columnsR -> (columnsR -> columnsW) -> (columnsR -> Opaleye.Column Opaleye.PGBool) -> m Int64+runUpdate :: MonadMigration m => Opaleye.Table columnsW columnsR -> (columnsR -> columnsW) -> (columnsR -> Opaleye.Field Opaleye.SqlBool) -> m Int64 runUpdate table permute filt = do conn <- ask $logDebug $ "updating " <> tshow (tableIdentifier table)- liftBase $ Opaleye.runUpdate conn table permute filt+ liftBase $ Opaleye.runUpdate conn (Opaleye.Update table permute filt Opaleye.rCount) -- |Run an Opaleye 'Opaleye.runDelete' against the database connection.-runDelete :: MonadMigration m => Opaleye.Table columnsW columnsR -> (columnsR -> Opaleye.Column Opaleye.PGBool) -> m Int64+runDelete :: MonadMigration m => Opaleye.Table columnsW columnsR -> (columnsR -> Opaleye.Field Opaleye.SqlBool) -> m Int64 runDelete table filt = do conn <- ask $logDebug $ "deleting from " <> tshow (tableIdentifier table)- liftBase $ Opaleye.runDelete conn table filt+ liftBase $ Opaleye.runDelete conn (Opaleye.Delete table filt Opaleye.rCount) -- |Check if a schema exists using the @information_schema@ views. doesSchemaExist :: MonadMigration m => Text -> m Bool
src/Refurb/Run/Info.hs view
@@ -20,7 +20,7 @@ #endif import Data.Thyme.Clock (NominalDiffTime, fromSeconds) import Data.Thyme.Format.Human (humanTimeDiff)-import Opaleye ((.==), constant, restrict)+import Opaleye ((.==), restrict, toFields) import Refurb.Run.Internal (MonadRefurb, contextDbConn, contextMigrations, optionallyColoredM, migrationResultDoc) import Refurb.Store (FQualifiedKey, MigrationLog, cQualifiedKey, fId, fApplied, fDuration, fOutput, fResult, fQualifiedKey, readMigrationStatus) import Refurb.Types (Migration, MigrationType(MigrationSeedData), migrationQualifiedKey, migrationType)@@ -74,11 +74,10 @@ dbConn <- asks contextDbConn migrations <- asks $ filter ((== key) . migrationQualifiedKey) . contextMigrations migrationStatus <- readMigrationStatus dbConn migrations $ proc mlog ->- restrict -< view cQualifiedKey mlog .== constant key+ restrict -< view cQualifiedKey mlog .== toFields key showMigrationStatus migrationStatus putStrLn "" case preview (each . there) migrationStatus of Nothing -> disp . black $ "Never been run." -- n.b.: black is not black Just mlog -> putStrLn . view fOutput $ mlog-
src/Refurb/Run/Internal.hs view
@@ -7,6 +7,7 @@ module Refurb.Run.Internal where import ClassyPrelude+import Control.Monad (MonadFail) import Control.Monad.Base (liftBase) import Control.Monad.Catch (MonadMask) import Control.Monad.Logger (MonadLogger, MonadLoggerIO)@@ -30,7 +31,7 @@ } -- |Constraint of actions for command execution, including access to the 'Context', logging, and underlying IO.-type MonadRefurb m = (MonadBaseControl IO m, MonadMask m, MonadReader Context m, MonadLogger m, MonadLoggerIO m)+type MonadRefurb m = (MonadBaseControl IO m, MonadFail m, MonadMask m, MonadReader Context m, MonadLogger m, MonadLoggerIO m) -- |Given the configuration implicitly available to 'MonadRefurb', produce a function which possibly strips ANSI colorization from a 'Doc' if the user -- requested colorless output.
src/Refurb/Run/Migrate.hs view
@@ -26,7 +26,7 @@ import qualified Database.PostgreSQL.Simple as PG import qualified Database.PostgreSQL.Simple.Types as PG import Language.Haskell.TH (Loc, loc_package, loc_module, loc_filename, loc_start)-import Opaleye (constant, runInsertMany)+import Opaleye (Insert (Insert), rCount, runInsert, toFields) import Refurb.Cli (GoNoGo(GoNoGo), PreMigrationBackup(PreMigrationBackup), InstallSeedData(InstallSeedData)) import Refurb.MigrationUtils (doesSchemaExist) import Refurb.Run.Backup (backup)@@ -102,7 +102,7 @@ putStrLn output void . liftIO $ PG.execute_ dbConn "set search_path = 'public'"- liftIO . runInsertMany dbConn migrationLog . singleton . (constant :: Record MigrationLogW -> Record MigrationLogColsW) $+ liftIO . runInsert dbConn . (\rows -> Insert migrationLog rows rCount Nothing) . singleton . (toFields :: Record MigrationLogW -> Record MigrationLogColsW) $ Nothing :*: migrationQualifiedKey migration :*: fromThyme start :*: output :*: result :*: (toSeconds :: NominalDiffTime -> Double) duration :*: RNil onException
src/Refurb/Store.hs view
@@ -25,7 +25,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Data.These (These(This, These, That)) import qualified Database.PostgreSQL.Simple as PG-import Opaleye (Column, PGBool, PGInt4, PGFloat8, PGText, PGTimestamptz, QueryArr, Table(TableWithSchema), asc, orderBy, queryTable, runQuery)+import Opaleye (Field, SelectArr, SqlBool, SqlInt4, SqlFloat8, SqlText, SqlTimestamptz, Table, asc, orderBy, runSelect, selectTable, tableWithSchema) import Refurb.MigrationUtils (doesTableExist, qqSqls) import Refurb.Types (Migration, migrationQualifiedKey) @@ -35,26 +35,26 @@ | MigrationFailure deriving (Eq, Show) -deriveOpaleyeEnum ''MigrationResult "migration_result_enum" (stripPrefix "migration" . toLower)+deriveOpaleyeEnum ''MigrationResult "refurb.migration_result_enum" (stripPrefix "migration" . toLower) withLensesAndProxies [d| type FId = "id" :-> Int32 type FIdMay = "id" :-> Maybe Int32- type CId = "id" :-> Column PGInt4- type CIdMay = "id" :-> Maybe (Column PGInt4)+ type CId = "id" :-> Field SqlInt4+ type CIdMay = "id" :-> Maybe (Field SqlInt4) type FQualifiedKey = "qualified_key" :-> Text- type CQualifiedKey = "qualified_key" :-> Column PGText+ type CQualifiedKey = "qualified_key" :-> Field SqlText type FApplied = "applied" :-> UTCTime- type CApplied = "applied" :-> Column PGTimestamptz+ type CApplied = "applied" :-> Field SqlTimestamptz type FOutput = "output" :-> Text- type COutput = "output" :-> Column PGText+ type COutput = "output" :-> Field SqlText type FResult = "result" :-> MigrationResult- type CResult = "result" :-> Column PGMigrationResult+ type CResult = "result" :-> Field PGMigrationResult type FDuration = "duration" :-> Double- type CDuration = "duration" :-> Column PGFloat8+ type CDuration = "duration" :-> Field SqlFloat8 type FProdSystem = "prod_system" :-> Bool- type CProdSystem = "prod_system" :-> Column PGBool+ type CProdSystem = "prod_system" :-> Field SqlBool |] -- |Fields of a migration log entry in memory fetched from the database (with ID)@@ -73,11 +73,11 @@ -- |The migration log table which records all executed migrations and their results migrationLog :: Table (Record MigrationLogColsW) (Record MigrationLogColsR)-migrationLog = TableWithSchema "refurb" "migration_log" defaultRecTable+migrationLog = tableWithSchema "refurb" "migration_log" defaultRecTable -- |The refurb config table which controls whether this database is considered a production one or not refurbConfig :: Table (Record RefurbConfigCols) (Record RefurbConfigCols)-refurbConfig = TableWithSchema "refurb" "config" defaultRecTable+refurbConfig = tableWithSchema "refurb" "config" defaultRecTable -- |Test to see if the schema seems to be installed by looking for an existing refurb_config table isSchemaPresent :: (MonadBaseControl IO m, MonadMask m, MonadLogger m) => PG.Connection -> m Bool@@ -89,8 +89,8 @@ isProdSystem :: (MonadBaseControl IO m, MonadLogger m) => PG.Connection -> m Bool isProdSystem conn = do $logDebug "Checking if this is a prod system"- map (fromMaybe False . headMay) . liftBase . runQuery conn $ proc () -> do- config <- queryTable refurbConfig -< ()+ map (fromMaybe False . headMay) . liftBase . runSelect conn $ proc () -> do+ config <- selectTable refurbConfig -< () returnA -< view cProdSystem config -- |Create the refurb schema elements. Will fail if they already exist.@@ -128,12 +128,12 @@ :: (MonadBaseControl IO m, MonadLogger m) => PG.Connection -> [Migration]- -> QueryArr (Record MigrationLogColsR) ()+ -> SelectArr (Record MigrationLogColsR) () -> m [These Migration (Record MigrationLog)] readMigrationStatus conn migrations restriction = do $logDebug "Reading migration status"- migrationStatus <- liftBase $ runQuery conn . orderBy (asc $ view cQualifiedKey) $ proc () -> do- mlog <- queryTable migrationLog -< ()+ migrationStatus <- liftBase $ runSelect conn . orderBy (asc $ view cQualifiedKey) $ proc () -> do+ mlog <- selectTable migrationLog -< () restriction -< mlog returnA -< mlog