{-# LANGUAGE ApplicativeDo #-}

-- | MSSQL Schema IfMatched
--
-- This module contains the building blocks for parsing @if_matched@ clauses
-- (represented as 'IfMatched'), which in the MSSQL backend are used to
-- implement upsert functionality.
--
-- These are used by 'Hasura.Backends.MSSQL.Instances.Schema.backendInsertParser' to
-- construct a mssql-specific schema parser for insert (and upsert) mutations.
module Hasura.Backends.MSSQL.Schema.IfMatched
  ( ifMatchedFieldParser,
  )
where

import Data.Has
import Data.Text.Extended
import Hasura.Backends.MSSQL.Types.Insert
import Hasura.Backends.MSSQL.Types.Internal (ScalarType (..))
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
import Hasura.RQL.IR.Value
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
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

-- | Field-parser for:
--
-- > if_matched: tablename_if_matched
-- >
-- > input tablename_if_matched {
-- >   match_columns: [tablename_select_column!]
-- >   update_columns: [tablename_update_columns!]
-- >   where: tablename_bool_exp
-- > }
--
-- Note that the types ordinarily produced by this parser are only created if
-- the active role has /both/ select and update permissions to the table
-- @tablename@ defined /and/ these grant non-empty column permissions.
ifMatchedFieldParser ::
  forall r m n.
  ( MonadBuildSchema 'MSSQL r m n,
    AggregationPredicatesSchema 'MSSQL
  ) =>
  TableInfo 'MSSQL ->
  SchemaT r m (InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedFieldParser :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema 'MSSQL r m n,
 AggregationPredicatesSchema 'MSSQL) =>
TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedFieldParser TableInfo 'MSSQL
tableInfo = do
  Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
maybeObject <- TableInfo 'MSSQL
-> SchemaT
     r m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema 'MSSQL r m n,
 AggregationPredicatesSchema 'MSSQL) =>
TableInfo 'MSSQL
-> SchemaT
     r m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser TableInfo 'MSSQL
tableInfo
  pure case Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
maybeObject of
    Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
Nothing -> Maybe (IfMatched (UnpreparedValue 'MSSQL))
-> InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL)))
forall a. a -> InputFieldsParser MetadataObjId n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IfMatched (UnpreparedValue 'MSSQL))
forall a. Maybe a
Nothing
    Just Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
object -> Name
-> Maybe Description
-> Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
-> InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL)))
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._if_matched (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"upsert condition") Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
object

-- | Parse a @tablename_if_matched@ object.
ifMatchedObjectParser ::
  forall r m n.
  ( MonadBuildSchema 'MSSQL r m n,
    AggregationPredicatesSchema 'MSSQL
  ) =>
  TableInfo 'MSSQL ->
  SchemaT r m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema 'MSSQL r m n,
 AggregationPredicatesSchema 'MSSQL) =>
TableInfo 'MSSQL
-> SchemaT
     r m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser TableInfo 'MSSQL
tableInfo = MaybeT
  (SchemaT r m)
  (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
-> SchemaT
     r m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  -- Short-circuit if we don't have sufficient permissions.
  SourceInfo 'MSSQL
sourceInfo :: SourceInfo 'MSSQL <- (r -> SourceInfo 'MSSQL)
-> MaybeT (SchemaT r m) (SourceInfo 'MSSQL)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo 'MSSQL
forall a t. Has a t => t -> a
getter
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT (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 'MSSQL -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo 'MSSQL
sourceInfo
      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
  UpdPermInfo 'MSSQL
updatePerms <- Maybe (UpdPermInfo 'MSSQL)
-> MaybeT (SchemaT r m) (UpdPermInfo 'MSSQL)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (UpdPermInfo 'MSSQL)
 -> MaybeT (SchemaT r m) (UpdPermInfo 'MSSQL))
-> Maybe (UpdPermInfo 'MSSQL)
-> MaybeT (SchemaT r m) (UpdPermInfo 'MSSQL)
forall a b. (a -> b) -> a -> b
$ RolePermInfo 'MSSQL -> Maybe (UpdPermInfo 'MSSQL)
forall (b :: BackendType). RolePermInfo b -> Maybe (UpdPermInfo b)
_permUpd (RolePermInfo 'MSSQL -> Maybe (UpdPermInfo 'MSSQL))
-> RolePermInfo 'MSSQL -> Maybe (UpdPermInfo 'MSSQL)
forall a b. (a -> b) -> a -> b
$ RoleName -> TableInfo 'MSSQL -> RolePermInfo 'MSSQL
forall (b :: BackendType).
RoleName -> TableInfo b -> RolePermInfo b
getRolePermInfo RoleName
roleName TableInfo 'MSSQL
tableInfo
  Parser MetadataObjId 'Both n ColumnName
matchColumnsEnum <- SchemaT r m (Maybe (Parser MetadataObjId 'Both n ColumnName))
-> MaybeT (SchemaT r m) (Parser MetadataObjId 'Both n ColumnName)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT r m (Maybe (Parser MetadataObjId 'Both n ColumnName))
 -> MaybeT (SchemaT r m) (Parser MetadataObjId 'Both n ColumnName))
-> SchemaT r m (Maybe (Parser MetadataObjId 'Both n ColumnName))
-> MaybeT (SchemaT r m) (Parser MetadataObjId 'Both n ColumnName)
forall a b. (a -> b) -> a -> b
$ TableInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Both n (Column 'MSSQL)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum TableInfo 'MSSQL
tableInfo
  SchemaT r m (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
-> MaybeT
     (SchemaT r m)
     (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    Parser MetadataObjId 'Both n (Maybe ColumnName)
updateColumnsEnum <- TableInfo 'MSSQL
-> SchemaT r m (Parser 'Both n (Maybe (Column 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
TableInfo b -> SchemaT r m (Parser 'Both n (Maybe (Column b)))
updateColumnsPlaceholderParser TableInfo 'MSSQL
tableInfo
    Name
tableGQLName <- TableInfo 'MSSQL -> SchemaT r m Name
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m Name
getTableGQLName TableInfo 'MSSQL
tableInfo
    let objectName :: Name
objectName = Name -> Name
mkTypename (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__if_matched
        _imColumnPresets :: HashMap ColumnName (UnpreparedValue 'MSSQL)
_imColumnPresets = PartialSQLExp 'MSSQL -> UnpreparedValue 'MSSQL
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (PartialSQLExp 'MSSQL -> UnpreparedValue 'MSSQL)
-> HashMap ColumnName (PartialSQLExp 'MSSQL)
-> HashMap ColumnName (UnpreparedValue 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdPermInfo 'MSSQL -> PreSetColsPartial 'MSSQL
forall (b :: BackendType). UpdPermInfo b -> PreSetColsPartial b
upiSet UpdPermInfo 'MSSQL
updatePerms
        updateFilter :: GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
updateFilter = (PartialSQLExp 'MSSQL -> UnpreparedValue 'MSSQL)
-> AnnBoolExpFld 'MSSQL (PartialSQLExp 'MSSQL)
-> AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)
forall a b.
(a -> b) -> AnnBoolExpFld 'MSSQL a -> AnnBoolExpFld 'MSSQL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartialSQLExp 'MSSQL -> UnpreparedValue 'MSSQL
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (AnnBoolExpFld 'MSSQL (PartialSQLExp 'MSSQL)
 -> AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
-> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (PartialSQLExp 'MSSQL))
-> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdPermInfo 'MSSQL
-> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (PartialSQLExp 'MSSQL))
forall (b :: BackendType). UpdPermInfo b -> AnnBoolExpPartialSQL b
upiFilter UpdPermInfo 'MSSQL
updatePerms
        objectDesc :: Description
objectDesc = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"upsert condition type for table " Text -> TableName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableInfo 'MSSQL -> TableName 'MSSQL
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo 'MSSQL
tableInfo
        matchColumnsName :: Name
matchColumnsName = Name
Name._match_columns
        updateColumnsName :: Name
updateColumnsName = Name
Name._update_columns
        whereName :: Name
whereName = Name
Name._where
    Parser
  'Input
  n
  (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
whereExpParser <- TableInfo 'MSSQL
-> SchemaT
     r
     m
     (Parser
        'Input
        n
        (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))))
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 'MSSQL
tableInfo
    pure
      $ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId n (IfMatched (UnpreparedValue 'MSSQL))
-> Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
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
        GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imConditions <-
          (\Maybe
  (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
whereExp -> [GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))]
-> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolAnd ([GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))]
 -> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
-> [GBoolExp
      'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))]
-> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
forall a b. (a -> b) -> a -> b
$ GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
updateFilter GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
-> [GBoolExp
      'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))]
-> [GBoolExp
      'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))]
forall a. a -> [a] -> [a]
: Maybe
  (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
-> [GBoolExp
      'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))]
forall a. Maybe a -> [a]
maybeToList Maybe
  (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
whereExp)
            (Maybe
   (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
 -> GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe
        (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))))
-> InputFieldsParser
     MetadataObjId
     n
     (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Input
     n
     (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe
        (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))))
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
whereName Maybe Description
forall a. Maybe a
Nothing Parser
  'Input
  n
  (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL)))
whereExpParser
        [ColumnName]
_imMatchColumns <-
          Name
-> Maybe Description
-> Value Void
-> Parser MetadataObjId 'Both n [ColumnName]
-> InputFieldsParser MetadataObjId n [ColumnName]
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
matchColumnsName Maybe Description
forall a. Maybe a
Nothing ([Value Void] -> Value Void
forall var. [Value var] -> Value var
G.VList []) (Parser MetadataObjId 'Both n ColumnName
-> Parser MetadataObjId 'Both n [ColumnName]
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 ColumnName
matchColumnsEnum)
        [ColumnName]
_imUpdateColumns <-
          Name
-> Maybe Description
-> Value Void
-> Parser MetadataObjId 'Both n [Maybe ColumnName]
-> InputFieldsParser MetadataObjId n [Maybe ColumnName]
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
updateColumnsName Maybe Description
forall a. Maybe a
Nothing ([Value Void] -> Value Void
forall var. [Value var] -> Value var
G.VList []) (Parser MetadataObjId 'Both n (Maybe ColumnName)
-> Parser MetadataObjId 'Both n [Maybe ColumnName]
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 ColumnName)
updateColumnsEnum) InputFieldsParser MetadataObjId n [Maybe ColumnName]
-> ([Maybe ColumnName] -> n [ColumnName])
-> InputFieldsParser MetadataObjId n [ColumnName]
forall (m :: * -> *) origin a b.
Monad m =>
InputFieldsParser origin m a
-> (a -> m b) -> InputFieldsParser origin m b
`P.bindFields` \[Maybe ColumnName]
cs ->
            -- this can only happen if the placeholder was used
            [Maybe ColumnName] -> Maybe [ColumnName]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [Maybe ColumnName]
cs Maybe [ColumnName] -> n [ColumnName] -> n [ColumnName]
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` ErrorMessage -> n [ColumnName]
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
parseError ErrorMessage
"erroneous column name"

        pure $ IfMatched {[ColumnName]
HashMap ColumnName (UnpreparedValue 'MSSQL)
GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imColumnPresets :: HashMap ColumnName (UnpreparedValue 'MSSQL)
_imConditions :: GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imMatchColumns :: [ColumnName]
_imUpdateColumns :: [ColumnName]
_imMatchColumns :: [ColumnName]
_imUpdateColumns :: [ColumnName]
_imConditions :: GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imColumnPresets :: HashMap ColumnName (UnpreparedValue 'MSSQL)
..}

-- | Table insert_match_columns enum
--
-- Parser for an enum type that matches the columns that can be used
-- for insert match_columns for a given table.
-- Maps to the insert_match_columns object.
--
-- Return Nothing if there's no column the current user has "select"
-- permissions for.
tableInsertMatchColumnsEnum ::
  forall r m n.
  (MonadBuildSourceSchema 'MSSQL r m n) =>
  TableInfo 'MSSQL ->
  SchemaT r m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum TableInfo 'MSSQL
tableInfo = do
  SourceInfo 'MSSQL
sourceInfo :: SourceInfo 'MSSQL <- (r -> SourceInfo 'MSSQL) -> SchemaT r m (SourceInfo 'MSSQL)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo 'MSSQL
forall a t. Has a t => t -> a
getter
  let customization :: ResolvedSourceCustomization
customization = SourceInfo 'MSSQL -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo 'MSSQL
sourceInfo
      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
tableGQLName <- forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m Name
getTableGQLName @'MSSQL TableInfo 'MSSQL
tableInfo
  [(StructuredColumnInfo 'MSSQL,
  AnnRedactionExpUnpreparedValue 'MSSQL)]
columns <- TableInfo 'MSSQL
-> SchemaT
     r
     m
     [(StructuredColumnInfo 'MSSQL,
       AnnRedactionExpUnpreparedValue 'MSSQL)]
forall (b :: BackendType) r (m :: * -> *).
(Backend b, MonadError QErr m, MonadReader r m,
 Has SchemaContext r, Has (SourceInfo b) r) =>
TableInfo b
-> m [(StructuredColumnInfo b, AnnRedactionExpUnpreparedValue b)]
tableSelectColumns TableInfo 'MSSQL
tableInfo
  let enumName :: Name
enumName = Name -> Name
mkTypename (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__insert_match_column
      description :: Maybe Description
description =
        Description -> Maybe Description
forall a. a -> Maybe a
Just
          (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description
          (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"select match_columns of table "
          Text -> TableName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableInfo 'MSSQL -> TableName 'MSSQL
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo 'MSSQL
tableInfo
  Maybe (Parser MetadataObjId 'Both n ColumnName)
-> SchemaT r m (Maybe (Parser MetadataObjId 'Both n ColumnName))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe (Parser MetadataObjId 'Both n ColumnName)
 -> SchemaT r m (Maybe (Parser MetadataObjId 'Both n ColumnName)))
-> Maybe (Parser MetadataObjId 'Both n ColumnName)
-> SchemaT r m (Maybe (Parser MetadataObjId 'Both n ColumnName))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> NonEmpty (Definition MetadataObjId EnumValueInfo, ColumnName)
-> Parser MetadataObjId 'Both n ColumnName
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
enumName Maybe Description
description
    (NonEmpty (Definition MetadataObjId EnumValueInfo, ColumnName)
 -> Parser MetadataObjId 'Both n ColumnName)
-> Maybe
     (NonEmpty (Definition MetadataObjId EnumValueInfo, ColumnName))
-> Maybe (Parser MetadataObjId 'Both n ColumnName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Definition MetadataObjId EnumValueInfo, ColumnName)]
-> Maybe
     (NonEmpty (Definition MetadataObjId EnumValueInfo, ColumnName))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
      [ ( Name -> Definition MetadataObjId EnumValueInfo
forall {origin}. Name -> Definition origin EnumValueInfo
define (Name -> Definition MetadataObjId EnumValueInfo)
-> Name -> Definition MetadataObjId EnumValueInfo
forall a b. (a -> b) -> a -> b
$ ColumnInfo 'MSSQL -> Name
forall (b :: BackendType). ColumnInfo b -> Name
ciName ColumnInfo 'MSSQL
column,
          ColumnInfo 'MSSQL -> Column 'MSSQL
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo 'MSSQL
column
        )
        | -- TODO(redactionExp): Does the redaction expression need to be considered here?
          (SCIScalarColumn ColumnInfo 'MSSQL
column, AnnRedactionExpUnpreparedValue 'MSSQL
_redactionExp) <- [(StructuredColumnInfo 'MSSQL,
  AnnRedactionExpUnpreparedValue 'MSSQL)]
columns,
          ColumnInfo 'MSSQL -> Bool
isMatchColumnValid ColumnInfo 'MSSQL
column
      ]
  where
    define :: Name -> Definition origin EnumValueInfo
define Name
name =
      Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> EnumValueInfo
-> Definition origin 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
$ Text -> Description
G.Description Text
"column name") Maybe origin
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo

-- | Check whether a column can be used for match_columns.
isMatchColumnValid :: ColumnInfo 'MSSQL -> Bool
isMatchColumnValid :: ColumnInfo 'MSSQL -> Bool
isMatchColumnValid = \case
  -- Unfortunately MSSQL does not support comparison for TEXT types.
  ColumnInfo {ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType = ColumnScalar ScalarType 'MSSQL
ScalarType
TextType} -> Bool
False
  ColumnInfo 'MSSQL
_ -> Bool
True