{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- | Postgres Schema OnConflict
--
-- This module contains the building blocks for parsing @on_conflict@ clauses,
-- which in the Postgres backend are used to implement upsert functionality.
-- These are used by 'Hasura.Backends.Postgres.Instances.Schema.backendInsertParser' to
-- construct a postgres-specific schema parser for insert (and upsert) mutations.
module Hasura.Backends.Postgres.Schema.OnConflict
  ( onConflictFieldParser,
  )
where

import Data.Has (getter)
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types (showPGCols)
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.BoolExp
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser
  ( InputFieldsParser,
    Kind (..),
    Parser,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Table
import Hasura.GraphQL.Schema.Typename (mkTypename)
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp qualified as IR
import Hasura.RQL.IR.Insert qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Language.GraphQL.Draft.Syntax qualified as G

-- | Parser for a field name @on_conflict@ of type @tablename_on_conflict@.
--
-- The @tablename_on_conflict@ object is used to generate the @ON CONFLICT@
-- SQL clause, indicating what should be done if an insert raises a conflict.
--
-- The types ordinarily produced by this parser are only created if the table has
-- unique or primary keys constraints.
--
-- If there are no columns for which the current role has update permissions, we
-- must still accept an empty list for @update_columns@ to support the "ON
-- CONFLICT DO NOTHING" case. We do this by adding a placeholder value to the
-- enum. See <https://github.com/hasura/graphql-engine/issues/6804>.
onConflictFieldParser ::
  forall pgKind r m n.
  ( MonadBuildSchema ('Postgres pgKind) r m n,
    AggregationPredicatesSchema ('Postgres pgKind)
  ) =>
  SourceInfo ('Postgres pgKind) ->
  TableInfo ('Postgres pgKind) ->
  m (InputFieldsParser n (Maybe (IR.OnConflictClause ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind)))))
onConflictFieldParser :: SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> m (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
onConflictFieldParser SourceInfo ('Postgres pgKind)
sourceInfo TableInfo ('Postgres pgKind)
tableInfo = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  RoleName
roleName <- (SchemaContext -> RoleName) -> m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  let permissions :: RolePermInfo ('Postgres pgKind)
permissions = RoleName
-> TableInfo ('Postgres pgKind) -> RolePermInfo ('Postgres pgKind)
forall (b :: BackendType).
RoleName -> TableInfo b -> RolePermInfo b
getRolePermInfo RoleName
roleName TableInfo ('Postgres pgKind)
tableInfo
      maybeConstraints :: Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
maybeConstraints = TableCoreInfoG
  ('Postgres pgKind)
  (FieldInfo ('Postgres pgKind))
  (ColumnInfo ('Postgres pgKind))
-> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
forall (b :: BackendType) f.
(Eq (Column b), Hashable (Column b)) =>
TableCoreInfoG b f (ColumnInfo b)
-> Maybe (NonEmpty (UniqueConstraint b))
tciUniqueOrPrimaryKeyConstraints (TableCoreInfoG
   ('Postgres pgKind)
   (FieldInfo ('Postgres pgKind))
   (ColumnInfo ('Postgres pgKind))
 -> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind))))
-> (TableInfo ('Postgres pgKind)
    -> TableCoreInfoG
         ('Postgres pgKind)
         (FieldInfo ('Postgres pgKind))
         (ColumnInfo ('Postgres pgKind)))
-> TableInfo ('Postgres pgKind)
-> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo ('Postgres pgKind)
-> TableCoreInfoG
     ('Postgres pgKind)
     (FieldInfo ('Postgres pgKind))
     (ColumnInfo ('Postgres pgKind))
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo (TableInfo ('Postgres pgKind)
 -> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind))))
-> TableInfo ('Postgres pgKind)
-> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres pgKind)
tableInfo
      maybeConflictObject :: Maybe
  (m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
maybeConflictObject = SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
-> NonEmpty (UniqueConstraint ('Postgres pgKind))
-> m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind)) =>
SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
-> NonEmpty (UniqueConstraint ('Postgres pgKind))
-> m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObjectParser SourceInfo ('Postgres pgKind)
sourceInfo TableInfo ('Postgres pgKind)
tableInfo (RolePermInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
forall (b :: BackendType). RolePermInfo b -> Maybe (UpdPermInfo b)
_permUpd RolePermInfo ('Postgres pgKind)
permissions) (NonEmpty (UniqueConstraint ('Postgres pgKind))
 -> m (Parser
         'Input
         n
         (OnConflictClause
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
-> Maybe
     (m (Parser
           'Input
           n
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
maybeConstraints
  case Maybe
  (m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
maybeConflictObject of
    Just m (Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObject -> m (Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObject m (Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> (Parser
      'Input
      n
      (OnConflictClause
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
    -> InputFieldsParser
         n
         (Maybe
            (OnConflictClause
               ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> m (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Name
-> Maybe Description
-> Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (Maybe
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional (NamingCase -> Name -> Name
applyFieldNameCaseCust NamingCase
tCase Name
Name._on_conflict) (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"upsert condition")
    Maybe
  (m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
Nothing -> InputFieldsParser
  n
  (Maybe
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> m (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall (m :: * -> *) a. Monad m => a -> m a
return (InputFieldsParser
   n
   (Maybe
      (OnConflictClause
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
 -> m (InputFieldsParser
         n
         (Maybe
            (OnConflictClause
               ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))))
-> InputFieldsParser
     n
     (Maybe
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> m (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall a b. (a -> b) -> a -> b
$ Maybe
  (OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (Maybe
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  (OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall a. Maybe a
Nothing

-- | Create a parser for the @_on_conflict@ object of the given table.
conflictObjectParser ::
  forall pgKind r m n.
  ( MonadBuildSchema ('Postgres pgKind) r m n,
    AggregationPredicatesSchema ('Postgres pgKind)
  ) =>
  SourceInfo ('Postgres pgKind) ->
  TableInfo ('Postgres pgKind) ->
  Maybe (UpdPermInfo ('Postgres pgKind)) ->
  NonEmpty (UniqueConstraint ('Postgres pgKind)) ->
  m (Parser 'Input n (IR.OnConflictClause ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind))))
conflictObjectParser :: SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
-> NonEmpty (UniqueConstraint ('Postgres pgKind))
-> m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObjectParser SourceInfo ('Postgres pgKind)
sourceInfo TableInfo ('Postgres pgKind)
tableInfo Maybe (UpdPermInfo ('Postgres pgKind))
maybeUpdatePerms NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  Parser MetadataObjId 'Both n (Maybe PGCol)
updateColumnsEnum <- TableInfo ('Postgres pgKind)
-> m (Parser 'Both n (Maybe (Column ('Postgres pgKind))))
forall (backend :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema backend r m n =>
TableInfo backend -> m (Parser 'Both n (Maybe (Column backend)))
updateColumnsPlaceholderParser TableInfo ('Postgres pgKind)
tableInfo
  Parser 'Both n (UniqueConstraint ('Postgres pgKind))
constraintParser <- NonEmpty (UniqueConstraint ('Postgres pgKind))
-> SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
NonEmpty (UniqueConstraint ('Postgres pgKind))
-> SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
conflictConstraint NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints SourceInfo ('Postgres pgKind)
sourceInfo TableInfo ('Postgres pgKind)
tableInfo
  Parser
  'Input
  n
  (AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
whereExpParser <- SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> m (Parser
        'Input
        n
        (AnnBoolExp
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b) =>
SourceInfo b
-> TableInfo b
-> m (Parser 'Input n (AnnBoolExp b (UnpreparedValue b)))
boolExp SourceInfo ('Postgres pgKind)
sourceInfo TableInfo ('Postgres pgKind)
tableInfo
  GQLNameIdentifier
tableGQLName <- TableInfo ('Postgres pgKind) -> m GQLNameIdentifier
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m GQLNameIdentifier
getTableIdentifierName TableInfo ('Postgres pgKind)
tableInfo
  Name
objectName <- Name -> m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier NamingCase
tCase (GQLNameIdentifier -> Name) -> GQLNameIdentifier -> Name
forall a b. (a -> b) -> a -> b
$ GQLNameIdentifier -> GQLNameIdentifier
mkOnConflictTypeName GQLNameIdentifier
tableGQLName
  let objectDesc :: Description
objectDesc = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"on_conflict condition type for table " Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName ('Postgres pgKind)
QualifiedTable
tableName
      (HashMap PGCol (UnpreparedValue ('Postgres pgKind))
presetColumns, AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
updateFilter) = (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
 AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Maybe
     (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
      AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
    AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall a. a -> Maybe a -> a
fromMaybe (HashMap PGCol (UnpreparedValue ('Postgres pgKind))
forall k v. HashMap k v
HM.empty, AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (backend :: BackendType) field. GBoolExp backend field
IR.gBoolExpTrue) (Maybe
   (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
    AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
 -> (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
     AnnBoolExp
       ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> Maybe
     (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
      AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
    AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ do
        UpdPermInfo {Bool
Maybe (AnnBoolExpPartialSQL ('Postgres pgKind))
PreSetColsPartial ('Postgres pgKind)
HashSet Text
HashSet (Column ('Postgres pgKind))
TableName ('Postgres pgKind)
AnnBoolExpPartialSQL ('Postgres pgKind)
upiRequiredHeaders :: forall (b :: BackendType). UpdPermInfo b -> HashSet Text
upiBackendOnly :: forall (b :: BackendType). UpdPermInfo b -> Bool
upiSet :: forall (b :: BackendType). UpdPermInfo b -> PreSetColsPartial b
upiCheck :: forall (b :: BackendType).
UpdPermInfo b -> Maybe (AnnBoolExpPartialSQL b)
upiFilter :: forall (b :: BackendType). UpdPermInfo b -> AnnBoolExpPartialSQL b
upiTable :: forall (b :: BackendType). UpdPermInfo b -> TableName b
upiCols :: forall (b :: BackendType). UpdPermInfo b -> HashSet (Column b)
upiRequiredHeaders :: HashSet Text
upiBackendOnly :: Bool
upiSet :: PreSetColsPartial ('Postgres pgKind)
upiCheck :: Maybe (AnnBoolExpPartialSQL ('Postgres pgKind))
upiFilter :: AnnBoolExpPartialSQL ('Postgres pgKind)
upiTable :: TableName ('Postgres pgKind)
upiCols :: HashSet (Column ('Postgres pgKind))
..} <- Maybe (UpdPermInfo ('Postgres pgKind))
maybeUpdatePerms
        (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
 AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Maybe
     (HashMap PGCol (UnpreparedValue ('Postgres pgKind)),
      AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( PartialSQLExp ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (PartialSQLExp ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind))
-> HashMap PGCol (PartialSQLExp ('Postgres pgKind))
-> HashMap PGCol (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreSetColsPartial ('Postgres pgKind)
HashMap PGCol (PartialSQLExp ('Postgres pgKind))
upiSet,
            (PartialSQLExp ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind))
-> AnnBoolExpFld
     ('Postgres pgKind) (PartialSQLExp ('Postgres pgKind))
-> AnnBoolExpFld
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartialSQLExp ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (AnnBoolExpFld
   ('Postgres pgKind) (PartialSQLExp ('Postgres pgKind))
 -> AnnBoolExpFld
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> AnnBoolExpPartialSQL ('Postgres pgKind)
-> AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnBoolExpPartialSQL ('Postgres pgKind)
upiFilter
          )

  Parser
  'Input
  n
  (OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser
   'Input
   n
   (OnConflictClause
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
 -> m (Parser
         'Input
         n
         (OnConflictClause
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> m (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall a b. (a -> b) -> a -> b
$
    Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
objectName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
objectDesc) (InputFieldsParser
   MetadataObjId
   n
   (OnConflictClause
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
 -> Parser
      'Input
      n
      (OnConflictClause
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ do
      UniqueConstraint ('Postgres pgKind)
constraintField <- Name
-> Maybe Description
-> Parser 'Both n (UniqueConstraint ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (UniqueConstraint ('Postgres pgKind))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._constraint Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (UniqueConstraint ('Postgres pgKind))
constraintParser
      let updateColumnsField :: InputFieldsParser MetadataObjId n [Maybe PGCol]
updateColumnsField = Name
-> Maybe Description
-> Value Void
-> Parser MetadataObjId 'Both n [Maybe PGCol]
-> InputFieldsParser MetadataObjId n [Maybe PGCol]
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Value Void
-> Parser origin k m a
-> InputFieldsParser origin m a
P.fieldWithDefault Name
Name._update_columns Maybe Description
forall a. Maybe a
Nothing ([Value Void] -> Value Void
forall var. [Value var] -> Value var
G.VList []) (Parser MetadataObjId 'Both n (Maybe PGCol)
-> Parser MetadataObjId 'Both n [Maybe PGCol]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list Parser MetadataObjId 'Both n (Maybe PGCol)
updateColumnsEnum)

      Maybe
  (AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
whereExp <- Name
-> Maybe Description
-> Parser
     'Input
     n
     (AnnBoolExp
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe
        (AnnBoolExp
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
Name._where Maybe Description
forall a. Maybe a
Nothing Parser
  'Input
  n
  (AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
whereExpParser

      [PGCol]
updateColumns <-
        InputFieldsParser MetadataObjId n [Maybe PGCol]
updateColumnsField InputFieldsParser MetadataObjId n [Maybe PGCol]
-> ([Maybe PGCol] -> n [PGCol])
-> InputFieldsParser MetadataObjId n [PGCol]
forall (m :: * -> *) origin a b.
Monad m =>
InputFieldsParser origin m a
-> (a -> m b) -> InputFieldsParser origin m b
`P.bindFields` \[Maybe PGCol]
updateColumnsMaybe ->
          Maybe [PGCol] -> n [PGCol] -> n [PGCol]
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
            ([Maybe PGCol] -> Maybe [PGCol]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA @[] @Maybe [Maybe PGCol]
updateColumnsMaybe)
            -- this can only happen if the placeholder was used
            (ErrorMessage -> n [PGCol]
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
parseError ErrorMessage
"erroneous column name")

      pure $
        let UniqueConstraint (Constraint {ConstraintName ('Postgres pgKind)
_cName :: forall (b :: BackendType). Constraint b -> ConstraintName b
_cName :: ConstraintName ('Postgres pgKind)
_cName}) HashSet (Column ('Postgres pgKind))
_ = UniqueConstraint ('Postgres pgKind)
constraintField
            constraintTarget :: ConflictTarget ('Postgres pgKind)
constraintTarget = ConstraintName ('Postgres pgKind)
-> ConflictTarget ('Postgres pgKind)
forall (b :: BackendType). ConstraintName b -> ConflictTarget b
IR.CTConstraint ConstraintName ('Postgres pgKind)
_cName
         in case [PGCol]
updateColumns of
              [] -> Maybe (ConflictTarget ('Postgres pgKind))
-> OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) v.
Maybe (ConflictTarget b) -> OnConflictClause b v
IR.OCCDoNothing (Maybe (ConflictTarget ('Postgres pgKind))
 -> OnConflictClause
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Maybe (ConflictTarget ('Postgres pgKind))
-> OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ ConflictTarget ('Postgres pgKind)
-> Maybe (ConflictTarget ('Postgres pgKind))
forall a. a -> Maybe a
Just ConflictTarget ('Postgres pgKind)
constraintTarget
              [PGCol]
_ ->
                OnConflictClauseData
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) v.
OnConflictClauseData b v -> OnConflictClause b v
IR.OCCUpdate (OnConflictClauseData
   ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
 -> OnConflictClause
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> OnConflictClauseData
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$
                  ConflictTarget ('Postgres pgKind)
-> [Column ('Postgres pgKind)]
-> PreSetColsG
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> OnConflictClauseData
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) v.
ConflictTarget b
-> [Column b]
-> PreSetColsG b v
-> AnnBoolExp b v
-> OnConflictClauseData b v
IR.OnConflictClauseData ConflictTarget ('Postgres pgKind)
constraintTarget [Column ('Postgres pgKind)]
[PGCol]
updateColumns PreSetColsG ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
HashMap PGCol (UnpreparedValue ('Postgres pgKind))
presetColumns (AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
 -> OnConflictClauseData
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> OnConflictClauseData
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$
                    [AnnBoolExp
   ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
-> AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
IR.BoolAnd ([AnnBoolExp
    ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
 -> AnnBoolExp
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> [AnnBoolExp
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
-> AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
updateFilter AnnBoolExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> [AnnBoolExp
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
-> [AnnBoolExp
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
forall a. a -> [a] -> [a]
: Maybe
  (AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> [AnnBoolExp
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]
forall a. Maybe a -> [a]
maybeToList Maybe
  (AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
whereExp
  where
    tableName :: TableName ('Postgres pgKind)
tableName = TableInfo ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo ('Postgres pgKind)
tableInfo

-- | Constructs a Parser for the name of the constraints on a given table.
--
-- The TableCoreInfo of a given table contains a list of unique or primary key
-- constraints. Given the list of such constraints, this function creates a
-- parser for an enum type that matches it. This function makes no attempt at
-- de-duplicating contraint names, and assumes they are correct.
--
-- This function can fail if a constraint has a name that cannot be translated
-- to a GraphQL name (see hasura/graphql-engine-mono#1748).
conflictConstraint ::
  forall pgKind r m n.
  MonadBuildSchema ('Postgres pgKind) r m n =>
  NonEmpty (UniqueConstraint ('Postgres pgKind)) ->
  SourceInfo ('Postgres pgKind) ->
  TableInfo ('Postgres pgKind) ->
  m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
conflictConstraint :: NonEmpty (UniqueConstraint ('Postgres pgKind))
-> SourceInfo ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
conflictConstraint NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints SourceInfo ('Postgres pgKind)
sourceInfo TableInfo ('Postgres pgKind)
tableInfo =
  Name
-> (SourceName, QualifiedTable)
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'conflictConstraint (SourceInfo ('Postgres pgKind) -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo ('Postgres pgKind)
sourceInfo, TableName ('Postgres pgKind)
QualifiedTable
tableName) (m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
 -> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind))))
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ do
    NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
    GQLNameIdentifier
tableGQLName <- TableInfo ('Postgres pgKind) -> m GQLNameIdentifier
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m GQLNameIdentifier
getTableIdentifierName TableInfo ('Postgres pgKind)
tableInfo
    NonEmpty
  (Definition MetadataObjId EnumValueInfo,
   UniqueConstraint ('Postgres pgKind))
constraintEnumValues <- NonEmpty (UniqueConstraint ('Postgres pgKind))
-> (UniqueConstraint ('Postgres pgKind)
    -> m (Definition MetadataObjId EnumValueInfo,
          UniqueConstraint ('Postgres pgKind)))
-> m (NonEmpty
        (Definition MetadataObjId EnumValueInfo,
         UniqueConstraint ('Postgres pgKind)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
      NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints
      \c :: UniqueConstraint ('Postgres pgKind)
c@(UniqueConstraint (Constraint {ConstraintName ('Postgres pgKind)
_cName :: ConstraintName ('Postgres pgKind)
_cName :: forall (b :: BackendType). Constraint b -> ConstraintName b
_cName}) HashSet (Column ('Postgres pgKind))
cCols) -> do
        Name
name <- Text -> m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> m Name) -> Text -> m Name
forall a b. (a -> b) -> a -> b
$ ConstraintName -> Text
forall a. ToTxt a => a -> Text
toTxt (ConstraintName -> Text) -> ConstraintName -> Text
forall a b. (a -> b) -> a -> b
$ ConstraintName ('Postgres pgKind)
ConstraintName
_cName
        pure
          ( Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> EnumValueInfo
-> Definition MetadataObjId EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition
              Name
name
              (Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Description
"unique or primary key constraint on columns " Description -> Description -> Description
forall a. Semigroup a => a -> a -> a
<> Text -> Description
coerce ([PGCol] -> Text
forall (t :: * -> *). (Foldable t, Functor t) => t PGCol -> Text
showPGCols (HashSet PGCol -> [PGCol]
forall a. HashSet a -> [a]
HS.toList HashSet (Column ('Postgres pgKind))
HashSet PGCol
cCols)))
              Maybe MetadataObjId
forall a. Maybe a
Nothing
              []
              EnumValueInfo
P.EnumValueInfo,
            UniqueConstraint ('Postgres pgKind)
c
          )
    Name
enumName <- Name -> m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier NamingCase
tCase (GQLNameIdentifier -> Name) -> GQLNameIdentifier -> Name
forall a b. (a -> b) -> a -> b
$ GQLNameIdentifier -> GQLNameIdentifier
mkTableConstraintTypeName GQLNameIdentifier
tableGQLName
    let enumDesc :: Description
enumDesc = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"unique or primary key constraints on table " Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName ('Postgres pgKind)
QualifiedTable
tableName
    Parser 'Both n (UniqueConstraint ('Postgres pgKind))
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Both n (UniqueConstraint ('Postgres pgKind))
 -> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind))))
-> Parser 'Both n (UniqueConstraint ('Postgres pgKind))
-> m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo,
      UniqueConstraint ('Postgres pgKind))
-> Parser 'Both n (UniqueConstraint ('Postgres pgKind))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
enumName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
enumDesc) NonEmpty
  (Definition MetadataObjId EnumValueInfo,
   UniqueConstraint ('Postgres pgKind))
constraintEnumValues
  where
    tableName :: TableName ('Postgres pgKind)
tableName = TableInfo ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo ('Postgres pgKind)
tableInfo