{-|
Module: Squeal.PostgreSQL.Manipulation.Insert
Description: insert statements
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

insert statements
-}

{-# LANGUAGE
    DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedStrings
  , PatternSynonyms
  , QuantifiedConstraints
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , TypeInType
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Manipulation.Insert
  ( -- * Insert
    insertInto
  , insertInto_
    -- * Clauses
  , QueryClause (..)
  , pattern Values_
  , inlineValues
  , inlineValues_
  , ConflictClause (..)
  , ConflictTarget (..)
  , ConflictAction (..)
  ) where

import Data.ByteString hiding (foldr)

import qualified Generics.SOP as SOP
import qualified Generics.SOP.Record as SOP

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Expression.Default
import Squeal.PostgreSQL.Expression.Inline
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Query
import Squeal.PostgreSQL.Query.Table
import Squeal.PostgreSQL.Type.Schema

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

{-----------------------------------------
INSERT statements
-----------------------------------------}

{- |
When a table is created, it contains no data. The first thing to do
before a database can be of much use is to insert data. Data is
conceptually inserted one row at a time. Of course you can also insert
more than one row, but there is no way to insert less than one row.
Even if you know only some column values, a complete row must be created.

>>> type CustomersColumns = '["name" ::: 'NoDef :=> 'NotNull 'PGtext, "email" ::: 'NoDef :=> 'NotNull 'PGtext]
>>> type CustomersConstraints = '["uq" ::: 'Unique '["name"]]
>>> type CustomersSchema = '["customers" ::: 'Table (CustomersConstraints :=> CustomersColumns)]
>>> :{
let
  manp :: Manipulation with (Public CustomersSchema) '[] '[]
  manp =
    insertInto #customers
      (Values_ (Set "John Smith" `as` #name :* Set "john@smith.com" `as` #email))
      (OnConflict (OnConstraint #uq)
        (DoUpdate (Set (#excluded ! #email <> "; " <> #customers ! #email) `as` #email) []))
      (Returning_ Nil)
in printSQL manp
:}
INSERT INTO "customers" AS "customers" ("name", "email") VALUES ((E'John Smith' :: text), (E'john@smith.com' :: text)) ON CONFLICT ON CONSTRAINT "uq" DO UPDATE SET "email" = ("excluded"."email" || ((E'; ' :: text) || "customers"."email"))
-}
insertInto
  :: ( Has sch db schema
     , Has tab0 schema ('Table table)
     , SOP.SListI (TableToColumns table)
     , SOP.SListI row )
  => Aliased (QualifiedAlias sch) (tab ::: tab0)
  -- ^ table
  -> QueryClause with db params (TableToColumns table)
  -- ^ what to insert
  -> ConflictClause tab with db params table
  -- ^ what to do in case of conflict
  -> ReturningClause with db params '[tab ::: TableToRow table] row
  -- ^ what to return
  -> Manipulation with db params row
insertInto :: Aliased (QualifiedAlias sch) (tab ::: tab0)
-> QueryClause with db params (TableToColumns table)
-> ConflictClause tab with db params table
-> ReturningClause with db params '[tab ::: TableToRow table] row
-> Manipulation with db params row
insertInto (QualifiedAlias sch ty
tab0 `As` Alias alias
tab) QueryClause with db params (TableToColumns table)
qry ConflictClause tab with db params table
conflict ReturningClause with db params '[tab ::: TableToRow table] row
ret = ByteString -> Manipulation with db params row
forall (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (columns :: RowType).
ByteString -> Manipulation with db params columns
UnsafeManipulation (ByteString -> Manipulation with db params row)
-> ByteString -> Manipulation with db params row
forall a b. (a -> b) -> a -> b
$
  ByteString
"INSERT" ByteString -> ByteString -> ByteString
<+> ByteString
"INTO"
  ByteString -> ByteString -> ByteString
<+> QualifiedAlias sch ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch ty
tab0 ByteString -> ByteString -> ByteString
<+> ByteString
"AS" ByteString -> ByteString -> ByteString
<+> Alias alias -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
tab
  ByteString -> ByteString -> ByteString
<+> QueryClause with db params (TableToColumns table) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QueryClause with db params (TableToColumns table)
qry
  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ConflictClause tab with db params table -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ConflictClause tab with db params table
conflict
  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ReturningClause
  with db params '[tab ::: ColumnsToRow (TableToColumns table)] row
-> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ReturningClause with db params '[tab ::: TableToRow table] row
ReturningClause
  with db params '[tab ::: ColumnsToRow (TableToColumns table)] row
ret

{- | Like `insertInto` but with `OnConflictDoRaise` and no `ReturningClause`.

>>> type Columns = '["col1" ::: 'NoDef :=> 'Null 'PGint4, "col2" ::: 'Def :=> 'NotNull 'PGint4]
>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]
>>> :{
let
  manp :: Manipulation with (Public Schema) '[] '[]
  manp =
    insertInto_ #tab (Values_ (Set 2 `as` #col1 :* Default `as` #col2))
in printSQL manp
:}
INSERT INTO "tab" AS "tab" ("col1", "col2") VALUES ((2 :: int4), DEFAULT)
-}
insertInto_
  :: ( Has sch db schema
     , Has tab0 schema ('Table table)
     , SOP.SListI (TableToColumns table) )
  => Aliased (QualifiedAlias sch) (tab ::: tab0)
  -- ^ table
  -> QueryClause with db params (TableToColumns table)
  -- ^ what to insert
  -> Manipulation with db params '[]
insertInto_ :: Aliased (QualifiedAlias sch) (tab ::: tab0)
-> QueryClause with db params (TableToColumns table)
-> Manipulation with db params '[]
insertInto_ Aliased (QualifiedAlias sch) (tab ::: tab0)
tab QueryClause with db params (TableToColumns table)
qry =
  Aliased (QualifiedAlias sch) (tab ::: tab0)
-> QueryClause with db params (TableToColumns table)
-> ConflictClause tab with db params table
-> ReturningClause with db params '[tab ::: TableToRow table] '[]
-> Manipulation with db params '[]
forall (sch :: Symbol) (db :: SchemasType)
       (schema :: [(Symbol, SchemumType)]) (tab0 :: Symbol)
       (table :: TableType) (row :: RowType) (tab :: Symbol)
       (with :: FromType) (params :: [NullType]).
(Has sch db schema, Has tab0 schema ('Table table),
 SListI (TableToColumns table), SListI row) =>
Aliased (QualifiedAlias sch) (tab ::: tab0)
-> QueryClause with db params (TableToColumns table)
-> ConflictClause tab with db params table
-> ReturningClause with db params '[tab ::: TableToRow table] row
-> Manipulation with db params row
insertInto Aliased (QualifiedAlias sch) (tab ::: tab0)
tab QueryClause with db params (TableToColumns table)
qry ConflictClause tab with db params table
forall (tab :: Symbol) (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (table :: TableType).
ConflictClause tab with db params table
OnConflictDoRaise (NP
  (Aliased
     (Expression
        'Ungrouped
        '[]
        with
        db
        params
        '[tab ::: ColumnsToRow (TableToColumns table)]))
  '[]
-> ReturningClause
     with db params '[tab ::: ColumnsToRow (TableToColumns table)] '[]
forall (row :: RowType) (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (from :: FromType).
SListI row =>
NP (Aliased (Expression 'Ungrouped '[] with db params from)) row
-> ReturningClause with db params from row
Returning_ NP
  (Aliased
     (Expression
        'Ungrouped
        '[]
        with
        db
        params
        '[tab ::: ColumnsToRow (TableToColumns table)]))
  '[]
forall k (a :: k -> *). NP a '[]
Nil)

-- | A `QueryClause` describes what to `insertInto` a table.
data QueryClause with db params columns where
  Values
    :: SOP.SListI columns
    => NP (Aliased (Optional (Expression 'Ungrouped '[] with db params from))) columns
    -- ^ row of values
    -> [NP (Aliased (Optional (Expression 'Ungrouped '[] with db params from))) columns]
    -- ^ additional rows of values
    -> QueryClause with db params columns
  Select
    :: SOP.SListI columns
    => NP (Aliased (Optional (Expression grp '[] with db params from))) columns
    -- ^ row of values
    -> TableExpression grp '[] with db params from
    -- ^ from a table expression
    -> QueryClause with db params columns
  Subquery
    :: ColumnsToRow columns ~ row
    => Query '[] with db params row
    -- ^ subquery to insert
    -> QueryClause with db params columns

instance RenderSQL (QueryClause with db params columns) where
  renderSQL :: QueryClause with db params columns -> ByteString
renderSQL = \case
    Values NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
row0 [NP
   (Aliased
      (Optional (Expression 'Ungrouped '[] with db params from)))
   columns]
rows ->
      ByteString -> ByteString
parenthesized ((forall (x :: (Symbol, ColumnType)).
 Aliased
   (Optional (Expression 'Ungrouped '[] with db params from)) x
 -> ByteString)
-> NP
     (Aliased
        (Optional (Expression 'Ungrouped '[] with db params from)))
     columns
-> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall (x :: (Symbol, ColumnType)).
Aliased
  (Optional (Expression 'Ungrouped '[] with db params from)) x
-> ByteString
forall (grp :: Grouping) (from :: FromType)
       (column :: (Symbol, ColumnType)).
Aliased (Optional (Expression grp '[] with db params from)) column
-> ByteString
renderSQLPart NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
row0)
      ByteString -> ByteString -> ByteString
<+> ByteString
"VALUES"
      ByteString -> ByteString -> ByteString
<+> [ByteString] -> ByteString
commaSeparated
            ( ByteString -> ByteString
parenthesized
            (ByteString -> ByteString)
-> (NP
      (Aliased
         (Optional (Expression 'Ungrouped '[] with db params from)))
      columns
    -> ByteString)
-> NP
     (Aliased
        (Optional (Expression 'Ungrouped '[] with db params from)))
     columns
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: (Symbol, ColumnType)).
 Aliased
   (Optional (Expression 'Ungrouped '[] with db params from)) x
 -> ByteString)
-> NP
     (Aliased
        (Optional (Expression 'Ungrouped '[] with db params from)))
     columns
-> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall (x :: (Symbol, ColumnType)).
Aliased
  (Optional (Expression 'Ungrouped '[] with db params from)) x
-> ByteString
forall (grp :: Grouping) (from :: FromType)
       (column :: (Symbol, ColumnType)).
Aliased (Optional (Expression grp '[] with db params from)) column
-> ByteString
renderValuePart (NP
   (Aliased
      (Optional (Expression 'Ungrouped '[] with db params from)))
   columns
 -> ByteString)
-> [NP
      (Aliased
         (Optional (Expression 'Ungrouped '[] with db params from)))
      columns]
-> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
row0 NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
-> [NP
      (Aliased
         (Optional (Expression 'Ungrouped '[] with db params from)))
      columns]
-> [NP
      (Aliased
         (Optional (Expression 'Ungrouped '[] with db params from)))
      columns]
forall a. a -> [a] -> [a]
: [NP
   (Aliased
      (Optional (Expression 'Ungrouped '[] with db params from)))
   columns]
rows )
    Select NP
  (Aliased (Optional (Expression grp '[] with db params from)))
  columns
row0 TableExpression grp '[] with db params from
tab ->
      ByteString -> ByteString
parenthesized ((forall (x :: (Symbol, ColumnType)).
 Aliased (Optional (Expression grp '[] with db params from)) x
 -> Maybe ByteString)
-> NP
     (Aliased (Optional (Expression grp '[] with db params from)))
     columns
-> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> Maybe ByteString)
-> NP expression xs -> ByteString
renderCommaSeparatedMaybe forall (x :: (Symbol, ColumnType)).
Aliased (Optional (Expression grp '[] with db params from)) x
-> Maybe ByteString
forall (grp :: Grouping) (from :: FromType)
       (column :: (Symbol, ColumnType)).
Aliased (Optional (Expression grp '[] with db params from)) column
-> Maybe ByteString
renderSQLPartMaybe NP
  (Aliased (Optional (Expression grp '[] with db params from)))
  columns
row0)
      ByteString -> ByteString -> ByteString
<+> ByteString
"SELECT"
      ByteString -> ByteString -> ByteString
<+> (forall (x :: (Symbol, ColumnType)).
 Aliased (Optional (Expression grp '[] with db params from)) x
 -> Maybe ByteString)
-> NP
     (Aliased (Optional (Expression grp '[] with db params from)))
     columns
-> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> Maybe ByteString)
-> NP expression xs -> ByteString
renderCommaSeparatedMaybe forall (x :: (Symbol, ColumnType)).
Aliased (Optional (Expression grp '[] with db params from)) x
-> Maybe ByteString
forall (grp :: Grouping) (from :: FromType)
       (column :: (Symbol, ColumnType)).
Aliased (Optional (Expression grp '[] with db params from)) column
-> Maybe ByteString
renderValuePartMaybe NP
  (Aliased (Optional (Expression grp '[] with db params from)))
  columns
row0
      ByteString -> ByteString -> ByteString
<+> TableExpression grp '[] with db params from -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TableExpression grp '[] with db params from
tab
    Subquery Query '[] with db params row
qry -> Query '[] with db params row -> ByteString
forall (lat :: FromType) (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (row :: RowType).
Query lat with db params row -> ByteString
renderQuery Query '[] with db params row
qry
    where
      renderSQLPartMaybe, renderValuePartMaybe
        :: Aliased (Optional (Expression grp '[] with db params from)) column
        -> Maybe ByteString
      renderSQLPartMaybe :: Aliased (Optional (Expression grp '[] with db params from)) column
-> Maybe ByteString
renderSQLPartMaybe = \case
        Optional (Expression grp '[] with db params from) ty
Default `As` Alias alias
_ -> Maybe ByteString
forall a. Maybe a
Nothing
        Set Expression grp '[] with db params from ty
_ `As` Alias alias
name -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Alias alias -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
name
      renderValuePartMaybe :: Aliased (Optional (Expression grp '[] with db params from)) column
-> Maybe ByteString
renderValuePartMaybe = \case
        Optional (Expression grp '[] with db params from) ty
Default `As` Alias alias
_ -> Maybe ByteString
forall a. Maybe a
Nothing
        Set Expression grp '[] with db params from ty
value `As` Alias alias
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Expression grp '[] with db params from ty -> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Expression grp lat with db params from ty -> ByteString
renderExpression Expression grp '[] with db params from ty
value
      renderSQLPart, renderValuePart
        :: Aliased (Optional (Expression grp '[] with db params from)) column
        -> ByteString
      renderSQLPart :: Aliased (Optional (Expression grp '[] with db params from)) column
-> ByteString
renderSQLPart (Optional (Expression grp '[] with db params from) ty
_ `As` Alias alias
name) = Alias alias -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
name
      renderValuePart :: Aliased (Optional (Expression grp '[] with db params from)) column
-> ByteString
renderValuePart (Optional (Expression grp '[] with db params from) ty
value `As` Alias alias
_) = Optional (Expression grp '[] with db params from) ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Optional (Expression grp '[] with db params from) ty
value

-- | `Values_` describes a single `NP` list of `Aliased` `Optional` `Expression`s
-- whose `ColumnsType` must match the tables'.
pattern Values_
  :: SOP.SListI columns
  => NP (Aliased (Optional (Expression  'Ungrouped '[] with db params from))) columns
  -- ^ row of values
  -> QueryClause with db params columns
pattern $bValues_ :: NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
-> QueryClause with db params columns
$mValues_ :: forall r (columns :: [(Symbol, ColumnType)]) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]).
SListI columns =>
QueryClause with db params columns
-> (forall (from :: FromType).
    NP
      (Aliased
         (Optional (Expression 'Ungrouped '[] with db params from)))
      columns
    -> r)
-> (Void# -> r)
-> r
Values_ vals = Values vals []

-- | `inlineValues_` a Haskell record in `insertInto`.
inlineValues_
  :: ( SOP.IsRecord hask xs
     , SOP.AllZip InlineColumn xs columns )
  => hask -- ^ record
  -> QueryClause with db params columns
inlineValues_ :: hask -> QueryClause with db params columns
inlineValues_ = NP
  (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
  columns
-> QueryClause with db params columns
forall (columns :: [(Symbol, ColumnType)]) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
SListI columns =>
NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
-> QueryClause with db params columns
Values_ (NP
   (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
   columns
 -> QueryClause with db params columns)
-> (hask
    -> NP
         (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
         columns)
-> hask
-> QueryClause with db params columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
forall hask (xs :: RecordCode) (columns :: [(Symbol, ColumnType)])
       (with :: FromType) (db :: SchemasType) (params :: [NullType]).
(IsRecord hask xs, AllZip InlineColumn xs columns) =>
hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
inlineColumns

-- | `inlineValues` Haskell records in `insertInto`.
inlineValues
  :: ( SOP.IsRecord hask xs
     , SOP.AllZip InlineColumn xs columns )
  => hask -- ^ record
  -> [hask] -- ^ more
  -> QueryClause with db params columns
inlineValues :: hask -> [hask] -> QueryClause with db params columns
inlineValues hask
hask [hask]
hasks = NP
  (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
  columns
-> [NP
      (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
      columns]
-> QueryClause with db params columns
forall (columns :: [(Symbol, ColumnType)]) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
SListI columns =>
NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  columns
-> [NP
      (Aliased
         (Optional (Expression 'Ungrouped '[] with db params from)))
      columns]
-> QueryClause with db params columns
Values (hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
forall hask (xs :: RecordCode) (columns :: [(Symbol, ColumnType)])
       (with :: FromType) (db :: SchemasType) (params :: [NullType]).
(IsRecord hask xs, AllZip InlineColumn xs columns) =>
hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
inlineColumns hask
hask) (hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
forall hask (xs :: RecordCode) (columns :: [(Symbol, ColumnType)])
       (with :: FromType) (db :: SchemasType) (params :: [NullType]).
(IsRecord hask xs, AllZip InlineColumn xs columns) =>
hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
inlineColumns (hask
 -> NP
      (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
      columns)
-> [hask]
-> [NP
      (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
      columns]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [hask]
hasks)

-- | A `ConflictClause` specifies an action to perform upon a constraint
-- violation. `OnConflictDoRaise` will raise an error.
-- `OnConflict` `DoNothing` simply avoids inserting a row.
-- `OnConflict` `DoUpdate` updates the existing row that conflicts with the row
-- proposed for insertion.
data ConflictClause tab with db params table where
  OnConflictDoRaise :: ConflictClause tab with db params table
  OnConflict
    :: ConflictTarget table
    -- ^ conflict target
    -> ConflictAction tab with db params table
    -- ^ conflict action
    -> ConflictClause tab with db params table

-- | Render a `ConflictClause`.
instance SOP.SListI (TableToColumns table)
  => RenderSQL (ConflictClause tab with db params table) where
    renderSQL :: ConflictClause tab with db params table -> ByteString
renderSQL = \case
      ConflictClause tab with db params table
OnConflictDoRaise -> ByteString
""
      OnConflict ConflictTarget table
target ConflictAction tab with db params table
action -> ByteString
" ON CONFLICT"
        ByteString -> ByteString -> ByteString
<+> ConflictTarget table -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ConflictTarget table
target ByteString -> ByteString -> ByteString
<+> ConflictAction tab with db params table -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ConflictAction tab with db params table
action

{- |
`ConflictAction` specifies an alternative `OnConflict` action.
It can be either `DoNothing`, or a `DoUpdate` clause specifying
the exact details of the update action to be performed in case of a conflict.
The `Set` and WHERE `Condition`s in `OnConflict` `DoUpdate` have access to the
existing row using the table's name, and to rows proposed
for insertion using the special @#excluded@ row.
`OnConflict` `DoNothing` simply avoids inserting a row as its alternative action.
`OnConflict` `DoUpdate` updates the existing row that conflicts
with the row proposed for insertion as its alternative action.
-}
data ConflictAction tab with db params table where
  DoNothing :: ConflictAction tab with db params table
  DoUpdate
    :: ( row ~ TableToRow table
       , from ~ '[tab ::: row, "excluded" ::: row]
       , Updatable table updates )
    => NP (Aliased (Optional (Expression  'Ungrouped '[] with db params from))) updates
    -> [Condition  'Ungrouped '[] with db params from]
       -- ^ WHERE `Condition`s
    -> ConflictAction tab with db params table

instance RenderSQL (ConflictAction tab with db params table) where
  renderSQL :: ConflictAction tab with db params table -> ByteString
renderSQL = \case
    ConflictAction tab with db params table
DoNothing -> ByteString
"DO NOTHING"
    DoUpdate NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  updates
updates [Condition 'Ungrouped '[] with db params from]
whs'
      -> ByteString
"DO UPDATE SET"
        ByteString -> ByteString -> ByteString
<+> (forall (x :: (Symbol, ColumnType)).
 Aliased
   (Optional (Expression 'Ungrouped '[] with db params from)) x
 -> ByteString)
-> NP
     (Aliased
        (Optional (Expression 'Ungrouped '[] with db params from)))
     updates
-> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall k (expr :: k -> *) (ty :: (Symbol, (Optionality, k))).
(forall (x :: k). RenderSQL (expr x)) =>
Aliased (Optional expr) ty -> ByteString
forall (x :: (Symbol, ColumnType)).
Aliased
  (Optional (Expression 'Ungrouped '[] with db params from)) x
-> ByteString
renderUpdate NP
  (Aliased
     (Optional (Expression 'Ungrouped '[] with db params from)))
  updates
updates
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> case [Condition 'Ungrouped '[] with db params from]
whs' of
          [] -> ByteString
""
          Condition 'Ungrouped '[] with db params from
wh:[Condition 'Ungrouped '[] with db params from]
whs -> ByteString
" WHERE" ByteString -> ByteString -> ByteString
<+> Condition 'Ungrouped '[] with db params from -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ((Condition 'Ungrouped '[] with db params from
 -> Condition 'Ungrouped '[] with db params from
 -> Condition 'Ungrouped '[] with db params from)
-> Condition 'Ungrouped '[] with db params from
-> [Condition 'Ungrouped '[] with db params from]
-> Condition 'Ungrouped '[] with db params from
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Condition 'Ungrouped '[] with db params from
-> Condition 'Ungrouped '[] with db params from
-> Condition 'Ungrouped '[] with db params from
forall (null :: PGType -> NullType).
Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
(.&&) Condition 'Ungrouped '[] with db params from
wh [Condition 'Ungrouped '[] with db params from]
whs)

renderUpdate
  :: (forall x. RenderSQL (expr x))
  => Aliased (Optional expr) ty
  -> ByteString
renderUpdate :: Aliased (Optional expr) ty -> ByteString
renderUpdate (Optional expr ty
expr `As` Alias alias
col) = Alias alias -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias alias
col ByteString -> ByteString -> ByteString
<+> ByteString
"=" ByteString -> ByteString -> ByteString
<+> Optional expr ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Optional expr ty
expr

-- | A `ConflictTarget` specifies the constraint violation that triggers a
-- `ConflictAction`.
data ConflictTarget table where
  OnConstraint
    :: Has con constraints constraint
    => Alias con
    -> ConflictTarget (constraints :=> columns)

-- | Render a `ConflictTarget`
instance RenderSQL (ConflictTarget constraints) where
  renderSQL :: ConflictTarget constraints -> ByteString
renderSQL (OnConstraint Alias con
con) =
    ByteString
"ON" ByteString -> ByteString -> ByteString
<+> ByteString
"CONSTRAINT" ByteString -> ByteString -> ByteString
<+> Alias con -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias con
con