{- ORMOLU_DISABLE -}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
-- NOTE: This module previously used Template Haskell to generate its instances,
-- but additional restrictions on Template Haskell splices introduced in GHC 9.0 impose an ordering
-- on the generated instances that is difficult to satisfy
-- To avoid these difficulties, we now use CPP.

-- | MSSQL Types Instances
--
-- Instances for types from "Hasura.Backends.MSSQL.Types.Internal" that're slow to compile.
module Hasura.Backends.MSSQL.Types.Instances () where

import Autodocodec (HasCodec (codec), dimapCodec, optionalFieldWithDefault', parseAlternative, requiredField')
import qualified Autodocodec as AC
import Data.Aeson.Extended
import Data.Aeson.Types
import Data.Text.Extended (ToTxt (..))
import Data.Time as Time
import Hasura.Backends.MSSQL.Types.Internal
import Hasura.Base.ErrorValue qualified as ErrorValue
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude
import Language.Haskell.TH.Syntax
import Hasura.Base.ToErrorValue

deriving instance Generic (Aliased a)
instance Hashable a => Hashable (Aliased a)
deriving instance Eq a => Eq (Aliased a)
instance NFData a => NFData (Aliased a)
deriving instance Show a => Show (Aliased a)
deriving instance Functor Aliased
deriving instance Data a => Data (Aliased a)


#define INSTANCE_CLUMP_1(name) \
         deriving instance Generic name ;\
         instance Hashable name ;\
         deriving instance Eq name ;\
         deriving instance Show name ;\
         deriving instance Data name ;\
         instance NFData name ;\
         instance FromJSON name ;\
         deriving instance Ord name
INSTANCE_CLUMP_1(UnifiedTableName)
INSTANCE_CLUMP_1(UnifiedObjectRelationship)
INSTANCE_CLUMP_1(UnifiedArrayRelationship)
INSTANCE_CLUMP_1(UnifiedUsing)
INSTANCE_CLUMP_1(UnifiedOn)
INSTANCE_CLUMP_1(UnifiedColumn)
INSTANCE_CLUMP_1(TempTableName)
INSTANCE_CLUMP_1(SomeTableName)
INSTANCE_CLUMP_1(ConstraintName)


#define INSTANCE_CLUMP_2(name) \
         deriving instance Generic name ;\
         instance Hashable name ;\
         deriving instance Eq name ;\
         deriving instance Show name ;\
         deriving instance Data name ;\
         instance NFData name
INSTANCE_CLUMP_2(Where)
INSTANCE_CLUMP_2(For)
INSTANCE_CLUMP_2(Aggregate)
INSTANCE_CLUMP_2(EntityAlias)
INSTANCE_CLUMP_2(ForJson)
INSTANCE_CLUMP_2(JsonCardinality)
INSTANCE_CLUMP_2(Root)
INSTANCE_CLUMP_2(OrderBy)
INSTANCE_CLUMP_2(JoinAlias)
INSTANCE_CLUMP_2(Reselect)
INSTANCE_CLUMP_2(ColumnName)
INSTANCE_CLUMP_2(DataLength)
INSTANCE_CLUMP_2(Expression)
INSTANCE_CLUMP_2(FunctionApplicationExpression)
INSTANCE_CLUMP_2(MethodApplicationExpression)
INSTANCE_CLUMP_2(NullsOrder)
INSTANCE_CLUMP_2(Order)
INSTANCE_CLUMP_2(ScalarType)
INSTANCE_CLUMP_2(TableName)
INSTANCE_CLUMP_2(FunctionName)
INSTANCE_CLUMP_2(Select)
INSTANCE_CLUMP_2(With)
INSTANCE_CLUMP_2(CTEBody)
INSTANCE_CLUMP_2(Top)
INSTANCE_CLUMP_2(FieldName)
INSTANCE_CLUMP_2(JsonPath)
INSTANCE_CLUMP_2(Op)
INSTANCE_CLUMP_2(SpatialOp)
INSTANCE_CLUMP_2(Projection)
INSTANCE_CLUMP_2(From)
INSTANCE_CLUMP_2(OpenJson)
INSTANCE_CLUMP_2(JsonFieldSpec)
INSTANCE_CLUMP_2(Join)
INSTANCE_CLUMP_2(JoinSource)
INSTANCE_CLUMP_2(SelectIntoTempTable)
INSTANCE_CLUMP_2(SITTConstraints)
INSTANCE_CLUMP_2(InsertValuesIntoTempTable)
INSTANCE_CLUMP_2(InsertOutput)
INSTANCE_CLUMP_2(Inserted)
INSTANCE_CLUMP_2(OutputColumn)
INSTANCE_CLUMP_2(TempTable)
INSTANCE_CLUMP_2(Deleted)
INSTANCE_CLUMP_2(DeleteOutput)
INSTANCE_CLUMP_2(Values)
INSTANCE_CLUMP_2(Delete)
INSTANCE_CLUMP_2(Insert)
INSTANCE_CLUMP_2(Merge)
INSTANCE_CLUMP_2(MergeUsing)
INSTANCE_CLUMP_2(MergeOn)
INSTANCE_CLUMP_2(MergeWhenMatched)
INSTANCE_CLUMP_2(MergeWhenNotMatched)

deriving instance Ord TableName
deriving instance Ord FunctionName
deriving instance Ord ScalarType

deriving instance Lift TableName
deriving instance Lift FunctionName
deriving instance Lift NullsOrder
deriving instance Lift Order

--------------------------------------------------------------------------------
-- Third-party types

deriving instance Generic (Time.TimeZone)

--------------------------------------------------------------------------------
-- Debug instances

instance ToErrorValue ScalarType where
  toErrorValue :: ScalarType -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (ScalarType -> Text) -> ScalarType -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarType -> Text
forall a. Show a => a -> Text
tshow

instance ToErrorValue TableName where
  toErrorValue :: TableName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (TableName -> Text) -> TableName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Text
forall a. Show a => a -> Text
tshow

instance ToErrorValue ConstraintName where
  toErrorValue :: ConstraintName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (ConstraintName -> Text) -> ConstraintName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintName -> Text
constraintNameText

instance ToErrorValue ColumnName where
  toErrorValue :: ColumnName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (ColumnName -> Text) -> ColumnName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnName -> Text
columnNameText

instance ToErrorValue FunctionName where
  toErrorValue :: FunctionName -> ErrorMessage
toErrorValue = Text -> ErrorMessage
ErrorValue.squote (Text -> ErrorMessage)
-> (FunctionName -> Text) -> FunctionName -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Text
forall a. Show a => a -> Text
tshow

instance ToTxt ScalarType where
  toTxt :: ScalarType -> Text
toTxt = ScalarType -> Text
forall a. Show a => a -> Text
tshow -- TODO: include schema

instance ToTxt TableName where
  toTxt :: TableName -> Text
toTxt (TableName Text
tableName (SchemaName Text
tableSchema)) =
    if Text
tableSchema Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dbo"
      then Text
tableName
      else Text
tableSchema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName

instance ToTxt FunctionName where
  toTxt :: FunctionName -> Text
toTxt (FunctionName Text
functionName (SchemaName Text
functionSchema)) =
    if Text
functionSchema Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dbo"
      then Text
functionName
      else Text
functionSchema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
functionName

instance ToTxt ColumnName where
  toTxt :: ColumnName -> Text
toTxt = ColumnName -> Text
columnNameText

instance ToTxt ConstraintName where
  toTxt :: ConstraintName -> Text
toTxt = ConstraintName -> Text
constraintNameText

#define INSTANCE_CLUMP_3(name) \
         instance ToJSON name where \
           { toJSON = genericToJSON hasuraJSON } ;\
         instance FromJSON name where \
           { parseJSON = genericParseJSON hasuraJSON }
INSTANCE_CLUMP_3(Order)
INSTANCE_CLUMP_3(NullsOrder)
INSTANCE_CLUMP_3(FieldName)

instance ToJSON ScalarType where
  toJSON :: ScalarType -> Value
toJSON ScalarType
scalarType = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
DataLengthUnspecified ScalarType
scalarType

instance FromJSON ScalarType where
  parseJSON :: Value -> Parser ScalarType
parseJSON (String Text
s) = ScalarType -> Parser ScalarType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ScalarType
parseScalarType Text
s)
  parseJSON Value
_ = String -> Parser ScalarType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected a string"

instance HasCodec ColumnName where
  codec :: JSONCodec ColumnName
codec = (Text -> ColumnName)
-> (ColumnName -> Text)
-> Codec Value Text Text
-> JSONCodec ColumnName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> ColumnName
ColumnName ColumnName -> Text
columnNameText Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

deriving instance FromJSON ColumnName

deriving instance ToJSON ColumnName

deriving instance ToJSON ConstraintName

instance ToJSON FunctionName where
  toJSON :: FunctionName -> Value
toJSON = Options -> FunctionName -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance HasCodec FunctionName where
  codec :: JSONCodec FunctionName
codec = JSONCodec FunctionName
-> Codec Value Text FunctionName -> JSONCodec FunctionName
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative JSONCodec FunctionName
objCodec Codec Value Text FunctionName
strCodec
    where
      objCodec :: JSONCodec FunctionName
objCodec =
        Text
-> ObjectCodec FunctionName FunctionName -> JSONCodec FunctionName
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MSSQLFunctionName" (ObjectCodec FunctionName FunctionName -> JSONCodec FunctionName)
-> ObjectCodec FunctionName FunctionName -> JSONCodec FunctionName
forall a b. (a -> b) -> a -> b
$
          Text -> SchemaName -> FunctionName
FunctionName
            (Text -> SchemaName -> FunctionName)
-> Codec Object FunctionName Text
-> Codec Object FunctionName (SchemaName -> FunctionName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" ObjectCodec Text Text
-> (FunctionName -> Text) -> Codec Object FunctionName Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionName -> Text
functionName
            Codec Object FunctionName (SchemaName -> FunctionName)
-> Codec Object FunctionName SchemaName
-> ObjectCodec FunctionName FunctionName
forall a b.
Codec Object FunctionName (a -> b)
-> Codec Object FunctionName a -> Codec Object FunctionName b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> SchemaName -> ObjectCodec SchemaName SchemaName
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"schema" SchemaName
"dbo" ObjectCodec SchemaName SchemaName
-> (FunctionName -> SchemaName)
-> Codec Object FunctionName SchemaName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionName -> SchemaName
functionSchema
      strCodec :: Codec Value Text FunctionName
strCodec = (Text -> SchemaName -> FunctionName)
-> SchemaName -> Text -> FunctionName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> SchemaName -> FunctionName
FunctionName SchemaName
"dbo" (Text -> FunctionName)
-> Codec Value Text Text -> Codec Value Text FunctionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance FromJSON FunctionName where
  parseJSON :: Value -> Parser FunctionName
parseJSON v :: Value
v@(String Text
_) =
    Text -> SchemaName -> FunctionName
FunctionName (Text -> SchemaName -> FunctionName)
-> Parser Text -> Parser (SchemaName -> FunctionName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (SchemaName -> FunctionName)
-> Parser SchemaName -> Parser FunctionName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SchemaName -> Parser SchemaName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SchemaName
"dbo"
  parseJSON (Object Object
o) =
    Text -> SchemaName -> FunctionName
FunctionName
      (Text -> SchemaName -> FunctionName)
-> Parser Text -> Parser (SchemaName -> FunctionName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (SchemaName -> FunctionName)
-> Parser SchemaName -> Parser FunctionName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe SchemaName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema" Parser (Maybe SchemaName) -> SchemaName -> Parser SchemaName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SchemaName
"dbo"
  parseJSON Value
_ =
    String -> Parser FunctionName
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting a string/object for FunctionName"

instance ToJSONKey FunctionName where
  toJSONKey :: ToJSONKeyFunction FunctionName
toJSONKey = (FunctionName -> Text) -> ToJSONKeyFunction FunctionName
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((FunctionName -> Text) -> ToJSONKeyFunction FunctionName)
-> (FunctionName -> Text) -> ToJSONKeyFunction FunctionName
forall a b. (a -> b) -> a -> b
$ \(FunctionName Text
name (SchemaName Text
schema)) -> Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

instance HasCodec TableName where
  codec :: JSONCodec TableName
codec = JSONCodec TableName
-> Codec Value Text TableName -> JSONCodec TableName
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative JSONCodec TableName
objCodec Codec Value Text TableName
strCodec
    where
      objCodec :: JSONCodec TableName
objCodec =
        Text -> ObjectCodec TableName TableName -> JSONCodec TableName
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MSSQLTableName" (ObjectCodec TableName TableName -> JSONCodec TableName)
-> ObjectCodec TableName TableName -> JSONCodec TableName
forall a b. (a -> b) -> a -> b
$
          Text -> SchemaName -> TableName
TableName
            (Text -> SchemaName -> TableName)
-> Codec Object TableName Text
-> Codec Object TableName (SchemaName -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name" ObjectCodec Text Text
-> (TableName -> Text) -> Codec Object TableName Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableName -> Text
tableName
            Codec Object TableName (SchemaName -> TableName)
-> Codec Object TableName SchemaName
-> ObjectCodec TableName TableName
forall a b.
Codec Object TableName (a -> b)
-> Codec Object TableName a -> Codec Object TableName b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> SchemaName -> ObjectCodec SchemaName SchemaName
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"schema" SchemaName
"dbo" ObjectCodec SchemaName SchemaName
-> (TableName -> SchemaName) -> Codec Object TableName SchemaName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableName -> SchemaName
tableSchema
      strCodec :: Codec Value Text TableName
strCodec = (Text -> SchemaName -> TableName)
-> SchemaName -> Text -> TableName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> SchemaName -> TableName
TableName SchemaName
"dbo" (Text -> TableName)
-> Codec Value Text Text -> Codec Value Text TableName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance HasCodec SchemaName where
  codec :: JSONCodec SchemaName
codec = (Text -> SchemaName)
-> (SchemaName -> Text)
-> Codec Value Text Text
-> JSONCodec SchemaName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> SchemaName
SchemaName SchemaName -> Text
_unSchemaName Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance FromJSON TableName where
  parseJSON :: Value -> Parser TableName
parseJSON v :: Value
v@(String Text
_) =
    Text -> SchemaName -> TableName
TableName (Text -> SchemaName -> TableName)
-> Parser Text -> Parser (SchemaName -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (SchemaName -> TableName)
-> Parser SchemaName -> Parser TableName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SchemaName -> Parser SchemaName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SchemaName
"dbo"
  parseJSON (Object Object
o) =
    Text -> SchemaName -> TableName
TableName
      (Text -> SchemaName -> TableName)
-> Parser Text -> Parser (SchemaName -> TableName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (SchemaName -> TableName)
-> Parser SchemaName -> Parser TableName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe SchemaName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema" Parser (Maybe SchemaName) -> SchemaName -> Parser SchemaName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SchemaName
"dbo"
  parseJSON Value
_ =
    String -> Parser TableName
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting a string/object for TableName"

instance ToJSON TableName where
  toJSON :: TableName -> Value
toJSON = Options -> TableName -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance ToJSONKey TableName where
  toJSONKey :: ToJSONKeyFunction TableName
toJSONKey = (TableName -> Text) -> ToJSONKeyFunction TableName
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((TableName -> Text) -> ToJSONKeyFunction TableName)
-> (TableName -> Text) -> ToJSONKeyFunction TableName
forall a b. (a -> b) -> a -> b
$ \(TableName Text
name (SchemaName Text
schema)) -> Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

instance ToJSONKey ScalarType

-- NOTE!: an empty (default) instance declaration here caused a bug; instead
-- use standalone deriving via underlying Int instance
deriving newtype instance ToJSONKey ColumnName

deriving newtype instance FromJSONKey ColumnName

--------------------------------------------------------------------------------
-- Manual instances

deriving instance Generic (Countable n)

instance Hashable n => Hashable (Countable n)

deriving instance Eq n => Eq (Countable n)

deriving instance Show n => Show (Countable n)

deriving instance Data n => Data (Countable n)

instance NFData n => NFData (Countable n)

instance ToJSON n => ToJSON (Countable n)

instance FromJSON n => FromJSON (Countable n)

deriving instance Ord ColumnName

deriving instance Monoid Where

deriving instance Semigroup Where

instance Monoid Top where
  mempty :: Top
mempty = Top
NoTop

instance Semigroup Top where
  (<>) :: Top -> Top -> Top
  <> :: Top -> Top -> Top
(<>) Top
NoTop Top
x = Top
x
  (<>) Top
x Top
NoTop = Top
x
  (<>) (Top Int
x) (Top Int
y) = Int -> Top
Top (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y)

deriving instance Generic (BooleanOperators a)

deriving instance Functor BooleanOperators

deriving instance Foldable BooleanOperators

deriving instance Traversable BooleanOperators

deriving instance Show a => Show (BooleanOperators a)

deriving instance Eq a => Eq (BooleanOperators a)

instance NFData a => NFData (BooleanOperators a)

instance Hashable a => Hashable (BooleanOperators a)

instance ToJSON a => ToJSONKeyValue (BooleanOperators a) where
  toJSONKeyValue :: BooleanOperators a -> Pair
toJSONKeyValue = \case
    ASTContains a
a -> (Key
"_st_contains", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    ASTCrosses a
a -> (Key
"_st_crosses", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    ASTEquals a
a -> (Key
"_st_equals", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    ASTIntersects a
a -> (Key
"_st_intersects", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    ASTOverlaps a
a -> (Key
"_st_overlaps", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    ASTTouches a
a -> (Key
"_st_touches", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)
    ASTWithin a
a -> (Key
"_st_within", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a)

instance HasCodec ScalarType where
  codec :: JSONCodec ScalarType
codec = Text -> JSONCodec ScalarType -> JSONCodec ScalarType
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.named Text
"ScalarType" JSONCodec ScalarType
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON