{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Expr.TableConstraint
  ( TableConstraint
  , uniqueConstraint
  , foreignKeyConstraint
  , ForeignKeyActionExpr
  , restrictExpr
  , cascadeExpr
  , setNullExpr
  , setDefaultExpr
  , ForeignKeyDeleteActionExpr
  , foreignKeyDeleteActionExpr
  , ForeignKeyUpdateActionExpr
  , foreignKeyUpdateActionExpr
  )
where

import Data.List.NonEmpty (NonEmpty)

import Orville.PostgreSQL.Expr.Name (ColumnName, Qualified, TableName)
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql

{- |
Type to represent a table constraint that would be part of a @CREATE TABLE@ or
@ALTER TABLE@ statement. For instance, the @UNIQUE@ constraint in

> CREATE TABLE FOO
>  ( id integer
>  , UNIQUE id
>  )
>

'TableConstraint' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype TableConstraint
  = TableConstraint RawSql.RawSql
  deriving (RawSql -> TableConstraint
TableConstraint -> RawSql
(TableConstraint -> RawSql)
-> (RawSql -> TableConstraint) -> SqlExpression TableConstraint
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: TableConstraint -> RawSql
toRawSql :: TableConstraint -> RawSql
$cunsafeFromRawSql :: RawSql -> TableConstraint
unsafeFromRawSql :: RawSql -> TableConstraint
RawSql.SqlExpression)

{- |
  Constructs a 'TableConstraint' will create a @UNIQUE@ constraint on the
  given columns.

  @since 1.0.0.0
-}
uniqueConstraint :: NonEmpty ColumnName -> TableConstraint
uniqueConstraint :: NonEmpty ColumnName -> TableConstraint
uniqueConstraint NonEmpty ColumnName
columnNames =
  RawSql -> TableConstraint
TableConstraint (RawSql -> TableConstraint) -> RawSql -> TableConstraint
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"UNIQUE "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.leftParen
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql -> NonEmpty ColumnName -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.comma NonEmpty ColumnName
columnNames
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.rightParen

{- |
Type to represent a foreign key action on a @FOREIGN KEY@ constraint. E.G.
the @CASCADE@ in

> FOREIGN KEY (foo_id) REFERENCES foo (id) ON DELETE CASCADE

'ForeignKeyActionExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype ForeignKeyActionExpr
  = ForeignKeyActionExpr RawSql.RawSql
  deriving (RawSql -> ForeignKeyActionExpr
ForeignKeyActionExpr -> RawSql
(ForeignKeyActionExpr -> RawSql)
-> (RawSql -> ForeignKeyActionExpr)
-> SqlExpression ForeignKeyActionExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: ForeignKeyActionExpr -> RawSql
toRawSql :: ForeignKeyActionExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> ForeignKeyActionExpr
unsafeFromRawSql :: RawSql -> ForeignKeyActionExpr
RawSql.SqlExpression)

{- |
  The foreign key action @RESTRICT@.

  @since 1.0.0.0
-}
restrictExpr :: ForeignKeyActionExpr
restrictExpr :: ForeignKeyActionExpr
restrictExpr = RawSql -> ForeignKeyActionExpr
ForeignKeyActionExpr (RawSql -> ForeignKeyActionExpr) -> RawSql -> ForeignKeyActionExpr
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"RESTRICT"

{- |
  The foreign key action @CASCADE@.

  @since 1.0.0.0
-}
cascadeExpr :: ForeignKeyActionExpr
cascadeExpr :: ForeignKeyActionExpr
cascadeExpr = RawSql -> ForeignKeyActionExpr
ForeignKeyActionExpr (RawSql -> ForeignKeyActionExpr) -> RawSql -> ForeignKeyActionExpr
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"CASCADE"

{- |
  The foreign key action @SET NULL@.

  @since 1.0.0.0
-}
setNullExpr :: ForeignKeyActionExpr
setNullExpr :: ForeignKeyActionExpr
setNullExpr = RawSql -> ForeignKeyActionExpr
ForeignKeyActionExpr (RawSql -> ForeignKeyActionExpr) -> RawSql -> ForeignKeyActionExpr
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"SET NULL"

{- |
  The foreign key action @SET DEFAULT@.

  @since 1.0.0.0
-}
setDefaultExpr :: ForeignKeyActionExpr
setDefaultExpr :: ForeignKeyActionExpr
setDefaultExpr = RawSql -> ForeignKeyActionExpr
ForeignKeyActionExpr (RawSql -> ForeignKeyActionExpr) -> RawSql -> ForeignKeyActionExpr
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"SET DEFAULT"

{- |
Type to represent a foreign key update action on a @FOREIGN KEY@ constraint. E.G.
the @ON UPDATE RESTRICT@ in

> FOREIGN KEY (foo_id) REFERENCES foo (id) ON UPDATE RESTRICT

'ForeignKeyUpdateActionExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype ForeignKeyUpdateActionExpr
  = ForeignKeyUpdateActionExpr RawSql.RawSql
  deriving (RawSql -> ForeignKeyUpdateActionExpr
ForeignKeyUpdateActionExpr -> RawSql
(ForeignKeyUpdateActionExpr -> RawSql)
-> (RawSql -> ForeignKeyUpdateActionExpr)
-> SqlExpression ForeignKeyUpdateActionExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: ForeignKeyUpdateActionExpr -> RawSql
toRawSql :: ForeignKeyUpdateActionExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> ForeignKeyUpdateActionExpr
unsafeFromRawSql :: RawSql -> ForeignKeyUpdateActionExpr
RawSql.SqlExpression)

{- |
  Constructs a 'ForeignKeyActionExpr' that uses the given 'ForeignKeyActionExpr'
  in an @ON UPDATE@ clause for a foreign key.

  @since 1.0.0.0
-}
foreignKeyUpdateActionExpr :: ForeignKeyActionExpr -> ForeignKeyUpdateActionExpr
foreignKeyUpdateActionExpr :: ForeignKeyActionExpr -> ForeignKeyUpdateActionExpr
foreignKeyUpdateActionExpr ForeignKeyActionExpr
action =
  RawSql -> ForeignKeyUpdateActionExpr
ForeignKeyUpdateActionExpr (RawSql -> ForeignKeyUpdateActionExpr)
-> RawSql -> ForeignKeyUpdateActionExpr
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"ON UPDATE"
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.space
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> ForeignKeyActionExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql ForeignKeyActionExpr
action

{- |
Type to represent a foreign key update action on a @FOREIGN KEY@ constraint. E.G.
the @ON DELETE RESTRICT@ in

> FOREIGN KEY (foo_id) REFERENCES foo (id) ON DELETE RESTRICT

'ForeignKeyDeleteActionExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype ForeignKeyDeleteActionExpr
  = ForeignKeyDeleteActionExpr RawSql.RawSql
  deriving (RawSql -> ForeignKeyDeleteActionExpr
ForeignKeyDeleteActionExpr -> RawSql
(ForeignKeyDeleteActionExpr -> RawSql)
-> (RawSql -> ForeignKeyDeleteActionExpr)
-> SqlExpression ForeignKeyDeleteActionExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: ForeignKeyDeleteActionExpr -> RawSql
toRawSql :: ForeignKeyDeleteActionExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> ForeignKeyDeleteActionExpr
unsafeFromRawSql :: RawSql -> ForeignKeyDeleteActionExpr
RawSql.SqlExpression)

{- |
  Constructs a 'ForeignKeyActionExpr' that uses the given 'ForeignKeyActionExpr'
  in an @ON UPDATE@ clause for a foreign key.

  @since 1.0.0.0
-}
foreignKeyDeleteActionExpr :: ForeignKeyActionExpr -> ForeignKeyDeleteActionExpr
foreignKeyDeleteActionExpr :: ForeignKeyActionExpr -> ForeignKeyDeleteActionExpr
foreignKeyDeleteActionExpr ForeignKeyActionExpr
action =
  RawSql -> ForeignKeyDeleteActionExpr
ForeignKeyDeleteActionExpr (RawSql -> ForeignKeyDeleteActionExpr)
-> RawSql -> ForeignKeyDeleteActionExpr
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"ON DELETE"
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.space
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> ForeignKeyActionExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql ForeignKeyActionExpr
action

{- |
  Constructs a 'TableConstraint' that represent a @FOREIGN KEY@ constraint

  @since 1.0.0.0
-}
foreignKeyConstraint ::
  -- | The names of the columns in the source table that form the foreign key.
  NonEmpty ColumnName ->
  -- | The name of the table that the foreign key references.
  Qualified TableName ->
  -- | The names of the columns in the foreign table that the foreign key references.
  NonEmpty ColumnName ->
  -- | An optional @ON UPDATE@ foreign key action to perform.
  Maybe ForeignKeyUpdateActionExpr ->
  -- | An optional @ON DELETE@ foreign key action to perform.
  Maybe ForeignKeyDeleteActionExpr ->
  TableConstraint
foreignKeyConstraint :: NonEmpty ColumnName
-> Qualified TableName
-> NonEmpty ColumnName
-> Maybe ForeignKeyUpdateActionExpr
-> Maybe ForeignKeyDeleteActionExpr
-> TableConstraint
foreignKeyConstraint NonEmpty ColumnName
columnNames Qualified TableName
foreignTableName NonEmpty ColumnName
foreignColumnNames Maybe ForeignKeyUpdateActionExpr
mbUpdateAction Maybe ForeignKeyDeleteActionExpr
mbDeleteAction =
  RawSql -> TableConstraint
TableConstraint (RawSql -> TableConstraint) -> RawSql -> TableConstraint
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"FOREIGN KEY "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.leftParen
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql -> NonEmpty ColumnName -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.comma NonEmpty ColumnName
columnNames
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.rightParen
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
" REFERENCES "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> Qualified TableName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Qualified TableName
foreignTableName
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.space
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.leftParen
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql -> NonEmpty ColumnName -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.comma NonEmpty ColumnName
foreignColumnNames
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
RawSql.rightParen
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
-> (ForeignKeyUpdateActionExpr -> RawSql)
-> Maybe ForeignKeyUpdateActionExpr
-> RawSql
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSql
forall a. Monoid a => a
mempty (\ForeignKeyUpdateActionExpr
updateAction -> RawSql
RawSql.space RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> ForeignKeyUpdateActionExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql ForeignKeyUpdateActionExpr
updateAction) Maybe ForeignKeyUpdateActionExpr
mbUpdateAction
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> RawSql
-> (ForeignKeyDeleteActionExpr -> RawSql)
-> Maybe ForeignKeyDeleteActionExpr
-> RawSql
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSql
forall a. Monoid a => a
mempty (\ForeignKeyDeleteActionExpr
deleteAction -> RawSql
RawSql.space RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> ForeignKeyDeleteActionExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql ForeignKeyDeleteActionExpr
deleteAction) Maybe ForeignKeyDeleteActionExpr
mbDeleteAction