{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Contains a schema for beam migration tools. Used by the CLI and
-- the managed migrations support here.
module Database.Beam.Migrate.Log where

import Database.Beam
import Database.Beam.Backend.SQL
import Database.Beam.Migrate
import Database.Beam.Migrate.Backend

import Control.Monad (when)

import Data.Int
import Data.String (fromString)
import Data.Text (Text)
import Data.Time (LocalTime)
import Data.UUID.Types (UUID)
import Data.Maybe (fromMaybe)

import qualified Control.Monad.Fail as Fail

data LogEntryT f
  = LogEntry
  { forall (f :: * -> *). LogEntryT f -> C f Int32
_logEntryId       :: C f Int32
  , forall (f :: * -> *). LogEntryT f -> C f Text
_logEntryCommitId :: C f Text
  , forall (f :: * -> *). LogEntryT f -> C f LocalTime
_logEntryDate     :: C f LocalTime
  } deriving (forall x. LogEntryT f -> Rep (LogEntryT f) x)
-> (forall x. Rep (LogEntryT f) x -> LogEntryT f)
-> Generic (LogEntryT f)
forall x. Rep (LogEntryT f) x -> LogEntryT f
forall x. LogEntryT f -> Rep (LogEntryT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (LogEntryT f) x -> LogEntryT f
forall (f :: * -> *) x. LogEntryT f -> Rep (LogEntryT f) x
$cto :: forall (f :: * -> *) x. Rep (LogEntryT f) x -> LogEntryT f
$cfrom :: forall (f :: * -> *) x. LogEntryT f -> Rep (LogEntryT f) x
Generic

instance Beamable LogEntryT
type LogEntry = LogEntryT Identity
deriving instance Show LogEntry

instance Table LogEntryT where
  data PrimaryKey LogEntryT f = LogEntryKey (C f Int32)
    deriving (forall x.
 PrimaryKey LogEntryT f -> Rep (PrimaryKey LogEntryT f) x)
-> (forall x.
    Rep (PrimaryKey LogEntryT f) x -> PrimaryKey LogEntryT f)
-> Generic (PrimaryKey LogEntryT f)
forall x. Rep (PrimaryKey LogEntryT f) x -> PrimaryKey LogEntryT f
forall x. PrimaryKey LogEntryT f -> Rep (PrimaryKey LogEntryT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey LogEntryT f) x -> PrimaryKey LogEntryT f
forall (f :: * -> *) x.
PrimaryKey LogEntryT f -> Rep (PrimaryKey LogEntryT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey LogEntryT f) x -> PrimaryKey LogEntryT f
$cfrom :: forall (f :: * -> *) x.
PrimaryKey LogEntryT f -> Rep (PrimaryKey LogEntryT f) x
Generic
  primaryKey :: forall (column :: * -> *).
LogEntryT column -> PrimaryKey LogEntryT column
primaryKey = C column Int32 -> PrimaryKey LogEntryT column
forall (f :: * -> *). C f Int32 -> PrimaryKey LogEntryT f
LogEntryKey (C column Int32 -> PrimaryKey LogEntryT column)
-> (LogEntryT column -> C column Int32)
-> LogEntryT column
-> PrimaryKey LogEntryT column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogEntryT column -> C column Int32
forall (f :: * -> *). LogEntryT f -> C f Int32
_logEntryId

instance Beamable (PrimaryKey LogEntryT)

type LogEntryKey = PrimaryKey LogEntryT Identity
deriving instance Show LogEntryKey

newtype BeamMigrateVersionT f
  = BeamMigrateVersion
  { forall (f :: * -> *). BeamMigrateVersionT f -> C f Int32
_beamMigrateVersion :: C f Int32
  } deriving (forall x. BeamMigrateVersionT f -> Rep (BeamMigrateVersionT f) x)
-> (forall x.
    Rep (BeamMigrateVersionT f) x -> BeamMigrateVersionT f)
-> Generic (BeamMigrateVersionT f)
forall x. Rep (BeamMigrateVersionT f) x -> BeamMigrateVersionT f
forall x. BeamMigrateVersionT f -> Rep (BeamMigrateVersionT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (BeamMigrateVersionT f) x -> BeamMigrateVersionT f
forall (f :: * -> *) x.
BeamMigrateVersionT f -> Rep (BeamMigrateVersionT f) x
$cto :: forall (f :: * -> *) x.
Rep (BeamMigrateVersionT f) x -> BeamMigrateVersionT f
$cfrom :: forall (f :: * -> *) x.
BeamMigrateVersionT f -> Rep (BeamMigrateVersionT f) x
Generic

instance Beamable BeamMigrateVersionT
type BeamMigrateVersion = BeamMigrateVersionT Identity
deriving instance Show BeamMigrateVersion

instance Table BeamMigrateVersionT where
  data PrimaryKey BeamMigrateVersionT f = BeamMigrateVersionKey (C f Int32)
    deriving (forall x.
 PrimaryKey BeamMigrateVersionT f
 -> Rep (PrimaryKey BeamMigrateVersionT f) x)
-> (forall x.
    Rep (PrimaryKey BeamMigrateVersionT f) x
    -> PrimaryKey BeamMigrateVersionT f)
-> Generic (PrimaryKey BeamMigrateVersionT f)
forall x.
Rep (PrimaryKey BeamMigrateVersionT f) x
-> PrimaryKey BeamMigrateVersionT f
forall x.
PrimaryKey BeamMigrateVersionT f
-> Rep (PrimaryKey BeamMigrateVersionT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey BeamMigrateVersionT f) x
-> PrimaryKey BeamMigrateVersionT f
forall (f :: * -> *) x.
PrimaryKey BeamMigrateVersionT f
-> Rep (PrimaryKey BeamMigrateVersionT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey BeamMigrateVersionT f) x
-> PrimaryKey BeamMigrateVersionT f
$cfrom :: forall (f :: * -> *) x.
PrimaryKey BeamMigrateVersionT f
-> Rep (PrimaryKey BeamMigrateVersionT f) x
Generic
  primaryKey :: forall (column :: * -> *).
BeamMigrateVersionT column -> PrimaryKey BeamMigrateVersionT column
primaryKey = C column Int32 -> PrimaryKey BeamMigrateVersionT column
forall (f :: * -> *). C f Int32 -> PrimaryKey BeamMigrateVersionT f
BeamMigrateVersionKey (C column Int32 -> PrimaryKey BeamMigrateVersionT column)
-> (BeamMigrateVersionT column -> C column Int32)
-> BeamMigrateVersionT column
-> PrimaryKey BeamMigrateVersionT column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BeamMigrateVersionT column -> C column Int32
forall (f :: * -> *). BeamMigrateVersionT f -> C f Int32
_beamMigrateVersion

instance Beamable (PrimaryKey BeamMigrateVersionT)

type BeamMigrateVersionKey = PrimaryKey BeamMigrateVersionT Identity
deriving instance Show BeamMigrateVersionKey

-- Database
data BeamMigrateDb entity
  = BeamMigrateDb
  { forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity BeamMigrateVersionT)
_beamMigrateVersionTbl :: entity (TableEntity BeamMigrateVersionT)
  , forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity LogEntryT)
_beamMigrateLogEntries :: entity (TableEntity LogEntryT)
  } deriving (forall x. BeamMigrateDb entity -> Rep (BeamMigrateDb entity) x)
-> (forall x. Rep (BeamMigrateDb entity) x -> BeamMigrateDb entity)
-> Generic (BeamMigrateDb entity)
forall x. Rep (BeamMigrateDb entity) x -> BeamMigrateDb entity
forall x. BeamMigrateDb entity -> Rep (BeamMigrateDb entity) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (entity :: * -> *) x.
Rep (BeamMigrateDb entity) x -> BeamMigrateDb entity
forall (entity :: * -> *) x.
BeamMigrateDb entity -> Rep (BeamMigrateDb entity) x
$cto :: forall (entity :: * -> *) x.
Rep (BeamMigrateDb entity) x -> BeamMigrateDb entity
$cfrom :: forall (entity :: * -> *) x.
BeamMigrateDb entity -> Rep (BeamMigrateDb entity) x
Generic

instance Database be BeamMigrateDb

beamMigratableDb :: forall be m
                  . ( BeamMigrateSqlBackend be
                    , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
                    , MonadBeam be m )
                 => CheckedDatabaseSettings be BeamMigrateDb
beamMigratableDb :: forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
CheckedDatabaseSettings be BeamMigrateDb
beamMigratableDb = Migration be (CheckedDatabaseSettings be BeamMigrateDb)
-> CheckedDatabaseSettings be BeamMigrateDb
forall be a. Migration be a -> a
runMigrationSilenced (Migration be (CheckedDatabaseSettings be BeamMigrateDb)
 -> CheckedDatabaseSettings be BeamMigrateDb)
-> Migration be (CheckedDatabaseSettings be BeamMigrateDb)
-> CheckedDatabaseSettings be BeamMigrateDb
forall a b. (a -> b) -> a -> b
$ forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
Migration be (CheckedDatabaseSettings be BeamMigrateDb)
beamMigrateDbMigration @be @m

beamMigrateDb :: forall be m
               . ( BeamMigrateSqlBackend be
                 , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
                 , MonadBeam be m )
               => DatabaseSettings be BeamMigrateDb
beamMigrateDb :: forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
DatabaseSettings be BeamMigrateDb
beamMigrateDb = CheckedDatabaseSettings be BeamMigrateDb
-> DatabaseSettings be BeamMigrateDb
forall be (db :: (* -> *) -> *).
Database be db =>
CheckedDatabaseSettings be db -> DatabaseSettings be db
unCheckDatabase (CheckedDatabaseSettings be BeamMigrateDb
 -> DatabaseSettings be BeamMigrateDb)
-> CheckedDatabaseSettings be BeamMigrateDb
-> DatabaseSettings be BeamMigrateDb
forall a b. (a -> b) -> a -> b
$ forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
CheckedDatabaseSettings be BeamMigrateDb
beamMigratableDb @be @m

beamMigrateDbMigration ::  forall be m
                        . ( BeamMigrateSqlBackend be
                          , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
                          , MonadBeam be m )
                       => Migration be (CheckedDatabaseSettings be BeamMigrateDb)
beamMigrateDbMigration :: forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
Migration be (CheckedDatabaseSettings be BeamMigrateDb)
beamMigrateDbMigration =
  CheckedDatabaseEntity
  be BeamMigrateDb (TableEntity BeamMigrateVersionT)
-> CheckedDatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
-> BeamMigrateDb (CheckedDatabaseEntity be BeamMigrateDb)
forall (entity :: * -> *).
entity (TableEntity BeamMigrateVersionT)
-> entity (TableEntity LogEntryT) -> BeamMigrateDb entity
BeamMigrateDb (CheckedDatabaseEntity
   be BeamMigrateDb (TableEntity BeamMigrateVersionT)
 -> CheckedDatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
 -> BeamMigrateDb (CheckedDatabaseEntity be BeamMigrateDb))
-> F (MigrationF be)
     (CheckedDatabaseEntity
        be BeamMigrateDb (TableEntity BeamMigrateVersionT))
-> F (MigrationF be)
     (CheckedDatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
      -> BeamMigrateDb (CheckedDatabaseEntity be BeamMigrateDb))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> TableSchema be BeamMigrateVersionT
-> F (MigrationF be)
     (CheckedDatabaseEntity
        be BeamMigrateDb (TableEntity BeamMigrateVersionT))
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable table, Table table, BeamMigrateSqlBackend be) =>
Text
-> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTable Text
"beam_version"
                      (C (TableFieldSchema be) Int32 -> TableSchema be BeamMigrateVersionT
forall (f :: * -> *). C f Int32 -> BeamMigrateVersionT f
BeamMigrateVersion (Text
-> DataType be Int32
-> NotNullConstraint be
-> TableFieldSchema be Int32
forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"version" DataType be Int32
forall be a. (BeamSqlBackend be, Integral a) => DataType be a
int NotNullConstraint be
forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull))
                F (MigrationF be)
  (CheckedDatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
   -> BeamMigrateDb (CheckedDatabaseEntity be BeamMigrateDb))
-> F (MigrationF be)
     (CheckedDatabaseEntity be BeamMigrateDb (TableEntity LogEntryT))
-> F (MigrationF be)
     (BeamMigrateDb (CheckedDatabaseEntity be BeamMigrateDb))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> TableSchema be LogEntryT
-> F (MigrationF be)
     (CheckedDatabaseEntity be BeamMigrateDb (TableEntity LogEntryT))
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable table, Table table, BeamMigrateSqlBackend be) =>
Text
-> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTable Text
"beam_migration"
                      (C (TableFieldSchema be) Int32
-> C (TableFieldSchema be) Text
-> C (TableFieldSchema be) LocalTime
-> TableSchema be LogEntryT
forall (f :: * -> *).
C f Int32 -> C f Text -> C f LocalTime -> LogEntryT f
LogEntry (Text
-> DataType be Int32
-> NotNullConstraint be
-> TableFieldSchema be Int32
forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"id" DataType be Int32
forall be a. (BeamSqlBackend be, Integral a) => DataType be a
int NotNullConstraint be
forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull) (Text
-> DataType be Text
-> NotNullConstraint be
-> TableFieldSchema be Text
forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"commitId" (Maybe Word -> DataType be Text
forall be. BeamSqlBackend be => Maybe Word -> DataType be Text
varchar Maybe Word
forall a. Maybe a
Nothing) NotNullConstraint be
forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull)
                                (Text
-> DataType be LocalTime
-> NotNullConstraint be
-> TableFieldSchema be LocalTime
forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"date" DataType be LocalTime
forall be. BeamSqlBackend be => DataType be LocalTime
timestamp NotNullConstraint be
forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull))

beamMigrateSchemaVersion :: Int32
beamMigrateSchemaVersion :: Int32
beamMigrateSchemaVersion = Int32
1

getLatestLogEntry :: forall be m
                   . ( BeamMigrateSqlBackend be
                     , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
                     , BeamSqlBackendCanDeserialize be Int32
                     , BeamSqlBackendCanDeserialize be LocalTime
                     , BeamSqlBackendSupportsDataType be Text
                     , HasQBuilder be
                     , MonadBeam be m )
                  => m (Maybe LogEntry)
getLatestLogEntry :: forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendCanDeserialize be Int32,
 BeamSqlBackendCanDeserialize be LocalTime,
 BeamSqlBackendSupportsDataType be Text, HasQBuilder be,
 MonadBeam be m) =>
m (Maybe LogEntry)
getLatestLogEntry =
  SqlSelect be LogEntry -> m (Maybe LogEntry)
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (Q be
  BeamMigrateDb
  QBaseScope
  (LogEntryT (QGenExpr QValueContext be QBaseScope))
-> SqlSelect
     be
     (QExprToIdentity
        (LogEntryT (QGenExpr QValueContext be QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q be
   BeamMigrateDb
   QBaseScope
   (LogEntryT (QGenExpr QValueContext be QBaseScope))
 -> SqlSelect
      be
      (QExprToIdentity
         (LogEntryT (QGenExpr QValueContext be QBaseScope))))
-> Q be
     BeamMigrateDb
     QBaseScope
     (LogEntryT (QGenExpr QValueContext be QBaseScope))
-> SqlSelect
     be
     (QExprToIdentity
        (LogEntryT (QGenExpr QValueContext be QBaseScope)))
forall a b. (a -> b) -> a -> b
$
                         Integer
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (LogEntryT (QGenExpr QValueContext be (QNested QBaseScope)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (LogEntryT (QGenExpr QValueContext be (QNested QBaseScope))))
forall s a be (db :: (* -> *) -> *).
(Projectible be a, ThreadRewritable (QNested s) a) =>
Integer
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
limit_ Integer
1 (Q be
   BeamMigrateDb
   (QNested QBaseScope)
   (LogEntryT (QGenExpr QValueContext be (QNested QBaseScope)))
 -> Q be
      BeamMigrateDb
      QBaseScope
      (WithRewrittenThread
         (QNested QBaseScope)
         QBaseScope
         (LogEntryT (QGenExpr QValueContext be (QNested QBaseScope)))))
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (LogEntryT (QGenExpr QValueContext be (QNested QBaseScope)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (LogEntryT (QGenExpr QValueContext be (QNested QBaseScope))))
forall a b. (a -> b) -> a -> b
$
                         (LogEntryT (QExpr be (QNested (QNested QBaseScope)))
 -> QOrd be (QNested (QNested QBaseScope)) Int32)
-> Q be
     BeamMigrateDb
     (QNested (QNested QBaseScope))
     (LogEntryT (QExpr be (QNested (QNested QBaseScope))))
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (WithRewrittenThread
        (QNested (QNested QBaseScope))
        (QNested QBaseScope)
        (LogEntryT (QExpr be (QNested (QNested QBaseScope)))))
forall s a ordering be (db :: (* -> *) -> *).
(Projectible be a, SqlOrderable be ordering,
 ThreadRewritable (QNested s) a) =>
(a -> ordering)
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
orderBy_ (QExpr be (QNested (QNested QBaseScope)) Int32
-> QOrd be (QNested (QNested QBaseScope)) Int32
forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
desc_ (QExpr be (QNested (QNested QBaseScope)) Int32
 -> QOrd be (QNested (QNested QBaseScope)) Int32)
-> (LogEntryT (QExpr be (QNested (QNested QBaseScope)))
    -> QExpr be (QNested (QNested QBaseScope)) Int32)
-> LogEntryT (QExpr be (QNested (QNested QBaseScope)))
-> QOrd be (QNested (QNested QBaseScope)) Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEntryT (QExpr be (QNested (QNested QBaseScope)))
-> QExpr be (QNested (QNested QBaseScope)) Int32
forall (f :: * -> *). LogEntryT f -> C f Int32
_logEntryId) (Q be
   BeamMigrateDb
   (QNested (QNested QBaseScope))
   (LogEntryT (QExpr be (QNested (QNested QBaseScope))))
 -> Q be
      BeamMigrateDb
      (QNested QBaseScope)
      (WithRewrittenThread
         (QNested (QNested QBaseScope))
         (QNested QBaseScope)
         (LogEntryT (QExpr be (QNested (QNested QBaseScope))))))
-> Q be
     BeamMigrateDb
     (QNested (QNested QBaseScope))
     (LogEntryT (QExpr be (QNested (QNested QBaseScope))))
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (WithRewrittenThread
        (QNested (QNested QBaseScope))
        (QNested QBaseScope)
        (LogEntryT (QExpr be (QNested (QNested QBaseScope)))))
forall a b. (a -> b) -> a -> b
$
                         DatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
-> Q be
     BeamMigrateDb
     (QNested (QNested QBaseScope))
     (LogEntryT (QExpr be (QNested (QNested QBaseScope))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (BeamMigrateDb (DatabaseEntity be BeamMigrateDb)
-> DatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity LogEntryT)
_beamMigrateLogEntries (forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
DatabaseSettings be BeamMigrateDb
beamMigrateDb @be @m)))


updateSchemaToCurrent :: forall be m
                       . ( BeamMigrateSqlBackend be
                         , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
                         , BeamSqlBackendCanSerialize be Text
                         , MonadBeam be m )
                      => m ()
updateSchemaToCurrent :: forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendCanSerialize be Text, MonadBeam be m) =>
m ()
updateSchemaToCurrent =
  SqlInsert be BeamMigrateVersionT -> m ()
forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert (DatabaseEntity be BeamMigrateDb (TableEntity BeamMigrateVersionT)
-> SqlInsertValues be (BeamMigrateVersionT (QExpr be Any))
-> SqlInsert be BeamMigrateVersionT
forall be (table :: (* -> *) -> *) s (db :: (* -> *) -> *).
(BeamSqlBackend be,
 ProjectibleWithPredicate AnyType () Text (table (QField s))) =>
DatabaseEntity be db (TableEntity table)
-> SqlInsertValues be (table (QExpr be s)) -> SqlInsert be table
insert (BeamMigrateDb (DatabaseEntity be BeamMigrateDb)
-> DatabaseEntity
     be BeamMigrateDb (TableEntity BeamMigrateVersionT)
forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity BeamMigrateVersionT)
_beamMigrateVersionTbl (forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
DatabaseSettings be BeamMigrateDb
beamMigrateDb @be @m)) ([BeamMigrateVersion]
-> SqlInsertValues be (BeamMigrateVersionT (QExpr be Any))
forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table,
 FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table) =>
[table Identity] -> SqlInsertValues be (table (QExpr be s))
insertValues [C Identity Int32 -> BeamMigrateVersion
forall (f :: * -> *). C f Int32 -> BeamMigrateVersionT f
BeamMigrateVersion Int32
C Identity Int32
beamMigrateSchemaVersion]))

recordCommit :: forall be m
             . ( BeamMigrateSqlBackend be
               , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
               , BeamSqlBackendSupportsDataType be Text
               , BeamSqlBackendCanDeserialize be Int32
               , BeamSqlBackendCanDeserialize be LocalTime
               , HasQBuilder be
               , MonadBeam be m )
             => UUID -> m ()
recordCommit :: forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendSupportsDataType be Text,
 BeamSqlBackendCanDeserialize be Int32,
 BeamSqlBackendCanDeserialize be LocalTime, HasQBuilder be,
 MonadBeam be m) =>
UUID -> m ()
recordCommit UUID
commitId = do
  let commitIdTxt :: Text
commitIdTxt = String -> Text
forall a. IsString a => String -> a
fromString (UUID -> String
forall a. Show a => a -> String
show UUID
commitId)

  Maybe LogEntry
logEntry <- m (Maybe LogEntry)
forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendCanDeserialize be Int32,
 BeamSqlBackendCanDeserialize be LocalTime,
 BeamSqlBackendSupportsDataType be Text, HasQBuilder be,
 MonadBeam be m) =>
m (Maybe LogEntry)
getLatestLogEntry
  let nextLogEntryId :: Int32
nextLogEntryId = Int32 -> (LogEntry -> Int32) -> Maybe LogEntry -> Int32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int32
0 (Int32 -> Int32
forall a. Enum a => a -> a
succ (Int32 -> Int32) -> (LogEntry -> Int32) -> LogEntry -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEntry -> Int32
forall (f :: * -> *). LogEntryT f -> C f Int32
_logEntryId) Maybe LogEntry
logEntry

  SqlInsert be LogEntryT -> m ()
forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert (DatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
-> SqlInsertValues be (LogEntryT (QExpr be Any))
-> SqlInsert be LogEntryT
forall be (table :: (* -> *) -> *) s (db :: (* -> *) -> *).
(BeamSqlBackend be,
 ProjectibleWithPredicate AnyType () Text (table (QField s))) =>
DatabaseEntity be db (TableEntity table)
-> SqlInsertValues be (table (QExpr be s)) -> SqlInsert be table
insert (BeamMigrateDb (DatabaseEntity be BeamMigrateDb)
-> DatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity LogEntryT)
_beamMigrateLogEntries (forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
DatabaseSettings be BeamMigrateDb
beamMigrateDb @be @m))
                    ((forall s'. [LogEntryT (QExpr be s')])
-> SqlInsertValues be (LogEntryT (QExpr be Any))
forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table) =>
(forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
insertExpressions
                     [ C (QExpr be s') Int32
-> C (QExpr be s') Text
-> C (QExpr be s') LocalTime
-> LogEntryT (QExpr be s')
forall (f :: * -> *).
C f Int32 -> C f Text -> C f LocalTime -> LogEntryT f
LogEntry (HaskellLiteralForQExpr (QGenExpr QValueContext be s' Int32)
-> QGenExpr QValueContext be s' Int32
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Int32
HaskellLiteralForQExpr (QGenExpr QValueContext be s' Int32)
nextLogEntryId)
                                (HaskellLiteralForQExpr (QGenExpr QValueContext be s' Text)
-> QGenExpr QValueContext be s' Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Text
HaskellLiteralForQExpr (QGenExpr QValueContext be s' Text)
commitIdTxt)
                                C (QExpr be s') LocalTime
forall be ctxt s. BeamSqlBackend be => QGenExpr ctxt be s LocalTime
currentTimestamp_]))

-- Ensure the backend tables exist
ensureBackendTables :: forall be m
                     . (BeamSqlBackendCanSerialize be Text, Fail.MonadFail m)
                    => BeamMigrationBackend be m
                    -> m ()
ensureBackendTables :: forall be (m :: * -> *).
(BeamSqlBackendCanSerialize be Text, MonadFail m) =>
BeamMigrationBackend be m -> m ()
ensureBackendTables be :: BeamMigrationBackend be m
be@BeamMigrationBackend { backendGetDbConstraints :: forall be (m :: * -> *).
BeamMigrationBackend be m -> m [SomeDatabasePredicate]
backendGetDbConstraints = m [SomeDatabasePredicate]
getCs } =
  do Bool
backendSchemaBuilt <- BeamMigrationBackend be m -> m Bool
forall be (m :: * -> *). BeamMigrationBackend be m -> m Bool
checkForBackendTables BeamMigrationBackend be m
be
     if Bool
backendSchemaBuilt
       then m ()
continueMigrate
       else m ()
createSchema

  where
    doStep :: BeamSqlBackendSyntax be -> m ()
doStep BeamSqlBackendSyntax be
cmd = BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn BeamSqlBackendSyntax be
cmd

    continueMigrate :: m ()
continueMigrate = do
      Maybe (Maybe Int32)
maxVersion <-
        SqlSelect be (Maybe Int32) -> m (Maybe (Maybe Int32))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (SqlSelect be (Maybe Int32) -> m (Maybe (Maybe Int32)))
-> SqlSelect be (Maybe Int32) -> m (Maybe (Maybe Int32))
forall a b. (a -> b) -> a -> b
$ Q be
  BeamMigrateDb
  QBaseScope
  (QGenExpr QValueContext be QBaseScope (Maybe Int32))
-> SqlSelect
     be
     (QExprToIdentity
        (QGenExpr QValueContext be QBaseScope (Maybe Int32)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q be
   BeamMigrateDb
   QBaseScope
   (QGenExpr QValueContext be QBaseScope (Maybe Int32))
 -> SqlSelect
      be
      (QExprToIdentity
         (QGenExpr QValueContext be QBaseScope (Maybe Int32))))
-> Q be
     BeamMigrateDb
     QBaseScope
     (QGenExpr QValueContext be QBaseScope (Maybe Int32))
-> SqlSelect
     be
     (QExprToIdentity
        (QGenExpr QValueContext be QBaseScope (Maybe Int32)))
forall a b. (a -> b) -> a -> b
$
        (BeamMigrateVersionT (QExpr be (QNested QBaseScope))
 -> QAgg be (QNested QBaseScope) (Maybe Int32))
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (BeamMigrateVersionT (QExpr be (QNested QBaseScope)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg be (QNested QBaseScope) (Maybe Int32)) QValueContext))
forall be a r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Aggregable be a, Projectible be r,
 Projectible be a, ContextRewritable a,
 ThreadRewritable
   (QNested s) (WithRewrittenContext a QValueContext)) =>
(r -> a)
-> Q be db (QNested s) r
-> Q be
     db
     s
     (WithRewrittenThread
        (QNested s) s (WithRewrittenContext a QValueContext))
aggregate_ (\BeamMigrateVersionT (QExpr be (QNested QBaseScope))
v -> QGenExpr QValueContext be (QNested QBaseScope) Int32
-> QAgg be (QNested QBaseScope) (Maybe Int32)
forall be s a.
BeamSqlBackend be =>
QExpr be s a -> QAgg be s (Maybe a)
max_ (BeamMigrateVersionT (QExpr be (QNested QBaseScope))
-> C (QExpr be (QNested QBaseScope)) Int32
forall (f :: * -> *). BeamMigrateVersionT f -> C f Int32
_beamMigrateVersion BeamMigrateVersionT (QExpr be (QNested QBaseScope))
v)) (Q be
   BeamMigrateDb
   (QNested QBaseScope)
   (BeamMigrateVersionT (QExpr be (QNested QBaseScope)))
 -> Q be
      BeamMigrateDb
      QBaseScope
      (WithRewrittenThread
         (QNested QBaseScope)
         QBaseScope
         (WithRewrittenContext
            (QAgg be (QNested QBaseScope) (Maybe Int32)) QValueContext)))
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (BeamMigrateVersionT (QExpr be (QNested QBaseScope)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg be (QNested QBaseScope) (Maybe Int32)) QValueContext))
forall a b. (a -> b) -> a -> b
$
        DatabaseEntity be BeamMigrateDb (TableEntity BeamMigrateVersionT)
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (BeamMigrateVersionT (QExpr be (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (BeamMigrateDb (DatabaseEntity be BeamMigrateDb)
-> DatabaseEntity
     be BeamMigrateDb (TableEntity BeamMigrateVersionT)
forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity BeamMigrateVersionT)
_beamMigrateVersionTbl (forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
DatabaseSettings be BeamMigrateDb
beamMigrateDb @be @m))

      case Maybe (Maybe Int32)
maxVersion of
        Maybe (Maybe Int32)
Nothing -> m ()
cleanAndCreateSchema
        Just Maybe Int32
Nothing -> m ()
cleanAndCreateSchema
        Just (Just Int32
maxVersion')
          | Int32
maxVersion' Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
beamMigrateSchemaVersion ->
              String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"This database is being managed by a newer version of beam-migrate"
          | Int32
maxVersion' Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
beamMigrateSchemaVersion ->
              String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"This database is being managed by an older version of beam-migrate, but there are no older versions"
          | Bool
otherwise -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    cleanAndCreateSchema :: m ()
cleanAndCreateSchema = do
      [SomeDatabasePredicate]
cs <- m [SomeDatabasePredicate]
getCs
      let migrationLogExists :: Bool
migrationLogExists = (SomeDatabasePredicate -> Bool) -> [SomeDatabasePredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SomeDatabasePredicate -> SomeDatabasePredicate -> Bool
forall a. Eq a => a -> a -> Bool
== TableExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p (QualifiedName -> TableExistsPredicate
TableExistsPredicate (Maybe Text -> Text -> QualifiedName
QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
"beam_migration"))) [SomeDatabasePredicate]
cs

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
migrationLogExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Int32
totalCnt <-
          (Maybe Int32 -> Int32) -> m (Maybe Int32) -> m Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0) (m (Maybe Int32) -> m Int32) -> m (Maybe Int32) -> m Int32
forall a b. (a -> b) -> a -> b
$ -- Should never return 'Nothing', but this prevents an irrefutable pattern match
          SqlSelect be Int32 -> m (Maybe Int32)
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (SqlSelect be Int32 -> m (Maybe Int32))
-> SqlSelect be Int32 -> m (Maybe Int32)
forall a b. (a -> b) -> a -> b
$ Q be
  BeamMigrateDb
  QBaseScope
  (QGenExpr QValueContext be QBaseScope Int32)
-> SqlSelect
     be (QExprToIdentity (QGenExpr QValueContext be QBaseScope Int32))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q be
   BeamMigrateDb
   QBaseScope
   (QGenExpr QValueContext be QBaseScope Int32)
 -> SqlSelect
      be (QExprToIdentity (QGenExpr QValueContext be QBaseScope Int32)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (QGenExpr QValueContext be QBaseScope Int32)
-> SqlSelect
     be (QExprToIdentity (QGenExpr QValueContext be QBaseScope Int32))
forall a b. (a -> b) -> a -> b
$
          (LogEntryT (QExpr be (QNested QBaseScope))
 -> QGenExpr QAggregateContext be (QNested QBaseScope) Int32)
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (LogEntryT (QExpr be (QNested QBaseScope)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QGenExpr QAggregateContext be (QNested QBaseScope) Int32)
           QValueContext))
forall be a r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Aggregable be a, Projectible be r,
 Projectible be a, ContextRewritable a,
 ThreadRewritable
   (QNested s) (WithRewrittenContext a QValueContext)) =>
(r -> a)
-> Q be db (QNested s) r
-> Q be
     db
     s
     (WithRewrittenThread
        (QNested s) s (WithRewrittenContext a QValueContext))
aggregate_ (\LogEntryT (QExpr be (QNested QBaseScope))
_ -> forall a ctxt be s. QGenExpr ctxt be s a -> QGenExpr ctxt be s a
as_ @Int32 QGenExpr QAggregateContext be (QNested QBaseScope) Int32
forall be a s. (BeamSqlBackend be, Integral a) => QAgg be s a
countAll_) (Q be
   BeamMigrateDb
   (QNested QBaseScope)
   (LogEntryT (QExpr be (QNested QBaseScope)))
 -> Q be
      BeamMigrateDb
      QBaseScope
      (WithRewrittenThread
         (QNested QBaseScope)
         QBaseScope
         (WithRewrittenContext
            (QGenExpr QAggregateContext be (QNested QBaseScope) Int32)
            QValueContext)))
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (LogEntryT (QExpr be (QNested QBaseScope)))
-> Q be
     BeamMigrateDb
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QGenExpr QAggregateContext be (QNested QBaseScope) Int32)
           QValueContext))
forall a b. (a -> b) -> a -> b
$
          DatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
-> Q be
     BeamMigrateDb
     (QNested QBaseScope)
     (LogEntryT (QExpr be (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (BeamMigrateDb (DatabaseEntity be BeamMigrateDb)
-> DatabaseEntity be BeamMigrateDb (TableEntity LogEntryT)
forall (entity :: * -> *).
BeamMigrateDb entity -> entity (TableEntity LogEntryT)
_beamMigrateLogEntries (forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
DatabaseSettings be BeamMigrateDb
beamMigrateDb @be @m))
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
totalCnt Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0) (String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"beam-migrate: No versioning information, but log entries present")
        BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be)
-> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandDropTableSyntax syntax -> syntax
dropTableCmd (Sql92DropTableTableNameSyntax
  (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92DropTableSyntax syntax =>
Sql92DropTableTableNameSyntax syntax -> syntax
dropTableSyntax (Maybe Text
-> Text
-> Sql92DropTableTableNameSyntax
     (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
forall a. Maybe a
Nothing Text
"beam_migration")))

      BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be)
-> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandDropTableSyntax syntax -> syntax
dropTableCmd (Sql92DropTableTableNameSyntax
  (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92DropTableSyntax syntax =>
Sql92DropTableTableNameSyntax syntax -> syntax
dropTableSyntax (Maybe Text
-> Text
-> Sql92DropTableTableNameSyntax
     (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
forall a. Maybe a
Nothing Text
"beam_version")))

      m ()
createSchema

    createSchema :: m ()
createSchema = do
      CheckedDatabaseSettings be BeamMigrateDb
_ <- (BeamSqlBackendSyntax be -> m ())
-> Migration be (CheckedDatabaseSettings be BeamMigrateDb)
-> m (CheckedDatabaseSettings be BeamMigrateDb)
forall (m :: * -> *) be a.
Applicative m =>
(BeamSqlBackendSyntax be -> m ()) -> Migration be a -> m a
executeMigration BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
doStep (forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 MonadBeam be m) =>
Migration be (CheckedDatabaseSettings be BeamMigrateDb)
beamMigrateDbMigration @be @m)
      m ()
forall be (m :: * -> *).
(BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendCanSerialize be Text, MonadBeam be m) =>
m ()
updateSchemaToCurrent

checkForBackendTables :: BeamMigrationBackend be m -> m Bool
checkForBackendTables :: forall be (m :: * -> *). BeamMigrationBackend be m -> m Bool
checkForBackendTables BeamMigrationBackend { backendGetDbConstraints :: forall be (m :: * -> *).
BeamMigrationBackend be m -> m [SomeDatabasePredicate]
backendGetDbConstraints = m [SomeDatabasePredicate]
getCs } =
  do [SomeDatabasePredicate]
cs <- m [SomeDatabasePredicate]
getCs
     Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SomeDatabasePredicate -> Bool) -> [SomeDatabasePredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SomeDatabasePredicate -> SomeDatabasePredicate -> Bool
forall a. Eq a => a -> a -> Bool
== TableExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p (QualifiedName -> TableExistsPredicate
TableExistsPredicate (Maybe Text -> Text -> QualifiedName
QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
"beam_version"))) [SomeDatabasePredicate]
cs)