{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Orville.PostgreSQL.Schema.ConstraintDefinition
( ConstraintDefinition
, uniqueConstraint
, foreignKeyConstraint
, foreignKeyConstraintWithOptions
, ForeignReference (ForeignReference, localFieldName, foreignFieldName)
, foreignReference
, ConstraintMigrationKey (ConstraintMigrationKey, constraintKeyType, constraintKeyColumns, constraintKeyForeignTable, constraintKeyForeignColumns, constraintKeyForeignKeyOnUpdateAction, constraintKeyForeignKeyOnDeleteAction)
, ConstraintKeyType (UniqueConstraint, ForeignKeyConstraint)
, constraintMigrationKey
, constraintSqlExpr
, ForeignKeyAction (..)
, ForeignKeyOptions (foreignKeyOptionsOnDelete, foreignKeyOptionsOnUpdate)
, defaultForeignKeyOptions
, TableConstraints
, emptyTableConstraints
, addConstraint
, tableConstraintDefinitions
, tableConstraintKeys
)
where
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Internal.FieldName as FieldName
import qualified Orville.PostgreSQL.Schema.TableIdentifier as TableIdentifier
newtype TableConstraints
= TableConstraints (Map.Map ConstraintMigrationKey ConstraintDefinition)
deriving (NonEmpty TableConstraints -> TableConstraints
TableConstraints -> TableConstraints -> TableConstraints
(TableConstraints -> TableConstraints -> TableConstraints)
-> (NonEmpty TableConstraints -> TableConstraints)
-> (forall b.
Integral b =>
b -> TableConstraints -> TableConstraints)
-> Semigroup TableConstraints
forall b. Integral b => b -> TableConstraints -> TableConstraints
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TableConstraints -> TableConstraints -> TableConstraints
<> :: TableConstraints -> TableConstraints -> TableConstraints
$csconcat :: NonEmpty TableConstraints -> TableConstraints
sconcat :: NonEmpty TableConstraints -> TableConstraints
$cstimes :: forall b. Integral b => b -> TableConstraints -> TableConstraints
stimes :: forall b. Integral b => b -> TableConstraints -> TableConstraints
Semigroup, Semigroup TableConstraints
TableConstraints
Semigroup TableConstraints
-> TableConstraints
-> (TableConstraints -> TableConstraints -> TableConstraints)
-> ([TableConstraints] -> TableConstraints)
-> Monoid TableConstraints
[TableConstraints] -> TableConstraints
TableConstraints -> TableConstraints -> TableConstraints
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: TableConstraints
mempty :: TableConstraints
$cmappend :: TableConstraints -> TableConstraints -> TableConstraints
mappend :: TableConstraints -> TableConstraints -> TableConstraints
$cmconcat :: [TableConstraints] -> TableConstraints
mconcat :: [TableConstraints] -> TableConstraints
Monoid)
emptyTableConstraints :: TableConstraints
emptyTableConstraints :: TableConstraints
emptyTableConstraints = Map ConstraintMigrationKey ConstraintDefinition -> TableConstraints
TableConstraints Map ConstraintMigrationKey ConstraintDefinition
forall k a. Map k a
Map.empty
addConstraint :: ConstraintDefinition -> TableConstraints -> TableConstraints
addConstraint :: ConstraintDefinition -> TableConstraints -> TableConstraints
addConstraint ConstraintDefinition
constraint (TableConstraints Map ConstraintMigrationKey ConstraintDefinition
constraintMap) =
Map ConstraintMigrationKey ConstraintDefinition -> TableConstraints
TableConstraints (Map ConstraintMigrationKey ConstraintDefinition
-> TableConstraints)
-> Map ConstraintMigrationKey ConstraintDefinition
-> TableConstraints
forall a b. (a -> b) -> a -> b
$
ConstraintMigrationKey
-> ConstraintDefinition
-> Map ConstraintMigrationKey ConstraintDefinition
-> Map ConstraintMigrationKey ConstraintDefinition
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
(ConstraintDefinition -> ConstraintMigrationKey
constraintMigrationKey ConstraintDefinition
constraint)
ConstraintDefinition
constraint
Map ConstraintMigrationKey ConstraintDefinition
constraintMap
tableConstraintKeys :: TableConstraints -> Set.Set ConstraintMigrationKey
tableConstraintKeys :: TableConstraints -> Set ConstraintMigrationKey
tableConstraintKeys (TableConstraints Map ConstraintMigrationKey ConstraintDefinition
constraints) =
Map ConstraintMigrationKey ConstraintDefinition
-> Set ConstraintMigrationKey
forall k a. Map k a -> Set k
Map.keysSet Map ConstraintMigrationKey ConstraintDefinition
constraints
tableConstraintDefinitions :: TableConstraints -> [ConstraintDefinition]
tableConstraintDefinitions :: TableConstraints -> [ConstraintDefinition]
tableConstraintDefinitions (TableConstraints Map ConstraintMigrationKey ConstraintDefinition
constraints) =
Map ConstraintMigrationKey ConstraintDefinition
-> [ConstraintDefinition]
forall k a. Map k a -> [a]
Map.elems Map ConstraintMigrationKey ConstraintDefinition
constraints
data ConstraintDefinition = ConstraintDefinition
{ ConstraintDefinition -> TableConstraint
_constraintSqlExpr :: Expr.TableConstraint
, ConstraintDefinition -> ConstraintMigrationKey
_constraintMigrationKey :: ConstraintMigrationKey
}
data ConstraintMigrationKey = ConstraintMigrationKey
{ ConstraintMigrationKey -> ConstraintKeyType
constraintKeyType :: ConstraintKeyType
, ConstraintMigrationKey -> Maybe [FieldName]
constraintKeyColumns :: Maybe [FieldName.FieldName]
, ConstraintMigrationKey -> Maybe TableIdentifier
constraintKeyForeignTable :: Maybe TableIdentifier.TableIdentifier
, ConstraintMigrationKey -> Maybe [FieldName]
constraintKeyForeignColumns :: Maybe [FieldName.FieldName]
, ConstraintMigrationKey -> Maybe ForeignKeyAction
constraintKeyForeignKeyOnUpdateAction :: Maybe ForeignKeyAction
, ConstraintMigrationKey -> Maybe ForeignKeyAction
constraintKeyForeignKeyOnDeleteAction :: Maybe ForeignKeyAction
}
deriving (ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
(ConstraintMigrationKey -> ConstraintMigrationKey -> Bool)
-> (ConstraintMigrationKey -> ConstraintMigrationKey -> Bool)
-> Eq ConstraintMigrationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
== :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
$c/= :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
/= :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
Eq, Eq ConstraintMigrationKey
Eq ConstraintMigrationKey
-> (ConstraintMigrationKey -> ConstraintMigrationKey -> Ordering)
-> (ConstraintMigrationKey -> ConstraintMigrationKey -> Bool)
-> (ConstraintMigrationKey -> ConstraintMigrationKey -> Bool)
-> (ConstraintMigrationKey -> ConstraintMigrationKey -> Bool)
-> (ConstraintMigrationKey -> ConstraintMigrationKey -> Bool)
-> (ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey)
-> (ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey)
-> Ord ConstraintMigrationKey
ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
ConstraintMigrationKey -> ConstraintMigrationKey -> Ordering
ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConstraintMigrationKey -> ConstraintMigrationKey -> Ordering
compare :: ConstraintMigrationKey -> ConstraintMigrationKey -> Ordering
$c< :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
< :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
$c<= :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
<= :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
$c> :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
> :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
$c>= :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
>= :: ConstraintMigrationKey -> ConstraintMigrationKey -> Bool
$cmax :: ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey
max :: ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey
$cmin :: ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey
min :: ConstraintMigrationKey
-> ConstraintMigrationKey -> ConstraintMigrationKey
Ord, Int -> ConstraintMigrationKey -> ShowS
[ConstraintMigrationKey] -> ShowS
ConstraintMigrationKey -> String
(Int -> ConstraintMigrationKey -> ShowS)
-> (ConstraintMigrationKey -> String)
-> ([ConstraintMigrationKey] -> ShowS)
-> Show ConstraintMigrationKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstraintMigrationKey -> ShowS
showsPrec :: Int -> ConstraintMigrationKey -> ShowS
$cshow :: ConstraintMigrationKey -> String
show :: ConstraintMigrationKey -> String
$cshowList :: [ConstraintMigrationKey] -> ShowS
showList :: [ConstraintMigrationKey] -> ShowS
Show)
data ConstraintKeyType
= UniqueConstraint
| ForeignKeyConstraint
deriving (ConstraintKeyType -> ConstraintKeyType -> Bool
(ConstraintKeyType -> ConstraintKeyType -> Bool)
-> (ConstraintKeyType -> ConstraintKeyType -> Bool)
-> Eq ConstraintKeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstraintKeyType -> ConstraintKeyType -> Bool
== :: ConstraintKeyType -> ConstraintKeyType -> Bool
$c/= :: ConstraintKeyType -> ConstraintKeyType -> Bool
/= :: ConstraintKeyType -> ConstraintKeyType -> Bool
Eq, Eq ConstraintKeyType
Eq ConstraintKeyType
-> (ConstraintKeyType -> ConstraintKeyType -> Ordering)
-> (ConstraintKeyType -> ConstraintKeyType -> Bool)
-> (ConstraintKeyType -> ConstraintKeyType -> Bool)
-> (ConstraintKeyType -> ConstraintKeyType -> Bool)
-> (ConstraintKeyType -> ConstraintKeyType -> Bool)
-> (ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType)
-> (ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType)
-> Ord ConstraintKeyType
ConstraintKeyType -> ConstraintKeyType -> Bool
ConstraintKeyType -> ConstraintKeyType -> Ordering
ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConstraintKeyType -> ConstraintKeyType -> Ordering
compare :: ConstraintKeyType -> ConstraintKeyType -> Ordering
$c< :: ConstraintKeyType -> ConstraintKeyType -> Bool
< :: ConstraintKeyType -> ConstraintKeyType -> Bool
$c<= :: ConstraintKeyType -> ConstraintKeyType -> Bool
<= :: ConstraintKeyType -> ConstraintKeyType -> Bool
$c> :: ConstraintKeyType -> ConstraintKeyType -> Bool
> :: ConstraintKeyType -> ConstraintKeyType -> Bool
$c>= :: ConstraintKeyType -> ConstraintKeyType -> Bool
>= :: ConstraintKeyType -> ConstraintKeyType -> Bool
$cmax :: ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType
max :: ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType
$cmin :: ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType
min :: ConstraintKeyType -> ConstraintKeyType -> ConstraintKeyType
Ord, Int -> ConstraintKeyType -> ShowS
[ConstraintKeyType] -> ShowS
ConstraintKeyType -> String
(Int -> ConstraintKeyType -> ShowS)
-> (ConstraintKeyType -> String)
-> ([ConstraintKeyType] -> ShowS)
-> Show ConstraintKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstraintKeyType -> ShowS
showsPrec :: Int -> ConstraintKeyType -> ShowS
$cshow :: ConstraintKeyType -> String
show :: ConstraintKeyType -> String
$cshowList :: [ConstraintKeyType] -> ShowS
showList :: [ConstraintKeyType] -> ShowS
Show)
constraintMigrationKey :: ConstraintDefinition -> ConstraintMigrationKey
constraintMigrationKey :: ConstraintDefinition -> ConstraintMigrationKey
constraintMigrationKey = ConstraintDefinition -> ConstraintMigrationKey
_constraintMigrationKey
constraintSqlExpr :: ConstraintDefinition -> Expr.TableConstraint
constraintSqlExpr :: ConstraintDefinition -> TableConstraint
constraintSqlExpr = ConstraintDefinition -> TableConstraint
_constraintSqlExpr
uniqueConstraint :: NonEmpty FieldName.FieldName -> ConstraintDefinition
uniqueConstraint :: NonEmpty FieldName -> ConstraintDefinition
uniqueConstraint NonEmpty FieldName
fieldNames =
let
expr :: TableConstraint
expr =
NonEmpty ColumnName -> TableConstraint
Expr.uniqueConstraint (NonEmpty ColumnName -> TableConstraint)
-> (NonEmpty FieldName -> NonEmpty ColumnName)
-> NonEmpty FieldName
-> TableConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName -> ColumnName)
-> NonEmpty FieldName -> NonEmpty ColumnName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> ColumnName
FieldName.fieldNameToColumnName (NonEmpty FieldName -> TableConstraint)
-> NonEmpty FieldName -> TableConstraint
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldName
fieldNames
migrationKey :: ConstraintMigrationKey
migrationKey =
ConstraintMigrationKey
{ constraintKeyType :: ConstraintKeyType
constraintKeyType = ConstraintKeyType
UniqueConstraint
, constraintKeyColumns :: Maybe [FieldName]
constraintKeyColumns = [FieldName] -> Maybe [FieldName]
forall a. a -> Maybe a
Just (NonEmpty FieldName -> [FieldName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty FieldName
fieldNames)
, constraintKeyForeignTable :: Maybe TableIdentifier
constraintKeyForeignTable = Maybe TableIdentifier
forall a. Maybe a
Nothing
, constraintKeyForeignColumns :: Maybe [FieldName]
constraintKeyForeignColumns = Maybe [FieldName]
forall a. Maybe a
Nothing
, constraintKeyForeignKeyOnUpdateAction :: Maybe ForeignKeyAction
constraintKeyForeignKeyOnUpdateAction = Maybe ForeignKeyAction
forall a. Maybe a
Nothing
, constraintKeyForeignKeyOnDeleteAction :: Maybe ForeignKeyAction
constraintKeyForeignKeyOnDeleteAction = Maybe ForeignKeyAction
forall a. Maybe a
Nothing
}
in
ConstraintDefinition
{ _constraintSqlExpr :: TableConstraint
_constraintSqlExpr = TableConstraint
expr
, _constraintMigrationKey :: ConstraintMigrationKey
_constraintMigrationKey = ConstraintMigrationKey
migrationKey
}
data ForeignReference = ForeignReference
{ ForeignReference -> FieldName
localFieldName :: FieldName.FieldName
, ForeignReference -> FieldName
foreignFieldName :: FieldName.FieldName
}
foreignReference ::
FieldName.FieldName ->
FieldName.FieldName ->
ForeignReference
foreignReference :: FieldName -> FieldName -> ForeignReference
foreignReference FieldName
localName FieldName
foreignName =
ForeignReference
{ localFieldName :: FieldName
localFieldName = FieldName
localName
, foreignFieldName :: FieldName
foreignFieldName = FieldName
foreignName
}
data ForeignKeyOptions = ForeignKeyOptions
{ ForeignKeyOptions -> ForeignKeyAction
foreignKeyOptionsOnUpdate :: ForeignKeyAction
, ForeignKeyOptions -> ForeignKeyAction
foreignKeyOptionsOnDelete :: ForeignKeyAction
}
defaultForeignKeyOptions :: ForeignKeyOptions
defaultForeignKeyOptions :: ForeignKeyOptions
defaultForeignKeyOptions =
ForeignKeyOptions
{ foreignKeyOptionsOnUpdate :: ForeignKeyAction
foreignKeyOptionsOnUpdate = ForeignKeyAction
NoAction
, foreignKeyOptionsOnDelete :: ForeignKeyAction
foreignKeyOptionsOnDelete = ForeignKeyAction
NoAction
}
data ForeignKeyAction
= NoAction
| Restrict
| Cascade
| SetNull
| SetDefault
deriving (Int -> ForeignKeyAction -> ShowS
[ForeignKeyAction] -> ShowS
ForeignKeyAction -> String
(Int -> ForeignKeyAction -> ShowS)
-> (ForeignKeyAction -> String)
-> ([ForeignKeyAction] -> ShowS)
-> Show ForeignKeyAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForeignKeyAction -> ShowS
showsPrec :: Int -> ForeignKeyAction -> ShowS
$cshow :: ForeignKeyAction -> String
show :: ForeignKeyAction -> String
$cshowList :: [ForeignKeyAction] -> ShowS
showList :: [ForeignKeyAction] -> ShowS
Show, ForeignKeyAction -> ForeignKeyAction -> Bool
(ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> Eq ForeignKeyAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignKeyAction -> ForeignKeyAction -> Bool
== :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c/= :: ForeignKeyAction -> ForeignKeyAction -> Bool
/= :: ForeignKeyAction -> ForeignKeyAction -> Bool
Eq, Eq ForeignKeyAction
Eq ForeignKeyAction
-> (ForeignKeyAction -> ForeignKeyAction -> Ordering)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> Bool)
-> (ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction)
-> (ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction)
-> Ord ForeignKeyAction
ForeignKeyAction -> ForeignKeyAction -> Bool
ForeignKeyAction -> ForeignKeyAction -> Ordering
ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForeignKeyAction -> ForeignKeyAction -> Ordering
compare :: ForeignKeyAction -> ForeignKeyAction -> Ordering
$c< :: ForeignKeyAction -> ForeignKeyAction -> Bool
< :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c<= :: ForeignKeyAction -> ForeignKeyAction -> Bool
<= :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c> :: ForeignKeyAction -> ForeignKeyAction -> Bool
> :: ForeignKeyAction -> ForeignKeyAction -> Bool
$c>= :: ForeignKeyAction -> ForeignKeyAction -> Bool
>= :: ForeignKeyAction -> ForeignKeyAction -> Bool
$cmax :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
max :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
$cmin :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
min :: ForeignKeyAction -> ForeignKeyAction -> ForeignKeyAction
Ord)
foreignKeyActionToExpr :: ForeignKeyAction -> Maybe Expr.ForeignKeyActionExpr
foreignKeyActionToExpr :: ForeignKeyAction -> Maybe ForeignKeyActionExpr
foreignKeyActionToExpr ForeignKeyAction
action = case ForeignKeyAction
action of
ForeignKeyAction
NoAction -> Maybe ForeignKeyActionExpr
forall a. Maybe a
Nothing
ForeignKeyAction
Restrict -> ForeignKeyActionExpr -> Maybe ForeignKeyActionExpr
forall a. a -> Maybe a
Just ForeignKeyActionExpr
Expr.restrictExpr
ForeignKeyAction
Cascade -> ForeignKeyActionExpr -> Maybe ForeignKeyActionExpr
forall a. a -> Maybe a
Just ForeignKeyActionExpr
Expr.cascadeExpr
ForeignKeyAction
SetNull -> ForeignKeyActionExpr -> Maybe ForeignKeyActionExpr
forall a. a -> Maybe a
Just ForeignKeyActionExpr
Expr.setNullExpr
ForeignKeyAction
SetDefault -> ForeignKeyActionExpr -> Maybe ForeignKeyActionExpr
forall a. a -> Maybe a
Just ForeignKeyActionExpr
Expr.setDefaultExpr
foreignKeyConstraint ::
TableIdentifier.TableIdentifier ->
NonEmpty ForeignReference ->
ConstraintDefinition
foreignKeyConstraint :: TableIdentifier
-> NonEmpty ForeignReference -> ConstraintDefinition
foreignKeyConstraint TableIdentifier
foreignTableId NonEmpty ForeignReference
foreignReferences =
TableIdentifier
-> NonEmpty ForeignReference
-> ForeignKeyOptions
-> ConstraintDefinition
foreignKeyConstraintWithOptions TableIdentifier
foreignTableId NonEmpty ForeignReference
foreignReferences ForeignKeyOptions
defaultForeignKeyOptions
foreignKeyConstraintWithOptions ::
TableIdentifier.TableIdentifier ->
NonEmpty ForeignReference ->
ForeignKeyOptions ->
ConstraintDefinition
foreignKeyConstraintWithOptions :: TableIdentifier
-> NonEmpty ForeignReference
-> ForeignKeyOptions
-> ConstraintDefinition
foreignKeyConstraintWithOptions TableIdentifier
foreignTableId NonEmpty ForeignReference
foreignReferences ForeignKeyOptions
options =
let
localFieldNames :: NonEmpty FieldName
localFieldNames =
ForeignReference -> FieldName
localFieldName (ForeignReference -> FieldName)
-> NonEmpty ForeignReference -> NonEmpty FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ForeignReference
foreignReferences
foreignFieldNames :: NonEmpty FieldName
foreignFieldNames =
ForeignReference -> FieldName
foreignFieldName (ForeignReference -> FieldName)
-> NonEmpty ForeignReference -> NonEmpty FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ForeignReference
foreignReferences
updateAction :: ForeignKeyAction
updateAction = ForeignKeyOptions -> ForeignKeyAction
foreignKeyOptionsOnUpdate ForeignKeyOptions
options
deleteAction :: ForeignKeyAction
deleteAction = ForeignKeyOptions -> ForeignKeyAction
foreignKeyOptionsOnDelete ForeignKeyOptions
options
onUpdateExpr :: Maybe ForeignKeyUpdateActionExpr
onUpdateExpr = (ForeignKeyActionExpr -> ForeignKeyUpdateActionExpr)
-> Maybe ForeignKeyActionExpr -> Maybe ForeignKeyUpdateActionExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignKeyActionExpr -> ForeignKeyUpdateActionExpr
Expr.foreignKeyUpdateActionExpr (Maybe ForeignKeyActionExpr -> Maybe ForeignKeyUpdateActionExpr)
-> Maybe ForeignKeyActionExpr -> Maybe ForeignKeyUpdateActionExpr
forall a b. (a -> b) -> a -> b
$ ForeignKeyAction -> Maybe ForeignKeyActionExpr
foreignKeyActionToExpr ForeignKeyAction
updateAction
onDeleteExpr :: Maybe ForeignKeyDeleteActionExpr
onDeleteExpr = (ForeignKeyActionExpr -> ForeignKeyDeleteActionExpr)
-> Maybe ForeignKeyActionExpr -> Maybe ForeignKeyDeleteActionExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignKeyActionExpr -> ForeignKeyDeleteActionExpr
Expr.foreignKeyDeleteActionExpr (Maybe ForeignKeyActionExpr -> Maybe ForeignKeyDeleteActionExpr)
-> Maybe ForeignKeyActionExpr -> Maybe ForeignKeyDeleteActionExpr
forall a b. (a -> b) -> a -> b
$ ForeignKeyAction -> Maybe ForeignKeyActionExpr
foreignKeyActionToExpr ForeignKeyAction
deleteAction
expr :: TableConstraint
expr =
NonEmpty ColumnName
-> Qualified TableName
-> NonEmpty ColumnName
-> Maybe ForeignKeyUpdateActionExpr
-> Maybe ForeignKeyDeleteActionExpr
-> TableConstraint
Expr.foreignKeyConstraint
((FieldName -> ColumnName)
-> NonEmpty FieldName -> NonEmpty ColumnName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> ColumnName
FieldName.fieldNameToColumnName NonEmpty FieldName
localFieldNames)
(TableIdentifier -> Qualified TableName
TableIdentifier.tableIdQualifiedName TableIdentifier
foreignTableId)
((FieldName -> ColumnName)
-> NonEmpty FieldName -> NonEmpty ColumnName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> ColumnName
FieldName.fieldNameToColumnName NonEmpty FieldName
foreignFieldNames)
Maybe ForeignKeyUpdateActionExpr
onUpdateExpr
Maybe ForeignKeyDeleteActionExpr
onDeleteExpr
migrationKey :: ConstraintMigrationKey
migrationKey =
ConstraintMigrationKey
{ constraintKeyType :: ConstraintKeyType
constraintKeyType = ConstraintKeyType
ForeignKeyConstraint
, constraintKeyColumns :: Maybe [FieldName]
constraintKeyColumns = [FieldName] -> Maybe [FieldName]
forall a. a -> Maybe a
Just (NonEmpty FieldName -> [FieldName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty FieldName
localFieldNames)
, constraintKeyForeignTable :: Maybe TableIdentifier
constraintKeyForeignTable = TableIdentifier -> Maybe TableIdentifier
forall a. a -> Maybe a
Just TableIdentifier
foreignTableId
, constraintKeyForeignColumns :: Maybe [FieldName]
constraintKeyForeignColumns = [FieldName] -> Maybe [FieldName]
forall a. a -> Maybe a
Just (NonEmpty FieldName -> [FieldName]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty FieldName
foreignFieldNames)
, constraintKeyForeignKeyOnUpdateAction :: Maybe ForeignKeyAction
constraintKeyForeignKeyOnUpdateAction = ForeignKeyAction -> Maybe ForeignKeyAction
forall a. a -> Maybe a
Just ForeignKeyAction
updateAction
, constraintKeyForeignKeyOnDeleteAction :: Maybe ForeignKeyAction
constraintKeyForeignKeyOnDeleteAction = ForeignKeyAction -> Maybe ForeignKeyAction
forall a. a -> Maybe a
Just ForeignKeyAction
deleteAction
}
in
ConstraintDefinition
{ _constraintSqlExpr :: TableConstraint
_constraintSqlExpr = TableConstraint
expr
, _constraintMigrationKey :: ConstraintMigrationKey
_constraintMigrationKey = ConstraintMigrationKey
migrationKey
}