{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | MSSQL Instances Schema
--
-- Defines a 'Hasura.GraphQL.Schema.Backend.BackendSchema' type class instance for MSSQL.
module Hasura.Backends.MSSQL.Instances.Schema () where

import Control.Applicative (Const (..))
import Data.Char qualified as Char
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Data.Text.Encoding as TE
import Data.Text.Extended
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Schema.IfMatched
import Hasura.Backends.MSSQL.Types.Insert (BackendInsert (..))
import Hasura.Backends.MSSQL.Types.Internal qualified as MSSQL
import Hasura.Backends.MSSQL.Types.Update (UpdateOperator (..))
import Hasura.Base.Error
import Hasura.Base.ErrorMessage (toErrorMessage)
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.BoolExp
import Hasura.GraphQL.Schema.Build qualified as GSB
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser
  ( InputFieldsParser,
    Kind (..),
    MonadParse,
    Parser,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Update qualified as SU
import Hasura.LogicalModel.Schema (defaultLogicalModelArgs, defaultLogicalModelSelectionSet)
import Hasura.Name qualified as Name
import Hasura.NativeQuery.Schema qualified as NativeQueries
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.Types.Backend hiding (BackendInsert)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.StoredProcedure.Schema qualified as StoredProcedures
import Language.GraphQL.Draft.Syntax qualified as G

----------------------------------------------------------------

-- * BackendSchema instance

instance BackendSchema 'MSSQL where
  -- top level parsers
  buildTableQueryAndSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            'MSSQL
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'MSSQL))],
      [FieldParser
         n
         (QueryDB
            'MSSQL
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'MSSQL))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
buildTableQueryAndSubscriptionFields = MkRootFieldName
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            'MSSQL
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'MSSQL))],
      [FieldParser
         n
         (QueryDB
            'MSSQL
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'MSSQL))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
GSB.buildTableQueryAndSubscriptionFields
  buildTableRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> NESeq (ColumnInfo 'MSSQL)
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildTableRelayQueryFields MkRootFieldName
_ TableName 'MSSQL
_ TableInfo 'MSSQL
_ GQLNameIdentifier
_ NESeq (ColumnInfo 'MSSQL)
_ = [FieldParser
   n
   (QueryDB
      'MSSQL
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'MSSQL))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildTableStreamingSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildTableStreamingSubscriptionFields = MkRootFieldName
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableStreamingSubscriptionFields
  buildTableInsertMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> Scenario
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedInsert
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildTableInsertMutationFields = (TableInfo 'MSSQL
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (BackendInsert 'MSSQL (UnpreparedValue 'MSSQL))))
-> MkRootFieldName
-> Scenario
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        MetadataObjId
        n
        (AnnotatedInsert
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
(TableInfo b
 -> SchemaT
      r m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> MkRootFieldName
-> Scenario
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedInsert
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableInsertMutationFields TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n (BackendInsert 'MSSQL (UnpreparedValue 'MSSQL)))
TableInfo 'MSSQL
-> SchemaT
     r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
forall (m :: * -> *) r (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT
     r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
backendInsertParser
  buildTableDeleteMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> Scenario
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnDelG
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildTableDeleteMutationFields = MkRootFieldName
-> Scenario
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnDelG
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> Scenario
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnDelG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableDeleteMutationFields
  buildTableUpdateMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
Scenario
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildTableUpdateMutationFields = (UpdateBatch
   'MSSQL (UpdateOperators 'MSSQL) (UnpreparedValue 'MSSQL)
 -> UpdateVariant 'MSSQL (UnpreparedValue 'MSSQL))
-> Scenario
-> TableInfo 'MSSQL
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b, BackendUpdateOperatorsSchema b) =>
(UpdateBatch b (UpdateOperators b) (UnpreparedValue b)
 -> UpdateVariant b (UnpreparedValue b))
-> Scenario
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildSingleBatchTableUpdateMutationFields UpdateBatch 'MSSQL UpdateOperator (UnpreparedValue 'MSSQL)
-> UpdateBatch 'MSSQL UpdateOperator (UnpreparedValue 'MSSQL)
UpdateBatch
  'MSSQL (UpdateOperators 'MSSQL) (UnpreparedValue 'MSSQL)
-> UpdateVariant 'MSSQL (UnpreparedValue 'MSSQL)
forall a. a -> a
id
  buildNativeQueryRootFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
NativeQueryInfo 'MSSQL
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              'MSSQL
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue 'MSSQL))))
buildNativeQueryRootFields = NativeQueryInfo 'MSSQL
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              'MSSQL
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue 'MSSQL))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
NativeQueries.defaultBuildNativeQueryRootFields
  buildStoredProcedureRootFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
StoredProcedureInfo 'MSSQL
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              'MSSQL
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue 'MSSQL))))
buildStoredProcedureRootFields = StoredProcedureInfo 'MSSQL
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              'MSSQL
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue 'MSSQL))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendLogicalModelSelectSchema b) =>
StoredProcedureInfo b
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
StoredProcedures.defaultBuildStoredProcedureRootFields

  buildFunctionQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> FunctionName 'MSSQL
-> FunctionInfo 'MSSQL
-> TableName 'MSSQL
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildFunctionQueryFields MkRootFieldName
_ FunctionName 'MSSQL
_ FunctionInfo 'MSSQL
_ TableName 'MSSQL
_ = [FieldParser
   n
   (QueryDB
      'MSSQL
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'MSSQL))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildFunctionRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> FunctionName 'MSSQL
-> FunctionInfo 'MSSQL
-> TableName 'MSSQL
-> NESeq (ColumnInfo 'MSSQL)
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildFunctionRelayQueryFields MkRootFieldName
_ FunctionName 'MSSQL
_ FunctionInfo 'MSSQL
_ TableName 'MSSQL
_ NESeq (ColumnInfo 'MSSQL)
_ = [FieldParser
   n
   (QueryDB
      'MSSQL
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'MSSQL))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildFunctionMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
MkRootFieldName
-> FunctionName 'MSSQL
-> FunctionInfo 'MSSQL
-> TableName 'MSSQL
-> SchemaT
     r
     m
     [FieldParser
        n
        (MutationDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
buildFunctionMutationFields MkRootFieldName
_ FunctionName 'MSSQL
_ FunctionInfo 'MSSQL
_ TableName 'MSSQL
_ = [FieldParser
   n
   (MutationDB
      'MSSQL
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'MSSQL))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (MutationDB
           'MSSQL
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'MSSQL))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  -- backend extensions
  relayExtension :: Maybe (XRelay 'MSSQL)
relayExtension = Maybe Void
Maybe (XRelay 'MSSQL)
forall a. Maybe a
Nothing
  nodesAggExtension :: Maybe (XNodesAgg 'MSSQL)
nodesAggExtension = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  streamSubscriptionExtension :: Maybe (XStreamingSubscription 'MSSQL)
streamSubscriptionExtension = Maybe Void
Maybe (XStreamingSubscription 'MSSQL)
forall a. Maybe a
Nothing

  -- When we support nested inserts, we also need to ensure we limit ourselves
  -- to inserting into tables whch supports inserts:
  {-
    import Hasura.GraphQL.Schema.Mutation qualified as GSB

    runMaybeT $ do
      let otherTableName = riRTable relationshipInfo
      otherTableInfo <- lift $ askTableInfo sourceName otherTableName
      guard (supportsInserts otherTableInfo)
  -}
  mkRelationshipParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
RelInfo 'MSSQL
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n (Maybe (AnnotatedInsertField 'MSSQL (UnpreparedValue 'MSSQL)))))
mkRelationshipParser RelInfo 'MSSQL
_ = Maybe
  (InputFieldsParser
     n (Maybe (AnnotatedInsertField 'MSSQL (UnpreparedValue 'MSSQL))))
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n (Maybe (AnnotatedInsertField 'MSSQL (UnpreparedValue 'MSSQL)))))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  (InputFieldsParser
     n (Maybe (AnnotatedInsertField 'MSSQL (UnpreparedValue 'MSSQL))))
forall a. Maybe a
Nothing

  -- individual components
  columnParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> Nullability
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
columnParser = ColumnType 'MSSQL
-> Nullability
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> Nullability
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
msColumnParser
  enumParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableName 'MSSQL
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
enumParser = TableName 'MSSQL
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableName 'MSSQL
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
msEnumParser
  possiblyNullable :: forall (m :: * -> *).
MonadParse m =>
ScalarType 'MSSQL
-> Nullability
-> Parser 'Both m (ScalarValue 'MSSQL)
-> Parser 'Both m (ScalarValue 'MSSQL)
possiblyNullable = ScalarType 'MSSQL
-> Nullability
-> Parser 'Both m (ScalarValue 'MSSQL)
-> Parser 'Both m (ScalarValue 'MSSQL)
forall (m :: * -> *).
MonadParse m =>
ScalarType 'MSSQL
-> Nullability
-> Parser 'Both m (ScalarValue 'MSSQL)
-> Parser 'Both m (ScalarValue 'MSSQL)
msPossiblyNullable
  scalarSelectionArgumentsParser :: forall (n :: * -> *).
MonadParse n =>
ColumnType 'MSSQL
-> InputFieldsParser n (Maybe (ScalarSelectionArguments 'MSSQL))
scalarSelectionArgumentsParser ColumnType 'MSSQL
_ = Maybe Void -> InputFieldsParser MetadataObjId n (Maybe Void)
forall a. a -> InputFieldsParser MetadataObjId n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Void
forall a. Maybe a
Nothing
  orderByOperators :: SourceInfo 'MSSQL
-> NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'MSSQL, NullsOrderType 'MSSQL)))
orderByOperators SourceInfo 'MSSQL
_sourceInfo = NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'MSSQL, NullsOrderType 'MSSQL)))
msOrderByOperators
  comparisonExps :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> SchemaT r m (Parser 'Input n [ComparisonExp 'MSSQL])
comparisonExps = ColumnType 'MSSQL
-> SchemaT r m (Parser 'Input n [ComparisonExp 'MSSQL])
forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> SchemaT r m (Parser 'Input n [ComparisonExp 'MSSQL])
msComparisonExps
  countTypeInput :: forall (n :: * -> *).
MonadParse n =>
Maybe
  (Parser
     'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL))
-> InputFieldsParser
     n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
countTypeInput = Maybe
  (Parser
     'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL))
-> InputFieldsParser
     n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
forall (n :: * -> *).
MonadParse n =>
Maybe
  (Parser
     'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL))
-> InputFieldsParser
     n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
msCountTypeInput
  aggregateOrderByCountType :: ScalarType 'MSSQL
aggregateOrderByCountType = ScalarType 'MSSQL
ScalarType
MSSQL.IntegerType
  computedField :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
ComputedFieldInfo 'MSSQL
-> TableName 'MSSQL
-> TableInfo 'MSSQL
-> SchemaT r m (Maybe (FieldParser n (AnnotatedField 'MSSQL)))
computedField ComputedFieldInfo 'MSSQL
_ TableName 'MSSQL
_ TableInfo 'MSSQL
_ = Maybe (FieldParser n (AnnotatedField 'MSSQL))
-> SchemaT r m (Maybe (FieldParser n (AnnotatedField 'MSSQL)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FieldParser n (AnnotatedField 'MSSQL))
forall a. Maybe a
Nothing

instance BackendTableSelectSchema 'MSSQL where
  tableArguments :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
tableArguments = TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
msTableArgs
  selectTable :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (SelectExp 'MSSQL)))
selectTable = TableInfo 'MSSQL
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (SelectExp 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
TableInfo b
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (SelectExp b)))
defaultSelectTable
  selectTableAggregate :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (AggSelectExp 'MSSQL)))
selectTableAggregate = TableInfo 'MSSQL
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (AggSelectExp 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
TableInfo b
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (AggSelectExp b)))
defaultSelectTableAggregate
  tableSelectionSet :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields 'MSSQL)))
tableSelectionSet = TableInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(AggregationPredicatesSchema b, BackendTableSelectSchema b,
 Eq (AnnBoolExp b (UnpreparedValue b)), MonadBuildSchema b r m n) =>
TableInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
defaultTableSelectionSet

instance BackendLogicalModelSelectSchema 'MSSQL where
  logicalModelArguments :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
LogicalModelInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
logicalModelArguments = LogicalModelInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b) =>
LogicalModelInfo b
-> SchemaT r m (InputFieldsParser n (SelectArgs b))
defaultLogicalModelArgs
  logicalModelSelectionSet :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
LogicalModelInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields 'MSSQL)))
logicalModelSelectionSet = LogicalModelInfo 'MSSQL
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
defaultLogicalModelSelectionSet

instance BackendNativeQuerySelectSchema 'MSSQL where
  selectNativeQuery :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema 'MSSQL r m n =>
NativeQueryInfo 'MSSQL
-> Name
-> Nullable
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (SelectExp 'MSSQL)))
selectNativeQuery = NativeQueryInfo 'MSSQL
-> Name
-> Nullable
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (SelectExp 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
NativeQueries.defaultSelectNativeQuery
  selectNativeQueryObject :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
NativeQueryInfo 'MSSQL
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              'MSSQL
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue 'MSSQL))))
selectNativeQueryObject = NativeQueryInfo 'MSSQL
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              'MSSQL
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue 'MSSQL))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
NativeQueries.defaultSelectNativeQueryObject

instance BackendUpdateOperatorsSchema 'MSSQL where
  type UpdateOperators 'MSSQL = UpdateOperator

  parseUpdateOperators :: forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> UpdPermInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column 'MSSQL) (UpdateOperators 'MSSQL (UnpreparedValue 'MSSQL))))
parseUpdateOperators = TableInfo 'MSSQL
-> UpdPermInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column 'MSSQL) (UpdateOperators 'MSSQL (UnpreparedValue 'MSSQL))))
forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> UpdPermInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column 'MSSQL) (UpdateOperators 'MSSQL (UnpreparedValue 'MSSQL))))
msParseUpdateOperators

----------------------------------------------------------------

-- * Top level parsers

backendInsertParser ::
  forall m r n.
  (MonadBuildSchema 'MSSQL r m n) =>
  TableInfo 'MSSQL ->
  SchemaT r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
backendInsertParser :: forall (m :: * -> *) r (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT
     r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
backendInsertParser TableInfo 'MSSQL
tableInfo = do
  InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL)))
ifMatched <- TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL))))
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
  let _biIdentityColumns :: ExtraTableMetadata 'MSSQL
_biIdentityColumns = TableCoreInfoG 'MSSQL (FieldInfo 'MSSQL) (ColumnInfo 'MSSQL)
-> ExtraTableMetadata 'MSSQL
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata (TableCoreInfoG 'MSSQL (FieldInfo 'MSSQL) (ColumnInfo 'MSSQL)
 -> ExtraTableMetadata 'MSSQL)
-> TableCoreInfoG 'MSSQL (FieldInfo 'MSSQL) (ColumnInfo 'MSSQL)
-> ExtraTableMetadata 'MSSQL
forall a b. (a -> b) -> a -> b
$ TableInfo 'MSSQL
-> TableCoreInfoG 'MSSQL (FieldInfo 'MSSQL) (ColumnInfo 'MSSQL)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo 'MSSQL
tableInfo
  InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL))
-> SchemaT
     r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL))
 -> SchemaT
      r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL))))
-> InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL))
-> SchemaT
     r m (InputFieldsParser n (BackendInsert (UnpreparedValue 'MSSQL)))
forall a b. (a -> b) -> a -> b
$ do
    Maybe (IfMatched (UnpreparedValue 'MSSQL))
_biIfMatched <- InputFieldsParser n (Maybe (IfMatched (UnpreparedValue 'MSSQL)))
ifMatched
    pure $ BackendInsert {Maybe (IfMatched (UnpreparedValue 'MSSQL))
_biIfMatched :: Maybe (IfMatched (UnpreparedValue 'MSSQL))
_biIfMatched :: Maybe (IfMatched (UnpreparedValue 'MSSQL))
..}

----------------------------------------------------------------

-- * Table arguments

msTableArgs ::
  forall r m n.
  (MonadBuildSchema 'MSSQL r m n) =>
  TableInfo 'MSSQL ->
  SchemaT r m (InputFieldsParser n (IR.SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
msTableArgs :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser n (SelectArgsG 'MSSQL (UnpreparedValue 'MSSQL)))
msTableArgs TableInfo 'MSSQL
tableInfo = do
  InputFieldsParser
  n (Maybe (AnnBoolExp 'MSSQL (UnpreparedValue 'MSSQL)))
whereParser <- TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Maybe (AnnBoolExp 'MSSQL (UnpreparedValue 'MSSQL))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(AggregationPredicatesSchema b, MonadBuildSchema b r m n) =>
TableInfo b
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (AnnBoolExp b (UnpreparedValue b))))
tableWhereArg TableInfo 'MSSQL
tableInfo
  InputFieldsParser
  n
  (Maybe
     (NonEmpty (AnnotatedOrderByItemG 'MSSQL (UnpreparedValue 'MSSQL))))
orderByParser <- TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (Maybe
           (NonEmpty
              (AnnotatedOrderByItemG 'MSSQL (UnpreparedValue 'MSSQL)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
TableInfo b
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Maybe (NonEmpty (AnnotatedOrderByItemG b (UnpreparedValue b)))))
tableOrderByArg TableInfo 'MSSQL
tableInfo
  pure do
    Maybe (AnnBoolExp 'MSSQL (UnpreparedValue 'MSSQL))
whereArg <- InputFieldsParser
  n (Maybe (AnnBoolExp 'MSSQL (UnpreparedValue 'MSSQL)))
whereParser
    Maybe
  (NonEmpty (AnnotatedOrderByItemG 'MSSQL (UnpreparedValue 'MSSQL)))
orderByArg <- InputFieldsParser
  n
  (Maybe
     (NonEmpty (AnnotatedOrderByItemG 'MSSQL (UnpreparedValue 'MSSQL))))
orderByParser
    Maybe Int
limitArg <- InputFieldsParser n (Maybe Int)
forall (n :: * -> *).
MonadParse n =>
InputFieldsParser n (Maybe Int)
tableLimitArg
    Maybe Int64
offsetArg <- InputFieldsParser n (Maybe Int64)
forall (n :: * -> *).
MonadParse n =>
InputFieldsParser n (Maybe Int64)
tableOffsetArg
    pure
      $ IR.SelectArgs
        { $sel:_saWhere:SelectArgs :: Maybe (AnnBoolExp 'MSSQL (UnpreparedValue 'MSSQL))
IR._saWhere = Maybe (AnnBoolExp 'MSSQL (UnpreparedValue 'MSSQL))
whereArg,
          $sel:_saOrderBy:SelectArgs :: Maybe
  (NonEmpty (AnnotatedOrderByItemG 'MSSQL (UnpreparedValue 'MSSQL)))
IR._saOrderBy = Maybe
  (NonEmpty (AnnotatedOrderByItemG 'MSSQL (UnpreparedValue 'MSSQL)))
orderByArg,
          $sel:_saLimit:SelectArgs :: Maybe Int
IR._saLimit = Maybe Int
limitArg,
          $sel:_saOffset:SelectArgs :: Maybe Int64
IR._saOffset = Maybe Int64
offsetArg,
          -- not supported on MSSQL for now
          $sel:_saDistinct:SelectArgs :: Maybe
  (NonEmpty (AnnDistinctColumn 'MSSQL (UnpreparedValue 'MSSQL)))
IR._saDistinct = Maybe
  (NonEmpty (AnnDistinctColumn 'MSSQL (UnpreparedValue 'MSSQL)))
forall a. Maybe a
Nothing
        }

----------------------------------------------------------------

-- * Individual components

msColumnParser ::
  (MonadBuildSchema 'MSSQL r m n) =>
  ColumnType 'MSSQL ->
  G.Nullability ->
  SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
msColumnParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> Nullability
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
msColumnParser ColumnType 'MSSQL
columnType Nullability
nullability = case ColumnType 'MSSQL
columnType of
  -- TODO: the mapping here is not consistent with mkMSSQLScalarTypeName. For
  -- example, exposing all the float types as a GraphQL Float type is
  -- incorrect, similarly exposing all the integer types as a GraphQL Int
  ColumnScalar ScalarType 'MSSQL
scalarType ->
    Name
-> (ScalarType, Nullability)
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
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 'msColumnParser (ScalarType 'MSSQL
ScalarType
scalarType, Nullability
nullability)
      (SchemaT
   r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
 -> SchemaT
      r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))))
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall a b. (a -> b) -> a -> b
$ Parser 'Both n (ColumnValue 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
forall (m :: * -> *) a.
MonadParse m =>
Parser 'Both m a -> Parser 'Both m (ValueWithOrigin a)
peelWithOrigin
      (Parser 'Both n (ColumnValue 'MSSQL)
 -> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
-> (Parser MetadataObjId 'Both n Value
    -> Parser 'Both n (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> ColumnValue 'MSSQL)
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ColumnValue 'MSSQL)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnType 'MSSQL -> ScalarValue 'MSSQL -> ColumnValue 'MSSQL
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType 'MSSQL
columnType)
      (Parser MetadataObjId 'Both n Value
 -> Parser 'Both n (ColumnValue 'MSSQL))
-> (Parser MetadataObjId 'Both n Value
    -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ColumnValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarType 'MSSQL
-> Nullability
-> Parser 'Both n (ScalarValue 'MSSQL)
-> Parser 'Both n (ScalarValue 'MSSQL)
forall (m :: * -> *).
MonadParse m =>
ScalarType 'MSSQL
-> Nullability
-> Parser 'Both m (ScalarValue 'MSSQL)
-> Parser 'Both m (ScalarValue 'MSSQL)
msPossiblyNullable ScalarType 'MSSQL
scalarType Nullability
nullability
      (Parser MetadataObjId 'Both n Value
 -> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ScalarType 'MSSQL
scalarType of
        -- text
        ScalarType 'MSSQL
ScalarType
MSSQL.CharType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
mkCharValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
        ScalarType 'MSSQL
ScalarType
MSSQL.VarcharType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
mkCharValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
        ScalarType 'MSSQL
ScalarType
MSSQL.WcharType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
ODBC.TextValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
        ScalarType 'MSSQL
ScalarType
MSSQL.WvarcharType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
ODBC.TextValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
        ScalarType 'MSSQL
ScalarType
MSSQL.WtextType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
ODBC.TextValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
        ScalarType 'MSSQL
ScalarType
MSSQL.TextType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
ODBC.TextValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
        -- integer
        ScalarType 'MSSQL
ScalarType
MSSQL.IntegerType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Int -> Value
ODBC.IntValue (Int -> Value) -> (Int32 -> Int) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Value)
-> Parser MetadataObjId 'Both n Int32
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.int
        ScalarType 'MSSQL
ScalarType
MSSQL.SmallintType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Int -> Value
ODBC.IntValue (Int -> Value) -> (Int32 -> Int) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Value)
-> Parser MetadataObjId 'Both n Int32
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.int
        ScalarType 'MSSQL
ScalarType
MSSQL.BigintType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Int -> Value
ODBC.IntValue (Int -> Value) -> (Int32 -> Int) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Value)
-> Parser MetadataObjId 'Both n Int32
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.int
        ScalarType 'MSSQL
ScalarType
MSSQL.TinyintType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Int -> Value
ODBC.IntValue (Int -> Value) -> (Int32 -> Int) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Value)
-> Parser MetadataObjId 'Both n Int32
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.int
        -- float
        ScalarType 'MSSQL
ScalarType
MSSQL.NumericType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Double -> Value
ODBC.DoubleValue (Double -> Value)
-> Parser MetadataObjId 'Both n Double
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Double
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Double
P.float
        ScalarType 'MSSQL
ScalarType
MSSQL.DecimalType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Double -> Value
ODBC.DoubleValue (Double -> Value)
-> Parser MetadataObjId 'Both n Double
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Double
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Double
P.float
        ScalarType 'MSSQL
ScalarType
MSSQL.FloatType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Double -> Value
ODBC.DoubleValue (Double -> Value)
-> Parser MetadataObjId 'Both n Double
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Double
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Double
P.float
        ScalarType 'MSSQL
ScalarType
MSSQL.RealType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Double -> Value
ODBC.DoubleValue (Double -> Value)
-> Parser MetadataObjId 'Both n Double
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Double
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Double
P.float
        -- boolean
        ScalarType 'MSSQL
ScalarType
MSSQL.BitType -> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Bool -> Value
ODBC.BoolValue (Bool -> Value)
-> Parser MetadataObjId 'Both n Bool
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Bool
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Bool
P.boolean
        ScalarType 'MSSQL
_ -> do
          Name
name <- ScalarType -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => ScalarType -> m Name
MSSQL.mkMSSQLScalarTypeName ScalarType 'MSSQL
ScalarType
scalarType
          let schemaType :: Type MetadataObjId 'Both
schemaType = Nullability
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
P.TNamed Nullability
P.NonNullable (Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
 -> Type MetadataObjId 'Both)
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> TypeInfo MetadataObjId 'Both
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
name Maybe Description
forall a. Maybe a
Nothing Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar
          Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Parser MetadataObjId 'Both n Value
 -> SchemaT r m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ P.Parser
              { pType :: Type MetadataObjId 'Both
pType = Type MetadataObjId 'Both
schemaType,
                pParser :: ParserInput 'Both -> n Value
pParser =
                  GType -> InputValue Variable -> n Value
forall (m :: * -> *).
MonadParse m =>
GType -> InputValue Variable -> m Value
P.valueToJSON (Type MetadataObjId 'Both -> GType
forall origin (k :: Kind). Type origin k -> GType
P.toGraphQLType Type MetadataObjId 'Both
schemaType)
                    (InputValue Variable -> n Value)
-> (Value -> n Value) -> InputValue Variable -> n Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (QErr -> n Value)
-> (Value -> n Value) -> Either QErr Value -> n Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseErrorCode -> ErrorMessage -> n Value
forall a. ParseErrorCode -> ErrorMessage -> n a
forall (m :: * -> *) a.
MonadParse m =>
ParseErrorCode -> ErrorMessage -> m a
P.parseErrorWith ParseErrorCode
P.ParseFailed (ErrorMessage -> n Value)
-> (QErr -> ErrorMessage) -> QErr -> n Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage) -> (QErr -> Text) -> QErr -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> Text
qeError) Value -> n Value
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    (Either QErr Value -> n Value)
-> (Value -> Either QErr Value) -> Value -> n Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScalarType -> Value -> Either QErr Value
MSSQL.parseScalarValue ScalarType 'MSSQL
ScalarType
scalarType)
              }
  ColumnEnumReference (EnumReference TableName 'MSSQL
tableName EnumValues
enumValues Maybe Name
customTableName) ->
    case [(EnumValue, EnumValueInfo)]
-> Maybe (NonEmpty (EnumValue, EnumValueInfo))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (EnumValues -> [(EnumValue, EnumValueInfo)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList EnumValues
enumValues) of
      Just NonEmpty (EnumValue, EnumValueInfo)
enumValuesList ->
        Parser 'Both n (ColumnValue 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
forall (m :: * -> *) a.
MonadParse m =>
Parser 'Both m a -> Parser 'Both m (ValueWithOrigin a)
peelWithOrigin
          (Parser 'Both n (ColumnValue 'MSSQL)
 -> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
-> (Parser MetadataObjId 'Both n Value
    -> Parser 'Both n (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> ColumnValue 'MSSQL)
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ColumnValue 'MSSQL)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnType 'MSSQL -> ScalarValue 'MSSQL -> ColumnValue 'MSSQL
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType 'MSSQL
columnType)
          (Parser MetadataObjId 'Both n Value
 -> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
-> SchemaT r m (Parser MetadataObjId 'Both n Value)
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableName 'MSSQL
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableName 'MSSQL
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
msEnumParser TableName 'MSSQL
tableName NonEmpty (EnumValue, EnumValueInfo)
enumValuesList Maybe Name
customTableName Nullability
nullability
      Maybe (NonEmpty (EnumValue, EnumValueInfo))
Nothing -> Code
-> Text
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"empty enum values"
  where
    -- CHAR/VARCHAR in MSSQL _can_ represent the full UCS (Universal Coded Character Set),
    -- but might not always if the collation used is not UTF-8 enabled
    -- https://docs.microsoft.com/en-us/sql/t-sql/data-types/char-and-varchar-transact-sql?view=sql-server-ver16
    --
    -- NCHAR/NVARCHAR in MSSQL are always able to represent the full UCS
    -- https://docs.microsoft.com/en-us/sql/t-sql/data-types/nchar-and-nvarchar-transact-sql?view=sql-server-ver16
    --
    -- We'd prefer to encode as CHAR/VARCHAR literals to CHAR/VARCHAR columns, as this
    -- means better index performance, BUT as we don't know what the collation
    -- the column is set to (an example is 'SQL_Latin1_General_CP437_BIN') and thus
    -- what characters are available in order to do this safely.
    --
    -- Therefore, we are conservative and only convert on the HGE side when the
    -- characters are all ASCII and guaranteed to be in the target character
    -- set, if not we pass an NCHAR/NVARCHAR and let MSSQL implicitly convert it.

    -- resolves https://github.com/hasura/graphql-engine/issues/8735
    mkCharValue :: Text -> ODBC.Value
    mkCharValue :: Text -> Value
mkCharValue Text
txt =
      if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
Char.isAscii Text
txt
        then ByteString -> Value
ODBC.ByteStringValue (Text -> ByteString
TE.encodeUtf8 Text
txt) -- an ODBC.ByteStringValue becomes a VARCHAR
        else Text -> Value
ODBC.TextValue Text
txt -- an ODBC.TextValue becomes an NVARCHAR

msEnumParser ::
  (MonadBuildSchema 'MSSQL r m n) =>
  TableName 'MSSQL ->
  NonEmpty (EnumValue, EnumValueInfo) ->
  Maybe G.Name ->
  G.Nullability ->
  SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
msEnumParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
TableName 'MSSQL
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue 'MSSQL))
msEnumParser TableName 'MSSQL
tableName NonEmpty (EnumValue, EnumValueInfo)
enumValues Maybe Name
customTableName Nullability
nullability = do
  Name
enumName <- forall (b :: BackendType) r (m :: * -> *).
(Backend b, MonadError QErr m, Has (SourceInfo b) r) =>
TableName b -> Maybe Name -> SchemaT r m Name
mkEnumTypeName @'MSSQL TableName 'MSSQL
tableName Maybe Name
customTableName
  pure $ ScalarType 'MSSQL
-> Nullability
-> Parser 'Both n (ScalarValue 'MSSQL)
-> Parser 'Both n (ScalarValue 'MSSQL)
forall (m :: * -> *).
MonadParse m =>
ScalarType 'MSSQL
-> Nullability
-> Parser 'Both m (ScalarValue 'MSSQL)
-> Parser 'Both m (ScalarValue 'MSSQL)
msPossiblyNullable ScalarType 'MSSQL
ScalarType
MSSQL.VarcharType Nullability
nullability (Parser 'Both n (ScalarValue 'MSSQL)
 -> Parser 'Both n (ScalarValue 'MSSQL))
-> Parser 'Both n (ScalarValue 'MSSQL)
-> Parser 'Both n (ScalarValue 'MSSQL)
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> NonEmpty (Definition EnumValueInfo, Value)
-> Parser MetadataObjId 'Both n Value
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
forall a. Maybe a
Nothing ((EnumValue, EnumValueInfo) -> (Definition EnumValueInfo, Value)
(EnumValue, EnumValueInfo)
-> (Definition EnumValueInfo, ScalarValue 'MSSQL)
mkEnumValue ((EnumValue, EnumValueInfo) -> (Definition EnumValueInfo, Value))
-> NonEmpty (EnumValue, EnumValueInfo)
-> NonEmpty (Definition EnumValueInfo, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (EnumValue, EnumValueInfo)
enumValues)
  where
    mkEnumValue :: (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, ScalarValue 'MSSQL)
    mkEnumValue :: (EnumValue, EnumValueInfo)
-> (Definition EnumValueInfo, ScalarValue 'MSSQL)
mkEnumValue (EnumValue Name
value, EnumValueInfo Maybe Text
description) =
      ( Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> EnumValueInfo
-> Definition EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
value (Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
description) Maybe MetadataObjId
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo,
        Text -> Value
ODBC.TextValue (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
value
      )

msPossiblyNullable ::
  (MonadParse m) =>
  ScalarType 'MSSQL ->
  G.Nullability ->
  Parser 'Both m (ScalarValue 'MSSQL) ->
  Parser 'Both m (ScalarValue 'MSSQL)
msPossiblyNullable :: forall (m :: * -> *).
MonadParse m =>
ScalarType 'MSSQL
-> Nullability
-> Parser 'Both m (ScalarValue 'MSSQL)
-> Parser 'Both m (ScalarValue 'MSSQL)
msPossiblyNullable ScalarType 'MSSQL
_scalarType (G.Nullability Bool
isNullable)
  | Bool
isNullable = (Maybe Value -> Value)
-> Parser MetadataObjId 'Both m (Maybe Value)
-> Parser MetadataObjId 'Both m Value
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both m a -> Parser MetadataObjId 'Both m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
ODBC.NullValue) (Parser MetadataObjId 'Both m (Maybe Value)
 -> Parser MetadataObjId 'Both m Value)
-> (Parser MetadataObjId 'Both m Value
    -> Parser MetadataObjId 'Both m (Maybe Value))
-> Parser MetadataObjId 'Both m Value
-> Parser MetadataObjId 'Both m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId 'Both m Value
-> Parser MetadataObjId 'Both m (Maybe Value)
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m (Maybe a)
P.nullable
  | Bool
otherwise = Parser MetadataObjId 'Both m Value
-> Parser MetadataObjId 'Both m Value
Parser MetadataObjId 'Both m (ScalarValue 'MSSQL)
-> Parser MetadataObjId 'Both m (ScalarValue 'MSSQL)
forall a. a -> a
id

msOrderByOperators ::
  NamingCase ->
  ( G.Name,
    NonEmpty
      ( P.Definition P.EnumValueInfo,
        (BasicOrderType 'MSSQL, NullsOrderType 'MSSQL)
      )
  )
msOrderByOperators :: NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'MSSQL, NullsOrderType 'MSSQL)))
msOrderByOperators NamingCase
_tCase =
  (Name
Name._order_by,)
    (NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))
 -> (Name,
     NonEmpty
       (Definition EnumValueInfo,
        (BasicOrderType 'MSSQL, NullsOrderType 'MSSQL))))
-> NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'MSSQL, NullsOrderType 'MSSQL)))
forall a b. (a -> b) -> a -> b
$
    -- NOTE: NamingCase is not being used here as we don't support naming conventions for this DB
    [(Definition EnumValueInfo, (Order, NullsOrder))]
-> NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
      [ ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._asc Description
"in ascending order, nulls first",
          (Order
MSSQL.AscOrder, NullsOrder
MSSQL.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._asc_nulls_first Description
"in ascending order, nulls first",
          (Order
MSSQL.AscOrder, NullsOrder
MSSQL.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._asc_nulls_last Description
"in ascending order, nulls last",
          (Order
MSSQL.AscOrder, NullsOrder
MSSQL.NullsLast)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._desc Description
"in descending order, nulls last",
          (Order
MSSQL.DescOrder, NullsOrder
MSSQL.NullsLast)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._desc_nulls_first Description
"in descending order, nulls first",
          (Order
MSSQL.DescOrder, NullsOrder
MSSQL.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._desc_nulls_last Description
"in descending order, nulls last",
          (Order
MSSQL.DescOrder, NullsOrder
MSSQL.NullsLast)
        )
      ]
  where
    define :: Name -> Description -> Definition origin EnumValueInfo
define Name
name Description
desc = 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
desc) Maybe origin
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo

msComparisonExps ::
  forall m n r.
  (MonadBuildSchema 'MSSQL r m n) =>
  ColumnType 'MSSQL ->
  SchemaT r m (Parser 'Input n [ComparisonExp 'MSSQL])
msComparisonExps :: forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> SchemaT r m (Parser 'Input n [ComparisonExp 'MSSQL])
msComparisonExps = Name
-> (ColumnType 'MSSQL
    -> SchemaT
         r m (Parser MetadataObjId 'Input n [ComparisonExp 'MSSQL]))
-> ColumnType 'MSSQL
-> SchemaT
     r m (Parser MetadataObjId 'Input n [ComparisonExp 'MSSQL])
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> (a -> m (p n b)) -> a -> m (p n b)
P.memoize 'comparisonExps \ColumnType 'MSSQL
columnType -> do
  -- see Note [Columns in comparison expression are never nullable]
  DangerouslyCollapseBooleans
collapseIfNull <- (SchemaOptions -> DangerouslyCollapseBooleans)
-> SchemaT r m DangerouslyCollapseBooleans
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> DangerouslyCollapseBooleans
Options.soDangerousBooleanCollapse

  -- parsers used for individual values
  Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser <- ColumnType 'MSSQL
-> Nullability
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'MSSQL r m n =>
ColumnType 'MSSQL
-> Nullability
-> SchemaT
     r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendSchema b, MonadBuildSchema b r m n) =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser ColumnType 'MSSQL
columnType (Bool -> Nullability
G.Nullability Bool
False)
  let columnListParser :: Parser MetadataObjId 'Both n [ColumnValue 'MSSQL]
columnListParser = (ValueWithOrigin (ColumnValue 'MSSQL) -> ColumnValue 'MSSQL)
-> [ValueWithOrigin (ColumnValue 'MSSQL)] -> [ColumnValue 'MSSQL]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue 'MSSQL) -> ColumnValue 'MSSQL
forall a. ValueWithOrigin a -> a
openValueOrigin ([ValueWithOrigin (ColumnValue 'MSSQL)] -> [ColumnValue 'MSSQL])
-> Parser
     MetadataObjId 'Both n [ValueWithOrigin (ColumnValue 'MSSQL)]
-> Parser MetadataObjId 'Both n [ColumnValue 'MSSQL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser
     MetadataObjId 'Both n [ValueWithOrigin (ColumnValue 'MSSQL)]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser

  -- field info
  let name :: Name
name = Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)) -> Name
forall a. HasName a => a -> Name
P.getName Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__MSSQL_comparison_exp
      desc :: Description
desc =
        Text -> Description
G.Description
          (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"Boolean expression to compare columns of type "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL)) -> Name
forall a. HasName a => a -> Name
P.getName Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser
          Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
". All fields are combined with logical 'AND'."

  -- Naming convention
  NamingCase
tCase <- (SourceInfo 'MSSQL -> NamingCase) -> SchemaT r m NamingCase
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve ((SourceInfo 'MSSQL -> NamingCase) -> SchemaT r m NamingCase)
-> (SourceInfo 'MSSQL -> NamingCase) -> SchemaT r m NamingCase
forall a b. (a -> b) -> a -> b
$ ResolvedSourceCustomization -> NamingCase
_rscNamingConvention (ResolvedSourceCustomization -> NamingCase)
-> (SourceInfo 'MSSQL -> ResolvedSourceCustomization)
-> SourceInfo 'MSSQL
-> NamingCase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization @'MSSQL

  pure
    $ Name
-> Maybe Description
-> InputFieldsParser MetadataObjId n [ComparisonExp 'MSSQL]
-> Parser MetadataObjId 'Input n [ComparisonExp 'MSSQL]
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
name (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
desc)
    (InputFieldsParser MetadataObjId n [ComparisonExp 'MSSQL]
 -> Parser MetadataObjId 'Input n [ComparisonExp 'MSSQL])
-> InputFieldsParser MetadataObjId n [ComparisonExp 'MSSQL]
-> Parser MetadataObjId 'Input n [ComparisonExp 'MSSQL]
forall a b. (a -> b) -> a -> b
$ ([Maybe (ComparisonExp 'MSSQL)] -> [ComparisonExp 'MSSQL])
-> InputFieldsParser MetadataObjId n [Maybe (ComparisonExp 'MSSQL)]
-> InputFieldsParser MetadataObjId n [ComparisonExp 'MSSQL]
forall a b.
(a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (ComparisonExp 'MSSQL)] -> [ComparisonExp 'MSSQL]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
    (InputFieldsParser MetadataObjId n [Maybe (ComparisonExp 'MSSQL)]
 -> InputFieldsParser MetadataObjId n [ComparisonExp 'MSSQL])
-> InputFieldsParser MetadataObjId n [Maybe (ComparisonExp 'MSSQL)]
-> InputFieldsParser MetadataObjId n [ComparisonExp 'MSSQL]
forall a b. (a -> b) -> a -> b
$ [InputFieldsParser MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
-> InputFieldsParser MetadataObjId n [Maybe (ComparisonExp 'MSSQL)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
    ([InputFieldsParser MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
 -> InputFieldsParser
      MetadataObjId n [Maybe (ComparisonExp 'MSSQL)])
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
-> InputFieldsParser MetadataObjId n [Maybe (ComparisonExp 'MSSQL)]
forall a b. (a -> b) -> a -> b
$ [[InputFieldsParser
    MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ -- Common ops for all types
        NamingCase
-> DangerouslyCollapseBooleans
-> Parser 'Both n (UnpreparedValue 'MSSQL)
-> Parser 'Both n (UnpreparedValue 'MSSQL)
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
forall (n :: * -> *) (k :: Kind) (b :: BackendType).
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> Parser k n (UnpreparedValue b)
-> Parser k n (UnpreparedValue b)
-> [InputFieldsParser n (Maybe (OpExpG b (UnpreparedValue b)))]
equalityOperators
          NamingCase
tCase
          DangerouslyCollapseBooleans
collapseIfNull
          (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser 'Both n (UnpreparedValue 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser)
          ([ColumnValue 'MSSQL] -> UnpreparedValue 'MSSQL
mkListLiteral ([ColumnValue 'MSSQL] -> UnpreparedValue 'MSSQL)
-> Parser MetadataObjId 'Both n [ColumnValue 'MSSQL]
-> Parser 'Both n (UnpreparedValue 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue 'MSSQL]
columnListParser),
        NamingCase
-> DangerouslyCollapseBooleans
-> Parser 'Both n (UnpreparedValue 'MSSQL)
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
forall (n :: * -> *) (k :: Kind) (b :: BackendType).
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> Parser k n (UnpreparedValue b)
-> [InputFieldsParser n (Maybe (OpExpG b (UnpreparedValue b)))]
comparisonOperators
          NamingCase
tCase
          DangerouslyCollapseBooleans
collapseIfNull
          (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser 'Both n (UnpreparedValue 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
        -- Ops for String like types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'MSSQL -> Bool) -> ColumnType 'MSSQL -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> [ScalarType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScalarType]
MSSQL.stringTypes) ColumnType 'MSSQL
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__like
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column match the given pattern")
                 (UnpreparedValue 'MSSQL -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALIKE (UnpreparedValue 'MSSQL -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
               Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__nlike
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column NOT match the given pattern")
                 (UnpreparedValue 'MSSQL -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANLIKE (UnpreparedValue 'MSSQL -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser)
             ],
        -- Ops for Geometry/Geography types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'MSSQL -> Bool) -> ColumnType 'MSSQL -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> [ScalarType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScalarType]
MSSQL.geoTypes) ColumnType 'MSSQL
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_contains
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column contain the given value")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTContains (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
               Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_equals
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column equal to given value (directionality is ignored)")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTEquals (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
               Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_intersects
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column spatially intersect the given value")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTIntersects (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
               Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_overlaps
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column 'spatially overlap' (intersect but not completely contain) the given value")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTOverlaps (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
               Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_within
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column contained in the given value")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTWithin (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser)
             ],
        -- Ops for Geometry types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'MSSQL -> Bool) -> ColumnType 'MSSQL -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType 'MSSQL
ScalarType
MSSQL.GeometryType ScalarType 'MSSQL -> ScalarType 'MSSQL -> Bool
forall a. Eq a => a -> a -> Bool
==) ColumnType 'MSSQL
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'MSSQL))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_crosses
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column cross the given geometry value")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTCrosses (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser),
               Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
-> InputFieldsParser MetadataObjId n (Maybe (ComparisonExp '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.__st_touches
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column have at least one point in common with the given geometry value")
                 (BooleanOperators 'MSSQL (UnpreparedValue 'MSSQL)
-> ComparisonExp 'MSSQL
BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> (ValueWithOrigin (ColumnValue 'MSSQL)
    -> BooleanOperators (UnpreparedValue 'MSSQL))
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> ComparisonExp 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'MSSQL -> BooleanOperators (UnpreparedValue 'MSSQL)
forall a. a -> BooleanOperators a
MSSQL.ASTTouches (UnpreparedValue 'MSSQL
 -> BooleanOperators (UnpreparedValue 'MSSQL))
-> (ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL)
-> ValueWithOrigin (ColumnValue 'MSSQL)
-> BooleanOperators (UnpreparedValue 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'MSSQL) -> UnpreparedValue 'MSSQL
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
mkParameter (ValueWithOrigin (ColumnValue 'MSSQL) -> ComparisonExp 'MSSQL)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
-> Parser MetadataObjId 'Both n (ComparisonExp 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'MSSQL))
typedParser)
             ]
      ]
  where
    mkListLiteral :: [ColumnValue 'MSSQL] -> UnpreparedValue 'MSSQL
    mkListLiteral :: [ColumnValue 'MSSQL] -> UnpreparedValue 'MSSQL
mkListLiteral =
      SQLExpression 'MSSQL -> UnpreparedValue 'MSSQL
Expression -> UnpreparedValue 'MSSQL
forall (b :: BackendType). SQLExpression b -> UnpreparedValue b
UVLiteral (Expression -> UnpreparedValue 'MSSQL)
-> ([ColumnValue 'MSSQL] -> Expression)
-> [ColumnValue 'MSSQL]
-> UnpreparedValue 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expression] -> Expression
MSSQL.ListExpression ([Expression] -> Expression)
-> ([ColumnValue 'MSSQL] -> [Expression])
-> [ColumnValue 'MSSQL]
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnValue 'MSSQL -> Expression)
-> [ColumnValue 'MSSQL] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Expression
MSSQL.ValueExpression (Value -> Expression)
-> (ColumnValue 'MSSQL -> Value)
-> ColumnValue 'MSSQL
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnValue 'MSSQL -> Value
ColumnValue 'MSSQL -> ScalarValue 'MSSQL
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue)

msCountTypeInput ::
  (MonadParse n) =>
  Maybe (Parser 'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)) ->
  InputFieldsParser n (IR.CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
msCountTypeInput :: forall (n :: * -> *).
MonadParse n =>
Maybe
  (Parser
     'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL))
-> InputFieldsParser
     n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
msCountTypeInput = \case
  Just Parser
  'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)
columnEnum -> do
    Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
column <- Name
-> Maybe Description
-> Parser
     MetadataObjId
     'Both
     n
     (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (ColumnName, AnnRedactionExpUnpreparedValue '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._column Maybe Description
forall a. Maybe a
Nothing Parser
  'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)
Parser
  MetadataObjId
  'Both
  n
  (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
columnEnum
    pure $ (CountDistinct
 -> Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
 -> Const (Countable ColumnName) (UnpreparedValue 'MSSQL))
-> Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
-> CountDistinct
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CountDistinct
-> Maybe (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)
-> CountType 'MSSQL (UnpreparedValue 'MSSQL)
CountDistinct
-> Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
mkCountType Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
column
  Maybe
  (Parser
     'Both n (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL))
Nothing -> (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
-> InputFieldsParser
     n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
forall a. a -> InputFieldsParser MetadataObjId n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
 -> InputFieldsParser
      n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL)))
-> (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
-> InputFieldsParser
     n (CountDistinct -> CountType 'MSSQL (UnpreparedValue 'MSSQL))
forall a b. (a -> b) -> a -> b
$ (CountDistinct
 -> Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
 -> Const (Countable ColumnName) (UnpreparedValue 'MSSQL))
-> Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
-> CountDistinct
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CountDistinct
-> Maybe (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)
-> CountType 'MSSQL (UnpreparedValue 'MSSQL)
CountDistinct
-> Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
mkCountType Maybe (ColumnName, AnnRedactionExpUnpreparedValue 'MSSQL)
forall a. Maybe a
Nothing
  where
    mkCountType :: IR.CountDistinct -> Maybe (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL) -> CountType 'MSSQL (UnpreparedValue 'MSSQL)
    mkCountType :: CountDistinct
-> Maybe (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)
-> CountType 'MSSQL (UnpreparedValue 'MSSQL)
mkCountType CountDistinct
_ Maybe (Column 'MSSQL, AnnRedactionExpUnpreparedValue 'MSSQL)
Nothing = Countable ColumnName
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall {k} a (b :: k). a -> Const a b
Const Countable ColumnName
forall name. Countable name
MSSQL.StarCountable
    mkCountType CountDistinct
IR.SelectCountDistinct (Just (Column 'MSSQL
col, AnnRedactionExpUnpreparedValue 'MSSQL
_redactionExp)) = Countable ColumnName
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall {k} a (b :: k). a -> Const a b
Const (Countable ColumnName
 -> Const (Countable ColumnName) (UnpreparedValue 'MSSQL))
-> Countable ColumnName
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall a b. (a -> b) -> a -> b
$ ColumnName -> Countable ColumnName
forall name. name -> Countable name
MSSQL.DistinctCountable Column 'MSSQL
ColumnName
col -- TODO(redactionExp): Deal with redaction expressions
    mkCountType CountDistinct
IR.SelectCountNonDistinct (Just (Column 'MSSQL
col, AnnRedactionExpUnpreparedValue 'MSSQL
_redactionExp)) = Countable ColumnName
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall {k} a (b :: k). a -> Const a b
Const (Countable ColumnName
 -> Const (Countable ColumnName) (UnpreparedValue 'MSSQL))
-> Countable ColumnName
-> Const (Countable ColumnName) (UnpreparedValue 'MSSQL)
forall a b. (a -> b) -> a -> b
$ ColumnName -> Countable ColumnName
forall name. name -> Countable name
MSSQL.NonNullFieldCountable Column 'MSSQL
ColumnName
col -- TODO(redactionExp): Deal with redaction expressions

msParseUpdateOperators ::
  forall m n r.
  (MonadBuildSchema 'MSSQL r m n) =>
  TableInfo 'MSSQL ->
  UpdPermInfo 'MSSQL ->
  SchemaT r m (InputFieldsParser n (HashMap (Column 'MSSQL) (UpdateOperators 'MSSQL (UnpreparedValue 'MSSQL))))
msParseUpdateOperators :: forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema 'MSSQL r m n =>
TableInfo 'MSSQL
-> UpdPermInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column 'MSSQL) (UpdateOperators 'MSSQL (UnpreparedValue 'MSSQL))))
msParseUpdateOperators TableInfo 'MSSQL
tableInfo UpdPermInfo 'MSSQL
updatePermissions = do
  HashMap (Column 'MSSQL) (UpdateOperator (UnpreparedValue 'MSSQL))
-> [UpdateOperator
      'MSSQL r m n (UpdateOperator (UnpreparedValue 'MSSQL))]
-> TableInfo 'MSSQL
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column 'MSSQL) (UpdateOperator (UnpreparedValue 'MSSQL))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *) op.
MonadBuildSchema b r m n =>
HashMap (Column b) op
-> [UpdateOperator b r m n op]
-> TableInfo b
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) op))
SU.buildUpdateOperators
    (UnpreparedValue 'MSSQL -> UpdateOperator (UnpreparedValue 'MSSQL)
forall v. v -> UpdateOperator v
UpdateSet (UnpreparedValue 'MSSQL -> UpdateOperator (UnpreparedValue 'MSSQL))
-> HashMap ColumnName (UnpreparedValue 'MSSQL)
-> HashMap ColumnName (UpdateOperator (UnpreparedValue 'MSSQL))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdPermInfo 'MSSQL
-> HashMap (Column 'MSSQL) (UnpreparedValue 'MSSQL)
forall (b :: BackendType).
UpdPermInfo b -> HashMap (Column b) (UnpreparedValue b)
SU.presetColumns UpdPermInfo 'MSSQL
updatePermissions)
    [ UnpreparedValue 'MSSQL -> UpdateOperator (UnpreparedValue 'MSSQL)
forall v. v -> UpdateOperator v
UpdateSet (UnpreparedValue 'MSSQL -> UpdateOperator (UnpreparedValue 'MSSQL))
-> UpdateOperator 'MSSQL r m n (UnpreparedValue 'MSSQL)
-> UpdateOperator
     'MSSQL r m n (UpdateOperator (UnpreparedValue 'MSSQL))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator 'MSSQL r m n (UnpreparedValue 'MSSQL)
forall (b :: BackendType) (n :: * -> *) r (m :: * -> *).
MonadBuildSchema b r m n =>
UpdateOperator b r m n (UnpreparedValue b)
SU.setOp,
      UnpreparedValue 'MSSQL -> UpdateOperator (UnpreparedValue 'MSSQL)
forall v. v -> UpdateOperator v
UpdateInc (UnpreparedValue 'MSSQL -> UpdateOperator (UnpreparedValue 'MSSQL))
-> UpdateOperator 'MSSQL r m n (UnpreparedValue 'MSSQL)
-> UpdateOperator
     'MSSQL r m n (UpdateOperator (UnpreparedValue 'MSSQL))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator 'MSSQL r m n (UnpreparedValue 'MSSQL)
forall (b :: BackendType) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema b r m n =>
UpdateOperator b r m n (UnpreparedValue b)
SU.incOp
    ]
    TableInfo 'MSSQL
tableInfo