{-# 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 HashMap
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
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.BackendType
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.Table.Cache
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)
  ) =>
  TableInfo ('Postgres pgKind) ->
  SchemaT r m (InputFieldsParser n (Maybe (IR.OnConflictClause ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind)))))
onConflictFieldParser :: forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind)) =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
onConflictFieldParser TableInfo ('Postgres pgKind)
tableInfo = do
  SourceInfo ('Postgres pgKind)
sourceInfo :: SourceInfo ('Postgres pgKind) <- (r -> SourceInfo ('Postgres pgKind))
-> SchemaT r m (SourceInfo ('Postgres pgKind))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo ('Postgres pgKind)
forall a t. Has a t => t -> a
getter
  RoleName
roleName <- (SchemaContext -> RoleName) -> SchemaT r m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  let customization :: ResolvedSourceCustomization
customization = SourceInfo ('Postgres pgKind) -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo ('Postgres pgKind)
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization
      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.
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
  (SchemaT
     r
     m
     (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
maybeConflictObject = TableInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
-> NonEmpty (UniqueConstraint ('Postgres pgKind))
-> SchemaT
     r
     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)) =>
TableInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
-> NonEmpty (UniqueConstraint ('Postgres pgKind))
-> SchemaT
     r
     m
     (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObjectParser 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))
 -> SchemaT
      r
      m
      (Parser
         'Input
         n
         (OnConflictClause
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> Maybe (NonEmpty (UniqueConstraint ('Postgres pgKind)))
-> Maybe
     (SchemaT
        r
        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
  (SchemaT
     r
     m
     (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
maybeConflictObject of
    Just SchemaT
  r
  m
  (Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObject -> SchemaT
  r
  m
  (Parser
     'Input
     n
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObject SchemaT
  r
  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)))))
-> SchemaT
     r
     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
  (SchemaT
     r
     m
     (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
Nothing -> InputFieldsParser
  n
  (Maybe
     (OnConflictClause
        ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall a. a -> SchemaT r m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InputFieldsParser
   n
   (Maybe
      (OnConflictClause
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
 -> SchemaT
      r
      m
      (InputFieldsParser
         n
         (Maybe
            (OnConflictClause
               ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))))
-> InputFieldsParser
     n
     (Maybe
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> SchemaT
     r
     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 a. a -> InputFieldsParser MetadataObjId n a
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)
  ) =>
  TableInfo ('Postgres pgKind) ->
  Maybe (UpdPermInfo ('Postgres pgKind)) ->
  NonEmpty (UniqueConstraint ('Postgres pgKind)) ->
  SchemaT r m (Parser 'Input n (IR.OnConflictClause ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind))))
conflictObjectParser :: forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind)) =>
TableInfo ('Postgres pgKind)
-> Maybe (UpdPermInfo ('Postgres pgKind))
-> NonEmpty (UniqueConstraint ('Postgres pgKind))
-> SchemaT
     r
     m
     (Parser
        'Input
        n
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
conflictObjectParser TableInfo ('Postgres pgKind)
tableInfo Maybe (UpdPermInfo ('Postgres pgKind))
maybeUpdatePerms NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints = do
  SourceInfo ('Postgres pgKind)
sourceInfo :: SourceInfo ('Postgres pgKind) <- (r -> SourceInfo ('Postgres pgKind))
-> SchemaT r m (SourceInfo ('Postgres pgKind))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo ('Postgres pgKind)
forall a t. Has a t => t -> a
getter
  let tableName :: TableName ('Postgres pgKind)
tableName = TableInfo ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo ('Postgres pgKind)
tableInfo
      customization :: ResolvedSourceCustomization
customization = SourceInfo ('Postgres pgKind) -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo ('Postgres pgKind)
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization
      mkTypename :: Name -> Name
mkTypename = MkTypename -> Name -> Name
runMkTypename (MkTypename -> Name -> Name) -> MkTypename -> Name -> Name
forall a b. (a -> b) -> a -> b
$ ResolvedSourceCustomization -> MkTypename
_rscTypeNames ResolvedSourceCustomization
customization
  Parser MetadataObjId 'Both n (Maybe PGCol)
updateColumnsEnum <- TableInfo ('Postgres pgKind)
-> SchemaT r m (Parser 'Both n (Maybe (Column ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
TableInfo b -> SchemaT r m (Parser 'Both n (Maybe (Column b)))
updateColumnsPlaceholderParser TableInfo ('Postgres pgKind)
tableInfo
  Parser 'Both n (UniqueConstraint ('Postgres pgKind))
constraintParser <- NonEmpty (UniqueConstraint ('Postgres pgKind))
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
NonEmpty (UniqueConstraint ('Postgres pgKind))
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
conflictConstraint NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints TableInfo ('Postgres pgKind)
tableInfo
  Parser
  'Input
  n
  (AnnBoolExp
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
whereExpParser <- TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Parser
        'Input
        n
        (AnnBoolExp
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b) =>
TableInfo b
-> SchemaT r m (Parser 'Input n (AnnBoolExp b (UnpreparedValue b)))
tableBoolExp TableInfo ('Postgres pgKind)
tableInfo
  GQLNameIdentifier
tableGQLName <- TableInfo ('Postgres pgKind) -> SchemaT r m GQLNameIdentifier
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m GQLNameIdentifier
getTableIdentifierName TableInfo ('Postgres pgKind)
tableInfo
  let objectName :: Name
objectName = Name -> Name
mkTypename (Name -> Name) -> Name -> 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
      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
HashMap.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))
Maybe (ValidateInput ResolvedWebhook)
PreSetColsPartial ('Postgres pgKind)
HashSet Text
HashSet (Column ('Postgres pgKind))
TableName ('Postgres pgKind)
AnnBoolExpPartialSQL ('Postgres pgKind)
upiCols :: HashSet (Column ('Postgres pgKind))
upiTable :: TableName ('Postgres pgKind)
upiFilter :: AnnBoolExpPartialSQL ('Postgres pgKind)
upiCheck :: Maybe (AnnBoolExpPartialSQL ('Postgres pgKind))
upiSet :: PreSetColsPartial ('Postgres pgKind)
upiBackendOnly :: Bool
upiRequiredHeaders :: HashSet Text
upiValidateInput :: Maybe (ValidateInput ResolvedWebhook)
upiCols :: forall (b :: BackendType). UpdPermInfo b -> HashSet (Column b)
upiTable :: forall (b :: BackendType). UpdPermInfo b -> TableName b
upiFilter :: forall (b :: BackendType). UpdPermInfo b -> AnnBoolExpPartialSQL b
upiCheck :: forall (b :: BackendType).
UpdPermInfo b -> Maybe (AnnBoolExpPartialSQL b)
upiSet :: forall (b :: BackendType). UpdPermInfo b -> PreSetColsPartial b
upiBackendOnly :: forall (b :: BackendType). UpdPermInfo b -> Bool
upiRequiredHeaders :: forall (b :: BackendType). UpdPermInfo b -> HashSet Text
upiValidateInput :: forall (b :: BackendType).
UpdPermInfo b -> Maybe (ValidateInput ResolvedWebhook)
..} <- 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 a. a -> Maybe a
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 a b.
(a -> b)
-> AnnBoolExpFld ('Postgres pgKind) a
-> AnnBoolExpFld ('Postgres pgKind) b
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
          )
  pure
    $ 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) 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 (NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
updateColumnsFieldName) 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
            (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 :: ConstraintName ('Postgres pgKind)
_cName :: forall (b :: BackendType). Constraint b -> ConstraintName b
_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

-- | 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)) ->
  TableInfo ('Postgres pgKind) ->
  SchemaT r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
conflictConstraint :: forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
NonEmpty (UniqueConstraint ('Postgres pgKind))
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
conflictConstraint NonEmpty (UniqueConstraint ('Postgres pgKind))
constraints TableInfo ('Postgres pgKind)
tableInfo = do
  SourceInfo ('Postgres pgKind)
sourceInfo :: SourceInfo ('Postgres pgKind) <- (r -> SourceInfo ('Postgres pgKind))
-> SchemaT r m (SourceInfo ('Postgres pgKind))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo ('Postgres pgKind)
forall a t. Has a t => t -> a
getter
  let sourceName :: SourceName
sourceName = SourceInfo ('Postgres pgKind) -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo ('Postgres pgKind)
sourceInfo
      tableName :: TableName ('Postgres pgKind)
tableName = TableInfo ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo ('Postgres pgKind)
tableInfo
      customization :: ResolvedSourceCustomization
customization = SourceInfo ('Postgres pgKind) -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo ('Postgres pgKind)
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization
      mkTypename :: Name -> Name
mkTypename = MkTypename -> Name -> Name
runMkTypename (MkTypename -> Name -> Name) -> MkTypename -> Name -> Name
forall a b. (a -> b) -> a -> b
$ ResolvedSourceCustomization -> MkTypename
_rscTypeNames ResolvedSourceCustomization
customization
  Name
-> (SourceName, QualifiedTable)
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
-> SchemaT
     r 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 (SourceName
sourceName, TableName ('Postgres pgKind)
QualifiedTable
tableName) (SchemaT r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
 -> SchemaT
      r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind))))
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ do
    GQLNameIdentifier
tableGQLName <- TableInfo ('Postgres pgKind) -> SchemaT r 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)
    -> SchemaT
         r
         m
         (Definition MetadataObjId EnumValueInfo,
          UniqueConstraint ('Postgres pgKind)))
-> SchemaT
     r
     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 :: forall (b :: BackendType). Constraint b -> ConstraintName b
_cName :: ConstraintName ('Postgres pgKind)
_cName}) HashSet (Column ('Postgres pgKind))
cCols) -> do
        Name
name <- Text -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> SchemaT r m Name) -> Text -> SchemaT r m Name
forall a b. (a -> b) -> a -> b
$ ConstraintName ('Postgres pgKind) -> Text
forall a. ToTxt a => a -> Text
toTxt (ConstraintName ('Postgres pgKind) -> Text)
-> ConstraintName ('Postgres pgKind) -> Text
forall a b. (a -> b) -> a -> b
$ ConstraintName ('Postgres pgKind)
_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
forall a b. Coercible a b => a -> b
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
          )
    let enumName :: Name
enumName = Name -> Name
mkTypename (Name -> Name) -> Name -> 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
        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))
-> SchemaT
     r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Both n (UniqueConstraint ('Postgres pgKind))
 -> SchemaT
      r m (Parser 'Both n (UniqueConstraint ('Postgres pgKind))))
-> Parser 'Both n (UniqueConstraint ('Postgres pgKind))
-> SchemaT
     r 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