graphql-engine/server/src-lib/Hasura/Backends/MSSQL/DDL/BoolExp.hs
Brandon Simmons 6e8da71ece server: migrate to aeson-2 in preparation for ghc 9.2 upgrade
(Work here originally done by awjchen, rebased and fixed up for merge by
jberryman)

This is part of a merge train towards GHC 9.2 compatibility. The main
issue is the use of the new abstract `KeyMap` in 2.0. See:
https://hackage.haskell.org/package/aeson-2.0.3.0/changelog

Alex's original work is here:
#4305

BEHAVIOR CHANGE NOTE: This change causes a different arbitrary ordering
of serialized Json, for example during metadata export. CLI users care
about this in particular, and so we need to call it out as a _behavior
change_ as we did in v2.5.0. The good news though is that after this
change ordering should be more stable (alphabetical key order).

See: https://hasurahq.slack.com/archives/C01M20G1YRW/p1654012632634389

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4611
Co-authored-by: awjchen <13142944+awjchen@users.noreply.github.com>
GitOrigin-RevId: 700265162c782739b2bb88300ee3cda3819b2e87
2022-06-08 15:32:27 +00:00

111 lines
4.4 KiB
Haskell

-- | 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.Column
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Backend
import Hasura.SQL.Types
parseBoolExpOperations ::
forall m v.
(MonadError QErr m) => -- , TableCoreInfoRM 'MSSQL m)
ValueParser 'MSSQL m v ->
TableName ->
FieldInfoMap (FieldInfo 'MSSQL) ->
ColumnReference 'MSSQL ->
J.Value ->
m [OpExpG 'MSSQL v]
parseBoolExpOperations rhsParser _table _fields columnRef value =
withPathK (toTxt columnRef) $ parseOperations (columnReferenceType columnRef) value
where
parseWithTy ty = rhsParser (CollectableTypeScalar ty)
parseOperations :: ColumnType 'MSSQL -> J.Value -> m [OpExpG 'MSSQL v]
parseOperations columnType = \case
J.Object o -> mapM (parseOperation columnType . first K.toText) $ KM.toList o
v -> pure . AEQ False <$> parseWithTy columnType v
parseOperation :: ColumnType 'MSSQL -> (Text, J.Value) -> m (OpExpG 'MSSQL v)
parseOperation columnType (opStr, val) = withPathK opStr $
case opStr of
"_eq" -> parseEq
"$eq" -> parseEq
"_neq" -> parseNeq
"$neq" -> parseNeq
"$in" -> parseIn
"_in" -> parseIn
"$nin" -> parseNin
"_nin" -> parseNin
"_gt" -> parseGt
"$gt" -> parseGt
"_lt" -> parseLt
"$lt" -> parseLt
"_gte" -> parseGte
"$gte" -> parseGte
"_lte" -> parseLte
"$lte" -> parseLte
"$like" -> parseLike
"_like" -> parseLike
"$nlike" -> parseNlike
"_nlike" -> parseNlike
"_st_contains" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTContains
"$st_contains" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTContains
"_st_equals" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTEquals
"$st_equals" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTEquals
"_st_intersects" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTIntersects
"$st_intersects" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTIntersects
"_st_overlaps" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTOverlaps
"$st_overlaps" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTOverlaps
"_st_within" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTWithin
"$st_within" -> ABackendSpecific <$> parseGeometryOrGeographyOp ASTWithin
"_st_crosses" -> ABackendSpecific <$> parseGeometryOp ASTCrosses
"$st_crosses" -> ABackendSpecific <$> parseGeometryOp ASTCrosses
"_st_touches" -> ABackendSpecific <$> parseGeometryOp ASTTouches
"$st_touches" -> ABackendSpecific <$> parseGeometryOp ASTTouches
x -> throw400 UnexpectedPayload $ "Unknown operator : " <> x
where
colTy = columnReferenceType columnRef
parseOne = parseWithTy columnType val
parseManyWithType ty = rhsParser (CollectableTypeArray ty) val
parseEq = AEQ False <$> parseOne
parseNeq = ANE False <$> parseOne
parseIn = AIN <$> parseManyWithType colTy
parseNin = ANIN <$> parseManyWithType colTy
parseGt = AGT <$> parseOne
parseLt = ALT <$> parseOne
parseGte = AGTE <$> parseOne
parseLte = ALTE <$> parseOne
parseLike = guardType stringTypes >> ALIKE <$> parseOne
parseNlike = guardType stringTypes >> ANLIKE <$> parseOne
parseGeometryOp f =
guardType [GeometryType] >> f <$> parseOneNoSess colTy val
parseGeometryOrGeographyOp f =
guardType geoTypes >> f <$> parseOneNoSess colTy val
parseOneNoSess ty = rhsParser (CollectableTypeScalar ty)
guardType validTys =
unless (isScalarColumnWhere (`elem` validTys) colTy) $
throwError $ buildMsg colTy validTys
buildMsg ty expTys =
err400 UnexpectedPayload $
" is of type " <> ty <<> "; this operator works only on columns of type "
<> T.intercalate "/" (map dquote expTys)