-- | 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 HashMap
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.IR.Update.Batch
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
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]
  deriving (Int -> UpdateCTE -> ShowS
[UpdateCTE] -> ShowS
UpdateCTE -> String
(Int -> UpdateCTE -> ShowS)
-> (UpdateCTE -> String)
-> ([UpdateCTE] -> ShowS)
-> Show UpdateCTE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateCTE -> ShowS
showsPrec :: Int -> UpdateCTE -> ShowS
$cshow :: UpdateCTE -> String
show :: UpdateCTE -> String
$cshowList :: [UpdateCTE] -> ShowS
showList :: [UpdateCTE] -> ShowS
Show)

-- | Create the update CTE.
mkUpdateCTE ::
  forall pgKind.
  (Backend ('Postgres pgKind)) =>
  AnnotatedUpdate ('Postgres pgKind) ->
  UpdateCTE
mkUpdateCTE :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnotatedUpdate ('Postgres pgKind) -> UpdateCTE
mkUpdateCTE (AnnotatedUpdateG TableName ('Postgres pgKind)
tn AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
permFltr AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
chk UpdateVariant ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
updateVariant MutationOutputG
  ('Postgres pgKind) Void (SQLExpression ('Postgres pgKind))
_ [ColumnInfo ('Postgres pgKind)]
columnsInfo Maybe NamingCase
_tCase Maybe (ValidateInput ResolvedWebhook)
_validateInput) =
  case UpdateVariant ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
updateVariant of
    SingleBatch UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp
update ->
      TopLevelCTE -> UpdateCTE
Update (TopLevelCTE -> UpdateCTE) -> TopLevelCTE -> UpdateCTE
forall a b. (a -> b) -> a -> b
$ UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp
-> TopLevelCTE
translateUpdate UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp
update
    MultipleBatches [UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp]
updates ->
      [TopLevelCTE] -> UpdateCTE
MultiUpdate ([TopLevelCTE] -> UpdateCTE) -> [TopLevelCTE] -> UpdateCTE
forall a b. (a -> b) -> a -> b
$ UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp
-> TopLevelCTE
translateUpdate (UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp
 -> TopLevelCTE)
-> [UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp]
-> [TopLevelCTE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp]
updates
  where
    mkWhere :: AnnBoolExp ('Postgres pgKind) S.SQLExp -> Maybe S.WhereFrag
    mkWhere :: AnnBoolExp ('Postgres pgKind) SQLExp -> Maybe WhereFrag
mkWhere =
      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 -> BoolExp)
-> (AnnBoolExp ('Postgres pgKind) SQLExp
    -> AnnBoolExp ('Postgres pgKind) SQLExp)
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> BoolExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

    checkConstraint :: Maybe S.RetExp
    checkConstraint :: Maybe RetExp
checkConstraint =
      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)
-> (AnnBoolExp
      ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
    -> SQLExp)
-> AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> Extractor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExp -> SQLExp
insertCheckConstraint
              (BoolExp -> SQLExp)
-> (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExp)
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> SQLExp
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) (SQLExpression ('Postgres pgKind))
 -> Extractor)
-> AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> Extractor
forall a b. (a -> b) -> a -> b
$ AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
chk
          ]

    translateUpdate :: UpdateBatch ('Postgres pgKind) UpdateOpExpression S.SQLExp -> S.TopLevelCTE
    translateUpdate :: UpdateBatch ('Postgres pgKind) UpdateOpExpression SQLExp
-> TopLevelCTE
translateUpdate UpdateBatch {HashMap (Column ('Postgres pgKind)) (UpdateOpExpression SQLExp)
AnnBoolExp ('Postgres pgKind) SQLExp
_ubOperations :: HashMap (Column ('Postgres pgKind)) (UpdateOpExpression SQLExp)
_ubWhere :: AnnBoolExp ('Postgres pgKind) SQLExp
_ubOperations :: forall (b :: BackendType) (updateOperators :: * -> *) v.
UpdateBatch b updateOperators v
-> HashMap (Column b) (updateOperators v)
_ubWhere :: forall (b :: BackendType) (updateOperators :: * -> *) v.
UpdateBatch b updateOperators v -> AnnBoolExp b v
..} =
      SQLUpdate -> TopLevelCTE
S.CTEUpdate
        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)]
HashMap.toList HashMap (Column ('Postgres pgKind)) (UpdateOpExpression SQLExp)
HashMap PGCol (UpdateOpExpression SQLExp)
_ubOperations),
            upFrom :: Maybe FromExp
upFrom = Maybe FromExp
forall a. Maybe a
Nothing,
            upWhere :: Maybe WhereFrag
upWhere = AnnBoolExp ('Postgres pgKind) SQLExp -> Maybe WhereFrag
mkWhere AnnBoolExp ('Postgres pgKind) SQLExp
_ubWhere,
            upRet :: Maybe RetExp
upRet = Maybe RetExp
checkConstraint
          }

expandOperator :: [ColumnInfo ('Postgres pgKind)] -> (PGCol, UpdateOpExpression S.SQLExp) -> S.SetExpItem
expandOperator :: forall (pgKind :: PostgresKind).
[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