{-# 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.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 (mkTypename)
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.Column
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
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
  ) =>
  SourceInfo 'MSSQL ->
  TableInfo 'MSSQL ->
  m (InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedFieldParser :: SourceInfo 'MSSQL
-> TableInfo 'MSSQL
-> m (InputFieldsParser
        n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedFieldParser SourceInfo 'MSSQL
sourceInfo TableInfo 'MSSQL
tableInfo = do
  Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
maybeObject <- SourceInfo 'MSSQL
-> TableInfo 'MSSQL
-> m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema 'MSSQL r m n,
 AggregationPredicatesSchema 'MSSQL) =>
SourceInfo 'MSSQL
-> TableInfo 'MSSQL
-> m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser SourceInfo 'MSSQL
sourceInfo TableInfo 'MSSQL
tableInfo
  return $ Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
-> (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
    -> InputFieldsParser
         n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
-> InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL)))
forall (m :: * -> *) a b.
Applicative m =>
Maybe a -> (a -> m (Maybe b)) -> m (Maybe b)
withJust Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
maybeObject ((Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
  -> InputFieldsParser
       n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
 -> InputFieldsParser
      n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
-> (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))
    -> InputFieldsParser
         n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
-> InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL)))
forall a b. (a -> b) -> a -> b
$ 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")

-- | Parse a @tablename_if_matched@ object.
ifMatchedObjectParser ::
  forall r m n.
  ( MonadBuildSchema 'MSSQL r m n,
    AggregationPredicatesSchema 'MSSQL
  ) =>
  SourceInfo 'MSSQL ->
  TableInfo 'MSSQL ->
  m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser :: SourceInfo 'MSSQL
-> TableInfo 'MSSQL
-> m (Maybe (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL))))
ifMatchedObjectParser SourceInfo 'MSSQL
sourceInfo TableInfo 'MSSQL
tableInfo = MaybeT m (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
-> 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.
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  UpdPermInfo 'MSSQL
updatePerms <- Maybe (UpdPermInfo 'MSSQL) -> MaybeT m (UpdPermInfo 'MSSQL)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (UpdPermInfo 'MSSQL) -> MaybeT m (UpdPermInfo 'MSSQL))
-> Maybe (UpdPermInfo 'MSSQL) -> MaybeT 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 (Column 'MSSQL)
matchColumnsEnum <- m (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL)))
-> MaybeT m (Parser MetadataObjId 'Both n (Column 'MSSQL))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL)))
 -> MaybeT m (Parser MetadataObjId 'Both n (Column 'MSSQL)))
-> m (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL)))
-> MaybeT m (Parser MetadataObjId 'Both n (Column 'MSSQL))
forall a b. (a -> b) -> a -> b
$ SourceInfo 'MSSQL
-> TableInfo 'MSSQL -> m (Maybe (Parser 'Both n (Column 'MSSQL)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchemaBase r m n =>
SourceInfo 'MSSQL
-> TableInfo 'MSSQL -> m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum SourceInfo 'MSSQL
sourceInfo TableInfo 'MSSQL
tableInfo
  m (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
-> MaybeT m (Parser 'Input n (IfMatched (UnpreparedValue 'MSSQL)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    Parser MetadataObjId 'Both n (Maybe (Column 'MSSQL))
updateColumnsEnum <- TableInfo 'MSSQL -> m (Parser 'Both n (Maybe (Column 'MSSQL)))
forall (backend :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema backend r m n =>
TableInfo backend -> m (Parser 'Both n (Maybe (Column backend)))
updateColumnsPlaceholderParser TableInfo 'MSSQL
tableInfo
    Name
tableGQLName <- TableInfo 'MSSQL -> m Name
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m Name
getTableGQLName TableInfo 'MSSQL
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
$ Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__if_matched
    let _imColumnPresets :: HashMap (Column 'MSSQL) (UnpreparedValue 'MSSQL)
_imColumnPresets = PartialSQLExp 'MSSQL -> UnpreparedValue 'MSSQL
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (PartialSQLExp 'MSSQL -> UnpreparedValue 'MSSQL)
-> HashMap (Column 'MSSQL) (PartialSQLExp 'MSSQL)
-> HashMap (Column 'MSSQL) (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 (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 <- SourceInfo 'MSSQL
-> TableInfo 'MSSQL
-> m (Parser
        'Input
        n
        (GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))))
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 'MSSQL
sourceInfo 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
        [Column 'MSSQL]
_imMatchColumns <-
          Name
-> Maybe Description
-> Value Void
-> Parser MetadataObjId 'Both n [Column 'MSSQL]
-> InputFieldsParser MetadataObjId n [Column 'MSSQL]
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 (Column 'MSSQL)
-> Parser MetadataObjId 'Both n [Column 'MSSQL]
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 (Column 'MSSQL)
matchColumnsEnum)
        [Column 'MSSQL]
_imUpdateColumns <-
          Name
-> Maybe Description
-> Value Void
-> Parser MetadataObjId 'Both n [Maybe (Column 'MSSQL)]
-> InputFieldsParser MetadataObjId n [Maybe (Column 'MSSQL)]
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 (Column 'MSSQL))
-> Parser MetadataObjId 'Both n [Maybe (Column 'MSSQL)]
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 (Column 'MSSQL))
updateColumnsEnum) InputFieldsParser MetadataObjId n [Maybe (Column 'MSSQL)]
-> ([Maybe (Column 'MSSQL)] -> n [Column 'MSSQL])
-> InputFieldsParser MetadataObjId n [Column 'MSSQL]
forall (m :: * -> *) origin a b.
Monad m =>
InputFieldsParser origin m a
-> (a -> m b) -> InputFieldsParser origin m b
`P.bindFields` \[Maybe (Column 'MSSQL)]
cs ->
            -- this can only happen if the placeholder was used
            [Maybe (Column 'MSSQL)] -> Maybe [Column 'MSSQL]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Maybe (Column 'MSSQL)]
cs Maybe [Column 'MSSQL] -> n [Column 'MSSQL] -> n [Column 'MSSQL]
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` ErrorMessage -> n [Column 'MSSQL]
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
parseError ErrorMessage
"erroneous column name"

        pure $ IfMatched :: forall v.
[Column 'MSSQL]
-> [Column 'MSSQL]
-> AnnBoolExp 'MSSQL v
-> HashMap (Column 'MSSQL) v
-> IfMatched v
IfMatched {[Column 'MSSQL]
HashMap (Column 'MSSQL) (UnpreparedValue 'MSSQL)
GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imColumnPresets :: HashMap (Column 'MSSQL) (UnpreparedValue 'MSSQL)
_imConditions :: GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imUpdateColumns :: [Column 'MSSQL]
_imMatchColumns :: [Column 'MSSQL]
_imUpdateColumns :: [Column 'MSSQL]
_imMatchColumns :: [Column 'MSSQL]
_imConditions :: GBoolExp 'MSSQL (AnnBoolExpFld 'MSSQL (UnpreparedValue 'MSSQL))
_imColumnPresets :: HashMap (Column 'MSSQL) (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.
  MonadBuildSchemaBase r m n =>
  SourceInfo 'MSSQL ->
  TableInfo 'MSSQL ->
  m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum :: SourceInfo 'MSSQL
-> TableInfo 'MSSQL -> m (Maybe (Parser 'Both n (Column 'MSSQL)))
tableInsertMatchColumnsEnum SourceInfo 'MSSQL
sourceInfo TableInfo 'MSSQL
tableInfo = do
  Name
tableGQLName <- TableInfo 'MSSQL -> m Name
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m Name
getTableGQLName @'MSSQL TableInfo 'MSSQL
tableInfo
  [ColumnInfo 'MSSQL]
columns <- SourceInfo 'MSSQL -> TableInfo 'MSSQL -> m [ColumnInfo 'MSSQL]
forall (b :: BackendType) r (m :: * -> *).
(Backend b, MonadError QErr m, MonadReader r m,
 Has SchemaContext r) =>
SourceInfo b -> TableInfo b -> m [ColumnInfo b]
tableSelectColumns SourceInfo 'MSSQL
sourceInfo TableInfo 'MSSQL
tableInfo
  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
$ Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__insert_match_column
  let 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 (Column 'MSSQL))
-> m (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL))
 -> m (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL))))
-> Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL))
-> m (Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL)))
forall a b. (a -> b) -> a -> b
$
    Name
-> Maybe Description
-> NonEmpty (Definition MetadataObjId EnumValueInfo, Column 'MSSQL)
-> Parser MetadataObjId 'Both n (Column 'MSSQL)
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, Column 'MSSQL)
 -> Parser MetadataObjId 'Both n (Column 'MSSQL))
-> Maybe
     (NonEmpty (Definition MetadataObjId EnumValueInfo, Column 'MSSQL))
-> Maybe (Parser MetadataObjId 'Both n (Column 'MSSQL))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Definition MetadataObjId EnumValueInfo, Column 'MSSQL)]
-> Maybe
     (NonEmpty (Definition MetadataObjId EnumValueInfo, Column 'MSSQL))
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
          )
          | ColumnInfo 'MSSQL
column <- [ColumnInfo '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
TextType} -> Bool
False
  ColumnInfo 'MSSQL
_ -> Bool
True