refurb-0.3.0.2: Tools for maintaining a database
Safe HaskellNone
LanguageHaskell2010

Refurb.Store

Description

Module containing definition of and functions for maintaining the in-database state storage for Refurb.

Synopsis

Documentation

data MigrationResult Source #

Result of running a migration, either success or failure.

Instances

Instances details
Eq MigrationResult Source # 
Instance details

Defined in Refurb.Store

Show MigrationResult Source # 
Instance details

Defined in Refurb.Store

FromField MigrationResult Source # 
Instance details

Defined in Refurb.Store

Methods

fromField :: FieldParser MigrationResult

DefaultFromField PGMigrationResult MigrationResult Source # 
Instance details

Defined in Refurb.Store

Default ToFields MigrationResult (Field PGMigrationResult) Source # 
Instance details

Defined in Refurb.Store

Methods

def :: ToFields MigrationResult (Field PGMigrationResult)

data PGMigrationResult Source #

Instances

Instances details
IsSqlType PGMigrationResult Source # 
Instance details

Defined in Refurb.Store

DefaultFromField PGMigrationResult MigrationResult Source # 
Instance details

Defined in Refurb.Store

Default ToFields MigrationResult (Field PGMigrationResult) Source # 
Instance details

Defined in Refurb.Store

Methods

def :: ToFields MigrationResult (Field PGMigrationResult)

type FId = (:->) "id" Int32 Source #

type FIdMay = (:->) "id" (Maybe Int32) Source #

type CId = (:->) "id" (Field SqlInt4) Source #

type CIdMay = (:->) "id" (Maybe (Field SqlInt4)) Source #

type FQualifiedKey = (:->) "qualified_key" Text Source #

type CQualifiedKey = (:->) "qualified_key" (Field SqlText) Source #

type FApplied = (:->) "applied" UTCTime Source #

type CApplied = (:->) "applied" (Field SqlTimestamptz) Source #

type FOutput = (:->) "output" Text Source #

type COutput = (:->) "output" (Field SqlText) Source #

type FResult = (:->) "result" MigrationResult Source #

type CResult = (:->) "result" (Field PGMigrationResult) Source #

type FDuration = (:->) "duration" Double Source #

type CDuration = (:->) "duration" (Field SqlFloat8) Source #

type FProdSystem = (:->) "prod_system" Bool Source #

type CProdSystem = (:->) "prod_system" (Field SqlBool) Source #

cProdSystem :: forall f rs. (Functor f, (∈) CProdSystem rs) => (Field SqlBool -> f (Field SqlBool)) -> Record rs -> f (Record rs) Source #

fProdSystem :: forall f rs. (Functor f, (∈) FProdSystem rs) => (Bool -> f Bool) -> Record rs -> f (Record rs) Source #

cDuration :: forall f rs. (Functor f, (∈) CDuration rs) => (Field SqlFloat8 -> f (Field SqlFloat8)) -> Record rs -> f (Record rs) Source #

fDuration :: forall f rs. (Functor f, (∈) FDuration rs) => (Double -> f Double) -> Record rs -> f (Record rs) Source #

cResult :: forall f rs. (Functor f, (∈) CResult rs) => (Field PGMigrationResult -> f (Field PGMigrationResult)) -> Record rs -> f (Record rs) Source #

fResult :: forall f rs. (Functor f, (∈) FResult rs) => (MigrationResult -> f MigrationResult) -> Record rs -> f (Record rs) Source #

cOutput :: forall f rs. (Functor f, (∈) COutput rs) => (Field SqlText -> f (Field SqlText)) -> Record rs -> f (Record rs) Source #

fOutput :: forall f rs. (Functor f, (∈) FOutput rs) => (Text -> f Text) -> Record rs -> f (Record rs) Source #

cApplied :: forall f rs. (Functor f, (∈) CApplied rs) => (Field SqlTimestamptz -> f (Field SqlTimestamptz)) -> Record rs -> f (Record rs) Source #

fApplied :: forall f rs. (Functor f, (∈) FApplied rs) => (UTCTime -> f UTCTime) -> Record rs -> f (Record rs) Source #

cQualifiedKey :: forall f rs. (Functor f, (∈) CQualifiedKey rs) => (Field SqlText -> f (Field SqlText)) -> Record rs -> f (Record rs) Source #

fQualifiedKey :: forall f rs. (Functor f, (∈) FQualifiedKey rs) => (Text -> f Text) -> Record rs -> f (Record rs) Source #

cIdMay :: forall f rs. (Functor f, (∈) CIdMay rs) => (Maybe (Field SqlInt4) -> f (Maybe (Field SqlInt4))) -> Record rs -> f (Record rs) Source #

cId :: forall f rs. (Functor f, (∈) CId rs) => (Field SqlInt4 -> f (Field SqlInt4)) -> Record rs -> f (Record rs) Source #

fIdMay :: forall f rs. (Functor f, (∈) FIdMay rs) => (Maybe Int32 -> f (Maybe Int32)) -> Record rs -> f (Record rs) Source #

fId :: forall f rs. (Functor f, (∈) FId rs) => (Int32 -> f Int32) -> Record rs -> f (Record rs) Source #

type MigrationLog = '[FId, FQualifiedKey, FApplied, FOutput, FResult, FDuration] Source #

Fields of a migration log entry in memory fetched from the database (with ID)

type MigrationLogW = '[FIdMay, FQualifiedKey, FApplied, FOutput, FResult, FDuration] Source #

Fields of a migration log entry to insert in the database (with the ID column optional)

type MigrationLogColsR = '[CId, CQualifiedKey, CApplied, COutput, CResult, CDuration] Source #

Columns of a migration log when reading from the database (with ID)

type MigrationLogColsW = '[CIdMay, CQualifiedKey, CApplied, COutput, CResult, CDuration] Source #

Columns of a migration log when inserting into the database (with ID column optional)

type RefurbConfig = '[FProdSystem] Source #

Fields of the Refurb config in memory

type RefurbConfigCols = '[CProdSystem] Source #

Columns of the Refurb config in the database

migrationLog :: Table (Record MigrationLogColsW) (Record MigrationLogColsR) Source #

The migration log table which records all executed migrations and their results

refurbConfig :: Table (Record RefurbConfigCols) (Record RefurbConfigCols) Source #

The refurb config table which controls whether this database is considered a production one or not

isSchemaPresent :: (MonadBaseControl IO m, MonadMask m, MonadLogger m) => Connection -> m Bool Source #

Test to see if the schema seems to be installed by looking for an existing refurb_config table

isProdSystem :: (MonadBaseControl IO m, MonadLogger m) => Connection -> m Bool Source #

Check if this database is configured as a production database by reading the refurb config table

initializeSchema :: (MonadBaseControl IO m, MonadLogger m) => Connection -> m () Source #

Create the refurb schema elements. Will fail if they already exist.

readMigrationStatus :: (MonadBaseControl IO m, MonadLogger m) => Connection -> [Migration] -> SelectArr (Record MigrationLogColsR) () -> m [These Migration (Record MigrationLog)] Source #

Read the migration log and stitch it together with the expected migration list, forming a list in the same order as the known migrations but with These representing whether the migration log for the known migration is present or not.

  • This migration represents a known migration that has no log entry.
  • That migrationLog represents an unknown migration that was applied in the past.
  • These migration migrationLog represents a migration that has an attempted application in the log.