{-|
Module: Squeal.PostgreSQL.Definition.Constraint
Description: constraint expressions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

constraint expressions
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , ConstraintKinds
  , DeriveAnyClass
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedLabels
  , OverloadedStrings
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeInType
  , TypeOperators
  , UndecidableSuperClasses
#-}

module Squeal.PostgreSQL.Definition.Constraint
  ( -- * Table Constraints
    TableConstraintExpression (..)
  , check
  , unique
  , primaryKey
    -- ** Foreign Keys
  , foreignKey
  , ForeignKeyed
  , OnDeleteClause (..)
  , OnUpdateClause (..)
  , ReferentialAction (..)
  ) where

import Control.DeepSeq
import Data.ByteString
import GHC.TypeLits

import qualified Generics.SOP as SOP
import qualified GHC.Generics as GHC

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL

-- | Data types are a way to limit the kind of data that can be stored in a
-- table. For many applications, however, the constraint they provide is
-- too coarse. For example, a column containing a product price should
-- probably only accept positive values. But there is no standard data type
-- that accepts only positive numbers. Another issue is that you might want
-- to constrain column data with respect to other columns or rows.
-- For example, in a table containing product information,
-- there should be only one row for each product number.
-- `TableConstraint`s give you as much control over the data in your tables
-- as you wish. If a user attempts to store data in a column that would
-- violate a constraint, an error is raised. This applies
-- even if the value came from the default value definition.
newtype TableConstraintExpression
  (sch :: Symbol)
  (tab :: Symbol)
  (db :: SchemasType)
  (constraint :: TableConstraint)
    = UnsafeTableConstraintExpression
    { TableConstraintExpression sch tab db constraint -> ByteString
renderTableConstraintExpression :: ByteString }
    deriving ((forall x.
 TableConstraintExpression sch tab db constraint
 -> Rep (TableConstraintExpression sch tab db constraint) x)
-> (forall x.
    Rep (TableConstraintExpression sch tab db constraint) x
    -> TableConstraintExpression sch tab db constraint)
-> Generic (TableConstraintExpression sch tab db constraint)
forall x.
Rep (TableConstraintExpression sch tab db constraint) x
-> TableConstraintExpression sch tab db constraint
forall x.
TableConstraintExpression sch tab db constraint
-> Rep (TableConstraintExpression sch tab db constraint) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint) x.
Rep (TableConstraintExpression sch tab db constraint) x
-> TableConstraintExpression sch tab db constraint
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint) x.
TableConstraintExpression sch tab db constraint
-> Rep (TableConstraintExpression sch tab db constraint) x
$cto :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint) x.
Rep (TableConstraintExpression sch tab db constraint) x
-> TableConstraintExpression sch tab db constraint
$cfrom :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint) x.
TableConstraintExpression sch tab db constraint
-> Rep (TableConstraintExpression sch tab db constraint) x
GHC.Generic,Int -> TableConstraintExpression sch tab db constraint -> ShowS
[TableConstraintExpression sch tab db constraint] -> ShowS
TableConstraintExpression sch tab db constraint -> String
(Int -> TableConstraintExpression sch tab db constraint -> ShowS)
-> (TableConstraintExpression sch tab db constraint -> String)
-> ([TableConstraintExpression sch tab db constraint] -> ShowS)
-> Show (TableConstraintExpression sch tab db constraint)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
Int -> TableConstraintExpression sch tab db constraint -> ShowS
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
[TableConstraintExpression sch tab db constraint] -> ShowS
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint -> String
showList :: [TableConstraintExpression sch tab db constraint] -> ShowS
$cshowList :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
[TableConstraintExpression sch tab db constraint] -> ShowS
show :: TableConstraintExpression sch tab db constraint -> String
$cshow :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint -> String
showsPrec :: Int -> TableConstraintExpression sch tab db constraint -> ShowS
$cshowsPrec :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
Int -> TableConstraintExpression sch tab db constraint -> ShowS
Show,TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
(TableConstraintExpression sch tab db constraint
 -> TableConstraintExpression sch tab db constraint -> Bool)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint -> Bool)
-> Eq (TableConstraintExpression sch tab db constraint)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
/= :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
$c/= :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
== :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
$c== :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
Eq,Eq (TableConstraintExpression sch tab db constraint)
Eq (TableConstraintExpression sch tab db constraint)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint -> Ordering)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint -> Bool)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint -> Bool)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint -> Bool)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint -> Bool)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint)
-> (TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint
    -> TableConstraintExpression sch tab db constraint)
-> Ord (TableConstraintExpression sch tab db constraint)
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Ordering
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
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
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
Eq (TableConstraintExpression sch tab db constraint)
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Ordering
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
min :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
$cmin :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
max :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
$cmax :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint
>= :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
$c>= :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
> :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
$c> :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
<= :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
$c<= :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
< :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
$c< :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Bool
compare :: TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Ordering
$ccompare :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint
-> TableConstraintExpression sch tab db constraint -> Ordering
$cp1Ord :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
Eq (TableConstraintExpression sch tab db constraint)
Ord,TableConstraintExpression sch tab db constraint -> ()
(TableConstraintExpression sch tab db constraint -> ())
-> NFData (TableConstraintExpression sch tab db constraint)
forall a. (a -> ()) -> NFData a
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint -> ()
rnf :: TableConstraintExpression sch tab db constraint -> ()
$crnf :: forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint -> ()
NFData)
instance RenderSQL
  (TableConstraintExpression sch tab db constraint) where
    renderSQL :: TableConstraintExpression sch tab db constraint -> ByteString
renderSQL = TableConstraintExpression sch tab db constraint -> ByteString
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
TableConstraintExpression sch tab db constraint -> ByteString
renderTableConstraintExpression

{-| A `check` constraint is the most generic `TableConstraint` type.
It allows you to specify that the value in a certain column must satisfy
a Boolean (truth-value) expression.

>>> :{
type Schema = '[
  "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
    "a" ::: 'NoDef :=> 'NotNull 'PGint4,
    "b" ::: 'NoDef :=> 'NotNull 'PGint4
  ])]
:}

>>> :{
let
  definition :: Definition (Public '[]) (Public Schema)
  definition = createTable #tab
    ( (int & notNullable) `as` #a :*
      (int & notNullable) `as` #b )
    ( check (#a :* #b) (#a .> #b) `as` #inequality )
:}

>>> printSQL definition
CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
-}
check
  :: ( Has sch db schema
     , Has tab schema ('Table table)
     , HasAll aliases (TableToRow table) subcolumns )
  => NP Alias aliases
  -- ^ specify the subcolumns which are getting checked
  -> (forall t. Condition 'Ungrouped '[] '[] db '[] '[t ::: subcolumns])
  -- ^ a closed `Condition` on those subcolumns
  -> TableConstraintExpression sch tab db ('Check aliases)
check :: NP Alias aliases
-> (forall (t :: Symbol).
    Condition 'Ungrouped '[] '[] db '[] '[t ::: subcolumns])
-> TableConstraintExpression sch tab db ('Check aliases)
check NP Alias aliases
_cols forall (t :: Symbol).
Condition 'Ungrouped '[] '[] db '[] '[t ::: subcolumns]
condition = ByteString -> TableConstraintExpression sch tab db ('Check aliases)
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
ByteString -> TableConstraintExpression sch tab db constraint
UnsafeTableConstraintExpression (ByteString
 -> TableConstraintExpression sch tab db ('Check aliases))
-> ByteString
-> TableConstraintExpression sch tab db ('Check aliases)
forall a b. (a -> b) -> a -> b
$
  ByteString
"CHECK" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (Condition 'Ungrouped '[] '[] db '[] '[Any ::: subcolumns]
-> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Condition 'Ungrouped '[] '[] db '[] '[Any ::: subcolumns]
forall (t :: Symbol).
Condition 'Ungrouped '[] '[] db '[] '[t ::: subcolumns]
condition)

{-| A `unique` constraint ensure that the data contained in a column,
or a group of columns, is unique among all the rows in the table.

>>> :{
type Schema = '[
  "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
    "a" ::: 'NoDef :=> 'Null 'PGint4,
    "b" ::: 'NoDef :=> 'Null 'PGint4
  ])]
:}

>>> :{
let
  definition :: Definition (Public '[]) (Public Schema)
  definition = createTable #tab
    ( (int & nullable) `as` #a :*
      (int & nullable) `as` #b )
    ( unique (#a :* #b) `as` #uq_a_b )
:}

>>> printSQL definition
CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
-}
unique
  :: ( Has sch db schema
     , Has tab schema ('Table table)
     , HasAll aliases (TableToRow table) subcolumns )
  => NP Alias aliases
  -- ^ specify subcolumns which together are unique for each row
  -> TableConstraintExpression sch tab db ('Unique aliases)
unique :: NP Alias aliases
-> TableConstraintExpression sch tab db ('Unique aliases)
unique NP Alias aliases
columns = ByteString
-> TableConstraintExpression sch tab db ('Unique aliases)
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
ByteString -> TableConstraintExpression sch tab db constraint
UnsafeTableConstraintExpression (ByteString
 -> TableConstraintExpression sch tab db ('Unique aliases))
-> ByteString
-> TableConstraintExpression sch tab db ('Unique aliases)
forall a b. (a -> b) -> a -> b
$
  ByteString
"UNIQUE" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (NP Alias aliases -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL NP Alias aliases
columns)

{-| A `primaryKey` constraint indicates that a column, or group of columns,
can be used as a unique identifier for rows in the table.
This requires that the values be both unique and not null.

>>> :{
type Schema = '[
  "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
    "id" ::: 'Def :=> 'NotNull 'PGint4,
    "name" ::: 'NoDef :=> 'NotNull 'PGtext
  ])]
:}

>>> :{
let
  definition :: Definition (Public '[]) (Public Schema)
  definition = createTable #tab
    ( serial `as` #id :*
      (text & notNullable) `as` #name )
    ( primaryKey #id `as` #pk_id )
:}

>>> printSQL definition
CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
-}
primaryKey
  :: ( Has sch db schema
     , Has tab schema ('Table table)
     , HasAll aliases (TableToColumns table) subcolumns
     , AllNotNull subcolumns )
  => NP Alias aliases
  -- ^ specify the subcolumns which together form a primary key.
  -> TableConstraintExpression sch tab db ('PrimaryKey aliases)
primaryKey :: NP Alias aliases
-> TableConstraintExpression sch tab db ('PrimaryKey aliases)
primaryKey NP Alias aliases
columns = ByteString
-> TableConstraintExpression sch tab db ('PrimaryKey aliases)
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
ByteString -> TableConstraintExpression sch tab db constraint
UnsafeTableConstraintExpression (ByteString
 -> TableConstraintExpression sch tab db ('PrimaryKey aliases))
-> ByteString
-> TableConstraintExpression sch tab db ('PrimaryKey aliases)
forall a b. (a -> b) -> a -> b
$
  ByteString
"PRIMARY KEY" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (NP Alias aliases -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL NP Alias aliases
columns)

{-| A `foreignKey` specifies that the values in a column
(or a group of columns) must match the values appearing in some row of
another table. We say this maintains the referential integrity
between two related tables.

>>> :{
type Schema =
  '[ "users" ::: 'Table (
       '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
       '[ "id" ::: 'Def :=> 'NotNull 'PGint4
        , "name" ::: 'NoDef :=> 'NotNull 'PGtext
        ])
   , "emails" ::: 'Table (
       '[  "pk_emails" ::: 'PrimaryKey '["id"]
        , "fk_user_id" ::: 'ForeignKey '["user_id"] "public" "users" '["id"]
        ] :=>
       '[ "id" ::: 'Def :=> 'NotNull 'PGint4
        , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
        , "email" ::: 'NoDef :=> 'Null 'PGtext
        ])
   ]
:}

>>> :{
let
  setup :: Definition (Public '[]) (Public Schema)
  setup =
   createTable #users
     ( serial `as` #id :*
       (text & notNullable) `as` #name )
     ( primaryKey #id `as` #pk_users ) >>>
   createTable #emails
     ( serial `as` #id :*
       (int & notNullable) `as` #user_id :*
       (text & nullable) `as` #email )
     ( primaryKey #id `as` #pk_emails :*
       foreignKey #user_id #users #id
         (OnDelete Cascade) (OnUpdate Cascade) `as` #fk_user_id )
in printSQL setup
:}
CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

A `foreignKey` can even be a table self-reference.

>>> :{
type Schema =
  '[ "employees" ::: 'Table (
       '[ "employees_pk"          ::: 'PrimaryKey '["id"]
        , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "public" "employees" '["id"]
        ] :=>
       '[ "id"          :::   'Def :=> 'NotNull 'PGint4
        , "name"        ::: 'NoDef :=> 'NotNull 'PGtext
        , "employer_id" ::: 'NoDef :=>    'Null 'PGint4
        ])
   ]
:}

>>> :{
let
  setup :: Definition (Public '[]) (Public Schema)
  setup =
   createTable #employees
     ( serial `as` #id :*
       (text & notNullable) `as` #name :*
       (integer & nullable) `as` #employer_id )
     ( primaryKey #id `as` #employees_pk :*
       foreignKey #employer_id #employees #id
         (OnDelete Cascade) (OnUpdate Cascade) `as` #employees_employer_fk )
in printSQL setup
:}
CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
-}
foreignKey
  :: (ForeignKeyed db 
        sch0 sch1
        schema0 schema1 
        child parent
        table reftable
        columns refcolumns
        constraints cols
        reftys tys )
  => NP Alias columns
  -- ^ column or columns in the table
  -> QualifiedAlias sch0 parent
  -- ^ reference table
  -> NP Alias refcolumns
  -- ^ reference column or columns in the reference table
  -> OnDeleteClause
  -- ^ what to do when reference is deleted
  -> OnUpdateClause
  -- ^ what to do when reference is updated
  -> TableConstraintExpression sch1 child db
      ('ForeignKey columns sch0 parent refcolumns)
foreignKey :: NP Alias columns
-> QualifiedAlias sch0 parent
-> NP Alias refcolumns
-> OnDeleteClause
-> OnUpdateClause
-> TableConstraintExpression
     sch1 child db ('ForeignKey columns sch0 parent refcolumns)
foreignKey NP Alias columns
keys QualifiedAlias sch0 parent
parent NP Alias refcolumns
refs OnDeleteClause
ondel OnUpdateClause
onupd = ByteString
-> TableConstraintExpression
     sch1 child db ('ForeignKey columns sch0 parent refcolumns)
forall (sch :: Symbol) (tab :: Symbol) (db :: SchemasType)
       (constraint :: TableConstraint).
ByteString -> TableConstraintExpression sch tab db constraint
UnsafeTableConstraintExpression (ByteString
 -> TableConstraintExpression
      sch1 child db ('ForeignKey columns sch0 parent refcolumns))
-> ByteString
-> TableConstraintExpression
     sch1 child db ('ForeignKey columns sch0 parent refcolumns)
forall a b. (a -> b) -> a -> b
$
  ByteString
"FOREIGN KEY" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (NP Alias columns -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL NP Alias columns
keys)
  ByteString -> ByteString -> ByteString
<+> ByteString
"REFERENCES" ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch0 parent -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch0 parent
parent
  ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (NP Alias refcolumns -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL NP Alias refcolumns
refs)
  ByteString -> ByteString -> ByteString
<+> OnDeleteClause -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL OnDeleteClause
ondel
  ByteString -> ByteString -> ByteString
<+> OnUpdateClause -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL OnUpdateClause
onupd

-- | A constraint synonym between types involved in a foreign key constraint.
type ForeignKeyed db
  sch0 sch1
  schema0 schema1
  child parent
  table reftable
  columns refcolumns
  constraints cols
  reftys tys =
    ( Has sch0 db schema0
    , Has sch1 db schema1
    , Has parent schema0 ('Table reftable)
    , Has child schema1 ('Table table)
    , HasAll columns (TableToColumns table) tys
    , reftable ~ (constraints :=> cols)
    , HasAll refcolumns cols reftys
    , SOP.AllZip SamePGType tys reftys
    , Uniquely refcolumns constraints )

-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
newtype OnDeleteClause = OnDelete ReferentialAction
  deriving ((forall x. OnDeleteClause -> Rep OnDeleteClause x)
-> (forall x. Rep OnDeleteClause x -> OnDeleteClause)
-> Generic OnDeleteClause
forall x. Rep OnDeleteClause x -> OnDeleteClause
forall x. OnDeleteClause -> Rep OnDeleteClause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OnDeleteClause x -> OnDeleteClause
$cfrom :: forall x. OnDeleteClause -> Rep OnDeleteClause x
GHC.Generic,Int -> OnDeleteClause -> ShowS
[OnDeleteClause] -> ShowS
OnDeleteClause -> String
(Int -> OnDeleteClause -> ShowS)
-> (OnDeleteClause -> String)
-> ([OnDeleteClause] -> ShowS)
-> Show OnDeleteClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnDeleteClause] -> ShowS
$cshowList :: [OnDeleteClause] -> ShowS
show :: OnDeleteClause -> String
$cshow :: OnDeleteClause -> String
showsPrec :: Int -> OnDeleteClause -> ShowS
$cshowsPrec :: Int -> OnDeleteClause -> ShowS
Show,OnDeleteClause -> OnDeleteClause -> Bool
(OnDeleteClause -> OnDeleteClause -> Bool)
-> (OnDeleteClause -> OnDeleteClause -> Bool) -> Eq OnDeleteClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnDeleteClause -> OnDeleteClause -> Bool
$c/= :: OnDeleteClause -> OnDeleteClause -> Bool
== :: OnDeleteClause -> OnDeleteClause -> Bool
$c== :: OnDeleteClause -> OnDeleteClause -> Bool
Eq,Eq OnDeleteClause
Eq OnDeleteClause
-> (OnDeleteClause -> OnDeleteClause -> Ordering)
-> (OnDeleteClause -> OnDeleteClause -> Bool)
-> (OnDeleteClause -> OnDeleteClause -> Bool)
-> (OnDeleteClause -> OnDeleteClause -> Bool)
-> (OnDeleteClause -> OnDeleteClause -> Bool)
-> (OnDeleteClause -> OnDeleteClause -> OnDeleteClause)
-> (OnDeleteClause -> OnDeleteClause -> OnDeleteClause)
-> Ord OnDeleteClause
OnDeleteClause -> OnDeleteClause -> Bool
OnDeleteClause -> OnDeleteClause -> Ordering
OnDeleteClause -> OnDeleteClause -> OnDeleteClause
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
min :: OnDeleteClause -> OnDeleteClause -> OnDeleteClause
$cmin :: OnDeleteClause -> OnDeleteClause -> OnDeleteClause
max :: OnDeleteClause -> OnDeleteClause -> OnDeleteClause
$cmax :: OnDeleteClause -> OnDeleteClause -> OnDeleteClause
>= :: OnDeleteClause -> OnDeleteClause -> Bool
$c>= :: OnDeleteClause -> OnDeleteClause -> Bool
> :: OnDeleteClause -> OnDeleteClause -> Bool
$c> :: OnDeleteClause -> OnDeleteClause -> Bool
<= :: OnDeleteClause -> OnDeleteClause -> Bool
$c<= :: OnDeleteClause -> OnDeleteClause -> Bool
< :: OnDeleteClause -> OnDeleteClause -> Bool
$c< :: OnDeleteClause -> OnDeleteClause -> Bool
compare :: OnDeleteClause -> OnDeleteClause -> Ordering
$ccompare :: OnDeleteClause -> OnDeleteClause -> Ordering
$cp1Ord :: Eq OnDeleteClause
Ord)
instance NFData OnDeleteClause
instance RenderSQL OnDeleteClause where
  renderSQL :: OnDeleteClause -> ByteString
renderSQL (OnDelete ReferentialAction
action) = ByteString
"ON DELETE" ByteString -> ByteString -> ByteString
<+> ReferentialAction -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ReferentialAction
action

-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
-- when a referenced column is changed (updated).
newtype OnUpdateClause = OnUpdate ReferentialAction
  deriving ((forall x. OnUpdateClause -> Rep OnUpdateClause x)
-> (forall x. Rep OnUpdateClause x -> OnUpdateClause)
-> Generic OnUpdateClause
forall x. Rep OnUpdateClause x -> OnUpdateClause
forall x. OnUpdateClause -> Rep OnUpdateClause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OnUpdateClause x -> OnUpdateClause
$cfrom :: forall x. OnUpdateClause -> Rep OnUpdateClause x
GHC.Generic,Int -> OnUpdateClause -> ShowS
[OnUpdateClause] -> ShowS
OnUpdateClause -> String
(Int -> OnUpdateClause -> ShowS)
-> (OnUpdateClause -> String)
-> ([OnUpdateClause] -> ShowS)
-> Show OnUpdateClause
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnUpdateClause] -> ShowS
$cshowList :: [OnUpdateClause] -> ShowS
show :: OnUpdateClause -> String
$cshow :: OnUpdateClause -> String
showsPrec :: Int -> OnUpdateClause -> ShowS
$cshowsPrec :: Int -> OnUpdateClause -> ShowS
Show,OnUpdateClause -> OnUpdateClause -> Bool
(OnUpdateClause -> OnUpdateClause -> Bool)
-> (OnUpdateClause -> OnUpdateClause -> Bool) -> Eq OnUpdateClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnUpdateClause -> OnUpdateClause -> Bool
$c/= :: OnUpdateClause -> OnUpdateClause -> Bool
== :: OnUpdateClause -> OnUpdateClause -> Bool
$c== :: OnUpdateClause -> OnUpdateClause -> Bool
Eq,Eq OnUpdateClause
Eq OnUpdateClause
-> (OnUpdateClause -> OnUpdateClause -> Ordering)
-> (OnUpdateClause -> OnUpdateClause -> Bool)
-> (OnUpdateClause -> OnUpdateClause -> Bool)
-> (OnUpdateClause -> OnUpdateClause -> Bool)
-> (OnUpdateClause -> OnUpdateClause -> Bool)
-> (OnUpdateClause -> OnUpdateClause -> OnUpdateClause)
-> (OnUpdateClause -> OnUpdateClause -> OnUpdateClause)
-> Ord OnUpdateClause
OnUpdateClause -> OnUpdateClause -> Bool
OnUpdateClause -> OnUpdateClause -> Ordering
OnUpdateClause -> OnUpdateClause -> OnUpdateClause
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
min :: OnUpdateClause -> OnUpdateClause -> OnUpdateClause
$cmin :: OnUpdateClause -> OnUpdateClause -> OnUpdateClause
max :: OnUpdateClause -> OnUpdateClause -> OnUpdateClause
$cmax :: OnUpdateClause -> OnUpdateClause -> OnUpdateClause
>= :: OnUpdateClause -> OnUpdateClause -> Bool
$c>= :: OnUpdateClause -> OnUpdateClause -> Bool
> :: OnUpdateClause -> OnUpdateClause -> Bool
$c> :: OnUpdateClause -> OnUpdateClause -> Bool
<= :: OnUpdateClause -> OnUpdateClause -> Bool
$c<= :: OnUpdateClause -> OnUpdateClause -> Bool
< :: OnUpdateClause -> OnUpdateClause -> Bool
$c< :: OnUpdateClause -> OnUpdateClause -> Bool
compare :: OnUpdateClause -> OnUpdateClause -> Ordering
$ccompare :: OnUpdateClause -> OnUpdateClause -> Ordering
$cp1Ord :: Eq OnUpdateClause
Ord)
instance NFData OnUpdateClause
instance RenderSQL OnUpdateClause where
  renderSQL :: OnUpdateClause -> ByteString
renderSQL (OnUpdate ReferentialAction
action) = ByteString
"ON UPDATE" ByteString -> ByteString -> ByteString
<+> ReferentialAction -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ReferentialAction
action

{- | When the data in the referenced columns is changed,
certain actions are performed on the data in this table's columns.-}
data ReferentialAction
  = NoAction
  {- ^ Produce an error indicating that the deletion or update
  would create a foreign key constraint violation.
  If the constraint is deferred, this error will be produced
  at constraint check time if there still exist any referencing rows.-}
  | Restrict
  {- ^ Produce an error indicating that the deletion or update
  would create a foreign key constraint violation.
  This is the same as `NoAction` except that the check is not deferrable.-}
  | Cascade
  {- ^ Delete any rows referencing the deleted row,
  or update the value of the referencing column
  to the new value of the referenced column, respectively.-}
  | SetNull {- ^ Set the referencing column(s) to null.-}
  | SetDefault {- ^ Set the referencing column(s) to their default values.-}
  deriving ((forall x. ReferentialAction -> Rep ReferentialAction x)
-> (forall x. Rep ReferentialAction x -> ReferentialAction)
-> Generic ReferentialAction
forall x. Rep ReferentialAction x -> ReferentialAction
forall x. ReferentialAction -> Rep ReferentialAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReferentialAction x -> ReferentialAction
$cfrom :: forall x. ReferentialAction -> Rep ReferentialAction x
GHC.Generic,Int -> ReferentialAction -> ShowS
[ReferentialAction] -> ShowS
ReferentialAction -> String
(Int -> ReferentialAction -> ShowS)
-> (ReferentialAction -> String)
-> ([ReferentialAction] -> ShowS)
-> Show ReferentialAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferentialAction] -> ShowS
$cshowList :: [ReferentialAction] -> ShowS
show :: ReferentialAction -> String
$cshow :: ReferentialAction -> String
showsPrec :: Int -> ReferentialAction -> ShowS
$cshowsPrec :: Int -> ReferentialAction -> ShowS
Show,ReferentialAction -> ReferentialAction -> Bool
(ReferentialAction -> ReferentialAction -> Bool)
-> (ReferentialAction -> ReferentialAction -> Bool)
-> Eq ReferentialAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferentialAction -> ReferentialAction -> Bool
$c/= :: ReferentialAction -> ReferentialAction -> Bool
== :: ReferentialAction -> ReferentialAction -> Bool
$c== :: ReferentialAction -> ReferentialAction -> Bool
Eq,Eq ReferentialAction
Eq ReferentialAction
-> (ReferentialAction -> ReferentialAction -> Ordering)
-> (ReferentialAction -> ReferentialAction -> Bool)
-> (ReferentialAction -> ReferentialAction -> Bool)
-> (ReferentialAction -> ReferentialAction -> Bool)
-> (ReferentialAction -> ReferentialAction -> Bool)
-> (ReferentialAction -> ReferentialAction -> ReferentialAction)
-> (ReferentialAction -> ReferentialAction -> ReferentialAction)
-> Ord ReferentialAction
ReferentialAction -> ReferentialAction -> Bool
ReferentialAction -> ReferentialAction -> Ordering
ReferentialAction -> ReferentialAction -> ReferentialAction
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
min :: ReferentialAction -> ReferentialAction -> ReferentialAction
$cmin :: ReferentialAction -> ReferentialAction -> ReferentialAction
max :: ReferentialAction -> ReferentialAction -> ReferentialAction
$cmax :: ReferentialAction -> ReferentialAction -> ReferentialAction
>= :: ReferentialAction -> ReferentialAction -> Bool
$c>= :: ReferentialAction -> ReferentialAction -> Bool
> :: ReferentialAction -> ReferentialAction -> Bool
$c> :: ReferentialAction -> ReferentialAction -> Bool
<= :: ReferentialAction -> ReferentialAction -> Bool
$c<= :: ReferentialAction -> ReferentialAction -> Bool
< :: ReferentialAction -> ReferentialAction -> Bool
$c< :: ReferentialAction -> ReferentialAction -> Bool
compare :: ReferentialAction -> ReferentialAction -> Ordering
$ccompare :: ReferentialAction -> ReferentialAction -> Ordering
$cp1Ord :: Eq ReferentialAction
Ord)
instance NFData ReferentialAction
instance RenderSQL ReferentialAction where
  renderSQL :: ReferentialAction -> ByteString
renderSQL = \case
    ReferentialAction
NoAction -> ByteString
"NO ACTION"
    ReferentialAction
Restrict -> ByteString
"RESTRICT"
    ReferentialAction
Cascade -> ByteString
"CASCADE"
    ReferentialAction
SetNull -> ByteString
"SET NULL"
    ReferentialAction
SetDefault -> ByteString
"SET DEFAULT"