-- | Postgres Translate Insert
--
-- Translates IR inserts to Postgres-specific SQL INSERT statements.
module Hasura.Backends.Postgres.Translate.Insert
  ( mkInsertCTE,
    toSQLConflict,
    insertCheckConstraint,
    insertOrUpdateCheckExpr,
  )
where

import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Translate.BoolExp
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Prelude
import Hasura.RQL.IR.Insert
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType

mkInsertCTE ::
  (Backend ('Postgres pgKind)) =>
  InsertQueryP1 ('Postgres pgKind) ->
  S.TopLevelCTE
mkInsertCTE :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
InsertQueryP1 ('Postgres pgKind) -> TopLevelCTE
mkInsertCTE (InsertQueryP1 TableName ('Postgres pgKind)
tn [Column ('Postgres pgKind)]
cols [[SQLExpression ('Postgres pgKind)]]
vals Maybe
  (OnConflictClause
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind)))
conflict (AnnBoolExpSQL ('Postgres pgKind)
insCheck, Maybe (AnnBoolExpSQL ('Postgres pgKind))
updCheck) MutationOutput ('Postgres pgKind)
_ [ColumnInfo ('Postgres pgKind)]
_) =
  SQLInsert -> TopLevelCTE
S.CTEInsert SQLInsert
insert
  where
    tupVals :: ValuesExp
tupVals = [TupleExp] -> ValuesExp
S.ValuesExp ([TupleExp] -> ValuesExp) -> [TupleExp] -> ValuesExp
forall a b. (a -> b) -> a -> b
$ ([SQLExp] -> TupleExp) -> [[SQLExp]] -> [TupleExp]
forall a b. (a -> b) -> [a] -> [b]
map [SQLExp] -> TupleExp
S.TupleExp [[SQLExpression ('Postgres pgKind)]]
[[SQLExp]]
vals
    insert :: SQLInsert
insert =
      QualifiedTable
-> [PGCol]
-> ValuesExp
-> Maybe SQLConflict
-> Maybe RetExp
-> SQLInsert
S.SQLInsert TableName ('Postgres pgKind)
QualifiedTable
tn [Column ('Postgres pgKind)]
[PGCol]
cols ValuesExp
tupVals (QualifiedTable
-> OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
QualifiedTable
-> OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict
toSQLConflict TableName ('Postgres pgKind)
QualifiedTable
tn (OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict)
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> Maybe SQLConflict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (OnConflictClause
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind)))
Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
conflict)
        (Maybe RetExp -> SQLInsert)
-> ([Extractor] -> Maybe RetExp) -> [Extractor] -> SQLInsert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetExp -> Maybe RetExp
forall a. a -> Maybe a
Just
        (RetExp -> Maybe RetExp)
-> ([Extractor] -> RetExp) -> [Extractor] -> Maybe RetExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extractor] -> RetExp
S.RetExp
        ([Extractor] -> SQLInsert) -> [Extractor] -> SQLInsert
forall a b. (a -> b) -> a -> b
$ [ Extractor
S.selectStar,
            QualifiedTable
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> BoolExp
-> Maybe BoolExp
-> Extractor
forall (pgKind :: PostgresKind).
QualifiedTable
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> BoolExp
-> Maybe BoolExp
-> Extractor
insertOrUpdateCheckExpr
              TableName ('Postgres pgKind)
QualifiedTable
tn
              Maybe
  (OnConflictClause
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind)))
Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
conflict
              (AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBool AnnBoolExpSQL ('Postgres pgKind)
insCheck)
              ((AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExp)
-> Maybe (AnnBoolExp ('Postgres pgKind) SQLExp) -> Maybe BoolExp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExp
toSQLBool Maybe (AnnBoolExpSQL ('Postgres pgKind))
Maybe (AnnBoolExp ('Postgres pgKind) SQLExp)
updCheck)
          ]
    toSQLBool :: AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBool = Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp)
-> Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> Qual
S.QualTable TableName ('Postgres pgKind)
QualifiedTable
tn

toSQLConflict ::
  (Backend ('Postgres pgKind)) =>
  QualifiedTable ->
  OnConflictClause ('Postgres pgKind) S.SQLExp ->
  S.SQLConflict
toSQLConflict :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
QualifiedTable
-> OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict
toSQLConflict QualifiedTable
tableName = \case
  OCCDoNothing Maybe (ConflictTarget ('Postgres pgKind))
ct -> Maybe SQLConflictTarget -> SQLConflict
S.DoNothing (Maybe SQLConflictTarget -> SQLConflict)
-> Maybe SQLConflictTarget -> SQLConflict
forall a b. (a -> b) -> a -> b
$ ConflictTarget ('Postgres pgKind) -> SQLConflictTarget
forall {b :: BackendType}.
(Column b ~ PGCol, ConstraintName b ~ ConstraintName) =>
ConflictTarget b -> SQLConflictTarget
toSQLCT (ConflictTarget ('Postgres pgKind) -> SQLConflictTarget)
-> Maybe (ConflictTarget ('Postgres pgKind))
-> Maybe SQLConflictTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ConflictTarget ('Postgres pgKind))
ct
  OCCUpdate OnConflictClauseData {[Column ('Postgres pgKind)]
PreSetColsG ('Postgres pgKind) SQLExp
AnnBoolExp ('Postgres pgKind) SQLExp
ConflictTarget ('Postgres pgKind)
cp1udConflictTarget :: ConflictTarget ('Postgres pgKind)
cp1udAffectedColumns :: [Column ('Postgres pgKind)]
cp1udValues :: PreSetColsG ('Postgres pgKind) SQLExp
cp1udFilter :: AnnBoolExp ('Postgres pgKind) SQLExp
cp1udConflictTarget :: forall (b :: BackendType) v.
OnConflictClauseData b v -> ConflictTarget b
cp1udAffectedColumns :: forall (b :: BackendType) v. OnConflictClauseData b v -> [Column b]
cp1udValues :: forall (b :: BackendType) v.
OnConflictClauseData b v -> PreSetColsG b v
cp1udFilter :: forall (b :: BackendType) v.
OnConflictClauseData b v -> AnnBoolExp b v
..} ->
    SQLConflictTarget -> SetExp -> Maybe WhereFrag -> SQLConflict
S.Update
      (ConflictTarget ('Postgres pgKind) -> SQLConflictTarget
forall {b :: BackendType}.
(Column b ~ PGCol, ConstraintName b ~ ConstraintName) =>
ConflictTarget b -> SQLConflictTarget
toSQLCT ConflictTarget ('Postgres pgKind)
cp1udConflictTarget)
      ([PGCol] -> HashMap PGCol SQLExp -> SetExp
S.buildUpsertSetExp [Column ('Postgres pgKind)]
[PGCol]
cp1udAffectedColumns PreSetColsG ('Postgres pgKind) SQLExp
HashMap PGCol SQLExp
cp1udValues)
      (Maybe WhereFrag -> SQLConflict) -> Maybe WhereFrag -> SQLConflict
forall a b. (a -> b) -> a -> b
$ WhereFrag -> Maybe WhereFrag
forall a. a -> Maybe a
Just
      (WhereFrag -> Maybe WhereFrag) -> WhereFrag -> Maybe WhereFrag
forall a b. (a -> b) -> a -> b
$ BoolExp -> WhereFrag
S.WhereFrag
      (BoolExp -> WhereFrag) -> BoolExp -> WhereFrag
forall a b. (a -> b) -> a -> b
$ Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (QualifiedTable -> Qual
S.QualTable QualifiedTable
tableName) AnnBoolExpSQL ('Postgres pgKind)
AnnBoolExp ('Postgres pgKind) SQLExp
cp1udFilter
  where
    toSQLCT :: ConflictTarget b -> SQLConflictTarget
toSQLCT ConflictTarget b
ct = case ConflictTarget b
ct of
      CTColumn [Column b]
pgCols -> [PGCol] -> SQLConflictTarget
S.SQLColumn [Column b]
[PGCol]
pgCols
      CTConstraint ConstraintName b
cn -> ConstraintName -> SQLConflictTarget
S.SQLConstraint ConstraintName b
ConstraintName
cn

-- | Annotates the check constraint expression with @boolean@
-- (<check-condition>)::boolean
insertCheckConstraint :: S.BoolExp -> S.SQLExp
insertCheckConstraint :: BoolExp -> SQLExp
insertCheckConstraint BoolExp
boolExp =
  SQLExp -> TypeAnn -> SQLExp
S.SETyAnn (BoolExp -> SQLExp
S.SEBool BoolExp
boolExp) TypeAnn
S.boolTypeAnn

-- | When inserting data, we might need to also enforce the update
-- check condition, because we might fall back to an update via an
-- @ON CONFLICT@ clause.
--
-- We generate something which looks like
--
-- > INSERT INTO
-- >   ...
-- > ON CONFLICT DO UPDATE SET
-- >   ...
-- > RETURNING
-- >   *,
-- >   CASE WHEN xmax = 0
-- >     THEN {insert_cond}
-- >     ELSE {update_cond}
-- >   END
-- >     AS "check__constraint"
--
-- See @https://stackoverflow.com/q/34762732@ for more information on the use of
-- the @xmax@ system column.
insertOrUpdateCheckExpr ::
  QualifiedTable ->
  Maybe (OnConflictClause ('Postgres pgKind) S.SQLExp) ->
  S.BoolExp ->
  Maybe S.BoolExp ->
  S.Extractor
insertOrUpdateCheckExpr :: forall (pgKind :: PostgresKind).
QualifiedTable
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> BoolExp
-> Maybe BoolExp
-> Extractor
insertOrUpdateCheckExpr QualifiedTable
qt (Just OnConflictClause ('Postgres pgKind) SQLExp
_conflict) BoolExp
insCheck (Just BoolExp
updCheck) =
  SQLExp -> Extractor
asCheckErrorExtractor
    (SQLExp -> Extractor) -> SQLExp -> Extractor
forall a b. (a -> b) -> a -> b
$ BoolExp -> SQLExp -> SQLExp -> SQLExp
S.SECond
      ( CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare
          CompareOp
S.SEQ
          (QIdentifier -> SQLExp
S.SEQIdentifier (Qual -> Identifier -> QIdentifier
S.QIdentifier (QualifiedTable -> Qual
S.mkQual QualifiedTable
qt) (Text -> Identifier
Identifier Text
"xmax")))
          (Text -> SQLExp
S.SEUnsafe Text
"0")
      )
      (BoolExp -> SQLExp
insertCheckConstraint BoolExp
insCheck)
      (BoolExp -> SQLExp
insertCheckConstraint BoolExp
updCheck)
insertOrUpdateCheckExpr QualifiedTable
_ Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
_ BoolExp
insCheck Maybe BoolExp
_ =
  -- If we won't generate an ON CONFLICT clause, there is no point
  -- in testing xmax. In particular, views don't provide the xmax
  -- system column, but we don't provide ON CONFLICT for views,
  -- even if they are auto-updatable, so we can fortunately avoid
  -- having to test the non-existent xmax value.
  --
  -- Alternatively, if there is no update check constraint, we should
  -- use the insert check constraint, for backwards compatibility.
  SQLExp -> Extractor
asCheckErrorExtractor (SQLExp -> Extractor) -> SQLExp -> Extractor
forall a b. (a -> b) -> a -> b
$ BoolExp -> SQLExp
insertCheckConstraint BoolExp
insCheck