module Hydra.Ext.Tinkerpop.Language where

import Hydra.All
import Hydra.Ext.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 m -> Language m
tinkerpopLanguage :: forall m. LanguageName -> Features -> ExtraFeatures m -> Language m
tinkerpopLanguage LanguageName
name Features
features ExtraFeatures m
extras = forall m. LanguageName -> LanguageConstraints m -> Language m
Language LanguageName
name forall a b. (a -> b) -> a -> b
$ LanguageConstraints {
    languageConstraintsEliminationVariants :: Set EliminationVariant
languageConstraintsEliminationVariants = forall a. Set a
S.empty,

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

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

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

    languageConstraintsIntegerTypes :: Set IntegerType
languageConstraintsIntegerTypes = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes [
      forall {a}. a -> Bool -> Maybe a
cond IntegerType
IntegerTypeInt32 (DataTypeFeatures -> Bool
dataTypeFeaturesSupportsIntegerValues DataTypeFeatures
vpFeatures),
      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 = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes [
      forall a. a -> Maybe a
Just TermVariant
TermVariantElement, -- Note: subject to the APG taxonomy
      forall {a}. a -> Bool -> Maybe a
cond TermVariant
TermVariantList Bool
supportsLists,
      forall {a}. a -> Bool -> Maybe a
cond TermVariant
TermVariantLiteral Bool
supportsLiterals,
      forall {a}. a -> Bool -> Maybe a
cond TermVariant
TermVariantMap Bool
supportsMaps,
      -- An optional value translates to an absent vertex property
      forall a. a -> Maybe a
Just TermVariant
TermVariantOptional],

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

    languageConstraintsTypes :: Type m -> Bool
languageConstraintsTypes = \Type m
typ -> case forall m. Type m -> Type m
stripType Type m
typ of
      TypeElement Type m
et -> Bool
True
      -- Only lists of literal values are supported, as nothing else is mentioned in Graph.Features
      TypeList Type m
t -> case forall m. Type m -> Type m
stripType Type m
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 m
_ -> Bool
False
      TypeLiteral LiteralType
_ -> Bool
True
      TypeMap (MapType Type m
kt Type m
_) -> forall m. ExtraFeatures m -> Type m -> Bool
extraFeaturesSupportsMapKey ExtraFeatures m
extras Type m
kt
      TypeNominal Name
_ -> Bool
True
      TypeOptional Type m
ot -> case forall m. Type m -> Type m
stripType Type m
ot of
        TypeElement Type m
_ -> Bool
True -- Note: subject to the APG taxonomy
        TypeLiteral LiteralType
_ -> Bool
True
        Type m
_ -> Bool
False
      Type m
_ -> Bool
True}

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

    vpFeatures :: DataTypeFeatures
vpFeatures = VertexPropertyFeatures -> DataTypeFeatures
vertexPropertyFeaturesDataTypeFeatures forall a b. (a -> b) -> a -> b
$ VertexFeatures -> VertexPropertyFeatures
vertexFeaturesProperties 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