{-# 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 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 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 = forall (f :: * -> *). C f Int32 -> PrimaryKey LogEntryT f
LogEntryKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 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 = forall (f :: * -> *). C f Int32 -> PrimaryKey BeamMigrateVersionT f
BeamMigrateVersionKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 = forall be a. Migration be a -> a
runMigrationSilenced 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 = forall be (db :: (* -> *) -> *).
Database be db =>
CheckedDatabaseSettings be db -> DatabaseSettings be db
unCheckDatabase 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 =
  forall (entity :: * -> *).
entity (TableEntity BeamMigrateVersionT)
-> entity (TableEntity LogEntryT) -> BeamMigrateDb entity
BeamMigrateDb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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"
                      (forall (f :: * -> *). C f Int32 -> BeamMigrateVersionT f
BeamMigrateVersion (forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"version" forall be a. (BeamSqlBackend be, Integral a) => DataType be a
int forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull))
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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"
                      (forall (f :: * -> *).
C f Int32 -> C f Text -> C f LocalTime -> LogEntryT f
LogEntry (forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"id" forall be a. (BeamSqlBackend be, Integral a) => DataType be a
int forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull) (forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"commitId" (forall be. BeamSqlBackend be => Maybe Word -> DataType be Text
varchar forall a. Maybe a
Nothing) forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull)
                                (forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
"date" forall be. BeamSqlBackend be => DataType be LocalTime
timestamp 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 =
  forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select forall a b. (a -> b) -> a -> b
$
                         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 forall a b. (a -> b) -> a -> b
$
                         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_ (forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
desc_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). LogEntryT f -> C f Int32
_logEntryId) forall a b. (a -> b) -> a -> b
$
                         forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (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 =
  forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert (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 (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)) (forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table,
 FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table) =>
[table Identity] -> SqlInsertValues be (table (QExpr be s))
insertValues [forall (f :: * -> *). C f Int32 -> BeamMigrateVersionT f
BeamMigrateVersion 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 = forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show UUID
commitId)

  Maybe LogEntry
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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int32
0 (forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). LogEntryT f -> C f Int32
_logEntryId) Maybe LogEntry
logEntry

  forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert (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 (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 be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table) =>
(forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
insertExpressions
                     [ forall (f :: * -> *).
C f Int32 -> C f Text -> C f LocalTime -> LogEntryT f
LogEntry (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Int32
nextLogEntryId)
                                (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Text
commitIdTxt)
                                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 <- 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 = forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn BeamSqlBackendSyntax be
cmd

    continueMigrate :: m ()
continueMigrate = do
      Maybe (Maybe Int32)
maxVersion <-
        forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne forall a b. (a -> b) -> a -> b
$ forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select forall a b. (a -> b) -> a -> b
$
        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 -> forall be s a.
BeamSqlBackend be =>
QExpr be s a -> QAgg be s (Maybe a)
max_ (forall (f :: * -> *). BeamMigrateVersionT f -> C f Int32
_beamMigrateVersion BeamMigrateVersionT (QExpr be (QNested QBaseScope))
v)) forall a b. (a -> b) -> a -> b
$
        forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (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' forall a. Ord a => a -> a -> Bool
> Int32
beamMigrateSchemaVersion ->
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"This database is being managed by a newer version of beam-migrate"
          | Int32
maxVersion' forall a. Ord a => a -> a -> Bool
< Int32
beamMigrateSchemaVersion ->
              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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
migrationLogExists forall a b. (a -> b) -> a -> b
$ do
        QExprToIdentity
  (WithRewrittenThread
     (QNested QBaseScope)
     QBaseScope
     (QGenExpr QValueContext be (QNested QBaseScope) Int32))
totalCnt <-
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe QExprToIdentity
  (WithRewrittenThread
     (QNested QBaseScope)
     QBaseScope
     (QGenExpr QValueContext be (QNested QBaseScope) Int32))
0) forall a b. (a -> b) -> a -> b
$ -- Should never return 'Nothing', but this prevents an irrefutable pattern match
          forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne forall a b. (a -> b) -> a -> b
$ forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select forall a b. (a -> b) -> a -> b
$
          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 forall be a s. (BeamSqlBackend be, Integral a) => QAgg be s a
countAll_) forall a b. (a -> b) -> a -> b
$
          forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (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 (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QExprToIdentity
  (WithRewrittenThread
     (QNested QBaseScope)
     QBaseScope
     (QGenExpr QValueContext be (QNested QBaseScope) Int32))
totalCnt forall a. Ord a => a -> a -> Bool
> QExprToIdentity
  (WithRewrittenThread
     (QNested QBaseScope)
     QBaseScope
     (QGenExpr QValueContext be (QNested QBaseScope) Int32))
0) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"beam-migrate: No versioning information, but log entries present")
        forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandDropTableSyntax syntax -> syntax
dropTableCmd (forall syntax.
IsSql92DropTableSyntax syntax =>
Sql92DropTableTableNameSyntax syntax -> syntax
dropTableSyntax (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName forall a. Maybe a
Nothing Text
"beam_migration")))

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

      m ()
createSchema

    createSchema :: m ()
createSchema = do
      CheckedDatabaseSettings be BeamMigrateDb
_ <- forall (m :: * -> *) be a.
Applicative m =>
(BeamSqlBackendSyntax be -> m ()) -> Migration be a -> m a
executeMigration 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)
      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
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p (QualifiedName -> TableExistsPredicate
TableExistsPredicate (Maybe Text -> Text -> QualifiedName
QualifiedName forall a. Maybe a
Nothing Text
"beam_version"))) [SomeDatabasePredicate]
cs)