{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
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

{- |
  A collection of constraints to be added to a table. This collection is
  indexed by 'ConstraintMigrationKey'. If multiple constraints with the same
  'ConstraintMigrationKey' are added, the most recently-added one will be kept
  and the previous one dropped.

@since 1.0.0.0
-}
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)

{- |
  Constructs an empty 'TableConstraints'.

@since 1.0.0.0
-}
emptyTableConstraints :: TableConstraints
emptyTableConstraints :: TableConstraints
emptyTableConstraints = Map ConstraintMigrationKey ConstraintDefinition -> TableConstraints
TableConstraints Map ConstraintMigrationKey ConstraintDefinition
forall k a. Map k a
Map.empty

{- |
  Adds a 'ConstraintDefinition' to an existing 'TableConstraints'. If a
  constraint already exists with the same 'ConstraintMigrationKey', it is
  replaced with the new constraint.

@since 1.0.0.0
-}
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

{- |
  Gets the list of 'ConstraintDefinition's that have been added to the
  'TableConstraints'.

@since 1.0.0.0
-}
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

{- |
  Gets the list of 'ConstraintDefinition's that have been added to the
  'TableConstraints'.

@since 1.0.0.0
-}
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

{- |
  Defines a constraint that can be added to a
  'Orville.PostgreSQL.TableDefinition'. Use one of the constructor functions
  below (such as 'uniqueConstraint') to construct the constraint definition you
  wish to have and then use 'Orville.PostgreSQL.addTableConstraints' to add
  them to your table definition. Orville will then add the constraint next time
  you run auto-migrations.

@since 1.0.0.0
-}
data ConstraintDefinition = ConstraintDefinition
  { ConstraintDefinition -> TableConstraint
_constraintSqlExpr :: Expr.TableConstraint
  , ConstraintDefinition -> ConstraintMigrationKey
_constraintMigrationKey :: ConstraintMigrationKey
  }

{- |
  The key used by Orville to determine whether a constraint should be added to
  a table when performing auto-migrations. For most use cases, the constructor
  functions that build a 'ConstraintDefinition' will create this automatically
  for you.

@since 1.0.0.0
-}
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)

{- |
  The kind of constraint that is described by a 'ConstraintMigrationKey' (e.g.
  unique, foreign key).

@since 1.0.0.0
-}
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)

{- |
  Gets the 'ConstraintMigrationKey' for the 'ConstraintDefinition'.

@since 1.0.0.0
-}
constraintMigrationKey :: ConstraintDefinition -> ConstraintMigrationKey
constraintMigrationKey :: ConstraintDefinition -> ConstraintMigrationKey
constraintMigrationKey = ConstraintDefinition -> ConstraintMigrationKey
_constraintMigrationKey

{- |
  Gets the SQL expression that will be used to add the constraint to the table.

@since 1.0.0.0
-}
constraintSqlExpr :: ConstraintDefinition -> Expr.TableConstraint
constraintSqlExpr :: ConstraintDefinition -> TableConstraint
constraintSqlExpr = ConstraintDefinition -> TableConstraint
_constraintSqlExpr

{- |
  Constructs a 'ConstraintDefinition' for a @UNIQUE@ constraint on the given
  columns.

@since 1.0.0.0
-}
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
      }

{- |
  A 'ForeignReference' represents one part of a foreign key. The entire foreign
  key may comprise multiple columns. The 'ForeignReference' defines a single
  column in the key and which column it references in the foreign table.

@since 1.0.0.0
-}
data ForeignReference = ForeignReference
  { ForeignReference -> FieldName
localFieldName :: FieldName.FieldName
  , ForeignReference -> FieldName
foreignFieldName :: FieldName.FieldName
  }

{- |
  Constructs a 'ForeignReference'.

@since 1.0.0.0
-}
foreignReference ::
  -- | The name of the field in the table with the constraint.
  FieldName.FieldName ->
  -- | The name of the field in the foreign table that the local field references.
  FieldName.FieldName ->
  ForeignReference
foreignReference :: FieldName -> FieldName -> ForeignReference
foreignReference FieldName
localName FieldName
foreignName =
  ForeignReference
    { localFieldName :: FieldName
localFieldName = FieldName
localName
    , foreignFieldName :: FieldName
foreignFieldName = FieldName
foreignName
    }

{- |
  Defines the options for a foreign key constraint. To construct
  'ForeignKeyOptions', perform a record update on 'defaultForeignKeyOptions'.

@since 1.0.0.0
-}
data ForeignKeyOptions = ForeignKeyOptions
  { ForeignKeyOptions -> ForeignKeyAction
foreignKeyOptionsOnUpdate :: ForeignKeyAction
  -- ^ The @ON UPDATE@ action for the foreign key.
  , ForeignKeyOptions -> ForeignKeyAction
foreignKeyOptionsOnDelete :: ForeignKeyAction
  -- ^ The @ON DELETE@ action for the foreign key.
  }

{- |
  The default 'ForeignKeyOptions', containing 'NoAction' for both
  'foreignKeyOptionsOnUpdate' and 'foreignKeyOptionsOnDelete'.

@since 1.0.0.0
-}
defaultForeignKeyOptions :: ForeignKeyOptions
defaultForeignKeyOptions :: ForeignKeyOptions
defaultForeignKeyOptions =
  ForeignKeyOptions
    { foreignKeyOptionsOnUpdate :: ForeignKeyAction
foreignKeyOptionsOnUpdate = ForeignKeyAction
NoAction
    , foreignKeyOptionsOnDelete :: ForeignKeyAction
foreignKeyOptionsOnDelete = ForeignKeyAction
NoAction
    }

{- |
  The actions that can be set on 'ForeignKeyOptions'.

@since 1.0.0.0
-}
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

{- |
  Builds a 'ConstraintDefinition' for a @FOREIGN KEY@ constraint.

@since 1.0.0.0
-}
foreignKeyConstraint ::
  -- | Identifier of the table referenced by the foreign key.
  TableIdentifier.TableIdentifier ->
  -- | The columns constrained by the foreign key and those that they reference in the foreign table.
  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

{- |
  Builds a 'ConstraintDefinition' for a @FOREIGN KEY@ constraint, with
  ON UPDATE and ON DELETE actions.

@since 1.0.0.0
-}
foreignKeyConstraintWithOptions ::
  -- | Identifier of the table referenced by the foreign key.
  TableIdentifier.TableIdentifier ->
  -- | The columns constrained by the foreign key and those that they reference in the foreign table.
  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
      }