-- | Postgres Translate Update
--
-- Translates IR update to Postgres-specific SQL UPDATE statements.
module Hasura.Backends.Postgres.Translate.Update
  ( mkUpdateCTE,
    UpdateCTE (..),
  )
where

import Data.HashMap.Strict qualified as Map
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.Insert
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Types.Update
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Update
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.SQL.Backend
import Hasura.SQL.Types

data UpdateCTE
  = -- | Used for /update_table/ and /update_table_by_pk/.
    Update S.TopLevelCTE
  | -- | Used for /update_table_many/.
    MultiUpdate [S.TopLevelCTE]

-- | Create the update CTE.
mkUpdateCTE ::
  forall pgKind.
  Backend ('Postgres pgKind) =>
  AnnotatedUpdate ('Postgres pgKind) ->
  UpdateCTE
mkUpdateCTE :: AnnotatedUpdate ('Postgres pgKind) -> UpdateCTE
mkUpdateCTE (AnnotatedUpdateG TableName ('Postgres pgKind)
tn (AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
permFltr, AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
wc) AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
chk BackendUpdate ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
backendUpdate MutationOutputG
  ('Postgres pgKind) Void (SQLExpression ('Postgres pgKind))
_ [ColumnInfo ('Postgres pgKind)]
columnsInfo Maybe NamingCase
_tCase) =
  case BackendUpdate ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
backendUpdate of
    BackendUpdate opExps ->
      TopLevelCTE -> UpdateCTE
Update (TopLevelCTE -> UpdateCTE) -> TopLevelCTE -> UpdateCTE
forall a b. (a -> b) -> a -> b
$ SQLUpdate -> TopLevelCTE
S.CTEUpdate SQLUpdate
update
      where
        update :: SQLUpdate
update =
          SQLUpdate :: QualifiedTable
-> SetExp
-> Maybe FromExp
-> Maybe WhereFrag
-> Maybe RetExp
-> SQLUpdate
S.SQLUpdate
            { upTable :: QualifiedTable
upTable = TableName ('Postgres pgKind)
QualifiedTable
tn,
              upSet :: SetExp
upSet =
                [SetExpItem] -> SetExp
S.SetExp ([SetExpItem] -> SetExp) -> [SetExpItem] -> SetExp
forall a b. (a -> b) -> a -> b
$ ((PGCol, UpdateOpExpression SQLExp) -> SetExpItem)
-> [(PGCol, UpdateOpExpression SQLExp)] -> [SetExpItem]
forall a b. (a -> b) -> [a] -> [b]
map ([ColumnInfo ('Postgres pgKind)]
-> (PGCol, UpdateOpExpression SQLExp) -> SetExpItem
forall (pgKind :: PostgresKind).
[ColumnInfo ('Postgres pgKind)]
-> (PGCol, UpdateOpExpression SQLExp) -> SetExpItem
expandOperator [ColumnInfo ('Postgres pgKind)]
columnsInfo) (HashMap PGCol (UpdateOpExpression SQLExp)
-> [(PGCol, UpdateOpExpression SQLExp)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap PGCol (UpdateOpExpression SQLExp)
opExps),
              upFrom :: Maybe FromExp
upFrom = Maybe FromExp
forall a. Maybe a
Nothing,
              upWhere :: Maybe WhereFrag
upWhere =
                WhereFrag -> Maybe WhereFrag
forall a. a -> Maybe a
Just
                  (WhereFrag -> Maybe WhereFrag)
-> (AnnBoolExp ('Postgres pgKind) SQLExp -> WhereFrag)
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> Maybe WhereFrag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExp -> WhereFrag
S.WhereFrag
                  (BoolExp -> WhereFrag)
-> (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExp)
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> WhereFrag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExp -> BoolExp
S.simplifyBoolExp
                  (BoolExp -> BoolExp)
-> (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExp)
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> BoolExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qual
-> AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (QualifiedTable -> Qual
S.QualTable TableName ('Postgres pgKind)
QualifiedTable
tn)
                  (AnnBoolExp ('Postgres pgKind) SQLExp -> Maybe WhereFrag)
-> AnnBoolExp ('Postgres pgKind) SQLExp -> Maybe WhereFrag
forall a b. (a -> b) -> a -> b
$ AnnBoolExp ('Postgres pgKind) SQLExp
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> AnnBoolExp ('Postgres pgKind) SQLExp
forall (backend :: BackendType) scalar.
AnnBoolExp backend scalar
-> AnnBoolExp backend scalar -> AnnBoolExp backend scalar
andAnnBoolExps AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
AnnBoolExp ('Postgres pgKind) SQLExp
permFltr AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
AnnBoolExp ('Postgres pgKind) SQLExp
wc,
              upRet :: Maybe RetExp
upRet =
                RetExp -> Maybe RetExp
forall a. a -> Maybe a
Just (RetExp -> Maybe RetExp) -> RetExp -> Maybe RetExp
forall a b. (a -> b) -> a -> b
$
                  [Extractor] -> RetExp
S.RetExp
                    [ Extractor
S.selectStar,
                      SQLExp -> Extractor
asCheckErrorExtractor (SQLExp -> Extractor) -> SQLExp -> Extractor
forall a b. (a -> b) -> a -> b
$
                        BoolExp -> SQLExp
insertCheckConstraint (BoolExp -> SQLExp) -> BoolExp -> SQLExp
forall a b. (a -> b) -> a -> b
$
                          Qual
-> AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (QualifiedTable -> Qual
S.QualTable TableName ('Postgres pgKind)
QualifiedTable
tn) AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
chk
                    ]
            }
    BackendMultiRowUpdate updates ->
      [TopLevelCTE] -> UpdateCTE
MultiUpdate ([TopLevelCTE] -> UpdateCTE) -> [TopLevelCTE] -> UpdateCTE
forall a b. (a -> b) -> a -> b
$ MultiRowUpdate pgKind SQLExp -> TopLevelCTE
translateUpdate (MultiRowUpdate pgKind SQLExp -> TopLevelCTE)
-> [MultiRowUpdate pgKind SQLExp] -> [TopLevelCTE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MultiRowUpdate pgKind SQLExp]
updates
      where
        translateUpdate :: MultiRowUpdate pgKind S.SQLExp -> S.TopLevelCTE
        translateUpdate :: MultiRowUpdate pgKind SQLExp -> TopLevelCTE
translateUpdate MultiRowUpdate {HashMap PGCol (UpdateOpExpression SQLExp)
AnnBoolExp ('Postgres pgKind) SQLExp
mruExpression :: forall (pgKind :: PostgresKind) v.
MultiRowUpdate pgKind v -> HashMap PGCol (UpdateOpExpression v)
mruWhere :: forall (pgKind :: PostgresKind) v.
MultiRowUpdate pgKind v -> AnnBoolExp ('Postgres pgKind) v
mruExpression :: HashMap PGCol (UpdateOpExpression SQLExp)
mruWhere :: AnnBoolExp ('Postgres pgKind) SQLExp
..} =
          SQLUpdate -> TopLevelCTE
S.CTEUpdate
            SQLUpdate :: QualifiedTable
-> SetExp
-> Maybe FromExp
-> Maybe WhereFrag
-> Maybe RetExp
-> SQLUpdate
S.SQLUpdate
              { upTable :: QualifiedTable
upTable = TableName ('Postgres pgKind)
QualifiedTable
tn,
                upSet :: SetExp
upSet =
                  [SetExpItem] -> SetExp
S.SetExp ([SetExpItem] -> SetExp) -> [SetExpItem] -> SetExp
forall a b. (a -> b) -> a -> b
$ ((PGCol, UpdateOpExpression SQLExp) -> SetExpItem)
-> [(PGCol, UpdateOpExpression SQLExp)] -> [SetExpItem]
forall a b. (a -> b) -> [a] -> [b]
map ([ColumnInfo ('Postgres pgKind)]
-> (PGCol, UpdateOpExpression SQLExp) -> SetExpItem
forall (pgKind :: PostgresKind).
[ColumnInfo ('Postgres pgKind)]
-> (PGCol, UpdateOpExpression SQLExp) -> SetExpItem
expandOperator [ColumnInfo ('Postgres pgKind)]
columnsInfo) (HashMap PGCol (UpdateOpExpression SQLExp)
-> [(PGCol, UpdateOpExpression SQLExp)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap PGCol (UpdateOpExpression SQLExp)
mruExpression),
                upFrom :: Maybe FromExp
upFrom = Maybe FromExp
forall a. Maybe a
Nothing,
                upWhere :: Maybe WhereFrag
upWhere =
                  WhereFrag -> Maybe WhereFrag
forall a. a -> Maybe a
Just
                    (WhereFrag -> Maybe WhereFrag)
-> (BoolExp -> WhereFrag) -> BoolExp -> Maybe WhereFrag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExp -> WhereFrag
S.WhereFrag
                    (BoolExp -> WhereFrag)
-> (BoolExp -> BoolExp) -> BoolExp -> WhereFrag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExp -> BoolExp
S.simplifyBoolExp
                    (BoolExp -> Maybe WhereFrag) -> BoolExp -> Maybe WhereFrag
forall a b. (a -> b) -> a -> b
$ Qual
-> AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (QualifiedTable -> Qual
S.QualTable TableName ('Postgres pgKind)
QualifiedTable
tn) AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
AnnBoolExp ('Postgres pgKind) SQLExp
mruWhere,
                upRet :: Maybe RetExp
upRet =
                  RetExp -> Maybe RetExp
forall a. a -> Maybe a
Just (RetExp -> Maybe RetExp) -> RetExp -> Maybe RetExp
forall a b. (a -> b) -> a -> b
$
                    [Extractor] -> RetExp
S.RetExp
                      [ Extractor
S.selectStar,
                        SQLExp -> Extractor
asCheckErrorExtractor
                          (SQLExp -> Extractor)
-> (BoolExp -> SQLExp) -> BoolExp -> Extractor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExp -> SQLExp
insertCheckConstraint
                          (BoolExp -> Extractor) -> BoolExp -> Extractor
forall a b. (a -> b) -> a -> b
$ Qual
-> AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp (QualifiedTable -> Qual
S.QualTable TableName ('Postgres pgKind)
QualifiedTable
tn) AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
chk
                      ]
              }

expandOperator :: [ColumnInfo ('Postgres pgKind)] -> (PGCol, UpdateOpExpression S.SQLExp) -> S.SetExpItem
expandOperator :: [ColumnInfo ('Postgres pgKind)]
-> (PGCol, UpdateOpExpression SQLExp) -> SetExpItem
expandOperator [ColumnInfo ('Postgres pgKind)]
infos (PGCol
column, UpdateOpExpression SQLExp
op) = (PGCol, SQLExp) -> SetExpItem
S.SetExpItem ((PGCol, SQLExp) -> SetExpItem) -> (PGCol, SQLExp) -> SetExpItem
forall a b. (a -> b) -> a -> b
$
  (PGCol
column,) (SQLExp -> (PGCol, SQLExp)) -> SQLExp -> (PGCol, SQLExp)
forall a b. (a -> b) -> a -> b
$ case UpdateOpExpression SQLExp
op of
    UpdateSet SQLExp
e -> SQLExp
e
    UpdateInc SQLExp
e -> SQLOp -> SQLExp -> SQLExp -> SQLExp
S.mkSQLOpExp SQLOp
S.incOp SQLExp
identifier (SQLExp -> SQLExp
asNum SQLExp
e)
    UpdateAppend SQLExp
e -> SQLOp -> SQLExp -> SQLExp -> SQLExp
S.mkSQLOpExp SQLOp
S.jsonbConcatOp SQLExp
identifier (SQLExp -> SQLExp
asJSON SQLExp
e)
    UpdatePrepend SQLExp
e -> SQLOp -> SQLExp -> SQLExp -> SQLExp
S.mkSQLOpExp SQLOp
S.jsonbConcatOp (SQLExp -> SQLExp
asJSON SQLExp
e) SQLExp
identifier
    UpdateDeleteKey SQLExp
e -> SQLOp -> SQLExp -> SQLExp -> SQLExp
S.mkSQLOpExp SQLOp
S.jsonbDeleteOp SQLExp
identifier (SQLExp -> SQLExp
asText SQLExp
e)
    UpdateDeleteElem SQLExp
e -> SQLOp -> SQLExp -> SQLExp -> SQLExp
S.mkSQLOpExp SQLOp
S.jsonbDeleteOp SQLExp
identifier (SQLExp -> SQLExp
asInt SQLExp
e)
    UpdateDeleteAtPath [SQLExp]
a -> SQLOp -> SQLExp -> SQLExp -> SQLExp
S.mkSQLOpExp SQLOp
S.jsonbDeleteAtPathOp SQLExp
identifier ([SQLExp] -> SQLExp
asArray [SQLExp]
a)
  where
    identifier :: SQLExp
identifier = Identifier -> SQLExp
S.SEIdentifier (Identifier -> SQLExp) -> Identifier -> SQLExp
forall a b. (a -> b) -> a -> b
$ PGCol -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier PGCol
column
    asInt :: SQLExp -> SQLExp
asInt SQLExp
e = SQLExp -> TypeAnn -> SQLExp
S.SETyAnn SQLExp
e TypeAnn
S.intTypeAnn
    asText :: SQLExp -> SQLExp
asText SQLExp
e = SQLExp -> TypeAnn -> SQLExp
S.SETyAnn SQLExp
e TypeAnn
S.textTypeAnn
    asJSON :: SQLExp -> SQLExp
asJSON SQLExp
e = SQLExp -> TypeAnn -> SQLExp
S.SETyAnn SQLExp
e TypeAnn
S.jsonbTypeAnn
    asArray :: [SQLExp] -> SQLExp
asArray [SQLExp]
a = SQLExp -> TypeAnn -> SQLExp
S.SETyAnn ([SQLExp] -> SQLExp
S.SEArray [SQLExp]
a) TypeAnn
S.textArrTypeAnn
    asNum :: SQLExp -> SQLExp
asNum SQLExp
e = SQLExp -> TypeAnn -> SQLExp
S.SETyAnn SQLExp
e (TypeAnn -> SQLExp) -> TypeAnn -> SQLExp
forall a b. (a -> b) -> a -> b
$
      case (ColumnInfo ('Postgres pgKind) -> Bool)
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe (ColumnInfo ('Postgres pgKind))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ColumnInfo ('Postgres pgKind)
info -> ColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres pgKind)
info PGCol -> PGCol -> Bool
forall a. Eq a => a -> a -> Bool
== PGCol
column) [ColumnInfo ('Postgres pgKind)]
infos Maybe (ColumnInfo ('Postgres pgKind))
-> (ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> Maybe (ColumnType ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType of
        Just (ColumnScalar ScalarType ('Postgres pgKind)
s) -> CollectableType PGScalarType -> TypeAnn
S.mkTypeAnn (CollectableType PGScalarType -> TypeAnn)
-> CollectableType PGScalarType -> TypeAnn
forall a b. (a -> b) -> a -> b
$ PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeScalar ScalarType ('Postgres pgKind)
PGScalarType
s
        Maybe (ColumnType ('Postgres pgKind))
_ -> TypeAnn
S.numericTypeAnn