{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Database.Beam.Migrate.SQL.Tables
  ( -- * Table manipulation

    -- ** Creation and deletion
    createTable, createTableWithSchema 
  , dropTable
  , preserve

    -- ** @ALTER TABLE@
  , TableMigration(..)
  , ColumnMigration(..)
  , alterTable

  , renameTableTo, renameColumnTo
  , addColumn, dropColumn

    -- * Schema manipulation
  , DatabaseSchema(databaseSchemaName), createDatabaseSchema, dropDatabaseSchema, existingDatabaseSchema

    -- * Field specification
  , DefaultValue, Constraint(..), NotNullConstraint

  , field

  , defaultTo_, notNull, unique

    -- ** Internal classes
    --    Provided without documentation for use in type signatures
  , 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.Coerce (coerce)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Typeable
import qualified Data.Kind as Kind (Constraint)

import GHC.TypeLits

import Lens.Micro ((^.))

-- * Table manipulation

-- | Add a @CREATE TABLE@ statement to this migration
--
--   The first argument is the name of the table.
--
--   The second argument is a table containing a 'FieldSchema' for each field.
--   See documentation on the 'Field' command for more information.
--
--   To create a table in a specific schema, see 'createTableWithSchema'.
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 = Maybe DatabaseSchema
-> Text
-> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable table, Table table, BeamMigrateSqlBackend be) =>
Maybe DatabaseSchema
-> Text
-> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTableWithSchema Maybe DatabaseSchema
forall a. Maybe a
Nothing

-- * Schema manipulation

-- | Represents a database schema. To create one, see 'createDatabaseSchema'; 
--   to materialize one, see 'existingDatabaseSchema'.
newtype DatabaseSchema 
  = DatabaseSchema{DatabaseSchema -> Text
databaseSchemaName :: Text}
  deriving (DatabaseSchema -> DatabaseSchema -> Bool
(DatabaseSchema -> DatabaseSchema -> Bool)
-> (DatabaseSchema -> DatabaseSchema -> Bool) -> Eq DatabaseSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatabaseSchema -> DatabaseSchema -> Bool
== :: DatabaseSchema -> DatabaseSchema -> Bool
$c/= :: DatabaseSchema -> DatabaseSchema -> Bool
/= :: DatabaseSchema -> DatabaseSchema -> Bool
Eq, Int -> DatabaseSchema -> ShowS
[DatabaseSchema] -> ShowS
DatabaseSchema -> String
(Int -> DatabaseSchema -> ShowS)
-> (DatabaseSchema -> String)
-> ([DatabaseSchema] -> ShowS)
-> Show DatabaseSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatabaseSchema -> ShowS
showsPrec :: Int -> DatabaseSchema -> ShowS
$cshow :: DatabaseSchema -> String
show :: DatabaseSchema -> String
$cshowList :: [DatabaseSchema] -> ShowS
showList :: [DatabaseSchema] -> ShowS
Show)

-- | Add a @CREATE SCHEMA@ statement to this migration
--
--   To create a table in a specific schema, see 'createTableWithSchema'.
--   To drop a schema, see 'dropDatabaseSchema'.
--   To materialize an existing schema for use in a migration, see 'existingDatabaseSchema'.
createDatabaseSchema :: BeamMigrateSchemaSqlBackend be
                     => Text
                     -> Migration be DatabaseSchema
createDatabaseSchema :: forall be.
BeamMigrateSchemaSqlBackend be =>
Text -> Migration be DatabaseSchema
createDatabaseSchema Text
nm = do
  BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (Sql92DdlCommandCreateSchemaSyntax (BeamSqlBackendSyntax be)
-> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlSchemaCommandSyntax syntax =>
Sql92DdlCommandCreateSchemaSyntax syntax -> syntax
createSchemaCmd (Sql92CreateSchemaSchemaNameSyntax
  (Sql92DdlCommandCreateSchemaSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandCreateSchemaSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92CreateSchemaSyntax syntax =>
Sql92CreateSchemaSchemaNameSyntax syntax -> syntax
createSchemaSyntax (Text
-> Sql92CreateSchemaSchemaNameSyntax
     (Sql92DdlCommandCreateSchemaSyntax (BeamSqlBackendSyntax be))
forall schemaName.
IsSql92SchemaNameSyntax schemaName =>
Text -> schemaName
schemaName Text
nm))) Maybe (BeamSqlBackendSyntax be)
forall a. Maybe a
Nothing
  DatabaseSchema -> Migration be DatabaseSchema
forall a. a -> F (MigrationF be) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseSchema -> Migration be DatabaseSchema)
-> DatabaseSchema -> Migration be DatabaseSchema
forall a b. (a -> b) -> a -> b
$ Text -> DatabaseSchema
DatabaseSchema Text
nm

-- | Add a @DROP SCHEMA@ statement to this migration.
--
--   Depending on the backend, this may fail if the schema is not empty. 
--
--   To create a schema, see 'createDatabaseSchema'.
--   To materialize a 'DatabaseSchema', see 'existingDatabaseSchema
dropDatabaseSchema :: BeamMigrateSchemaSqlBackend be
                   => DatabaseSchema
                   -> Migration be ()
dropDatabaseSchema :: forall be.
BeamMigrateSchemaSqlBackend be =>
DatabaseSchema -> Migration be ()
dropDatabaseSchema (DatabaseSchema Text
nm) 
  = BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (Sql92DdlCommandDropSchemaSyntax (BeamSqlBackendSyntax be)
-> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlSchemaCommandSyntax syntax =>
Sql92DdlCommandDropSchemaSyntax syntax -> syntax
dropSchemaCmd (Sql92DropSchemaSchemaNameSyntax
  (Sql92DdlCommandDropSchemaSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandDropSchemaSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92DropSchemaSyntax syntax =>
Sql92DropSchemaSchemaNameSyntax syntax -> syntax
dropSchemaSyntax (Text
-> Sql92DropSchemaSchemaNameSyntax
     (Sql92DdlCommandDropSchemaSyntax (BeamSqlBackendSyntax be))
forall schemaName.
IsSql92SchemaNameSyntax schemaName =>
Text -> schemaName
schemaName Text
nm))) Maybe (BeamSqlBackendSyntax be)
forall a. Maybe a
Nothing

-- | Materialize a schema for use during a migration.
--
--   Example usage, where @NewDB@ has one more table than @OldDB@ in the @my_schema@ schema:
--
-- @
-- migrationStep :: 'CheckedDatabaseSettings' be OldDB
--               -> 'Migration' be ('CheckedDatabaseSettings' be NewDB)
-- migrationStep (OldDB oldtable)= do
--   schema <- 'existingDatabaseSchema' "my_schema"
--   pure $ NewDB \<$\> pure oldtable
--                \<*\> 'createTableWithSchema' (Just schema) "my_table"
-- @
existingDatabaseSchema :: Text -> Migration be DatabaseSchema
existingDatabaseSchema :: forall be. Text -> Migration be DatabaseSchema
existingDatabaseSchema = DatabaseSchema -> F (MigrationF be) DatabaseSchema
forall a. a -> F (MigrationF be) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseSchema -> F (MigrationF be) DatabaseSchema)
-> (Text -> DatabaseSchema)
-> Text
-> F (MigrationF be) DatabaseSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DatabaseSchema
DatabaseSchema

-- | Add a @CREATE TABLE@ statement to this migration, with an explicit schema
--
--   The first argument is the name of the schema, while the second argument is the name of the table.
--
--   The second argument is a table containing a 'FieldSchema' for each field.
--   See documentation on the 'Field' command for more information.
--
--   Note that the database schema is expected to exist; see 'createDatabaseSchema' to create
--   a database schema.
createTableWithSchema :: ( Beamable table, Table table
                         , BeamMigrateSqlBackend be )
                      => Maybe DatabaseSchema -- ^ Schema name, if any
                      -> Text       -- ^ Table name 
                      -> TableSchema be table
                      -> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTableWithSchema :: forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Beamable table, Table table, BeamMigrateSqlBackend be) =>
Maybe DatabaseSchema
-> Text
-> TableSchema be table
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
createTableWithSchema Maybe DatabaseSchema
maybeSchemaName Text
newTblName TableSchema be table
tblSettings =
  do let pkFields :: [Text]
pkFields = (forall a. Columnar' (TableFieldSchema be) a -> Text)
-> PrimaryKey table (TableFieldSchema be) -> [Text]
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) (TableSchema be table -> PrimaryKey table (TableFieldSchema be)
forall (column :: * -> *). table column -> PrimaryKey table column
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey TableSchema be table
tblSettings)
         tblConstraints :: [Sql92CreateTableTableConstraintSyntax
   (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))]
tblConstraints = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
pkFields then [] else [ [Text]
-> Sql92CreateTableTableConstraintSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
forall constraint.
IsSql92TableConstraintSyntax constraint =>
[Text] -> constraint
primaryKeyConstraintSyntax [Text]
pkFields ]
         createTableCommand :: Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)
createTableCommand =
           Maybe
  (Sql92CreateTableOptionsSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))
-> Sql92CreateTableTableNameSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
-> [(Text,
     Sql92CreateTableColumnSchemaSyntax
       (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))]
-> [Sql92CreateTableTableConstraintSyntax
      (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))]
-> Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92CreateTableSyntax syntax =>
Maybe (Sql92CreateTableOptionsSyntax syntax)
-> Sql92CreateTableTableNameSyntax syntax
-> [(Text, Sql92CreateTableColumnSchemaSyntax syntax)]
-> [Sql92CreateTableTableConstraintSyntax syntax]
-> syntax
createTableSyntax Maybe
  (Sql92CreateTableOptionsSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))
forall a. Maybe a
Nothing (Maybe Text
-> Text
-> Sql92CreateTableTableNameSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName (DatabaseSchema -> Text
forall a b. Coercible a b => a -> b
coerce (DatabaseSchema -> Text) -> Maybe DatabaseSchema -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DatabaseSchema
maybeSchemaName) Text
newTblName)
                             ((forall a.
 Columnar' (TableFieldSchema be) a
 -> (Text,
     Sql92CreateTableColumnSchemaSyntax
       (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
-> TableSchema be table
-> [(Text,
     Sql92CreateTableColumnSchemaSyntax
       (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))]
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 = Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)
-> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandCreateTableSyntax syntax -> syntax
createTableCmd Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)
createTableCommand

         tbl' :: table (TableField table)
tbl' = (forall a.
 Columnar' (TableFieldSchema be) a
 -> Columnar' (TableField table) a)
-> TableSchema be table -> table (TableField table)
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]
_)) -> Columnar (TableField table) a -> Columnar' (TableField table) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField table a
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name) Text
name)) TableSchema be table
tblSettings

         fieldChecks :: table (Const [FieldCheck])
fieldChecks = (forall a.
 Columnar' (TableFieldSchema be) a
 -> Columnar' (Const [FieldCheck]) a)
-> TableSchema be table -> table (Const [FieldCheck])
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)) -> Columnar (Const [FieldCheck]) a -> Columnar' (Const [FieldCheck]) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ([FieldCheck] -> Const [FieldCheck] a
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)
_ -> SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just (TableExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName -> TableExistsPredicate
TableExistsPredicate QualifiedName
tblName))) ] [TableCheck] -> [TableCheck] -> [TableCheck]
forall a. [a] -> [a] -> [a]
++
                     [TableCheck]
primaryKeyCheck

         primaryKeyCheck :: [TableCheck]
primaryKeyCheck =
           case (forall a. Columnar' (TableFieldSchema be) a -> Text)
-> PrimaryKey table (TableFieldSchema be) -> [Text]
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) (TableSchema be table -> PrimaryKey table (TableFieldSchema be)
forall (column :: * -> *). table column -> PrimaryKey table column
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)
_ -> SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just (TableHasPrimaryKey -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName -> [Text] -> TableHasPrimaryKey
TableHasPrimaryKey QualifiedName
tblName [Text]
cols))) ]
         
         -- If a schema has been defined explicitly, then it should be part of checks
         schemaCheck :: [SomeDatabasePredicate]
schemaCheck = 
            case Maybe DatabaseSchema
maybeSchemaName of
              Maybe DatabaseSchema
Nothing -> []
              Just (DatabaseSchema Text
sn) -> [ SchemaExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (Text -> SchemaExistsPredicate
SchemaExistsPredicate Text
sn) ] 

     BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown BeamSqlBackendSyntax be
command Maybe (BeamSqlBackendSyntax be)
forall a. Maybe a
Nothing
     CheckedDatabaseEntity be db (TableEntity table)
-> Migration be (CheckedDatabaseEntity be db (TableEntity table))
forall a. a -> F (MigrationF be) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckedDatabaseEntityDescriptor be (TableEntity table)
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db (TableEntity table)
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity 
            (DatabaseEntityDescriptor be (TableEntity table)
-> [TableCheck]
-> table (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity table)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable 
              (Maybe Text
-> Text
-> Text
-> table (TableField table)
-> DatabaseEntityDescriptor be (TableEntity table)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
DatabaseTable (DatabaseSchema -> Text
forall a b. Coercible a b => a -> b
coerce (DatabaseSchema -> Text) -> Maybe DatabaseSchema -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DatabaseSchema
maybeSchemaName) Text
newTblName Text
newTblName table (TableField table)
tbl') 
              [TableCheck]
tblChecks 
              table (Const [FieldCheck])
fieldChecks
            ) 
            [SomeDatabasePredicate]
schemaCheck
          )

-- | Add a @DROP TABLE@ statement to this migration.
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 = 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 (DatabaseEntityDescriptor be (TableEntity table)
-> Sql92DropTableTableNameSyntax
     (Sql92DdlCommandDropTableSyntax (BeamSqlBackendSyntax be))
forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt))
  in BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown BeamSqlBackendSyntax be
command Maybe (BeamSqlBackendSyntax be)
forall a. Maybe a
Nothing

-- | Copy a table schema from one database to another
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) = CheckedDatabaseEntity be db' e
-> F (MigrationF be) (CheckedDatabaseEntity be db' e)
forall a. a -> F (MigrationF be) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckedDatabaseEntityDescriptor be e
-> [SomeDatabasePredicate] -> CheckedDatabaseEntity be db' e
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be e
desc [SomeDatabasePredicate]
checks)

-- * Alter table

-- | A column in the process of being altered
data ColumnMigration a
  = ColumnMigration
  { forall a. ColumnMigration a -> Text
columnMigrationFieldName :: Text
  , forall a. ColumnMigration a -> [FieldCheck]
columnMigrationFieldChecks :: [FieldCheck] }

-- | Monad representing a series of @ALTER TABLE@ statements
newtype TableMigration be a
  = TableMigration (WriterT [BeamSqlBackendAlterTableSyntax be] (State (TableName, [TableCheck])) a)
  deriving (Applicative (TableMigration be)
Applicative (TableMigration be) =>
(forall a b.
 TableMigration be a
 -> (a -> TableMigration be b) -> TableMigration be b)
-> (forall a b.
    TableMigration be a -> TableMigration be b -> TableMigration be b)
-> (forall a. a -> TableMigration be a)
-> Monad (TableMigration be)
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
$c>>= :: forall be a b.
TableMigration be a
-> (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 -> TableMigration be b -> TableMigration be b
>> :: forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
$creturn :: forall be a. a -> TableMigration be a
return :: forall a. a -> TableMigration be a
Monad, Functor (TableMigration be)
Functor (TableMigration be) =>
(forall a. a -> TableMigration be a)
-> (forall 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 a b.
    TableMigration be a -> TableMigration be b -> TableMigration be b)
-> (forall a b.
    TableMigration be a -> TableMigration be b -> TableMigration be a)
-> Applicative (TableMigration be)
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
$cpure :: forall be a. a -> TableMigration be a
pure :: forall a. a -> TableMigration be a
$c<*> :: forall be a b.
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
<*> :: forall a b.
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
$cliftA2 :: forall be a b c.
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
liftA2 :: forall a b c.
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
$c*> :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
*> :: 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 a
<* :: forall a b.
TableMigration be a -> TableMigration be b -> TableMigration be a
Applicative, (forall a b.
 (a -> b) -> TableMigration be a -> TableMigration be b)
-> (forall a b. a -> TableMigration be b -> TableMigration be a)
-> Functor (TableMigration be)
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
$cfmap :: forall be a b.
(a -> b) -> TableMigration be a -> TableMigration be b
fmap :: forall a b. (a -> b) -> TableMigration be a -> TableMigration be b
$c<$ :: forall be a b. a -> TableMigration be b -> TableMigration be a
<$ :: forall a b. a -> TableMigration be b -> TableMigration be a
Functor)

-- | @ALTER TABLE ... RENAME TO@ command
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 = WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (table ColumnMigration)
-> TableMigration be (table ColumnMigration)
forall be a.
WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  a
-> TableMigration be a
TableMigration (WriterT
   [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
   (State (TableName, [TableCheck]))
   (table ColumnMigration)
 -> TableMigration be (table ColumnMigration))
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     (table ColumnMigration)
-> TableMigration be (table ColumnMigration)
forall a b. (a -> b) -> a -> b
$ do
  (TableName Maybe Text
curSchema Text
curNm, [TableCheck]
chks) <- WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax
  (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm) (Text
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> syntax
renameTableToSyntax Text
newName) ]
  (TableName, [TableCheck])
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe Text -> Text -> TableName
TableName Maybe Text
curSchema Text
curNm, [TableCheck]
chks)
  table ColumnMigration
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     (table ColumnMigration)
forall a.
a
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return table ColumnMigration
oldTbl

-- | @ALTER TABLE ... RENAME COLUMN ... TO ...@ command
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 = WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (ColumnMigration a)
-> TableMigration be (ColumnMigration a)
forall be a.
WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  a
-> TableMigration be a
TableMigration (WriterT
   [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
   (State (TableName, [TableCheck]))
   (ColumnMigration a)
 -> TableMigration be (ColumnMigration a))
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     (ColumnMigration a)
-> TableMigration be (ColumnMigration a)
forall a b. (a -> b) -> a -> b
$ do
  (TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_) <- WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax
  (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm)
           (Text
-> Text
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> Text -> syntax
renameColumnToSyntax (ColumnMigration a -> Text
forall a. ColumnMigration a -> Text
columnMigrationFieldName ColumnMigration a
column) Text
newName) ]
  ColumnMigration a
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     (ColumnMigration a)
forall a.
a
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnMigration a
column { columnMigrationFieldName = newName }

-- | @ALTER TABLE ... DROP COLUMN ...@ command
dropColumn :: BeamMigrateSqlBackend be
           => ColumnMigration a -> TableMigration be ()
dropColumn :: forall be a.
BeamMigrateSqlBackend be =>
ColumnMigration a -> TableMigration be ()
dropColumn ColumnMigration a
column = WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  ()
-> TableMigration be ()
forall be a.
WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  a
-> TableMigration be a
TableMigration (WriterT
   [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
   (State (TableName, [TableCheck]))
   ()
 -> TableMigration be ())
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     ()
-> TableMigration be ()
forall a b. (a -> b) -> a -> b
$ do
  (TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_)<- WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax
  (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm)
           (Text
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> syntax
dropColumnSyntax (ColumnMigration a -> Text
forall a. ColumnMigration a -> Text
columnMigrationFieldName ColumnMigration a
column)) ]

-- | @ALTER TABLE ... ADD COLUMN ...@ command
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) =
  WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (ColumnMigration a)
-> TableMigration be (ColumnMigration a)
forall be a.
WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  a
-> TableMigration be a
TableMigration (WriterT
   [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
   (State (TableName, [TableCheck]))
   (ColumnMigration a)
 -> TableMigration be (ColumnMigration a))
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     (ColumnMigration a)
-> TableMigration be (ColumnMigration a)
forall a b. (a -> b) -> a -> b
$
  do (TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_) <- WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax
  (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
-> Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm) (Text
-> Sql92AlterTableColumnSchemaSyntax
     (Sql92AlterTableAlterTableActionSyntax
        (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)))
-> Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be))
forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> Sql92AlterTableColumnSchemaSyntax syntax -> syntax
addColumnSyntax Text
nm Sql92AlterTableColumnSchemaSyntax
  (Sql92AlterTableAlterTableActionSyntax
     (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)))
Sql92CreateTableColumnSchemaSyntax
  (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
fieldSchemaSyntax) ]
     ColumnMigration a
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     (ColumnMigration a)
forall a.
a
-> WriterT
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
     (State (TableName, [TableCheck]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [FieldCheck] -> ColumnMigration a
forall a. Text -> [FieldCheck] -> ColumnMigration a
ColumnMigration Text
nm [FieldCheck]
checks)

-- | Compose a series of @ALTER TABLE@ commands
--
--   Example usage
--
-- @
-- migrate (OldDb oldTbl) = do
--   alterTable oldTbl $ \oldTbl' ->
--     field2 <- renameColumnTo "NewNameForField2" (_field2 oldTbl')
--     dropColumn (_field3 oldTbl')
--     renameTableTo "NewTableName"
--     field4 <- addColumn (field "ANewColumn" smallint notNull (defaultTo_ (val_ 0)))
--     return (NewTable (_field1 oldTbl') field2 field4)
-- @
--
--   The above would result in commands like:
--
-- @
-- ALTER TABLE <oldtable> RENAME COLUMN <field2> TO "NewNameForField2";
-- ALTER TABLE <oldtable> DROP COLUMN <field3>;
-- ALTER TABLE <oldtable> RENAME TO "NewTableName";
-- ALTER TABLE "NewTableName" ADD COLUMN "ANewColumn" SMALLINT NOT NULL DEFAULT 0;
-- @
--
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 = Identity (table ColumnMigration) -> table ColumnMigration
forall a. Identity a -> a
runIdentity (Identity (table ColumnMigration) -> table ColumnMigration)
-> Identity (table ColumnMigration) -> table ColumnMigration
forall a b. (a -> b) -> a -> b
$
                  (forall a.
 Columnar' (TableField table) a
 -> Columnar' (Const [FieldCheck]) a
 -> Identity (Columnar' ColumnMigration a))
-> table (TableField table)
-> table (Const [FieldCheck])
-> Identity (table ColumnMigration)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
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) ->
                         Columnar' ColumnMigration a
-> Identity (Columnar' ColumnMigration a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar ColumnMigration a -> Columnar' ColumnMigration a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Text -> [FieldCheck] -> ColumnMigration a
forall a. Text -> [FieldCheck] -> ColumnMigration a
ColumnMigration (Columnar (TableField table) a
TableField table a
fd TableField table a
-> Getting Text (TableField table a) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TableField table a) Text
forall (table :: (* -> *) -> *) ty (f :: * -> *).
Functor f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldName) [FieldCheck]
checks)
                               :: Columnar' ColumnMigration x))
                      (DatabaseEntityDescriptor be (TableEntity table)
-> table (TableField table)
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt) table (Const [FieldCheck])
tblFieldChecks

     TableMigration WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (table' ColumnMigration)
alterColumns' = table ColumnMigration -> TableMigration be (table' ColumnMigration)
alterColumns table ColumnMigration
initialTbl
     ((table' ColumnMigration
newTbl, [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
cmds), (TableName Maybe Text
tblSchema' Text
tblNm', [TableCheck]
tblChecks')) =
       State
  (TableName, [TableCheck])
  (table' ColumnMigration,
   [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)])
-> (TableName, [TableCheck])
-> ((table' ColumnMigration,
     [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]),
    (TableName, [TableCheck]))
forall s a. State s a -> s -> (a, s)
runState (WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (table' ColumnMigration)
-> State
     (TableName, [TableCheck])
     (table' ColumnMigration,
      [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
  [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
  (State (TableName, [TableCheck]))
  (table' ColumnMigration)
alterColumns')
                ( Maybe Text -> Text -> TableName
TableName (DatabaseEntityDescriptor be (TableEntity table) -> Maybe Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor be (TableEntity table)
dt) (DatabaseEntityDescriptor be (TableEntity table) -> Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity table)
dt)
                , [TableCheck]
tblChecks )

     fieldChecks' :: table' (Const [FieldCheck])
fieldChecks' = (forall a.
 Columnar' ColumnMigration a -> Columnar' (Const [FieldCheck]) a)
-> table' ColumnMigration -> table' (Const [FieldCheck])
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) ->
                                     Columnar (Const [FieldCheck]) a -> Columnar' (Const [FieldCheck]) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ([FieldCheck] -> Const [FieldCheck] a
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 a.
 Columnar' ColumnMigration a -> Columnar' (TableField table') a)
-> table' ColumnMigration -> TableSettings table'
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) ->
                              Columnar (TableField table') a -> Columnar' (TableField table') a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (NonEmpty Text -> Text -> TableField table' a
forall (table :: (* -> *) -> *) ty.
NonEmpty Text -> Text -> TableField table ty
TableField (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
nm) Text
nm) :: Columnar' (TableField table') a)
                          table' ColumnMigration
newTbl
 in [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
-> (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
    -> F (MigrationF be) ())
-> F (MigrationF be) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)]
cmds (\Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
cmd -> BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> F (MigrationF be) ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
-> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandAlterTableSyntax syntax -> syntax
alterTableCmd Sql92DdlCommandAlterTableSyntax (BeamSqlBackendSyntax be)
cmd) Maybe (BeamSqlBackendSyntax be)
forall a. Maybe a
Nothing) F (MigrationF be) ()
-> F (MigrationF be)
     (CheckedDatabaseEntity be db' (TableEntity table'))
-> F (MigrationF be)
     (CheckedDatabaseEntity be db' (TableEntity table'))
forall a b.
F (MigrationF be) a -> F (MigrationF be) b -> F (MigrationF be) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    CheckedDatabaseEntity be db' (TableEntity table')
-> F (MigrationF be)
     (CheckedDatabaseEntity be db' (TableEntity table'))
forall a. a -> F (MigrationF be) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckedDatabaseEntityDescriptor be (TableEntity table')
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db' (TableEntity table')
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity (DatabaseEntityDescriptor be (TableEntity table')
-> [TableCheck]
-> table' (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity table')
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable
                                  (Maybe Text
-> Text
-> Text
-> TableSettings table'
-> DatabaseEntityDescriptor be (TableEntity table')
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
Maybe Text
-> Text
-> Text
-> TableSettings tbl
-> DatabaseEntityDescriptor be (TableEntity tbl)
DatabaseTable Maybe Text
tblSchema' (DatabaseEntityDescriptor be (TableEntity table) -> Text
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)

-- * Fields

-- | Build a schema for a field. This function takes the name and type of the
-- field and a variable number of modifiers, such as constraints and default
-- values. GHC will complain at you if the modifiers do not make sense. For
-- example, you cannot apply the 'notNull' constraint to a column with a 'Maybe'
-- type.
--
-- Example of creating a table named "Employee" with three columns: "FirstName",
-- "LastName", and "HireDate"
--
-- @
-- data Employee f =
--   Employee { _firstName :: C f Text
--            , _lastName  :: C f Text
--            , _hireDate  :: C f (Maybe LocalTime)
--            } deriving Generic
-- instance Beamable Employee
--
-- instance Table Employee where
--    data PrimaryKey Employee f = EmployeeKey (C f Text) (C f Text) deriving Generic
--    primaryKey = EmployeeKey \<$\> _firstName \<*\> _lastName
--
-- instance Beamable PrimaryKey Employee f
--
-- data EmployeeDb entity
--     = EmployeeDb { _employees :: entity (TableEntity Employee) }
--     deriving Generic
-- instance Database EmployeeDb
--
-- migration :: IsSql92DdlCommandSyntax syntax => Migration syntax () EmployeeDb
-- migration = do
--   employees <- createTable "EmployeesTable"
--                  (Employee (field "FirstNameField" (varchar (Just 15)) notNull)
--                            (field "last_name" (varchar Nothing) notNull (defaultTo_ (val_ "Smith")))
--                            (field "hiredDate" (maybeType timestamp)))
--   return (EmployeeDb employees)
-- @
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
  (Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
ty) = Proxy 'False
-> Proxy 'False
-> Text
-> Sql92ColumnSchemaColumnTypeSyntax
     (Sql92CreateTableColumnSchemaSyntax
        (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))
-> Maybe
     (Sql92SelectTableExpressionSyntax
        (Sql92SelectSelectTableSyntax
           (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> Maybe Text
-> [Sql92ColumnSchemaColumnConstraintDefinitionSyntax
      (Sql92CreateTableColumnSchemaSyntax
         (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))]
-> a
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 (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @'False) (forall (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @'False) Text
name Sql92ExpressionCastTargetSyntax
  (Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
Sql92ColumnSchemaColumnTypeSyntax
  (Sql92CreateTableColumnSchemaSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))
ty Maybe
  (Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing []

-- ** Default values

-- | Represents the default value of a field with a given column schema syntax and type
newtype DefaultValue be a = DefaultValue (BeamSqlBackendExpressionSyntax be)

-- | Build a 'DefaultValue' from a 'QExpr'. GHC will complain if you supply more
-- than one default value.
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) =
  BeamSqlBackendExpressionSyntax be -> DefaultValue be a
forall be a. BeamSqlBackendExpressionSyntax be -> DefaultValue be a
DefaultValue (Text -> BeamSqlBackendExpressionSyntax be
e Text
"t")

-- ** Constraints

-- | Represents a constraint in the given column schema syntax
newtype Constraint be
  = Constraint (BeamSqlBackendConstraintSyntax be)

newtype NotNullConstraint be
  = NotNullConstraint (Constraint be)

-- | The SQL92 @NOT NULL@ constraint
notNull :: BeamMigrateSqlBackend be => NotNullConstraint be
notNull :: forall be. BeamMigrateSqlBackend be => NotNullConstraint be
notNull = Constraint be -> NotNullConstraint be
forall be. Constraint be -> NotNullConstraint be
NotNullConstraint (Sql92ColumnConstraintDefinitionConstraintSyntax
  (Sql92ColumnSchemaColumnConstraintDefinitionSyntax
     (Sql92CreateTableColumnSchemaSyntax
        (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
-> Constraint be
forall be. BeamSqlBackendConstraintSyntax be -> Constraint be
Constraint Sql92ColumnConstraintDefinitionConstraintSyntax
  (Sql92ColumnSchemaColumnConstraintDefinitionSyntax
     (Sql92CreateTableColumnSchemaSyntax
        (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
notNullConstraintSyntax)

-- | SQL @UNIQUE@ constraint
unique :: BeamMigrateSqlBackend be => Constraint be
unique :: forall be. BeamMigrateSqlBackend be => Constraint be
unique = Sql92ColumnConstraintDefinitionConstraintSyntax
  (Sql92ColumnSchemaColumnConstraintDefinitionSyntax
     (Sql92CreateTableColumnSchemaSyntax
        (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
-> Constraint be
forall be. BeamSqlBackendConstraintSyntax be -> Constraint be
Constraint Sql92ColumnConstraintDefinitionConstraintSyntax
  (Sql92ColumnSchemaColumnConstraintDefinitionSyntax
     (Sql92CreateTableColumnSchemaSyntax
        (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
uniqueColumnConstraintSyntax

-- ** 'field' variable arity classes

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) =
    Proxy 'True
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
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 (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @'True) Proxy collationGiven
collationGiven Text
nm BeamMigrateSqlBackendDataTypeSyntax be
ty (BeamSqlBackendExpressionSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
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) =
    Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
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 [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
forall a. [a] -> [a] -> [a]
++ [ Maybe Text
-> BeamSqlBackendConstraintSyntax be
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        (BeamSqlBackendColumnConstraintDefinitionSyntax be))
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing BeamSqlBackendConstraintSyntax be
e Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     (BeamSqlBackendColumnConstraintDefinitionSyntax be))
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) =
    Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> Constraint be
-> a
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' = String
-> Proxy 'True
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DefaultValue be resTy
-> a
forall a. HasCallStack => String -> a
error String
"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' = String
-> Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DataType be' x
-> a
forall a. HasCallStack => String -> a
error String
"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 =
    Text
-> FieldSchema be resTy
-> [FieldCheck]
-> TableFieldSchema be resTy
forall be a.
Text -> FieldSchema be a -> [FieldCheck] -> TableFieldSchema be a
TableFieldSchema Text
nm (Sql92CreateTableColumnSchemaSyntax
  (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
-> FieldSchema be resTy
forall be a.
BeamSqlBackendColumnSchemaSyntax be -> FieldSchema be a
FieldSchema (BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe
     (Sql92ColumnSchemaExpressionSyntax
        (Sql92CreateTableColumnSchemaSyntax
           (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> Maybe Text
-> Sql92CreateTableColumnSchemaSyntax
     (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))
forall columnSchema.
IsSql92ColumnSchemaSyntax columnSchema =>
Sql92ColumnSchemaColumnTypeSyntax columnSchema
-> Maybe (Sql92ColumnSchemaExpressionSyntax columnSchema)
-> [Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema]
-> Maybe Text
-> columnSchema
columnSchemaSyntax BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
Maybe
  (Sql92ColumnSchemaExpressionSyntax
     (Sql92CreateTableColumnSchemaSyntax
        (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))))
default_' [BeamSqlBackendColumnConstraintDefinitionSyntax be]
constraints Maybe Text
collation)) [FieldCheck]
checks
    where checks :: [FieldCheck]
checks = [ (QualifiedName -> Text -> SomeDatabasePredicate) -> FieldCheck
FieldCheck (\QualifiedName
tbl Text
field'' -> TableHasColumn be -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
TableHasColumn QualifiedName
tbl Text
field'' BeamMigrateSqlBackendDataTypeSyntax be
ty :: TableHasColumn be)) ] [FieldCheck] -> [FieldCheck] -> [FieldCheck]
forall a. [a] -> [a] -> [a]
++
                   (BeamSqlBackendColumnConstraintDefinitionSyntax be -> FieldCheck)
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> [FieldCheck]
forall a b. (a -> b) -> [a] -> [b]
map (\BeamSqlBackendColumnConstraintDefinitionSyntax be
cns -> (QualifiedName -> Text -> SomeDatabasePredicate) -> FieldCheck
FieldCheck (\QualifiedName
tbl Text
field'' -> TableColumnHasConstraint be -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
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 :: Type) :: 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 = ()