-- | MSSQL DDL BoolExp
--
-- How to parse the boolean expressions and operations relevant for MSSQL.
module Hasura.Backends.MSSQL.DDL.BoolExp
  ( parseBoolExpOperations,
  )
where

import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Text qualified as T
import Data.Text.Extended (dquote, toTxt, (<<>))
import Hasura.Backends.MSSQL.Types.Internal hiding (ColumnType)
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types

parseBoolExpOperations ::
  forall m v.
  (MonadError QErr m) => -- , TableCoreInfoRM 'MSSQL m)
  ValueParser 'MSSQL m v ->
  FieldInfoMap (FieldInfo 'MSSQL) ->
  FieldInfoMap (FieldInfo 'MSSQL) ->
  ColumnReference 'MSSQL ->
  J.Value ->
  m [OpExpG 'MSSQL v]
parseBoolExpOperations :: forall (m :: * -> *) v.
MonadError QErr m =>
ValueParser 'MSSQL m v
-> FieldInfoMap (FieldInfo 'MSSQL)
-> FieldInfoMap (FieldInfo 'MSSQL)
-> ColumnReference 'MSSQL
-> Value
-> m [OpExpG 'MSSQL v]
parseBoolExpOperations ValueParser 'MSSQL m v
rhsParser FieldInfoMap (FieldInfo 'MSSQL)
_rootTableFieldInfoMap FieldInfoMap (FieldInfo 'MSSQL)
_fields ColumnReference 'MSSQL
columnRef Value
value =
  Text -> m [OpExpG 'MSSQL v] -> m [OpExpG 'MSSQL v]
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (ColumnReference 'MSSQL -> Text
forall a. ToTxt a => a -> Text
toTxt ColumnReference 'MSSQL
columnRef) (m [OpExpG 'MSSQL v] -> m [OpExpG 'MSSQL v])
-> m [OpExpG 'MSSQL v] -> m [OpExpG 'MSSQL v]
forall a b. (a -> b) -> a -> b
$ ColumnType 'MSSQL -> Value -> m [OpExpG 'MSSQL v]
parseOperations (ColumnReference 'MSSQL -> ColumnType 'MSSQL
forall (backend :: BackendType).
ColumnReference backend -> ColumnType backend
columnReferenceType ColumnReference 'MSSQL
columnRef) Value
value
  where
    parseWithTy :: ColumnType 'MSSQL -> Value -> m v
parseWithTy ColumnType 'MSSQL
ty = ValueParser 'MSSQL m v
rhsParser (ColumnType 'MSSQL -> CollectableType (ColumnType 'MSSQL)
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType 'MSSQL
ty)

    parseOperations :: ColumnType 'MSSQL -> J.Value -> m [OpExpG 'MSSQL v]
    parseOperations :: ColumnType 'MSSQL -> Value -> m [OpExpG 'MSSQL v]
parseOperations ColumnType 'MSSQL
columnType = \case
      J.Object Object
o -> ((Key, Value) -> m (OpExpG 'MSSQL v))
-> [(Key, Value)] -> m [OpExpG 'MSSQL v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ColumnType 'MSSQL -> (Text, Value) -> m (OpExpG 'MSSQL v)
parseOperation ColumnType 'MSSQL
columnType ((Text, Value) -> m (OpExpG 'MSSQL v))
-> ((Key, Value) -> (Text, Value))
-> (Key, Value)
-> m (OpExpG 'MSSQL v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Text) -> (Key, Value) -> (Text, Value)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Key -> Text
K.toText) ([(Key, Value)] -> m [OpExpG 'MSSQL v])
-> [(Key, Value)] -> m [OpExpG 'MSSQL v]
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
o
      Value
v -> OpExpG 'MSSQL v -> [OpExpG 'MSSQL v]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpExpG 'MSSQL v -> [OpExpG 'MSSQL v])
-> (v -> OpExpG 'MSSQL v) -> v -> [OpExpG 'MSSQL v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComparisonNullability -> v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
ComparisonNullability -> field -> OpExpG backend field
AEQ ComparisonNullability
NullableComparison (v -> [OpExpG 'MSSQL v]) -> m v -> m [OpExpG 'MSSQL v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'MSSQL -> Value -> m v
parseWithTy ColumnType 'MSSQL
columnType Value
v

    parseOperation :: ColumnType 'MSSQL -> (Text, J.Value) -> m (OpExpG 'MSSQL v)
    parseOperation :: ColumnType 'MSSQL -> (Text, Value) -> m (OpExpG 'MSSQL v)
parseOperation ColumnType 'MSSQL
columnType (Text
opStr, Value
val) = Text -> m (OpExpG 'MSSQL v) -> m (OpExpG 'MSSQL v)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
opStr
      (m (OpExpG 'MSSQL v) -> m (OpExpG 'MSSQL v))
-> m (OpExpG 'MSSQL v) -> m (OpExpG 'MSSQL v)
forall a b. (a -> b) -> a -> b
$ case Text
opStr of
        Text
"_eq" -> m (OpExpG 'MSSQL v)
parseEq
        Text
"$eq" -> m (OpExpG 'MSSQL v)
parseEq
        Text
"_neq" -> m (OpExpG 'MSSQL v)
parseNeq
        Text
"$neq" -> m (OpExpG 'MSSQL v)
parseNeq
        Text
"$in" -> m (OpExpG 'MSSQL v)
parseIn
        Text
"_in" -> m (OpExpG 'MSSQL v)
parseIn
        Text
"$nin" -> m (OpExpG 'MSSQL v)
parseNin
        Text
"_nin" -> m (OpExpG 'MSSQL v)
parseNin
        Text
"_gt" -> m (OpExpG 'MSSQL v)
parseGt
        Text
"$gt" -> m (OpExpG 'MSSQL v)
parseGt
        Text
"_lt" -> m (OpExpG 'MSSQL v)
parseLt
        Text
"$lt" -> m (OpExpG 'MSSQL v)
parseLt
        Text
"_gte" -> m (OpExpG 'MSSQL v)
parseGte
        Text
"$gte" -> m (OpExpG 'MSSQL v)
parseGte
        Text
"_lte" -> m (OpExpG 'MSSQL v)
parseLte
        Text
"$lte" -> m (OpExpG 'MSSQL v)
parseLte
        Text
"$like" -> m (OpExpG 'MSSQL v)
parseLike
        Text
"_like" -> m (OpExpG 'MSSQL v)
parseLike
        Text
"$nlike" -> m (OpExpG 'MSSQL v)
parseNlike
        Text
"_nlike" -> m (OpExpG 'MSSQL v)
parseNlike
        Text
"$is_null" -> m (OpExpG 'MSSQL v)
parseIsNull
        Text
"_is_null" -> m (OpExpG 'MSSQL v)
parseIsNull
        Text
"_st_contains" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTContains
        Text
"$st_contains" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTContains
        Text
"_st_equals" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTEquals
        Text
"$st_equals" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTEquals
        Text
"_st_intersects" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTIntersects
        Text
"$st_intersects" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTIntersects
        Text
"_st_overlaps" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTOverlaps
        Text
"$st_overlaps" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTOverlaps
        Text
"_st_within" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTWithin
        Text
"$st_within" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTWithin
        Text
"_st_crosses" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTCrosses
        Text
"$st_crosses" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTCrosses
        Text
"_st_touches" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTTouches
        Text
"$st_touches" -> BooleanOperators 'MSSQL v -> OpExpG 'MSSQL v
BooleanOperators v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators v -> OpExpG 'MSSQL v)
-> m (BooleanOperators v) -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOp v -> BooleanOperators v
forall a. a -> BooleanOperators a
ASTTouches
        Text
x -> Code -> Text -> m (OpExpG 'MSSQL v)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload (Text -> m (OpExpG 'MSSQL v)) -> Text -> m (OpExpG 'MSSQL v)
forall a b. (a -> b) -> a -> b
$ Text
"Unknown operator: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
      where
        colTy :: ColumnType 'MSSQL
colTy = ColumnReference 'MSSQL -> ColumnType 'MSSQL
forall (backend :: BackendType).
ColumnReference backend -> ColumnType backend
columnReferenceType ColumnReference 'MSSQL
columnRef

        parseOne :: m v
parseOne = ColumnType 'MSSQL -> Value -> m v
parseWithTy ColumnType 'MSSQL
columnType Value
val
        parseManyWithType :: ColumnType 'MSSQL -> m v
parseManyWithType ColumnType 'MSSQL
ty = ValueParser 'MSSQL m v
rhsParser (ColumnType 'MSSQL -> CollectableType (ColumnType 'MSSQL)
forall a. a -> CollectableType a
CollectableTypeArray ColumnType 'MSSQL
ty) Value
val

        parseEq :: m (OpExpG 'MSSQL v)
parseEq = ComparisonNullability -> v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
ComparisonNullability -> field -> OpExpG backend field
AEQ ComparisonNullability
NullableComparison (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseNeq :: m (OpExpG 'MSSQL v)
parseNeq = ComparisonNullability -> v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
ComparisonNullability -> field -> OpExpG backend field
ANE ComparisonNullability
NullableComparison (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseIn :: m (OpExpG 'MSSQL v)
parseIn = v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
AIN (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'MSSQL -> m v
parseManyWithType ColumnType 'MSSQL
colTy
        parseNin :: m (OpExpG 'MSSQL v)
parseNin = v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANIN (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'MSSQL -> m v
parseManyWithType ColumnType 'MSSQL
colTy
        parseGt :: m (OpExpG 'MSSQL v)
parseGt = v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
AGT (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseLt :: m (OpExpG 'MSSQL v)
parseLt = v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALT (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseGte :: m (OpExpG 'MSSQL v)
parseGte = v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
AGTE (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseLte :: m (OpExpG 'MSSQL v)
parseLte = v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALTE (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseLike :: m (OpExpG 'MSSQL v)
parseLike = [ScalarType] -> m ()
guardType [ScalarType]
stringTypes m () -> m (OpExpG 'MSSQL v) -> m (OpExpG 'MSSQL v)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALIKE (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseNlike :: m (OpExpG 'MSSQL v)
parseNlike = [ScalarType] -> m ()
guardType [ScalarType]
stringTypes m () -> m (OpExpG 'MSSQL v) -> m (OpExpG 'MSSQL v)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v -> OpExpG 'MSSQL v
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANLIKE (v -> OpExpG 'MSSQL v) -> m v -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m v
parseOne
        parseIsNull :: m (OpExpG 'MSSQL v)
parseIsNull = OpExpG 'MSSQL v -> OpExpG 'MSSQL v -> Bool -> OpExpG 'MSSQL v
forall a. a -> a -> Bool -> a
bool OpExpG 'MSSQL v
forall (backend :: BackendType) field. OpExpG backend field
ANISNOTNULL OpExpG 'MSSQL v
forall (backend :: BackendType) field. OpExpG backend field
ANISNULL (Bool -> OpExpG 'MSSQL v) -> m Bool -> m (OpExpG 'MSSQL v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
forall a. FromJSON a => m a
parseVal

        parseGeometryOp :: (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOp v -> BooleanOperators v
f =
          [ScalarType] -> m ()
guardType [ScalarType
GeometryType] m () -> m (BooleanOperators v) -> m (BooleanOperators v)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v -> BooleanOperators v
f (v -> BooleanOperators v) -> m v -> m (BooleanOperators v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'MSSQL -> Value -> m v
parseOneNoSess ColumnType 'MSSQL
colTy Value
val
        parseGeometryOrGeographyOp :: (v -> BooleanOperators v) -> m (BooleanOperators v)
parseGeometryOrGeographyOp v -> BooleanOperators v
f =
          [ScalarType] -> m ()
guardType [ScalarType]
geoTypes m () -> m (BooleanOperators v) -> m (BooleanOperators v)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v -> BooleanOperators v
f (v -> BooleanOperators v) -> m v -> m (BooleanOperators v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType 'MSSQL -> Value -> m v
parseOneNoSess ColumnType 'MSSQL
colTy Value
val
        parseOneNoSess :: ColumnType 'MSSQL -> Value -> m v
parseOneNoSess ColumnType 'MSSQL
ty = ValueParser 'MSSQL m v
rhsParser (ColumnType 'MSSQL -> CollectableType (ColumnType 'MSSQL)
forall a. a -> CollectableType a
CollectableTypeScalar ColumnType 'MSSQL
ty)

        guardType :: [ScalarType] -> m ()
guardType [ScalarType]
validTys =
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((ScalarType 'MSSQL -> Bool) -> ColumnType 'MSSQL -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType 'MSSQL -> [ScalarType 'MSSQL] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScalarType 'MSSQL]
[ScalarType]
validTys) ColumnType 'MSSQL
colTy)
            (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
            (QErr -> m ()) -> QErr -> m ()
forall a b. (a -> b) -> a -> b
$ ColumnType 'MSSQL -> [ScalarType] -> QErr
forall {t} {a}. (ToTxt t, ToTxt a) => t -> [a] -> QErr
buildMsg ColumnType 'MSSQL
colTy [ScalarType]
validTys

        buildMsg :: t -> [a] -> QErr
buildMsg t
ty [a]
expTys =
          Code -> Text -> QErr
err400 Code
UnexpectedPayload
            (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
" is of type "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> t
ty
            t -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"; this operator works only on columns of type "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" ((a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. ToTxt a => a -> Text
dquote [a]
expTys)

        parseVal :: (J.FromJSON a) => m a
        parseVal :: forall a. FromJSON a => m a
parseVal = Value -> m a
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
val