{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Database.Beam.Migrate.SQL.Tables
(
createTable, dropTable
, preserve
, TableMigration(..)
, ColumnMigration(..)
, alterTable
, renameTableTo, renameColumnTo
, addColumn, dropColumn
, DefaultValue, Constraint(..), NotNullConstraint
, field
, defaultTo_, notNull, unique
, FieldReturnType(..)
, IsNotNull
) where
import Database.Beam
import Database.Beam.Schema.Tables
import Database.Beam.Backend.SQL
import Database.Beam.Backend.SQL.AST (TableName(..))
import Database.Beam.Query.Internal (tableNameFromEntity)
import Database.Beam.Migrate.Types
import Database.Beam.Migrate.Checks
import Database.Beam.Migrate.SQL.Types
import Database.Beam.Migrate.SQL.SQL92
import Control.Applicative
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Writer.Strict
import Control.Monad.State
import Data.Text (Text)
import Data.Typeable
import qualified Data.Kind as Kind (Constraint)
import GHC.TypeLits
import Lens.Micro ((^.))
createTable :: ( Beamable table, Table table
, BeamMigrateSqlBackend be )
=> Text -> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTable :: forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable table, Table table, BeamMigrateSqlBackend be) =>
Text
-> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTable Text
newTblName TableSchema be table
tblSettings =
do let pkFields :: [Text]
pkFields = forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (TableFieldSchema Text
name FieldSchema be a
_ [FieldCheck]
_)) -> Text
name) (forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey TableSchema be table
tblSettings)
tblConstraints :: [Sql92CreateTableTableConstraintSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))]
tblConstraints = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
pkFields then [] else [ forall constraint.
IsSql92TableConstraintSyntax constraint =>
[Text] -> constraint
primaryKeyConstraintSyntax [Text]
pkFields ]
createTableCommand :: Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)
createTableCommand =
forall syntax.
IsSql92CreateTableSyntax syntax =>
Maybe (Sql92CreateTableOptionsSyntax syntax)
-> Sql92CreateTableTableNameSyntax syntax
-> [(Text, Sql92CreateTableColumnSchemaSyntax syntax)]
-> [Sql92CreateTableTableConstraintSyntax syntax]
-> syntax
createTableSyntax forall a. Maybe a
Nothing (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName forall a. Maybe a
Nothing Text
newTblName)
(forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (TableFieldSchema Text
name (FieldSchema Sql92CreateTableColumnSchemaSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
schema) [FieldCheck]
_)) -> (Text
name, Sql92CreateTableColumnSchemaSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
schema)) TableSchema be table
tblSettings)
[Sql92CreateTableTableConstraintSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))]
tblConstraints
command :: BeamSqlBackendSyntax be
command = forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandCreateTableSyntax syntax -> syntax
createTableCmd Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)
createTableCommand
tbl' :: table (TableField table)
tbl' = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (TableFieldSchema Text
name FieldSchema be a
_ [FieldCheck]
_)) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name) Text
name)) TableSchema be table
tblSettings
fieldChecks :: table (Const [FieldCheck])
fieldChecks = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (TableFieldSchema Text
_ FieldSchema be a
_ [FieldCheck]
cs)) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall {k} a (b :: k). a -> Const a b
Const [FieldCheck]
cs)) TableSchema be table
tblSettings
tblChecks :: [TableCheck]
tblChecks = [ (forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck
TableCheck (\QualifiedName
tblName tbl (TableField tbl)
_ -> forall a. a -> Maybe a
Just (forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName -> TableExistsPredicate
TableExistsPredicate QualifiedName
tblName))) ] forall a. [a] -> [a] -> [a]
++
[TableCheck]
primaryKeyCheck
primaryKeyCheck :: [TableCheck]
primaryKeyCheck =
case forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (TableFieldSchema Text
name FieldSchema be a
_ [FieldCheck]
_)) -> Text
name) (forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey TableSchema be table
tblSettings) of
[] -> []
[Text]
cols -> [ (forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck
TableCheck (\QualifiedName
tblName tbl (TableField tbl)
_ -> forall a. a -> Maybe a
Just (forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName -> [Text] -> TableHasPrimaryKey
TableHasPrimaryKey QualifiedName
tblName [Text]
cols))) ]
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown BeamSqlBackendSyntax be
command forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity (forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable (forall (tbl :: (* -> *) -> *) be.
Table tbl =>
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
DatabaseTable forall a. Maybe a
Nothing Text
newTblName Text
newTblName table (TableField table)
tbl') [TableCheck]
tblChecks table (Const [FieldCheck])
fieldChecks) [])
dropTable :: BeamMigrateSqlBackend be
=> CheckedDatabaseEntity be db (TableEntity table)
-> Migration be ()
dropTable :: forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamMigrateSqlBackend be =>
CheckedDatabaseEntity be db (TableEntity table) -> Migration be ()
dropTable (CheckedDatabaseEntity (CheckedDatabaseTable DatabaseEntityDescriptor be (TableEntity table)
dt [TableCheck]
_ table (Const [FieldCheck])
_) [SomeDatabasePredicate]
_) =
let command :: BeamSqlBackendSyntax be
command = forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandDropTableSyntax syntax -> syntax
dropTableCmd (forall syntax.
IsSql92DropTableSyntax syntax =>
Sql92DropTableTableNameSyntax syntax -> syntax
dropTableSyntax (forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt))
in forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown BeamSqlBackendSyntax be
command forall a. Maybe a
Nothing
preserve :: CheckedDatabaseEntity be db e
-> Migration be (CheckedDatabaseEntity be db' e)
preserve :: forall be (db :: (* -> *) -> *) e (db' :: (* -> *) -> *).
CheckedDatabaseEntity be db e
-> Migration be (CheckedDatabaseEntity be db' e)
preserve (CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be e
desc [SomeDatabasePredicate]
checks) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be e
desc [SomeDatabasePredicate]
checks)
data ColumnMigration a
= ColumnMigration
{ forall a. ColumnMigration a -> Text
columnMigrationFieldName :: Text
, forall a. ColumnMigration a -> [FieldCheck]
columnMigrationFieldChecks :: [FieldCheck] }
newtype TableMigration be a
= TableMigration (WriterT [BeamSqlBackendAlterTableSyntax be] (State (TableName, [TableCheck])) a)
deriving (forall {be}. Applicative (TableMigration be)
forall a. a -> TableMigration be a
forall be a. a -> TableMigration be a
forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
forall a b.
TableMigration be a
-> (a -> TableMigration be b) -> TableMigration be b
forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
forall be a b.
TableMigration be a
-> (a -> TableMigration be b) -> TableMigration be b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> TableMigration be a
$creturn :: forall be a. a -> TableMigration be a
>> :: forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
$c>> :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
>>= :: forall a b.
TableMigration be a
-> (a -> TableMigration be b) -> TableMigration be b
$c>>= :: forall be a b.
TableMigration be a
-> (a -> TableMigration be b) -> TableMigration be b
Monad, forall {be}. Functor (TableMigration be)
forall a. a -> TableMigration be a
forall be a. a -> TableMigration be a
forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be a
forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
forall a b.
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be a
forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
forall be a b.
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
forall a b c.
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
forall be a b c.
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be a
$c<* :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be a
*> :: forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
$c*> :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
liftA2 :: forall a b c.
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
$cliftA2 :: forall be a b c.
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
<*> :: forall a b.
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
$c<*> :: forall be a b.
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
pure :: forall a. a -> TableMigration be a
$cpure :: forall be a. a -> TableMigration be a
Applicative, forall a b. a -> TableMigration be b -> TableMigration be a
forall a b. (a -> b) -> TableMigration be a -> TableMigration be b
forall be a b. a -> TableMigration be b -> TableMigration be a
forall be a b.
(a -> b) -> TableMigration be a -> TableMigration be b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TableMigration be b -> TableMigration be a
$c<$ :: forall be a b. a -> TableMigration be b -> TableMigration be a
fmap :: forall a b. (a -> b) -> TableMigration be a -> TableMigration be b
$cfmap :: forall be a b.
(a -> b) -> TableMigration be a -> TableMigration be b
Functor)
renameTableTo :: BeamMigrateSqlBackend be
=> Text -> table ColumnMigration
-> TableMigration be (table ColumnMigration)
renameTableTo :: forall be (table :: (* -> *) -> *).
BeamMigrateSqlBackend be =>
Text
-> table ColumnMigration
-> TableMigration be (table ColumnMigration)
renameTableTo Text
newName table ColumnMigration
oldTbl = forall be a.
WriterT
[BeamSqlBackendAlterTableSyntax be]
(State (TableName, [TableCheck]))
a
-> TableMigration be a
TableMigration forall a b. (a -> b) -> a -> b
$ do
(TableName Maybe Text
curSchema Text
curNm, [TableCheck]
chks) <- forall s (m :: * -> *). MonadState s m => m s
get
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm) (forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> syntax
renameTableToSyntax Text
newName) ]
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe Text -> Text -> TableName
TableName Maybe Text
curSchema Text
curNm, [TableCheck]
chks)
forall (m :: * -> *) a. Monad m => a -> m a
return table ColumnMigration
oldTbl
renameColumnTo :: BeamMigrateSqlBackend be
=> Text -> ColumnMigration a
-> TableMigration be (ColumnMigration a)
renameColumnTo :: forall be a.
BeamMigrateSqlBackend be =>
Text -> ColumnMigration a -> TableMigration be (ColumnMigration a)
renameColumnTo Text
newName ColumnMigration a
column = forall be a.
WriterT
[BeamSqlBackendAlterTableSyntax be]
(State (TableName, [TableCheck]))
a
-> TableMigration be a
TableMigration forall a b. (a -> b) -> a -> b
$ do
(TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_) <- forall s (m :: * -> *). MonadState s m => m s
get
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm)
(forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> Text -> syntax
renameColumnToSyntax (forall a. ColumnMigration a -> Text
columnMigrationFieldName ColumnMigration a
column) Text
newName) ]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnMigration a
column { columnMigrationFieldName :: Text
columnMigrationFieldName = Text
newName }
dropColumn :: BeamMigrateSqlBackend be
=> ColumnMigration a -> TableMigration be ()
dropColumn :: forall be a.
BeamMigrateSqlBackend be =>
ColumnMigration a -> TableMigration be ()
dropColumn ColumnMigration a
column = forall be a.
WriterT
[BeamSqlBackendAlterTableSyntax be]
(State (TableName, [TableCheck]))
a
-> TableMigration be a
TableMigration forall a b. (a -> b) -> a -> b
$ do
(TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_)<- forall s (m :: * -> *). MonadState s m => m s
get
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm)
(forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> syntax
dropColumnSyntax (forall a. ColumnMigration a -> Text
columnMigrationFieldName ColumnMigration a
column)) ]
addColumn :: BeamMigrateSqlBackend be
=> TableFieldSchema be a
-> TableMigration be (ColumnMigration a)
addColumn :: forall be a.
BeamMigrateSqlBackend be =>
TableFieldSchema be a -> TableMigration be (ColumnMigration a)
addColumn (TableFieldSchema Text
nm (FieldSchema Sql92CreateTableColumnSchemaSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
fieldSchemaSyntax) [FieldCheck]
checks) =
forall be a.
WriterT
[BeamSqlBackendAlterTableSyntax be]
(State (TableName, [TableCheck]))
a
-> TableMigration be a
TableMigration forall a b. (a -> b) -> a -> b
$
do (TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_) <- forall s (m :: * -> *). MonadState s m => m s
get
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm) (forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> Sql92AlterTableColumnSchemaSyntax syntax -> syntax
addColumnSyntax Text
nm Sql92CreateTableColumnSchemaSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
fieldSchemaSyntax) ]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Text -> [FieldCheck] -> ColumnMigration a
ColumnMigration Text
nm [FieldCheck]
checks)
alterTable :: forall be db db' table table'
. (Table table', BeamMigrateSqlBackend be)
=> CheckedDatabaseEntity be db (TableEntity table)
-> (table ColumnMigration -> TableMigration be (table' ColumnMigration))
-> Migration be (CheckedDatabaseEntity be db' (TableEntity table'))
alterTable :: forall be (db :: (* -> *) -> *) (db' :: (* -> *) -> *)
(table :: (* -> *) -> *) (table' :: (* -> *) -> *).
(Table table', BeamMigrateSqlBackend be) =>
CheckedDatabaseEntity be db (TableEntity table)
-> (table ColumnMigration
-> TableMigration be (table' ColumnMigration))
-> Migration be (CheckedDatabaseEntity be db' (TableEntity table'))
alterTable (CheckedDatabaseEntity (CheckedDatabaseTable DatabaseEntityDescriptor be (TableEntity table)
dt [TableCheck]
tblChecks table (Const [FieldCheck])
tblFieldChecks) [SomeDatabasePredicate]
entityChecks) table ColumnMigration -> TableMigration be (table' ColumnMigration)
alterColumns =
let initialTbl :: table ColumnMigration
initialTbl = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM
(\(Columnar' Columnar (TableField table) a
fd :: Columnar' (TableField table) x)
(Columnar' (Const [FieldCheck]
checks) :: Columnar' (Const [FieldCheck]) x) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall a. Text -> [FieldCheck] -> ColumnMigration a
ColumnMigration (Columnar (TableField table) a
fd forall s a. s -> Getting a s a -> a
^. forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) Text
fieldName) [FieldCheck]
checks)
:: Columnar' ColumnMigration x))
(forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt) table (Const [FieldCheck])
tblFieldChecks
TableMigration WriterT
[BeamSqlBackendAlterTableSyntax be]
(State (TableName, [TableCheck]))
(table' ColumnMigration)
alterColumns' = table ColumnMigration -> TableMigration be (table' ColumnMigration)
alterColumns table ColumnMigration
initialTbl
((table' ColumnMigration
newTbl, [BeamSqlBackendAlterTableSyntax be]
cmds), (TableName Maybe Text
tblSchema' Text
tblNm', [TableCheck]
tblChecks')) =
forall s a. State s a -> s -> (a, s)
runState (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
[BeamSqlBackendAlterTableSyntax be]
(State (TableName, [TableCheck]))
(table' ColumnMigration)
alterColumns')
( Maybe Text -> Text -> TableName
TableName (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor be (TableEntity table)
dt) (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity table)
dt)
, [TableCheck]
tblChecks )
fieldChecks' :: table' (Const [FieldCheck])
fieldChecks' = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (ColumnMigration Text
_ [FieldCheck]
checks) :: Columnar' ColumnMigration a) ->
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall {k} a (b :: k). a -> Const a b
Const [FieldCheck]
checks) :: Columnar' (Const [FieldCheck]) a)
table' ColumnMigration
newTbl
tbl' :: TableSettings table'
tbl' :: TableSettings table'
tbl' = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (ColumnMigration Text
nm [FieldCheck]
_) :: Columnar' ColumnMigration a) ->
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
nm) Text
nm) :: Columnar' (TableField table') a)
table' ColumnMigration
newTbl
in forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BeamSqlBackendAlterTableSyntax be]
cmds (\BeamSqlBackendAlterTableSyntax be
cmd -> forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandAlterTableSyntax syntax -> syntax
alterTableCmd BeamSqlBackendAlterTableSyntax be
cmd) forall a. Maybe a
Nothing) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity (forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable
(forall (tbl :: (* -> *) -> *) be.
Table tbl =>
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
DatabaseTable Maybe Text
tblSchema' (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableOrigName DatabaseEntityDescriptor be (TableEntity table)
dt)
Text
tblNm' TableSettings table'
tbl')
[TableCheck]
tblChecks' table' (Const [FieldCheck])
fieldChecks') [SomeDatabasePredicate]
entityChecks)
field :: ( BeamMigrateSqlBackend be
, FieldReturnType 'False 'False be resTy a )
=> Text -> DataType be resTy -> a
field :: forall be resTy a.
(BeamMigrateSqlBackend be,
FieldReturnType 'False 'False be resTy a) =>
Text -> DataType be resTy -> a
field Text
name (DataType Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
ty) = forall (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a.
(FieldReturnType defaultGiven collationGiven be resTy a,
BeamMigrateSqlBackend be) =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
field' (forall {k} (t :: k). Proxy t
Proxy @'False) (forall {k} (t :: k). Proxy t
Proxy @'False) Text
name Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
ty forall a. Maybe a
Nothing forall a. Maybe a
Nothing []
newtype DefaultValue be a = DefaultValue (BeamSqlBackendExpressionSyntax be)
defaultTo_ :: BeamMigrateSqlBackend be
=> (forall s. QExpr be s a)
-> DefaultValue be a
defaultTo_ :: forall be a.
BeamMigrateSqlBackend be =>
(forall s. QExpr be s a) -> DefaultValue be a
defaultTo_ (QExpr Text -> BeamSqlBackendExpressionSyntax be
e) =
forall be a. BeamSqlBackendExpressionSyntax be -> DefaultValue be a
DefaultValue (Text -> BeamSqlBackendExpressionSyntax be
e Text
"t")
newtype Constraint be
= Constraint (BeamSqlBackendConstraintSyntax be)
newtype NotNullConstraint be
= NotNullConstraint (Constraint be)
notNull :: BeamMigrateSqlBackend be => NotNullConstraint be
notNull :: forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull = forall be. Constraint be -> NotNullConstraint be
NotNullConstraint (forall be. BeamSqlBackendConstraintSyntax be -> Constraint be
Constraint forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
notNullConstraintSyntax)
unique :: BeamMigrateSqlBackend be => Constraint be
unique :: forall be. BeamMigrateSqlBackend be => Constraint be
unique = forall be. BeamSqlBackendConstraintSyntax be -> Constraint be
Constraint forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
uniqueColumnConstraintSyntax
class FieldReturnType (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a | a -> be resTy where
field' :: BeamMigrateSqlBackend be
=> Proxy defaultGiven -> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text -> [ BeamSqlBackendColumnConstraintDefinitionSyntax be ]
-> a
instance FieldReturnType 'True collationGiven be resTy a =>
FieldReturnType 'False collationGiven be resTy (DefaultValue be resTy -> a) where
field' :: BeamMigrateSqlBackend be =>
Proxy 'False
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DefaultValue be resTy
-> a
field' Proxy 'False
_ Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
_ Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints (DefaultValue BeamSqlBackendExpressionSyntax be
e) =
forall (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a.
(FieldReturnType defaultGiven collationGiven be resTy a,
BeamMigrateSqlBackend be) =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
field' (forall {k} (t :: k). Proxy t
Proxy @'True) Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty (forall a. a -> Maybe a
Just BeamSqlBackendExpressionSyntax be
e) Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints
instance FieldReturnType defaultGiven collationGiven be resTy a =>
FieldReturnType defaultGiven collationGiven be resTy (Constraint be -> a) where
field' :: BeamMigrateSqlBackend be =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> Constraint be
-> a
field' Proxy defaultGiven
defaultGiven Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
default_' Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints (Constraint BeamSqlBackendConstraintSyntax be
e) =
forall (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a.
(FieldReturnType defaultGiven collationGiven be resTy a,
BeamMigrateSqlBackend be) =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
field' Proxy defaultGiven
defaultGiven Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
default_' Maybe Text
collation ([BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints forall a. [a] -> [a] -> [a]
++ [ forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
(Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
constraintDefinitionSyntax forall a. Maybe a
Nothing BeamSqlBackendConstraintSyntax be
e forall a. Maybe a
Nothing ])
instance ( FieldReturnType defaultGiven collationGiven be resTy (Constraint be -> a)
, IsNotNull resTy ) =>
FieldReturnType defaultGiven collationGiven be resTy (NotNullConstraint be -> a) where
field' :: BeamMigrateSqlBackend be =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> NotNullConstraint be
-> a
field' Proxy defaultGiven
defaultGiven Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
default_' Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints (NotNullConstraint Constraint be
c) =
forall (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a.
(FieldReturnType defaultGiven collationGiven be resTy a,
BeamMigrateSqlBackend be) =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
field' Proxy defaultGiven
defaultGiven Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
default_' Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints Constraint be
c
instance ( FieldReturnType 'True collationGiven be resTy a
, TypeError ('Text "Only one DEFAULT clause can be given per 'field' invocation") ) =>
FieldReturnType 'True collationGiven be resTy (DefaultValue be resTy -> a) where
field' :: BeamMigrateSqlBackend be =>
Proxy 'True
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DefaultValue be resTy
-> a
field' = forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable because of GHC Custom Type Errors"
instance ( FieldReturnType defaultGiven collationGiven be resTy a
, TypeError ('Text "Only one type declaration allowed per 'field' invocation")) =>
FieldReturnType defaultGiven collationGiven be resTy (DataType be' x -> a) where
field' :: BeamMigrateSqlBackend be =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DataType be' x
-> a
field' = forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable because of GHC Custom Type Errors"
instance ( BeamMigrateSqlBackend be, HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) ) =>
FieldReturnType defaultGiven collationGiven be resTy (TableFieldSchema be resTy) where
field' :: BeamMigrateSqlBackend be =>
Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> TableFieldSchema be resTy
field' Proxy defaultGiven
_ Proxy collationGiven
_ Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
default_' Maybe Text
collation [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints =
forall be a.
Text -> FieldSchema be a -> [FieldCheck] -> TableFieldSchema be a
TableFieldSchema Text
nm (forall be a.
BeamSqlBackendColumnSchemaSyntax be -> FieldSchema be a
FieldSchema (forall columnSchema.
IsSql92ColumnSchemaSyntax columnSchema =>
Sql92ColumnSchemaColumnTypeSyntax columnSchema
-> Maybe (Sql92ColumnSchemaExpressionSyntax columnSchema)
-> [Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema]
-> Maybe Text
-> columnSchema
columnSchemaSyntax BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
default_' [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints Maybe Text
collation)) [FieldCheck]
checks
where checks :: [FieldCheck]
checks = [ (QualifiedName -> Text -> SomeDatabasePredicate) -> FieldCheck
FieldCheck (\QualifiedName
tbl Text
field'' -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
TableHasColumn QualifiedName
tbl Text
field'' BeamMigrateSqlBackendDataTypeSyntax be
ty :: TableHasColumn be)) ] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\BeamSqlBackendColumnConstraintDefinitionSyntax be
cns -> (QualifiedName -> Text -> SomeDatabasePredicate) -> FieldCheck
FieldCheck (\QualifiedName
tbl Text
field'' -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
TableColumnHasConstraint QualifiedName
tbl Text
field'' BeamSqlBackendColumnConstraintDefinitionSyntax be
cns :: TableColumnHasConstraint be))) [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints
type family IsNotNull (x :: *) :: Kind.Constraint where
IsNotNull (Maybe x) = TypeError ('Text "You used Database.Beam.Migrate.notNull on a column with type" ':$$:
'ShowType (Maybe x) ':$$:
'Text "Either remove 'notNull' from your migration or 'Maybe' from your table")
IsNotNull x = ()