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

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

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

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

  , renameTableTo, renameColumnTo
  , addColumn, dropColumn

    -- * 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.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 ((^.))

-- * 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.c
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 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 (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey TableSchema be table
tblSettings)
         tblConstraints :: [Sql92CreateTableTableConstraintSyntax
   (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))]
tblConstraints = if [Text] -> 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 Maybe Text
forall a. Maybe a
Nothing 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 (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 (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))) ]

     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 (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 Maybe Text
forall a. Maybe a
Nothing Text
newTblName Text
newTblName table (TableField table)
tbl') [TableCheck]
tblChecks table (Const [FieldCheck])
fieldChecks) [])

-- | 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 (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
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, 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
<* :: 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 -> 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
<$ :: 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)

-- | @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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ColumnMigration a
column { columnMigrationFieldName :: Text
columnMigrationFieldName = Text
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 (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 (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 (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.
Lens' (TableField table ty) Text
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 (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 (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 (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
  (Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
ty) = Proxy 'False
-> Proxy 'False
-> Text
-> Sql92DdlCommandDataTypeSyntax (BeamSqlBackendSyntax be)
-> Maybe (Sql92ExpressionSyntax (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
  (Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
Sql92DdlCommandDataTypeSyntax (BeamSqlBackendSyntax be)
ty Maybe (Sql92ExpressionSyntax (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 (Sql92UpdateExpressionSyntax
  (Sql92UpdateSyntax (BeamSqlBackendSyntax be))
-> Maybe
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
forall a. a -> Maybe a
Just BeamSqlBackendExpressionSyntax be
Sql92UpdateExpressionSyntax
  (Sql92UpdateSyntax (BeamSqlBackendSyntax 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 Sql92ColumnConstraintDefinitionConstraintSyntax
  (BeamSqlBackendColumnConstraintDefinitionSyntax 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
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     (BeamSqlBackendColumnConstraintDefinitionSyntax 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 Sql92ColumnConstraintDefinitionConstraintSyntax
  (BeamSqlBackendColumnConstraintDefinitionSyntax 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' = [Char]
-> Proxy 'True
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DefaultValue be resTy
-> a
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' = [Char]
-> Proxy defaultGiven
-> Proxy collationGiven
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> Maybe Text
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> DataType be' x
-> a
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 =
    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 :: *) :: 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 = ()