mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
11a454c2d6
This commit applies ormolu to the whole Haskell code base by running `make format`. For in-flight branches, simply merging changes from `main` will result in merge conflicts. To avoid this, update your branch using the following instructions. Replace `<format-commit>` by the hash of *this* commit. $ git checkout my-feature-branch $ git merge <format-commit>^ # and resolve conflicts normally $ make format $ git commit -a -m "reformat with ormolu" $ git merge -s ours post-ormolu https://github.com/hasura/graphql-engine-mono/pull/2404 GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
107 lines
3.3 KiB
Haskell
107 lines
3.3 KiB
Haskell
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
|
|
|
|
mkInsertCTE ::
|
|
Backend ('Postgres pgKind) =>
|
|
InsertQueryP1 ('Postgres pgKind) ->
|
|
S.CTE
|
|
mkInsertCTE (InsertQueryP1 tn cols vals conflict (insCheck, updCheck) _ _) =
|
|
S.CTEInsert insert
|
|
where
|
|
tupVals = S.ValuesExp $ map S.TupleExp vals
|
|
insert =
|
|
S.SQLInsert tn cols tupVals (toSQLConflict tn <$> conflict)
|
|
. Just
|
|
. S.RetExp
|
|
$ [ S.selectStar,
|
|
insertOrUpdateCheckExpr
|
|
tn
|
|
conflict
|
|
(toSQLBool insCheck)
|
|
(fmap toSQLBool updCheck)
|
|
]
|
|
toSQLBool = toSQLBoolExp $ S.QualTable tn
|
|
|
|
toSQLConflict ::
|
|
Backend ('Postgres pgKind) =>
|
|
QualifiedTable ->
|
|
ConflictClauseP1 ('Postgres pgKind) S.SQLExp ->
|
|
S.SQLConflict
|
|
toSQLConflict tableName = \case
|
|
CP1DoNothing ct -> S.DoNothing $ toSQLCT <$> ct
|
|
CP1Update ct inpCols preSet filtr ->
|
|
S.Update
|
|
(toSQLCT ct)
|
|
(S.buildUpsertSetExp inpCols preSet)
|
|
$ Just $ S.WhereFrag $ toSQLBoolExp (S.QualTable tableName) filtr
|
|
where
|
|
toSQLCT ct = case ct of
|
|
CTColumn pgCols -> S.SQLColumn pgCols
|
|
CTConstraint cn -> S.SQLConstraint cn
|
|
|
|
-- | Annotates the check constraint expression with @boolean@
|
|
-- (<check-condition>)::boolean
|
|
insertCheckConstraint :: S.BoolExp -> S.SQLExp
|
|
insertCheckConstraint boolExp =
|
|
S.SETyAnn (S.SEBool boolExp) 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 (ConflictClauseP1 ('Postgres pgKind) S.SQLExp) ->
|
|
S.BoolExp ->
|
|
Maybe S.BoolExp ->
|
|
S.Extractor
|
|
insertOrUpdateCheckExpr qt (Just _conflict) insCheck (Just updCheck) =
|
|
asCheckErrorExtractor $
|
|
S.SECond
|
|
( S.BECompare
|
|
S.SEQ
|
|
(S.SEQIdentifier (S.QIdentifier (S.mkQual qt) (Identifier "xmax")))
|
|
(S.SEUnsafe "0")
|
|
)
|
|
(insertCheckConstraint insCheck)
|
|
(insertCheckConstraint updCheck)
|
|
insertOrUpdateCheckExpr _ _ insCheck _ =
|
|
-- 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.
|
|
asCheckErrorExtractor $ insertCheckConstraint insCheck
|