module Hydra.Langs.Tinkerpop.Language where

import Hydra.Kernel
import Hydra.Langs.Tinkerpop.Features

import qualified Data.Set as S
import qualified Data.Maybe as Y


-- Populate language constraints based on TinkerPop Graph.Features.
-- Note: although Graph.Features is phrased such that it defaults to supporting features not explicitly mentioned,
--       for Hydra we cannot support a term or type pattern unless it is provably safe in the target environment.
--       Otherwise, generated expressions could cause failure during runtime operations.
-- Also note that extra features are required on top of Graph.Features, again for reasons of completeness.
tinkerpopLanguage :: LanguageName -> Features -> ExtraFeatures a -> Language
tinkerpopLanguage :: forall a. LanguageName -> Features -> ExtraFeatures a -> Language
tinkerpopLanguage LanguageName
name Features
features ExtraFeatures a
extras = LanguageName -> LanguageConstraints -> Language
Language LanguageName
name (LanguageConstraints -> Language)
-> LanguageConstraints -> Language
forall a b. (a -> b) -> a -> b
$ LanguageConstraints {
    languageConstraintsEliminationVariants :: Set EliminationVariant
languageConstraintsEliminationVariants = Set EliminationVariant
forall a. Set a
S.empty,

    languageConstraintsLiteralVariants :: Set LiteralVariant
languageConstraintsLiteralVariants = [LiteralVariant] -> Set LiteralVariant
forall a. Ord a => [a] -> Set a
S.fromList ([LiteralVariant] -> Set LiteralVariant)
-> [LiteralVariant] -> Set LiteralVariant
forall a b. (a -> b) -> a -> b
$ [Maybe LiteralVariant] -> [LiteralVariant]
forall a. [Maybe a] -> [a]
Y.catMaybes [
      -- Binary values map to byte arrays. Lists of uint8 also map to byte arrays.
      LiteralVariant -> Bool -> Maybe LiteralVariant
forall {a}. a -> Bool -> Maybe a
cond LiteralVariant
LiteralVariantBinary (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsByteArrayValues DataTypeFeatures
vpFeatures),
      LiteralVariant -> Bool -> Maybe LiteralVariant
forall {a}. a -> Bool -> Maybe a
cond LiteralVariant
LiteralVariantBoolean (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsBooleanValues DataTypeFeatures
vpFeatures),
      LiteralVariant -> Bool -> Maybe LiteralVariant
forall {a}. a -> Bool -> Maybe a
cond LiteralVariant
LiteralVariantFloat (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsFloatValues DataTypeFeatures
vpFeatures
        Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsDoubleValues DataTypeFeatures
vpFeatures),
      LiteralVariant -> Bool -> Maybe LiteralVariant
forall {a}. a -> Bool -> Maybe a
cond LiteralVariant
LiteralVariantInteger (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsIntegerValues DataTypeFeatures
vpFeatures
        Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsLongValues DataTypeFeatures
vpFeatures),
      LiteralVariant -> Bool -> Maybe LiteralVariant
forall {a}. a -> Bool -> Maybe a
cond LiteralVariant
LiteralVariantString (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsStringValues DataTypeFeatures
vpFeatures)],

    languageConstraintsFloatTypes :: Set FloatType
languageConstraintsFloatTypes = [FloatType] -> Set FloatType
forall a. Ord a => [a] -> Set a
S.fromList ([FloatType] -> Set FloatType) -> [FloatType] -> Set FloatType
forall a b. (a -> b) -> a -> b
$ [Maybe FloatType] -> [FloatType]
forall a. [Maybe a] -> [a]
Y.catMaybes [
      FloatType -> Bool -> Maybe FloatType
forall {a}. a -> Bool -> Maybe a
cond FloatType
FloatTypeFloat32 (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsFloatValues DataTypeFeatures
vpFeatures),
      FloatType -> Bool -> Maybe FloatType
forall {a}. a -> Bool -> Maybe a
cond FloatType
FloatTypeFloat64 (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsDoubleValues DataTypeFeatures
vpFeatures)],

    languageConstraintsFunctionVariants :: Set FunctionVariant
languageConstraintsFunctionVariants = Set FunctionVariant
forall a. Set a
S.empty,

    languageConstraintsIntegerTypes :: Set IntegerType
languageConstraintsIntegerTypes = [IntegerType] -> Set IntegerType
forall a. Ord a => [a] -> Set a
S.fromList ([IntegerType] -> Set IntegerType)
-> [IntegerType] -> Set IntegerType
forall a b. (a -> b) -> a -> b
$ [Maybe IntegerType] -> [IntegerType]
forall a. [Maybe a] -> [a]
Y.catMaybes [
      IntegerType -> Bool -> Maybe IntegerType
forall {a}. a -> Bool -> Maybe a
cond IntegerType
IntegerTypeInt32 (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsIntegerValues DataTypeFeatures
vpFeatures),
      IntegerType -> Bool -> Maybe IntegerType
forall {a}. a -> Bool -> Maybe a
cond IntegerType
IntegerTypeInt64 (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsLongValues DataTypeFeatures
vpFeatures)],

    -- Only lists and literal values may be explicitly supported via Graph.Features.
    languageConstraintsTermVariants :: Set TermVariant
languageConstraintsTermVariants = [TermVariant] -> Set TermVariant
forall a. Ord a => [a] -> Set a
S.fromList ([TermVariant] -> Set TermVariant)
-> [TermVariant] -> Set TermVariant
forall a b. (a -> b) -> a -> b
$ [Maybe TermVariant] -> [TermVariant]
forall a. [Maybe a] -> [a]
Y.catMaybes [
      TermVariant -> Bool -> Maybe TermVariant
forall {a}. a -> Bool -> Maybe a
cond TermVariant
TermVariantList Bool
supportsLists,
      TermVariant -> Bool -> Maybe TermVariant
forall {a}. a -> Bool -> Maybe a
cond TermVariant
TermVariantLiteral Bool
supportsLiterals,
      TermVariant -> Bool -> Maybe TermVariant
forall {a}. a -> Bool -> Maybe a
cond TermVariant
TermVariantMap Bool
supportsMaps,
      -- An optional value translates to an absent vertex property
      TermVariant -> Maybe TermVariant
forall a. a -> Maybe a
Just TermVariant
TermVariantOptional],

    languageConstraintsTypeVariants :: Set TypeVariant
languageConstraintsTypeVariants = [TypeVariant] -> Set TypeVariant
forall a. Ord a => [a] -> Set a
S.fromList ([TypeVariant] -> Set TypeVariant)
-> [TypeVariant] -> Set TypeVariant
forall a b. (a -> b) -> a -> b
$ [Maybe TypeVariant] -> [TypeVariant]
forall a. [Maybe a] -> [a]
Y.catMaybes [
      TypeVariant -> Bool -> Maybe TypeVariant
forall {a}. a -> Bool -> Maybe a
cond TypeVariant
TypeVariantList Bool
supportsLists,
      TypeVariant -> Bool -> Maybe TypeVariant
forall {a}. a -> Bool -> Maybe a
cond TypeVariant
TypeVariantLiteral Bool
supportsLiterals,
      TypeVariant -> Bool -> Maybe TypeVariant
forall {a}. a -> Bool -> Maybe a
cond TypeVariant
TypeVariantMap Bool
supportsMaps,
      TypeVariant -> Maybe TypeVariant
forall a. a -> Maybe a
Just TypeVariant
TypeVariantOptional,
      TypeVariant -> Maybe TypeVariant
forall a. a -> Maybe a
Just TypeVariant
TypeVariantWrap],

    languageConstraintsTypes :: Type -> Bool
languageConstraintsTypes = \Type
typ -> case Type -> Type
stripType Type
typ of
      -- Only lists of literal values are supported, as nothing else is mentioned in Graph.Features
      TypeList Type
t -> case Type -> Type
stripType Type
t of
        TypeLiteral LiteralType
lt -> case LiteralType
lt of
          LiteralType
LiteralTypeBoolean -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsBooleanArrayValues DataTypeFeatures
vpFeatures
          LiteralTypeFloat FloatType
ft -> case FloatType
ft of
            FloatType
FloatTypeFloat64 -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsDoubleArrayValues DataTypeFeatures
vpFeatures
            FloatType
FloatTypeFloat32 -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsFloatArrayValues DataTypeFeatures
vpFeatures
            FloatType
_ -> Bool
False
          LiteralTypeInteger IntegerType
it -> case IntegerType
it of
             IntegerType
IntegerTypeUint8 -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsByteArrayValues DataTypeFeatures
vpFeatures
             IntegerType
IntegerTypeInt32 -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsIntegerArrayValues DataTypeFeatures
vpFeatures
             IntegerType
IntegerTypeInt64 -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsLongArrayValues DataTypeFeatures
vpFeatures
             IntegerType
_ -> Bool
False
          LiteralType
LiteralTypeString -> DataTypeFeatures -> Bool
dataTypeFeaturesSupportsStringArrayValues DataTypeFeatures
vpFeatures
          LiteralType
_ -> Bool
False
        Type
_ -> Bool
False
      TypeLiteral LiteralType
_ -> Bool
True
      TypeMap (MapType Type
kt Type
_) -> ExtraFeatures a -> Type -> Bool
forall a. ExtraFeatures a -> Type -> Bool
extraFeaturesSupportsMapKey ExtraFeatures a
extras Type
kt
      TypeWrap WrappedType
_ -> Bool
True
      TypeOptional Type
ot -> case Type -> Type
stripType Type
ot of
        TypeLiteral LiteralType
_ -> Bool
True
        Type
_ -> Bool
False
      Type
_ -> Bool
True}

  where
    cond :: a -> Bool -> Maybe a
cond a
v Bool
b = if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just a
v else Maybe a
forall a. Maybe a
Nothing

    vpFeatures :: DataTypeFeatures
vpFeatures = VertexPropertyFeatures -> DataTypeFeatures
vertexPropertyFeaturesDataTypeFeatures (VertexPropertyFeatures -> DataTypeFeatures)
-> VertexPropertyFeatures -> DataTypeFeatures
forall a b. (a -> b) -> a -> b
$ VertexFeatures -> VertexPropertyFeatures
vertexFeaturesProperties (VertexFeatures -> VertexPropertyFeatures)
-> VertexFeatures -> VertexPropertyFeatures
forall a b. (a -> b) -> a -> b
$ Features -> VertexFeatures
featuresVertex Features
features

    supportsLists :: Bool
supportsLists = DataTypeFeatures -> Bool
dataTypeFeaturesSupportsBooleanArrayValues DataTypeFeatures
vpFeatures
      Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsByteArrayValues DataTypeFeatures
vpFeatures
      Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsDoubleArrayValues DataTypeFeatures
vpFeatures
      Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsFloatArrayValues DataTypeFeatures
vpFeatures
      Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsIntegerArrayValues DataTypeFeatures
vpFeatures
      Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsLongArrayValues DataTypeFeatures
vpFeatures
      Bool -> Bool -> Bool
|| DataTypeFeatures -> Bool
dataTypeFeaturesSupportsStringArrayValues DataTypeFeatures
vpFeatures

      -- Support for at least one of the Graph.Features literal types is assumed.
    supportsLiterals :: Bool
supportsLiterals = Bool
True

    -- Note: additional constraints are required, beyond Graph.Features, if maps are supported
    supportsMaps :: Bool
supportsMaps = DataTypeFeatures -> Bool
dataTypeFeaturesSupportsMapValues DataTypeFeatures
vpFeatures