{-# 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 :: 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 name _ _)) -> 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 name (FieldSchema schema) _)) -> (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 name _ _)) -> 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 _ _ 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 name _ _)) -> 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 :: CheckedDatabaseEntity be db (TableEntity table) -> Migration be ()
dropTable (CheckedDatabaseEntity (CheckedDatabaseTable dt _ _) [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 :: CheckedDatabaseEntity be db e
-> Migration be (CheckedDatabaseEntity be db' e)
preserve (CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be e
desc [SomeDatabasePredicate]
checks) = CheckedDatabaseEntity be db' e
-> Migration 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
  { ColumnMigration a -> Text
columnMigrationFieldName :: Text
  , 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)
a -> TableMigration be a
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)
TableMigration be a
-> (a -> TableMigration be b) -> TableMigration be b
TableMigration be a -> TableMigration be b -> TableMigration be b
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 :: a -> TableMigration be a
$creturn :: forall be a. a -> TableMigration be a
>> :: TableMigration be a -> TableMigration be b -> TableMigration be b
$c>> :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be 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
$cp1Monad :: forall be. Applicative (TableMigration be)
Monad, Functor (TableMigration be)
a -> TableMigration be a
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)
TableMigration be a -> TableMigration be b -> TableMigration be b
TableMigration be a -> TableMigration be b -> TableMigration be a
TableMigration be (a -> b)
-> TableMigration be a -> TableMigration be b
(a -> b -> c)
-> TableMigration be a
-> TableMigration be b
-> TableMigration be c
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
<* :: TableMigration be a -> TableMigration be b -> TableMigration be a
$c<* :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be a
*> :: TableMigration be a -> TableMigration be b -> TableMigration be b
$c*> :: forall be a b.
TableMigration be a -> TableMigration be b -> TableMigration be b
liftA2 :: (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
<*> :: 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 :: a -> TableMigration be a
$cpure :: forall be a. a -> TableMigration be a
$cp1Applicative :: forall be. Functor (TableMigration be)
Applicative, a -> TableMigration be b -> TableMigration be a
(a -> b) -> TableMigration be a -> TableMigration be b
(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
<$ :: a -> TableMigration be b -> TableMigration be a
$c<$ :: forall be a b. a -> TableMigration be b -> TableMigration be a
fmap :: (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 :: Text
-> table ColumnMigration
-> TableMigration be (table ColumnMigration)
renameTableTo Text
newName table ColumnMigration
oldTbl = WriterT
  [BeamSqlBackendAlterTableSyntax 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
   [BeamSqlBackendAlterTableSyntax be]
   (State (TableName, [TableCheck]))
   (table ColumnMigration)
 -> TableMigration be (table ColumnMigration))
-> WriterT
     [BeamSqlBackendAlterTableSyntax 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
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
  [BeamSqlBackendAlterTableSyntax be]
-> WriterT
     [BeamSqlBackendAlterTableSyntax be]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax (BeamSqlBackendAlterTableSyntax be)
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be)
-> BeamSqlBackendAlterTableSyntax be
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (BeamSqlBackendAlterTableSyntax be)
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm) (Text
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be)
forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> syntax
renameTableToSyntax Text
newName) ]
  (TableName, [TableCheck])
-> WriterT
     [BeamSqlBackendAlterTableSyntax 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
     [BeamSqlBackendAlterTableSyntax 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 :: Text -> ColumnMigration a -> TableMigration be (ColumnMigration a)
renameColumnTo Text
newName ColumnMigration a
column = WriterT
  [BeamSqlBackendAlterTableSyntax 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
   [BeamSqlBackendAlterTableSyntax be]
   (State (TableName, [TableCheck]))
   (ColumnMigration a)
 -> TableMigration be (ColumnMigration a))
-> WriterT
     [BeamSqlBackendAlterTableSyntax 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
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
  [BeamSqlBackendAlterTableSyntax be]
-> WriterT
     [BeamSqlBackendAlterTableSyntax be]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax (BeamSqlBackendAlterTableSyntax be)
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be)
-> BeamSqlBackendAlterTableSyntax be
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (BeamSqlBackendAlterTableSyntax be)
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm)
           (Text
-> Text
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax 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
     [BeamSqlBackendAlterTableSyntax 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 :: ColumnMigration a -> TableMigration be ()
dropColumn ColumnMigration a
column = WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  ()
-> TableMigration be ()
forall be a.
WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  a
-> TableMigration be a
TableMigration (WriterT
   [BeamSqlBackendAlterTableSyntax be]
   (State (TableName, [TableCheck]))
   ()
 -> TableMigration be ())
-> WriterT
     [BeamSqlBackendAlterTableSyntax be]
     (State (TableName, [TableCheck]))
     ()
-> TableMigration be ()
forall a b. (a -> b) -> a -> b
$ do
  (TableName Maybe Text
curSchema Text
curNm, [TableCheck]
_)<- WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
  [BeamSqlBackendAlterTableSyntax be]
-> WriterT
     [BeamSqlBackendAlterTableSyntax be]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax (BeamSqlBackendAlterTableSyntax be)
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be)
-> BeamSqlBackendAlterTableSyntax be
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (BeamSqlBackendAlterTableSyntax be)
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm)
           (Text
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax 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 :: TableFieldSchema be a -> TableMigration be (ColumnMigration a)
addColumn (TableFieldSchema Text
nm (FieldSchema BeamSqlBackendColumnSchemaSyntax be
fieldSchemaSyntax) [FieldCheck]
checks) =
  WriterT
  [BeamSqlBackendAlterTableSyntax 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
   [BeamSqlBackendAlterTableSyntax be]
   (State (TableName, [TableCheck]))
   (ColumnMigration a)
 -> TableMigration be (ColumnMigration a))
-> WriterT
     [BeamSqlBackendAlterTableSyntax 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
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (TableName, [TableCheck])
forall s (m :: * -> *). MonadState s m => m s
get
     [BeamSqlBackendAlterTableSyntax be]
-> WriterT
     [BeamSqlBackendAlterTableSyntax be]
     (State (TableName, [TableCheck]))
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Sql92AlterTableTableNameSyntax (BeamSqlBackendAlterTableSyntax be)
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be)
-> BeamSqlBackendAlterTableSyntax be
forall syntax.
IsSql92AlterTableSyntax syntax =>
Sql92AlterTableTableNameSyntax syntax
-> Sql92AlterTableAlterTableActionSyntax syntax -> syntax
alterTableSyntax (Maybe Text
-> Text
-> Sql92AlterTableTableNameSyntax
     (BeamSqlBackendAlterTableSyntax be)
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
curSchema Text
curNm) (Text
-> Sql92AlterTableColumnSchemaSyntax
     (Sql92AlterTableAlterTableActionSyntax
        (BeamSqlBackendAlterTableSyntax be))
-> Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be)
forall syntax.
IsSql92AlterTableActionSyntax syntax =>
Text -> Sql92AlterTableColumnSchemaSyntax syntax -> syntax
addColumnSyntax Text
nm Sql92AlterTableColumnSchemaSyntax
  (Sql92AlterTableAlterTableActionSyntax
     (BeamSqlBackendAlterTableSyntax be))
BeamSqlBackendColumnSchemaSyntax be
fieldSchemaSyntax) ]
     ColumnMigration a
-> WriterT
     [BeamSqlBackendAlterTableSyntax 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 :: CheckedDatabaseEntity be db (TableEntity table)
-> (table ColumnMigration
    -> TableMigration be (table' ColumnMigration))
-> Migration be (CheckedDatabaseEntity be db' (TableEntity table'))
alterTable (CheckedDatabaseEntity (CheckedDatabaseTable dt tblChecks 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' fd :: Columnar' (TableField table) x)
                        (Columnar' (Const 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 be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt) table (Const [FieldCheck])
tblFieldChecks

     TableMigration WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (table' ColumnMigration)
alterColumns' = table ColumnMigration -> TableMigration be (table' ColumnMigration)
alterColumns table ColumnMigration
initialTbl
     ((table' ColumnMigration
newTbl, [BeamSqlBackendAlterTableSyntax be]
cmds), (TableName Maybe Text
tblSchema' Text
tblNm', [TableCheck]
tblChecks')) =
       State
  (TableName, [TableCheck])
  (table' ColumnMigration, [BeamSqlBackendAlterTableSyntax be])
-> (TableName, [TableCheck])
-> ((table' ColumnMigration, [BeamSqlBackendAlterTableSyntax be]),
    (TableName, [TableCheck]))
forall s a. State s a -> s -> (a, s)
runState (WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (table' ColumnMigration)
-> State
     (TableName, [TableCheck])
     (table' ColumnMigration, [BeamSqlBackendAlterTableSyntax be])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
  [BeamSqlBackendAlterTableSyntax be]
  (State (TableName, [TableCheck]))
  (table' ColumnMigration)
alterColumns')
                ( Maybe Text -> Text -> TableName
TableName (DatabaseEntityDescriptor be (TableEntity table) -> Maybe Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor be (TableEntity table)
dt) (DatabaseEntityDescriptor be (TableEntity table) -> Text
forall be (tbl :: (* -> *) -> *).
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 _ 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 nm _) :: 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 [BeamSqlBackendAlterTableSyntax be]
-> (BeamSqlBackendAlterTableSyntax be -> F (MigrationF be) ())
-> F (MigrationF be) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [BeamSqlBackendAlterTableSyntax be]
cmds (\BeamSqlBackendAlterTableSyntax be
cmd -> BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> F (MigrationF be) ()
forall be.
BeamSqlBackendSyntax be
-> Maybe (BeamSqlBackendSyntax be) -> Migration be ()
upDown (BeamSqlBackendAlterTableSyntax be -> BeamSqlBackendSyntax be
forall syntax.
IsSql92DdlCommandSyntax syntax =>
Sql92DdlCommandAlterTableSyntax syntax -> syntax
alterTableCmd BeamSqlBackendAlterTableSyntax be
cmd) Maybe (BeamSqlBackendSyntax be)
forall a. Maybe a
Nothing) F (MigrationF be) ()
-> Migration be (CheckedDatabaseEntity be db' (TableEntity table'))
-> Migration be (CheckedDatabaseEntity be db' (TableEntity table'))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    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
-> 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 be (tbl :: (* -> *) -> *).
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 :: Text -> DataType be resTy -> a
field Text
name (DataType BeamSqlBackendCastTargetSyntax be
ty) = Proxy 'False
-> Proxy 'False
-> 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 'False
forall k (t :: k). Proxy t
Proxy @'False) (Proxy 'False
forall k (t :: k). Proxy t
Proxy @'False) Text
name BeamSqlBackendCastTargetSyntax be
BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax 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 s. QExpr be s a) -> DefaultValue be a
defaultTo_ (QExpr 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 :: NotNullConstraint be
notNull = Constraint be -> NotNullConstraint be
forall be. Constraint be -> NotNullConstraint be
NotNullConstraint (BeamSqlBackendConstraintSyntax be -> Constraint be
forall be. BeamSqlBackendConstraintSyntax be -> Constraint be
Constraint BeamSqlBackendConstraintSyntax be
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
notNullConstraintSyntax)

-- | SQL @UNIQUE@ constraint
unique :: BeamMigrateSqlBackend be => Constraint be
unique :: Constraint be
unique = BeamSqlBackendConstraintSyntax be -> Constraint be
forall be. BeamSqlBackendConstraintSyntax be -> Constraint be
Constraint BeamSqlBackendConstraintSyntax 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' :: 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' (Proxy 'True
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' :: 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' :: 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' :: 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' :: 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' :: 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 (BeamSqlBackendColumnSchemaSyntax be -> FieldSchema be resTy
forall be a.
BeamSqlBackendColumnSchemaSyntax be -> FieldSchema be a
FieldSchema (BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe
     (Sql92ColumnSchemaExpressionSyntax
        (BeamSqlBackendColumnSchemaSyntax be))
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> Maybe Text
-> BeamSqlBackendColumnSchemaSyntax be
forall columnSchema.
IsSql92ColumnSchemaSyntax columnSchema =>
Sql92ColumnSchemaColumnTypeSyntax columnSchema
-> Maybe (Sql92ColumnSchemaExpressionSyntax columnSchema)
-> [Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema]
-> Maybe Text
-> columnSchema
columnSchemaSyntax BeamMigrateSqlBackendDataTypeSyntax be
ty Maybe (BeamSqlBackendExpressionSyntax be)
Maybe
  (Sql92ColumnSchemaExpressionSyntax
     (BeamSqlBackendColumnSchemaSyntax 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 = ()