diff --git a/hydra.cabal b/hydra.cabal --- a/hydra.cabal +++ b/hydra.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra -version: 0.5.1 +version: 0.8.0 synopsis: Type-aware transformations for data and programs description: Hydra is a domain-specific language for data models and data transformations. It is based on a typed lambda calculus, and transforms data and schemas between languages in a way which maintains type conformance. Hydra will even transform functional programs between selected languages, including much of its own source code. category: Data @@ -52,6 +52,8 @@ Hydra.Dsl.Lib.Sets Hydra.Dsl.Lib.Strings Hydra.Dsl.Literals + Hydra.Dsl.LiteralTypes + Hydra.Dsl.Mantle Hydra.Dsl.Module Hydra.Dsl.PhantomLiterals Hydra.Dsl.Prims @@ -59,51 +61,55 @@ Hydra.Dsl.Terms Hydra.Dsl.Tests Hydra.Dsl.Types + Hydra.Ext.Avro.Coder + Hydra.Ext.Avro.Language + Hydra.Ext.Avro.SchemaJson + Hydra.Ext.Graphql.Coder + Hydra.Ext.Graphql.Language + Hydra.Ext.Graphql.Serde + Hydra.Ext.Haskell.Coder + Hydra.Ext.Haskell.Language + Hydra.Ext.Haskell.Operators + Hydra.Ext.Haskell.Serde + Hydra.Ext.Haskell.Settings + Hydra.Ext.Haskell.Utils + Hydra.Ext.Java.Coder + Hydra.Ext.Java.Names + Hydra.Ext.Java.Serde + Hydra.Ext.Java.Settings + Hydra.Ext.Java.Utils + Hydra.Ext.Json.Coder + Hydra.Ext.Json.Eliminate + Hydra.Ext.Json.Language + Hydra.Ext.Json.Serde + Hydra.Ext.Pegasus.Coder + Hydra.Ext.Pegasus.Language + Hydra.Ext.Pegasus.Serde + Hydra.Ext.Pg.Coder + Hydra.Ext.Pg.TermsToElements + Hydra.Ext.Protobuf.Coder + Hydra.Ext.Protobuf.Serde + Hydra.Ext.Rdf.Serde + Hydra.Ext.Rdf.Utils + Hydra.Ext.Scala.Coder + Hydra.Ext.Scala.Language + Hydra.Ext.Scala.Prepare + Hydra.Ext.Scala.Serde + Hydra.Ext.Scala.Utils + Hydra.Ext.Shacl.Coder + Hydra.Ext.Shacl.Language + Hydra.Ext.Yaml.Coder + Hydra.Ext.Yaml.Language + Hydra.Ext.Yaml.Modules + Hydra.Ext.Yaml.Serde Hydra.Flows - Hydra.Inference + Hydra.Inference.AlgorithmW + Hydra.Inference.AlgorithmWBridge + Hydra.Inference.AltInference + Hydra.Inference.Inference + Hydra.Inference.Rules + Hydra.Inference.Substitution Hydra.Kernel - Hydra.Langs.Avro.Coder - Hydra.Langs.Avro.Language - Hydra.Langs.Avro.SchemaJson - Hydra.Langs.Graphql.Coder - Hydra.Langs.Graphql.Language - Hydra.Langs.Graphql.Serde - Hydra.Langs.Haskell.Coder - Hydra.Langs.Haskell.Language - Hydra.Langs.Haskell.Operators - Hydra.Langs.Haskell.Serde - Hydra.Langs.Haskell.Settings - Hydra.Langs.Haskell.Utils - Hydra.Langs.Java.Coder - Hydra.Langs.Java.Names - Hydra.Langs.Java.Serde - Hydra.Langs.Java.Settings - Hydra.Langs.Java.Utils - Hydra.Langs.Json.Coder - Hydra.Langs.Json.Eliminate - Hydra.Langs.Json.Language - Hydra.Langs.Json.Serde - Hydra.Langs.Pegasus.Coder - Hydra.Langs.Pegasus.Language - Hydra.Langs.Pegasus.Serde - Hydra.Langs.Protobuf.Coder - Hydra.Langs.Protobuf.Serde - Hydra.Langs.Rdf.Serde - Hydra.Langs.Rdf.Utils - Hydra.Langs.Scala.Coder - Hydra.Langs.Scala.Language - Hydra.Langs.Scala.Prepare - Hydra.Langs.Scala.Serde - Hydra.Langs.Scala.Utils - Hydra.Langs.Shacl.Coder - Hydra.Langs.Shacl.Language - Hydra.Langs.Tinkerpop.Coder - Hydra.Langs.Tinkerpop.Language - Hydra.Langs.Tinkerpop.TermsToElements - Hydra.Langs.Yaml.Coder - Hydra.Langs.Yaml.Language - Hydra.Langs.Yaml.Modules - Hydra.Langs.Yaml.Serde Hydra.Lexical Hydra.Lib.Equality Hydra.Lib.Flows @@ -117,10 +123,10 @@ Hydra.Lib.Sets Hydra.Lib.Strings Hydra.LiteralAdapters + Hydra.Minimal Hydra.Reduction Hydra.Rewriting - Hydra.Rules - Hydra.Scratchpad + Hydra.Schemas Hydra.Sources.Core Hydra.Sources.Libraries Hydra.Sources.Tier0.All @@ -140,6 +146,7 @@ Hydra.Sources.Tier1.All Hydra.Sources.Tier1.Constants Hydra.Sources.Tier1.CoreEncoding + Hydra.Sources.Tier1.Decode Hydra.Sources.Tier1.Messages Hydra.Sources.Tier1.Strip Hydra.Sources.Tier1.Tier1 @@ -152,44 +159,36 @@ Hydra.Sources.Tier3.All Hydra.Sources.Tier3.Tier3 Hydra.Sources.Tier4.All - Hydra.Sources.Tier4.Langs.Avro.Schema - Hydra.Sources.Tier4.Langs.Cypher.Features - Hydra.Sources.Tier4.Langs.Cypher.OpenCypher - Hydra.Sources.Tier4.Langs.Graphql.Syntax - Hydra.Sources.Tier4.Langs.Haskell.Ast - Hydra.Sources.Tier4.Langs.Java.Language - Hydra.Sources.Tier4.Langs.Java.Syntax - Hydra.Sources.Tier4.Langs.Json.Decoding - Hydra.Sources.Tier4.Langs.Kusto.Kql - Hydra.Sources.Tier4.Langs.Owl.Syntax - Hydra.Sources.Tier4.Langs.Parquet.Delta - Hydra.Sources.Tier4.Langs.Parquet.Format - Hydra.Sources.Tier4.Langs.Pegasus.Pdl - Hydra.Sources.Tier4.Langs.Protobuf.Any - Hydra.Sources.Tier4.Langs.Protobuf.Language - Hydra.Sources.Tier4.Langs.Protobuf.Proto3 - Hydra.Sources.Tier4.Langs.Protobuf.SourceContext - Hydra.Sources.Tier4.Langs.Python.Python3 - Hydra.Sources.Tier4.Langs.Rdf.Syntax - Hydra.Sources.Tier4.Langs.RelationalModel - Hydra.Sources.Tier4.Langs.Scala.Meta - Hydra.Sources.Tier4.Langs.Shacl.Model - Hydra.Sources.Tier4.Langs.Shex.Syntax - Hydra.Sources.Tier4.Langs.Sql.Ansi - Hydra.Sources.Tier4.Langs.Tabular - Hydra.Sources.Tier4.Langs.Tinkerpop.Features - Hydra.Sources.Tier4.Langs.Tinkerpop.Gremlin - Hydra.Sources.Tier4.Langs.Tinkerpop.Mappings - Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph - Hydra.Sources.Tier4.Langs.Tinkerpop.Queries - Hydra.Sources.Tier4.Langs.Tinkerpop.Validate - Hydra.Sources.Tier4.Langs.Xml.Schema - Hydra.Sources.Tier4.Langs.Yaml.Model + Hydra.Sources.Tier4.Ext.Avro.Schema + Hydra.Sources.Tier4.Ext.Csharp.Syntax + Hydra.Sources.Tier4.Ext.Cypher.Features + Hydra.Sources.Tier4.Ext.Cypher.Functions + Hydra.Sources.Tier4.Ext.Cypher.OpenCypher + Hydra.Sources.Tier4.Ext.Graphql.Syntax + Hydra.Sources.Tier4.Ext.Haskell.Ast + Hydra.Sources.Tier4.Ext.Java.Language + Hydra.Sources.Tier4.Ext.Java.Syntax + Hydra.Sources.Tier4.Ext.Json.Decoding + Hydra.Sources.Tier4.Ext.Pegasus.Pdl + Hydra.Sources.Tier4.Ext.Pg.Mapping + Hydra.Sources.Tier4.Ext.Pg.Model + Hydra.Sources.Tier4.Ext.Pg.Query + Hydra.Sources.Tier4.Ext.Pg.Validation + Hydra.Sources.Tier4.Ext.Protobuf.Any + Hydra.Sources.Tier4.Ext.Protobuf.Language + Hydra.Sources.Tier4.Ext.Protobuf.Proto3 + Hydra.Sources.Tier4.Ext.Protobuf.SourceContext + Hydra.Sources.Tier4.Ext.Rdf.Syntax + Hydra.Sources.Tier4.Ext.RelationalModel + Hydra.Sources.Tier4.Ext.Scala.Meta + Hydra.Sources.Tier4.Ext.Shacl.Model + Hydra.Sources.Tier4.Ext.Tabular + Hydra.Sources.Tier4.Ext.Yaml.Model Hydra.Sources.Tier4.Test.Lib.Lists Hydra.Sources.Tier4.Test.Lib.Strings Hydra.Sources.Tier4.Test.TestSuite - Hydra.Substitution Hydra.TermAdapters + Hydra.Tools.Accessors Hydra.Tools.Bytestrings Hydra.Tools.Debug Hydra.Tools.Formatting @@ -207,45 +206,38 @@ Hydra.Core Hydra.CoreEncoding Hydra.CoreLanguage + Hydra.Decode + Hydra.Ext.Csharp.Syntax + Hydra.Ext.Cypher.Features + Hydra.Ext.Cypher.OpenCypher + Hydra.Ext.Haskell.Ast + Hydra.Ext.Java.Language + Hydra.Ext.Java.Syntax + Hydra.Ext.Org.Apache.Avro.Schema + Hydra.Ext.Org.Graphql.Syntax + Hydra.Ext.Org.Json.Decoding + Hydra.Ext.Org.W3.Rdf.Syntax + Hydra.Ext.Org.W3.Shacl.Model + Hydra.Ext.Org.Yaml.Model + Hydra.Ext.Pegasus.Pdl + Hydra.Ext.Protobuf.Any + Hydra.Ext.Protobuf.Language + Hydra.Ext.Protobuf.Proto3 + Hydra.Ext.Protobuf.SourceContext + Hydra.Ext.RelationalModel + Hydra.Ext.Scala.Meta + Hydra.Ext.Tabular Hydra.Extras Hydra.Grammar Hydra.Graph Hydra.Json - Hydra.Langs.Avro.Schema - Hydra.Langs.Cypher.Features - Hydra.Langs.Cypher.OpenCypher - Hydra.Langs.Graphql.Syntax - Hydra.Langs.Haskell.Ast - Hydra.Langs.Java.Language - Hydra.Langs.Java.Syntax - Hydra.Langs.Json.Decoding - Hydra.Langs.Kusto.Kql - Hydra.Langs.Owl.Syntax - Hydra.Langs.Parquet.Delta - Hydra.Langs.Parquet.Format - Hydra.Langs.Pegasus.Pdl - Hydra.Langs.Protobuf.Any - Hydra.Langs.Protobuf.Language - Hydra.Langs.Protobuf.Proto3 - Hydra.Langs.Protobuf.SourceContext - Hydra.Langs.Rdf.Syntax - Hydra.Langs.RelationalModel - Hydra.Langs.Scala.Meta - Hydra.Langs.Shacl.Model - Hydra.Langs.Shex.Syntax - Hydra.Langs.Sql.Ansi - Hydra.Langs.Tabular - Hydra.Langs.Tinkerpop.Features - Hydra.Langs.Tinkerpop.Gremlin - Hydra.Langs.Tinkerpop.Mappings - Hydra.Langs.Tinkerpop.PropertyGraph - Hydra.Langs.Tinkerpop.Queries - Hydra.Langs.Tinkerpop.Validate - Hydra.Langs.Xml.Schema - Hydra.Langs.Yaml.Model Hydra.Mantle Hydra.Messages Hydra.Module + Hydra.Pg.Mapping + Hydra.Pg.Model + Hydra.Pg.Query + Hydra.Pg.Validation Hydra.Phantoms Hydra.Printing Hydra.Query @@ -269,6 +261,7 @@ , containers >=0.6.5 && <0.7 , directory >=1.3.6 && <1.4 , filepath >=1.4.2 && <1.5 + , mtl , scientific >=0.3.7 && <0.4 , split >=0.2.3 && <0.3 , text >=2.0.2 && <2.1 @@ -283,12 +276,20 @@ Hydra.ArbitraryCore Hydra.CoreCodersSpec Hydra.Dsl.TypesSpec + Hydra.Ext.Json.CoderSpec + Hydra.Ext.Json.SerdeSpec + Hydra.Ext.Yaml.CoderSpec + Hydra.Ext.Yaml.SerdeSpec Hydra.FlowsSpec - Hydra.InferenceSpec - Hydra.Langs.Json.CoderSpec - Hydra.Langs.Json.SerdeSpec - Hydra.Langs.Yaml.CoderSpec - Hydra.Langs.Yaml.SerdeSpec + Hydra.Inference.AlgebraicTypesSpec + Hydra.Inference.AlgorithmWSpec + Hydra.Inference.AltInferenceSpec + Hydra.Inference.FundamentalsSpec + Hydra.Inference.InferenceSpec + Hydra.Inference.InferenceTestUtils + Hydra.Inference.NominalTypesSpec + Hydra.Inference.SubstitutionSpec + Hydra.Inference.TypeAnnotationsSpec Hydra.LiteralAdaptersSpec Hydra.ReductionSpec Hydra.RewritingSpec @@ -298,6 +299,7 @@ Hydra.TestGraph Hydra.TestSuiteSpec Hydra.TestUtils + Hydra.Tier1Spec Hydra.Tools.SerializationSpec Hydra.Tools.SortingSpec Hydra.UnificationSpec @@ -320,6 +322,7 @@ , hspec , hspec-discover , hydra + , mtl , scientific >=0.3.7 && <0.4 , split >=0.2.3 && <0.3 , text >=2.0.2 && <2.1 diff --git a/src/gen-main/haskell/Hydra/Basics.hs b/src/gen-main/haskell/Hydra/Basics.hs --- a/src/gen-main/haskell/Hydra/Basics.hs +++ b/src/gen-main/haskell/Hydra/Basics.hs @@ -133,8 +133,8 @@ literalType x = case x of Core.LiteralBinary _ -> Core.LiteralTypeBinary Core.LiteralBoolean _ -> Core.LiteralTypeBoolean - Core.LiteralFloat v187 -> ((\x2 -> Core.LiteralTypeFloat x2) (floatValueType v187)) - Core.LiteralInteger v188 -> ((\x2 -> Core.LiteralTypeInteger x2) (integerValueType v188)) + Core.LiteralFloat v228 -> ((\x2 -> Core.LiteralTypeFloat x2) (floatValueType v228)) + Core.LiteralInteger v229 -> ((\x2 -> Core.LiteralTypeInteger x2) (integerValueType v229)) Core.LiteralString _ -> Core.LiteralTypeString -- | Find the literal type variant (constructor) for a given literal value @@ -174,6 +174,8 @@ Core.TermRecord _ -> Mantle.TermVariantRecord Core.TermSet _ -> Mantle.TermVariantSet Core.TermSum _ -> Mantle.TermVariantSum + Core.TermTypeAbstraction _ -> Mantle.TermVariantTypeAbstraction + Core.TermTypeApplication _ -> Mantle.TermVariantTypeApplication Core.TermTyped _ -> Mantle.TermVariantTyped Core.TermUnion _ -> Mantle.TermVariantUnion Core.TermVariable _ -> Mantle.TermVariantVariable @@ -193,6 +195,8 @@ Mantle.TermVariantRecord, Mantle.TermVariantSet, Mantle.TermVariantSum, + Mantle.TermVariantTypeAbstraction, + Mantle.TermVariantTypeApplication, Mantle.TermVariantTyped, Mantle.TermVariantUnion, Mantle.TermVariantVariable, @@ -263,15 +267,15 @@ isEncodedType :: (Core.Term -> Bool) isEncodedType t = ((\x -> case x of - Core.TermApplication v226 -> (isEncodedType (Core.applicationFunction v226)) - Core.TermUnion v227 -> (Equality.equalString "hydra/core.Type" (Core.unName (Core.injectionTypeName v227))) + Core.TermApplication v269 -> (isEncodedType (Core.applicationFunction v269)) + Core.TermUnion v270 -> (Equality.equalString "hydra/core.Type" (Core.unName (Core.injectionTypeName v270))) _ -> False) (Strip.stripTerm t)) isType :: (Core.Type -> Bool) isType t = ((\x -> case x of - Core.TypeApplication v228 -> (isType (Core.applicationTypeFunction v228)) - Core.TypeLambda v229 -> (isType (Core.lambdaTypeBody v229)) - Core.TypeUnion v230 -> (Equality.equalString "hydra/core.Type" (Core.unName (Core.rowTypeTypeName v230))) + Core.TypeApplication v271 -> (isType (Core.applicationTypeFunction v271)) + Core.TypeLambda v272 -> (isType (Core.lambdaTypeBody v272)) + Core.TypeUnion v273 -> (Equality.equalString "hydra/core.Type" (Core.unName (Core.rowTypeTypeName v273))) _ -> False) (Strip.stripType t)) isUnitTerm :: (Core.Term -> Bool) @@ -282,7 +286,6 @@ isUnitType :: (Core.Type -> Bool) isUnitType t = (Equality.equalType (Strip.stripType t) (Core.TypeRecord (Core.RowType { Core.rowTypeTypeName = (Core.Name "hydra/core.Unit"), - Core.rowTypeExtends = Nothing, Core.rowTypeFields = []}))) elementsToGraph :: (Graph.Graph -> Maybe Graph.Graph -> [Graph.Element] -> Graph.Graph) diff --git a/src/gen-main/haskell/Hydra/Compute.hs b/src/gen-main/haskell/Hydra/Compute.hs --- a/src/gen-main/haskell/Hydra/Compute.hs +++ b/src/gen-main/haskell/Hydra/Compute.hs @@ -79,7 +79,7 @@ traceStack :: [String], traceMessages :: [String], -- | A map of string keys to arbitrary terms as values, for application-specific use - traceOther :: (Map String Core.Term)} + traceOther :: (Map Core.Name Core.Term)} deriving (Eq, Ord, Read, Show) _Trace = (Core.Name "hydra/compute.Trace") diff --git a/src/gen-main/haskell/Hydra/Core.hs b/src/gen-main/haskell/Hydra/Core.hs --- a/src/gen-main/haskell/Hydra/Core.hs +++ b/src/gen-main/haskell/Hydra/Core.hs @@ -11,7 +11,7 @@ data AnnotatedTerm = AnnotatedTerm { annotatedTermSubject :: Term, - annotatedTermAnnotation :: (Map String Term)} + annotatedTermAnnotation :: (Map Name Term)} deriving (Eq, Ord, Read, Show) _AnnotatedTerm = (Name "hydra/core.AnnotatedTerm") @@ -24,7 +24,7 @@ data AnnotatedType = AnnotatedType { annotatedTypeSubject :: Type, - annotatedTypeAnnotation :: (Map String Term)} + annotatedTypeAnnotation :: (Map Name Term)} deriving (Eq, Ord, Read, Show) _AnnotatedType = (Name "hydra/core.AnnotatedType") @@ -292,6 +292,8 @@ Lambda { -- | The parameter of the lambda lambdaParameter :: Name, + -- | An optional domain type for the lambda + lambdaDomain :: (Maybe Type), -- | The body of the lambda lambdaBody :: Term} deriving (Eq, Ord, Read, Show) @@ -300,6 +302,8 @@ _Lambda_parameter = (Name "parameter") +_Lambda_domain = (Name "domain") + _Lambda_body = (Name "body") -- | A type abstraction; the type-level analog of a lambda term @@ -406,7 +410,7 @@ _MapType_values = (Name "values") --- | A symbol which stands for a term, type, or element +-- | A unique identifier in some context; a string-valued key newtype Name = Name { unName :: String} @@ -488,8 +492,6 @@ RowType { -- | The name of the row type, which must correspond to the name of a Type element rowTypeTypeName :: Name, - -- | Optionally, the name of another row type which this one extends. If/when field order is preserved, the inherited fields of the extended type precede those of the extension. - rowTypeExtends :: (Maybe Name), -- | The fields of this row type, excluding any inherited fields rowTypeFields :: [FieldType]} deriving (Eq, Ord, Read, Show) @@ -498,8 +500,6 @@ _RowType_typeName = (Name "typeName") -_RowType_extends = (Name "extends") - _RowType_fields = (Name "fields") -- | The unlabeled equivalent of an Injection term @@ -543,6 +543,10 @@ TermSet (Set Term) | -- | A variant tuple TermSum Sum | + -- | A System F type abstraction term + TermTypeAbstraction TypeAbstraction | + -- | A System F type application term + TermTypeApplication TypedTerm | -- | A term annotated with its type TermTyped TypedTerm | -- | An injection; an instance of a union type @@ -578,6 +582,10 @@ _Term_sum = (Name "sum") +_Term_typeAbstraction = (Name "typeAbstraction") + +_Term_typeApplication = (Name "typeApplication") + _Term_typed = (Name "typed") _Term_union = (Name "union") @@ -651,6 +659,21 @@ _Type_variable = (Name "variable") _Type_wrap = (Name "wrap") + +-- | A System F type abstraction term +data TypeAbstraction = + TypeAbstraction { + -- | The type variable introduced by the abstraction + typeAbstractionParameter :: Name, + -- | The body of the abstraction + typeAbstractionBody :: Term} + deriving (Eq, Ord, Read, Show) + +_TypeAbstraction = (Name "hydra/core.TypeAbstraction") + +_TypeAbstraction_parameter = (Name "parameter") + +_TypeAbstraction_body = (Name "body") -- | A type expression together with free type variables occurring in the expression data TypeScheme = diff --git a/src/gen-main/haskell/Hydra/CoreEncoding.hs b/src/gen-main/haskell/Hydra/CoreEncoding.hs --- a/src/gen-main/haskell/Hydra/CoreEncoding.hs +++ b/src/gen-main/haskell/Hydra/CoreEncoding.hs @@ -318,6 +318,9 @@ Core.fieldName = (Core.Name "parameter"), Core.fieldTerm = (coreEncodeName (Core.lambdaParameter l))}, Core.Field { + Core.fieldName = (Core.Name "domain"), + Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeType (Core.lambdaDomain l)))}, + Core.Field { Core.fieldName = (Core.Name "body"), Core.fieldTerm = (coreEncodeTerm (Core.lambdaBody l))}]})) @@ -476,9 +479,6 @@ Core.fieldName = (Core.Name "typeName"), Core.fieldTerm = (coreEncodeName (Core.rowTypeTypeName rt))}, Core.Field { - Core.fieldName = (Core.Name "extends"), - Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeName (Core.rowTypeExtends rt)))}, - Core.Field { Core.fieldName = (Core.Name "fields"), Core.fieldTerm = (Core.TermList (Lists.map coreEncodeFieldType (Core.rowTypeFields rt)))}]})) @@ -553,21 +553,36 @@ Core.injectionField = Core.Field { Core.fieldName = (Core.Name "sum"), Core.fieldTerm = (coreEncodeSum v53)}})) - Core.TermUnion v54 -> (Core.TermUnion (Core.Injection { + Core.TermTypeAbstraction v54 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Term"), Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "typeAbstraction"), + Core.fieldTerm = (coreEncodeTypeAbstraction v54)}})) + Core.TermTypeApplication v55 -> (Core.TermUnion (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra/core.Term"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "typeApplication"), + Core.fieldTerm = (coreEncodeTypedTerm v55)}})) + Core.TermTyped v56 -> (Core.TermUnion (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra/core.Term"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "typed"), + Core.fieldTerm = (coreEncodeTypedTerm v56)}})) + Core.TermUnion v57 -> (Core.TermUnion (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra/core.Term"), + Core.injectionField = Core.Field { Core.fieldName = (Core.Name "union"), - Core.fieldTerm = (coreEncodeInjection v54)}})) - Core.TermVariable v55 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeInjection v57)}})) + Core.TermVariable v58 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Term"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), - Core.fieldTerm = (coreEncodeName v55)}})) - Core.TermWrap v56 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeName v58)}})) + Core.TermWrap v59 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Term"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), - Core.fieldTerm = (coreEncodeWrappedTerm v56)}})) + Core.fieldTerm = (coreEncodeWrappedTerm v59)}})) _ -> (Core.TermLiteral (Core.LiteralString "not implemented")) coreEncodeTupleProjection :: (Core.TupleProjection -> Core.Term) @@ -583,80 +598,91 @@ coreEncodeType :: (Core.Type -> Core.Term) coreEncodeType x = case x of - Core.TypeAnnotated v57 -> (Core.TermAnnotated (Core.AnnotatedTerm { - Core.annotatedTermSubject = (coreEncodeType (Core.annotatedTypeSubject v57)), - Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation v57)})) - Core.TypeApplication v58 -> (Core.TermUnion (Core.Injection { + Core.TypeAnnotated v60 -> (Core.TermAnnotated (Core.AnnotatedTerm { + Core.annotatedTermSubject = (coreEncodeType (Core.annotatedTypeSubject v60)), + Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation v60)})) + Core.TypeApplication v61 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "application"), - Core.fieldTerm = (coreEncodeApplicationType v58)}})) - Core.TypeFunction v59 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeApplicationType v61)}})) + Core.TypeFunction v62 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "function"), - Core.fieldTerm = (coreEncodeFunctionType v59)}})) - Core.TypeLambda v60 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeFunctionType v62)}})) + Core.TypeLambda v63 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "lambda"), - Core.fieldTerm = (coreEncodeLambdaType v60)}})) - Core.TypeList v61 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeLambdaType v63)}})) + Core.TypeList v64 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "list"), - Core.fieldTerm = (coreEncodeType v61)}})) - Core.TypeLiteral v62 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeType v64)}})) + Core.TypeLiteral v65 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "literal"), - Core.fieldTerm = (coreEncodeLiteralType v62)}})) - Core.TypeMap v63 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeLiteralType v65)}})) + Core.TypeMap v66 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "map"), - Core.fieldTerm = (coreEncodeMapType v63)}})) - Core.TypeOptional v64 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeMapType v66)}})) + Core.TypeOptional v67 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "optional"), - Core.fieldTerm = (coreEncodeType v64)}})) - Core.TypeProduct v65 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeType v67)}})) + Core.TypeProduct v68 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "product"), - Core.fieldTerm = (Core.TermList (Lists.map coreEncodeType v65))}})) - Core.TypeRecord v66 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (Core.TermList (Lists.map coreEncodeType v68))}})) + Core.TypeRecord v69 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "record"), - Core.fieldTerm = (coreEncodeRowType v66)}})) - Core.TypeSet v67 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeRowType v69)}})) + Core.TypeSet v70 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "set"), - Core.fieldTerm = (coreEncodeType v67)}})) - Core.TypeSum v68 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeType v70)}})) + Core.TypeSum v71 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "sum"), - Core.fieldTerm = (Core.TermList (Lists.map coreEncodeType v68))}})) - Core.TypeUnion v69 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (Core.TermList (Lists.map coreEncodeType v71))}})) + Core.TypeUnion v72 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "union"), - Core.fieldTerm = (coreEncodeRowType v69)}})) - Core.TypeVariable v70 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeRowType v72)}})) + Core.TypeVariable v73 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "variable"), - Core.fieldTerm = (coreEncodeName v70)}})) - Core.TypeWrap v71 -> (Core.TermUnion (Core.Injection { + Core.fieldTerm = (coreEncodeName v73)}})) + Core.TypeWrap v74 -> (Core.TermUnion (Core.Injection { Core.injectionTypeName = (Core.Name "hydra/core.Type"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "wrap"), - Core.fieldTerm = (coreEncodeWrappedType v71)}})) + Core.fieldTerm = (coreEncodeWrappedType v74)}})) +coreEncodeTypeAbstraction :: (Core.TypeAbstraction -> Core.Term) +coreEncodeTypeAbstraction l = (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra/core.TypeAbstraction"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "parameter"), + Core.fieldTerm = (coreEncodeName (Core.typeAbstractionParameter l))}, + Core.Field { + Core.fieldName = (Core.Name "body"), + Core.fieldTerm = (coreEncodeTerm (Core.typeAbstractionBody l))}]})) + coreEncodeTypeScheme :: (Core.TypeScheme -> Core.Term) coreEncodeTypeScheme ts = (Core.TermRecord (Core.Record { Core.recordTypeName = (Core.Name "hydra/core.TypeScheme"), @@ -667,6 +693,17 @@ Core.Field { Core.fieldName = (Core.Name "type"), Core.fieldTerm = (coreEncodeType (Core.typeSchemeType ts))}]})) + +coreEncodeTypedTerm :: (Core.TypedTerm -> Core.Term) +coreEncodeTypedTerm tt = (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra/core.TypedTerm"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "term"), + Core.fieldTerm = (coreEncodeTerm (Core.typedTermTerm tt))}, + Core.Field { + Core.fieldName = (Core.Name "type"), + Core.fieldTerm = (coreEncodeType (Core.typedTermType tt))}]})) coreEncodeWrappedTerm :: (Core.WrappedTerm -> Core.Term) coreEncodeWrappedTerm n = (Core.TermRecord (Core.Record { diff --git a/src/gen-main/haskell/Hydra/Decode.hs b/src/gen-main/haskell/Hydra/Decode.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Decode.hs @@ -0,0 +1,258 @@ +-- | A module for decoding terms to native objects + +module Hydra.Decode where + +import qualified Hydra.Core as Core +import qualified Hydra.Lib.Equality as Equality +import qualified Hydra.Lib.Lists as Lists +import qualified Hydra.Lib.Logic as Logic +import qualified Hydra.Lib.Optionals as Optionals +import qualified Hydra.Strip as Strip +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +bigfloat :: (Core.Term -> Maybe Double) +bigfloat = (Optionals.compose (Optionals.compose literal floatLiteral) bigfloatValue) + +bigfloatValue :: (Core.FloatValue -> Maybe Double) +bigfloatValue x = case x of + Core.FloatValueBigfloat v75 -> (Optionals.pure v75) + _ -> Nothing + +bigint :: (Core.Term -> Maybe Integer) +bigint = (Optionals.compose (Optionals.compose literal integerLiteral) bigintValue) + +bigintValue :: (Core.IntegerValue -> Maybe Integer) +bigintValue x = case x of + Core.IntegerValueBigint v76 -> (Optionals.pure v76) + _ -> Nothing + +binary :: (Core.Term -> Maybe String) +binary = (Optionals.compose literal binaryLiteral) + +binaryLiteral :: (Core.Literal -> Maybe String) +binaryLiteral x = case x of + Core.LiteralBinary v77 -> (Optionals.pure v77) + _ -> Nothing + +boolean :: (Core.Term -> Maybe Bool) +boolean = (Optionals.compose literal booleanLiteral) + +booleanLiteral :: (Core.Literal -> Maybe Bool) +booleanLiteral x = case x of + Core.LiteralBoolean v78 -> (Optionals.pure v78) + _ -> Nothing + +casesCase :: (Core.Name -> Core.Name -> Core.Term -> Maybe Core.Term) +casesCase tname fname = (Optionals.compose (cases tname) (field fname)) + +cases :: (Core.Name -> Core.Term -> Maybe [Core.Field]) +cases = (nominal Core.caseStatementTypeName Core.caseStatementCases (Optionals.compose (Optionals.compose (\x -> (\x -> case x of + Core.TermFunction v79 -> (Optionals.pure v79) + _ -> Nothing) (Strip.fullyStripTerm x)) (\x -> case x of + Core.FunctionElimination v80 -> (Optionals.pure v80) + _ -> Nothing)) (\x -> case x of + Core.EliminationUnion v81 -> (Optionals.pure v81) + _ -> Nothing))) + +field :: (Core.Name -> [Core.Field] -> Maybe Core.Term) +field fname fields = + let matches = (Lists.filter (\f -> Equality.equal (Core.fieldName f) fname) fields) + in (Logic.ifElse (Just (Core.fieldTerm (Lists.head matches))) Nothing (Equality.equal 1 (Lists.length matches))) + +float32 :: (Core.Term -> Maybe Float) +float32 = (Optionals.compose (Optionals.compose literal floatLiteral) float32Value) + +float32Value :: (Core.FloatValue -> Maybe Float) +float32Value x = case x of + Core.FloatValueFloat32 v82 -> (Optionals.pure v82) + _ -> Nothing + +float64 :: (Core.Term -> Maybe Double) +float64 = (Optionals.compose (Optionals.compose literal floatLiteral) float64Value) + +float64Value :: (Core.FloatValue -> Maybe Double) +float64Value x = case x of + Core.FloatValueFloat64 v83 -> (Optionals.pure v83) + _ -> Nothing + +floatLiteral :: (Core.Literal -> Maybe Core.FloatValue) +floatLiteral x = case x of + Core.LiteralFloat v84 -> (Optionals.pure v84) + _ -> Nothing + +int16 :: (Core.Term -> Maybe Int16) +int16 = (Optionals.compose (Optionals.compose literal integerLiteral) int16Value) + +int16Value :: (Core.IntegerValue -> Maybe Int16) +int16Value x = case x of + Core.IntegerValueInt16 v85 -> (Optionals.pure v85) + _ -> Nothing + +int32 :: (Core.Term -> Maybe Int) +int32 = (Optionals.compose (Optionals.compose literal integerLiteral) int32Value) + +int32Value :: (Core.IntegerValue -> Maybe Int) +int32Value x = case x of + Core.IntegerValueInt32 v86 -> (Optionals.pure v86) + _ -> Nothing + +int64 :: (Core.Term -> Maybe Int64) +int64 = (Optionals.compose (Optionals.compose literal integerLiteral) int64Value) + +int64Value :: (Core.IntegerValue -> Maybe Int64) +int64Value x = case x of + Core.IntegerValueInt64 v87 -> (Optionals.pure v87) + _ -> Nothing + +int8 :: (Core.Term -> Maybe Int8) +int8 = (Optionals.compose (Optionals.compose literal integerLiteral) int8Value) + +int8Value :: (Core.IntegerValue -> Maybe Int8) +int8Value x = case x of + Core.IntegerValueInt8 v88 -> (Optionals.pure v88) + _ -> Nothing + +integerLiteral :: (Core.Literal -> Maybe Core.IntegerValue) +integerLiteral x = case x of + Core.LiteralInteger v89 -> (Optionals.pure v89) + _ -> Nothing + +lambda :: (Core.Term -> Maybe Core.Lambda) +lambda = (Optionals.compose (\x -> (\x -> case x of + Core.TermFunction v90 -> (Optionals.pure v90) + _ -> Nothing) (Strip.fullyStripTerm x)) (\x -> case x of + Core.FunctionLambda v91 -> (Optionals.pure v91) + _ -> Nothing)) + +letBinding :: (Core.Name -> Core.Term -> Maybe Core.LetBinding) +letBinding fname term = (Optionals.bind (Optionals.map Core.letBindings (letTerm term)) (letBindingWithKey fname)) + +letBindingWithKey :: (Core.Name -> [Core.LetBinding] -> Maybe Core.LetBinding) +letBindingWithKey fname bindings = + let matches = (Lists.filter (\b -> Equality.equal (Core.letBindingName b) fname) bindings) + in (Logic.ifElse (Just (Lists.head matches)) Nothing (Equality.equal 1 (Lists.length matches))) + +letTerm :: (Core.Term -> Maybe Core.Let) +letTerm x = ((\x -> case x of + Core.TermLet v92 -> (Optionals.pure v92) + _ -> Nothing) (Strip.fullyStripTerm x)) + +list :: (Core.Term -> Maybe [Core.Term]) +list x = ((\x -> case x of + Core.TermList v93 -> (Optionals.pure v93) + _ -> Nothing) (Strip.fullyStripTerm x)) + +literal :: (Core.Term -> Maybe Core.Literal) +literal x = ((\x -> case x of + Core.TermLiteral v94 -> (Optionals.pure v94) + _ -> Nothing) (Strip.fullyStripTerm x)) + +map :: (Core.Term -> Maybe (Map Core.Term Core.Term)) +map x = ((\x -> case x of + Core.TermMap v95 -> (Optionals.pure v95) + _ -> Nothing) (Strip.fullyStripTerm x)) + +name :: (Core.Term -> Maybe Core.Name) +name term = (Optionals.map (\s -> Core.Name s) (Optionals.bind (wrap (Core.Name "hydra/core.Name") term) string)) + +nominal :: ((a -> Core.Name) -> (a -> b) -> (c -> Maybe a) -> Core.Name -> c -> Maybe b) +nominal getName getB getA expected = (Optionals.compose getA (\a -> Logic.ifElse (Just (getB a)) Nothing (Equality.equal (getName a) expected))) + +optCases :: (Core.Term -> Maybe Core.OptionalCases) +optCases = (Optionals.compose (Optionals.compose (\x -> (\x -> case x of + Core.TermFunction v96 -> (Optionals.pure v96) + _ -> Nothing) (Strip.fullyStripTerm x)) (\x -> case x of + Core.FunctionElimination v97 -> (Optionals.pure v97) + _ -> Nothing)) (\x -> case x of + Core.EliminationOptional v98 -> (Optionals.pure v98) + _ -> Nothing)) + +optCasesJust :: (Core.Term -> Maybe Core.Term) +optCasesJust term = (Optionals.map Core.optionalCasesJust (optCases term)) + +optCasesNothing :: (Core.Term -> Maybe Core.Term) +optCasesNothing term = (Optionals.map Core.optionalCasesNothing (optCases term)) + +optional :: (Core.Term -> Maybe (Maybe Core.Term)) +optional x = ((\x -> case x of + Core.TermOptional v99 -> (Optionals.pure v99) + _ -> Nothing) (Strip.fullyStripTerm x)) + +pair :: (Core.Term -> Maybe (Core.Term, Core.Term)) +pair = (Optionals.compose (\x -> (\x -> case x of + Core.TermProduct v100 -> (Optionals.pure v100) + _ -> Nothing) (Strip.fullyStripTerm x)) (\l -> Logic.ifElse (Just (Lists.at 0 l, (Lists.at 1 l))) Nothing (Equality.equal 2 (Lists.length l)))) + +record :: (Core.Name -> Core.Term -> Maybe [Core.Field]) +record = (nominal Core.recordTypeName Core.recordFields (\x -> (\x -> case x of + Core.TermRecord v101 -> (Optionals.pure v101) + _ -> Nothing) (Strip.fullyStripTerm x))) + +set :: (Core.Term -> Maybe (Set Core.Term)) +set x = ((\x -> case x of + Core.TermSet v102 -> (Optionals.pure v102) + _ -> Nothing) (Strip.fullyStripTerm x)) + +string :: (Core.Term -> Maybe String) +string = (Optionals.compose literal stringLiteral) + +stringLiteral :: (Core.Literal -> Maybe String) +stringLiteral x = case x of + Core.LiteralString v103 -> (Optionals.pure v103) + _ -> Nothing + +uint16 :: (Core.Term -> Maybe Int) +uint16 = (Optionals.compose (Optionals.compose literal integerLiteral) uint16Value) + +uint16Value :: (Core.IntegerValue -> Maybe Int) +uint16Value x = case x of + Core.IntegerValueUint16 v104 -> (Optionals.pure v104) + _ -> Nothing + +uint32 :: (Core.Term -> Maybe Int64) +uint32 = (Optionals.compose (Optionals.compose literal integerLiteral) uint32Value) + +uint32Value :: (Core.IntegerValue -> Maybe Int64) +uint32Value x = case x of + Core.IntegerValueUint32 v105 -> (Optionals.pure v105) + _ -> Nothing + +uint64 :: (Core.Term -> Maybe Integer) +uint64 = (Optionals.compose (Optionals.compose literal integerLiteral) uint64Value) + +uint64Value :: (Core.IntegerValue -> Maybe Integer) +uint64Value x = case x of + Core.IntegerValueUint64 v106 -> (Optionals.pure v106) + _ -> Nothing + +uint8 :: (Core.Term -> Maybe Int16) +uint8 = (Optionals.compose (Optionals.compose literal integerLiteral) uint8Value) + +uint8Value :: (Core.IntegerValue -> Maybe Int16) +uint8Value x = case x of + Core.IntegerValueUint8 v107 -> (Optionals.pure v107) + _ -> Nothing + +unit :: (Core.Term -> Maybe ()) +unit term = (Optionals.map (\_ -> ()) (record (Core.Name "hydra/core.Unit") term)) + +unitVariant :: (Core.Name -> Core.Term -> Maybe Core.Name) +unitVariant tname term = (Optionals.map Core.fieldName (variant tname term)) + +variable :: (Core.Term -> Maybe Core.Name) +variable x = ((\x -> (\x -> case x of + Core.TermVariable v108 -> (Optionals.pure v108) + _ -> Nothing) (Strip.fullyStripTerm x)) (Strip.fullyStripTerm x)) + +variant :: (Core.Name -> Core.Term -> Maybe Core.Field) +variant = (nominal Core.injectionTypeName Core.injectionField (\x -> (\x -> case x of + Core.TermUnion v109 -> (Optionals.pure v109) + _ -> Nothing) (Strip.fullyStripTerm x))) + +wrap :: (Core.Name -> Core.Term -> Maybe Core.Term) +wrap = (nominal Core.wrappedTermTypeName Core.wrappedTermObject (\x -> (\x -> case x of + Core.TermWrap v110 -> (Optionals.pure v110) + _ -> Nothing) (Strip.fullyStripTerm x))) diff --git a/src/gen-main/haskell/Hydra/Ext/Csharp/Syntax.hs b/src/gen-main/haskell/Hydra/Ext/Csharp/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Csharp/Syntax.hs @@ -0,0 +1,4949 @@ +-- | A C# syntax module based on the ANTLR grammar dated 02/07/2024 and available at: +-- | https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/language-specification/grammar + +module Hydra.Ext.Csharp.Syntax where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +newtype Identifier = + Identifier { + unIdentifier :: String} + deriving (Eq, Ord, Read, Show) + +_Identifier = (Core.Name "hydra/ext/csharp/syntax.Identifier") + +newtype Keyword = + Keyword { + unKeyword :: String} + deriving (Eq, Ord, Read, Show) + +_Keyword = (Core.Name "hydra/ext/csharp/syntax.Keyword") + +data Literal = + LiteralBoolean Bool | + LiteralInteger IntegerLiteral | + LiteralReal Double | + LiteralCharacter String | + LiteralString String | + LiteralNull + deriving (Eq, Ord, Read, Show) + +_Literal = (Core.Name "hydra/ext/csharp/syntax.Literal") + +_Literal_boolean = (Core.Name "boolean") + +_Literal_integer = (Core.Name "integer") + +_Literal_real = (Core.Name "real") + +_Literal_character = (Core.Name "character") + +_Literal_string = (Core.Name "string") + +_Literal_null = (Core.Name "null") + +data IntegerLiteral = + IntegerLiteralDecimal String | + IntegerLiteralHexadecimal String | + IntegerLiteralBinary Integer + deriving (Eq, Ord, Read, Show) + +_IntegerLiteral = (Core.Name "hydra/ext/csharp/syntax.IntegerLiteral") + +_IntegerLiteral_decimal = (Core.Name "decimal") + +_IntegerLiteral_hexadecimal = (Core.Name "hexadecimal") + +_IntegerLiteral_binary = (Core.Name "binary") + +newtype NamespaceName = + NamespaceName { + unNamespaceName :: NamespaceOrTypeName} + deriving (Eq, Ord, Read, Show) + +_NamespaceName = (Core.Name "hydra/ext/csharp/syntax.NamespaceName") + +newtype TypeName = + TypeName { + unTypeName :: NamespaceOrTypeName} + deriving (Eq, Ord, Read, Show) + +_TypeName = (Core.Name "hydra/ext/csharp/syntax.TypeName") + +data NamespaceOrTypeName = + NamespaceOrTypeNameIdentifier IdentifierNamespaceOrTypeName | + NamespaceOrTypeNameQualified QualifiedNamespaceOrTypeName | + NamespaceOrTypeNameAlias QualifiedAliasMember + deriving (Eq, Ord, Read, Show) + +_NamespaceOrTypeName = (Core.Name "hydra/ext/csharp/syntax.NamespaceOrTypeName") + +_NamespaceOrTypeName_identifier = (Core.Name "identifier") + +_NamespaceOrTypeName_qualified = (Core.Name "qualified") + +_NamespaceOrTypeName_alias = (Core.Name "alias") + +data IdentifierNamespaceOrTypeName = + IdentifierNamespaceOrTypeName { + identifierNamespaceOrTypeNameIdentifier :: Identifier, + identifierNamespaceOrTypeNameArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_IdentifierNamespaceOrTypeName = (Core.Name "hydra/ext/csharp/syntax.IdentifierNamespaceOrTypeName") + +_IdentifierNamespaceOrTypeName_identifier = (Core.Name "identifier") + +_IdentifierNamespaceOrTypeName_arguments = (Core.Name "arguments") + +data QualifiedNamespaceOrTypeName = + QualifiedNamespaceOrTypeName { + qualifiedNamespaceOrTypeNameNamespaceOrType :: NamespaceOrTypeName, + qualifiedNamespaceOrTypeNameIdentifier :: Identifier, + qualifiedNamespaceOrTypeNameArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_QualifiedNamespaceOrTypeName = (Core.Name "hydra/ext/csharp/syntax.QualifiedNamespaceOrTypeName") + +_QualifiedNamespaceOrTypeName_namespaceOrType = (Core.Name "namespaceOrType") + +_QualifiedNamespaceOrTypeName_identifier = (Core.Name "identifier") + +_QualifiedNamespaceOrTypeName_arguments = (Core.Name "arguments") + +data Type = + TypeReference ReferenceType | + TypeValue ValueType | + TypeParam TypeParameter | + TypePointer PointerType + deriving (Eq, Ord, Read, Show) + +_Type = (Core.Name "hydra/ext/csharp/syntax.Type") + +_Type_reference = (Core.Name "reference") + +_Type_value = (Core.Name "value") + +_Type_param = (Core.Name "param") + +_Type_pointer = (Core.Name "pointer") + +data ReferenceType = + ReferenceTypeClass ClassType | + ReferenceTypeInterface InterfaceType | + ReferenceTypeArray ArrayType | + ReferenceTypeDelegate DelegateType | + ReferenceTypeDynamic + deriving (Eq, Ord, Read, Show) + +_ReferenceType = (Core.Name "hydra/ext/csharp/syntax.ReferenceType") + +_ReferenceType_class = (Core.Name "class") + +_ReferenceType_interface = (Core.Name "interface") + +_ReferenceType_array = (Core.Name "array") + +_ReferenceType_delegate = (Core.Name "delegate") + +_ReferenceType_dynamic = (Core.Name "dynamic") + +data ClassType = + ClassTypeTypeName TypeName | + ClassTypeObject | + ClassTypeString + deriving (Eq, Ord, Read, Show) + +_ClassType = (Core.Name "hydra/ext/csharp/syntax.ClassType") + +_ClassType_typeName = (Core.Name "typeName") + +_ClassType_object = (Core.Name "object") + +_ClassType_string = (Core.Name "string") + +newtype InterfaceType = + InterfaceType { + unInterfaceType :: TypeName} + deriving (Eq, Ord, Read, Show) + +_InterfaceType = (Core.Name "hydra/ext/csharp/syntax.InterfaceType") + +data ArrayType = + ArrayType { + arrayTypeType :: NonArrayType, + arrayTypeRank :: [RankSpecifier]} + deriving (Eq, Ord, Read, Show) + +_ArrayType = (Core.Name "hydra/ext/csharp/syntax.ArrayType") + +_ArrayType_type = (Core.Name "type") + +_ArrayType_rank = (Core.Name "rank") + +data NonArrayType = + NonArrayTypeValue ValueType | + NonArrayTypeClass ClassType | + NonArrayTypeInterface InterfaceType | + NonArrayTypeDelegate DelegateType | + NonArrayTypeDynamic | + NonArrayTypeParameter TypeParameter | + NonArrayTypePointer PointerType + deriving (Eq, Ord, Read, Show) + +_NonArrayType = (Core.Name "hydra/ext/csharp/syntax.NonArrayType") + +_NonArrayType_value = (Core.Name "value") + +_NonArrayType_class = (Core.Name "class") + +_NonArrayType_interface = (Core.Name "interface") + +_NonArrayType_delegate = (Core.Name "delegate") + +_NonArrayType_dynamic = (Core.Name "dynamic") + +_NonArrayType_parameter = (Core.Name "parameter") + +_NonArrayType_pointer = (Core.Name "pointer") + +newtype RankSpecifier = + RankSpecifier { + unRankSpecifier :: Int} + deriving (Eq, Ord, Read, Show) + +_RankSpecifier = (Core.Name "hydra/ext/csharp/syntax.RankSpecifier") + +newtype DelegateType = + DelegateType { + unDelegateType :: TypeName} + deriving (Eq, Ord, Read, Show) + +_DelegateType = (Core.Name "hydra/ext/csharp/syntax.DelegateType") + +data ValueType = + ValueTypeNonNullable StructOrEnumType | + ValueTypeNullable StructOrEnumType + deriving (Eq, Ord, Read, Show) + +_ValueType = (Core.Name "hydra/ext/csharp/syntax.ValueType") + +_ValueType_nonNullable = (Core.Name "nonNullable") + +_ValueType_nullable = (Core.Name "nullable") + +data StructOrEnumType = + StructOrEnumTypeStruct StructType | + StructOrEnumTypeEnum EnumType + deriving (Eq, Ord, Read, Show) + +_StructOrEnumType = (Core.Name "hydra/ext/csharp/syntax.StructOrEnumType") + +_StructOrEnumType_struct = (Core.Name "struct") + +_StructOrEnumType_enum = (Core.Name "enum") + +data StructType = + StructTypeTypeName TypeName | + StructTypeSimple SimpleType | + StructTypeTuple TupleType + deriving (Eq, Ord, Read, Show) + +_StructType = (Core.Name "hydra/ext/csharp/syntax.StructType") + +_StructType_typeName = (Core.Name "typeName") + +_StructType_simple = (Core.Name "simple") + +_StructType_tuple = (Core.Name "tuple") + +data SimpleType = + SimpleTypeNumeric NumericType | + SimpleTypeBool + deriving (Eq, Ord, Read, Show) + +_SimpleType = (Core.Name "hydra/ext/csharp/syntax.SimpleType") + +_SimpleType_numeric = (Core.Name "numeric") + +_SimpleType_bool = (Core.Name "bool") + +data NumericType = + NumericTypeIntegral IntegralType | + NumericTypeFloatingPoint FloatingPointType | + NumericTypeDecimal + deriving (Eq, Ord, Read, Show) + +_NumericType = (Core.Name "hydra/ext/csharp/syntax.NumericType") + +_NumericType_integral = (Core.Name "integral") + +_NumericType_floatingPoint = (Core.Name "floatingPoint") + +_NumericType_decimal = (Core.Name "decimal") + +data IntegralType = + IntegralTypeSbyte | + IntegralTypeByte | + IntegralTypeShort | + IntegralTypeUshort | + IntegralTypeInt | + IntegralTypeUint | + IntegralTypeLong | + IntegralTypeUlong | + IntegralTypeChar + deriving (Eq, Ord, Read, Show) + +_IntegralType = (Core.Name "hydra/ext/csharp/syntax.IntegralType") + +_IntegralType_sbyte = (Core.Name "sbyte") + +_IntegralType_byte = (Core.Name "byte") + +_IntegralType_short = (Core.Name "short") + +_IntegralType_ushort = (Core.Name "ushort") + +_IntegralType_int = (Core.Name "int") + +_IntegralType_uint = (Core.Name "uint") + +_IntegralType_long = (Core.Name "long") + +_IntegralType_ulong = (Core.Name "ulong") + +_IntegralType_char = (Core.Name "char") + +data FloatingPointType = + FloatingPointTypeFloat | + FloatingPointTypeDouble + deriving (Eq, Ord, Read, Show) + +_FloatingPointType = (Core.Name "hydra/ext/csharp/syntax.FloatingPointType") + +_FloatingPointType_float = (Core.Name "float") + +_FloatingPointType_double = (Core.Name "double") + +newtype TupleType = + TupleType { + unTupleType :: [TupleTypeElement]} + deriving (Eq, Ord, Read, Show) + +_TupleType = (Core.Name "hydra/ext/csharp/syntax.TupleType") + +data TupleTypeElement = + TupleTypeElement { + tupleTypeElementType :: Type, + tupleTypeElementIdentifier :: (Maybe Identifier)} + deriving (Eq, Ord, Read, Show) + +_TupleTypeElement = (Core.Name "hydra/ext/csharp/syntax.TupleTypeElement") + +_TupleTypeElement_type = (Core.Name "type") + +_TupleTypeElement_identifier = (Core.Name "identifier") + +newtype EnumType = + EnumType { + unEnumType :: TypeName} + deriving (Eq, Ord, Read, Show) + +_EnumType = (Core.Name "hydra/ext/csharp/syntax.EnumType") + +newtype TypeArgumentList = + TypeArgumentList { + unTypeArgumentList :: [Type]} + deriving (Eq, Ord, Read, Show) + +_TypeArgumentList = (Core.Name "hydra/ext/csharp/syntax.TypeArgumentList") + +newtype TypeParameter = + TypeParameter { + unTypeParameter :: Identifier} + deriving (Eq, Ord, Read, Show) + +_TypeParameter = (Core.Name "hydra/ext/csharp/syntax.TypeParameter") + +data UnmanagedType = + UnmanagedTypeValue ValueType | + UnmanagedTypePointer PointerType + deriving (Eq, Ord, Read, Show) + +_UnmanagedType = (Core.Name "hydra/ext/csharp/syntax.UnmanagedType") + +_UnmanagedType_value = (Core.Name "value") + +_UnmanagedType_pointer = (Core.Name "pointer") + +newtype VariableReference = + VariableReference { + unVariableReference :: Expression} + deriving (Eq, Ord, Read, Show) + +_VariableReference = (Core.Name "hydra/ext/csharp/syntax.VariableReference") + +data Pattern = + PatternDeclaration DeclarationPattern | + PatternConstant Expression | + PatternVar Designation + deriving (Eq, Ord, Read, Show) + +_Pattern = (Core.Name "hydra/ext/csharp/syntax.Pattern") + +_Pattern_declaration = (Core.Name "declaration") + +_Pattern_constant = (Core.Name "constant") + +_Pattern_var = (Core.Name "var") + +data DeclarationPattern = + DeclarationPattern { + declarationPatternType :: Type, + declarationPatternDesignation :: Designation} + deriving (Eq, Ord, Read, Show) + +_DeclarationPattern = (Core.Name "hydra/ext/csharp/syntax.DeclarationPattern") + +_DeclarationPattern_type = (Core.Name "type") + +_DeclarationPattern_designation = (Core.Name "designation") + +newtype Designation = + Designation { + unDesignation :: Identifier} + deriving (Eq, Ord, Read, Show) + +_Designation = (Core.Name "hydra/ext/csharp/syntax.Designation") + +newtype ArgumentList = + ArgumentList { + unArgumentList :: [Argument]} + deriving (Eq, Ord, Read, Show) + +_ArgumentList = (Core.Name "hydra/ext/csharp/syntax.ArgumentList") + +data Argument = + Argument { + argumentName :: (Maybe Identifier), + argumentValue :: ArgumentValue} + deriving (Eq, Ord, Read, Show) + +_Argument = (Core.Name "hydra/ext/csharp/syntax.Argument") + +_Argument_name = (Core.Name "name") + +_Argument_value = (Core.Name "value") + +data ArgumentValue = + ArgumentValueExpression Expression | + ArgumentValueIn VariableReference | + ArgumentValueRef VariableReference | + ArgumentValueOut VariableReference + deriving (Eq, Ord, Read, Show) + +_ArgumentValue = (Core.Name "hydra/ext/csharp/syntax.ArgumentValue") + +_ArgumentValue_expression = (Core.Name "expression") + +_ArgumentValue_in = (Core.Name "in") + +_ArgumentValue_ref = (Core.Name "ref") + +_ArgumentValue_out = (Core.Name "out") + +data PrimaryExpression = + PrimaryExpressionNoArray PrimaryNoArrayCreationExpression | + PrimaryExpressionArray ArrayCreationExpression + deriving (Eq, Ord, Read, Show) + +_PrimaryExpression = (Core.Name "hydra/ext/csharp/syntax.PrimaryExpression") + +_PrimaryExpression_noArray = (Core.Name "noArray") + +_PrimaryExpression_array = (Core.Name "array") + +data PrimaryNoArrayCreationExpression = + PrimaryNoArrayCreationExpressionLiteral Literal | + PrimaryNoArrayCreationExpressionInterpolatedString InterpolatedStringExpression | + PrimaryNoArrayCreationExpressionSimpleName SimpleName | + PrimaryNoArrayCreationExpressionParenthesized Expression | + PrimaryNoArrayCreationExpressionTuple TupleExpression | + PrimaryNoArrayCreationExpressionMemberAccess MemberAccess | + PrimaryNoArrayCreationExpressionNullConditionalMemberAccess NullConditionalMemberAccess | + PrimaryNoArrayCreationExpressionInvocation InvocationExpression | + PrimaryNoArrayCreationExpressionElementAccess ElementAccess | + PrimaryNoArrayCreationExpressionNullConditionalElementAccess NullConditionalElementAccess | + PrimaryNoArrayCreationExpressionThisAccess | + PrimaryNoArrayCreationExpressionBaseAccess BaseAccess | + PrimaryNoArrayCreationExpressionPostIncrement PrimaryExpression | + PrimaryNoArrayCreationExpressionPostDecrement PrimaryExpression | + PrimaryNoArrayCreationExpressionObjectCreation ObjectCreationExpression | + PrimaryNoArrayCreationExpressionDelegateCreation DelegateCreationExpression | + PrimaryNoArrayCreationExpressionAnonymousObjectCreation (Maybe MemberDeclaratorList) | + PrimaryNoArrayCreationExpressionTypeof TypeofExpression | + PrimaryNoArrayCreationExpressionSizeof UnmanagedType | + PrimaryNoArrayCreationExpressionChecked Expression | + PrimaryNoArrayCreationExpressionUnchecked Expression | + PrimaryNoArrayCreationExpressionDefaultValue DefaultValueExpression | + PrimaryNoArrayCreationExpressionNameof NamedEntity | + PrimaryNoArrayCreationExpressionAnonymousMethod AnonymousMethodExpression | + PrimaryNoArrayCreationExpressionPointerMemberAccess PointerMemberAccess | + PrimaryNoArrayCreationExpressionPointerElementAccess PointerElementAccess | + PrimaryNoArrayCreationExpressionStackalloc StackallocExpression + deriving (Eq, Ord, Read, Show) + +_PrimaryNoArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.PrimaryNoArrayCreationExpression") + +_PrimaryNoArrayCreationExpression_literal = (Core.Name "literal") + +_PrimaryNoArrayCreationExpression_interpolatedString = (Core.Name "interpolatedString") + +_PrimaryNoArrayCreationExpression_simpleName = (Core.Name "simpleName") + +_PrimaryNoArrayCreationExpression_parenthesized = (Core.Name "parenthesized") + +_PrimaryNoArrayCreationExpression_tuple = (Core.Name "tuple") + +_PrimaryNoArrayCreationExpression_memberAccess = (Core.Name "memberAccess") + +_PrimaryNoArrayCreationExpression_nullConditionalMemberAccess = (Core.Name "nullConditionalMemberAccess") + +_PrimaryNoArrayCreationExpression_invocation = (Core.Name "invocation") + +_PrimaryNoArrayCreationExpression_elementAccess = (Core.Name "elementAccess") + +_PrimaryNoArrayCreationExpression_nullConditionalElementAccess = (Core.Name "nullConditionalElementAccess") + +_PrimaryNoArrayCreationExpression_thisAccess = (Core.Name "thisAccess") + +_PrimaryNoArrayCreationExpression_baseAccess = (Core.Name "baseAccess") + +_PrimaryNoArrayCreationExpression_postIncrement = (Core.Name "postIncrement") + +_PrimaryNoArrayCreationExpression_postDecrement = (Core.Name "postDecrement") + +_PrimaryNoArrayCreationExpression_objectCreation = (Core.Name "objectCreation") + +_PrimaryNoArrayCreationExpression_delegateCreation = (Core.Name "delegateCreation") + +_PrimaryNoArrayCreationExpression_anonymousObjectCreation = (Core.Name "anonymousObjectCreation") + +_PrimaryNoArrayCreationExpression_typeof = (Core.Name "typeof") + +_PrimaryNoArrayCreationExpression_sizeof = (Core.Name "sizeof") + +_PrimaryNoArrayCreationExpression_checked = (Core.Name "checked") + +_PrimaryNoArrayCreationExpression_unchecked = (Core.Name "unchecked") + +_PrimaryNoArrayCreationExpression_defaultValue = (Core.Name "defaultValue") + +_PrimaryNoArrayCreationExpression_nameof = (Core.Name "nameof") + +_PrimaryNoArrayCreationExpression_anonymousMethod = (Core.Name "anonymousMethod") + +_PrimaryNoArrayCreationExpression_pointerMemberAccess = (Core.Name "pointerMemberAccess") + +_PrimaryNoArrayCreationExpression_pointerElementAccess = (Core.Name "pointerElementAccess") + +_PrimaryNoArrayCreationExpression_stackalloc = (Core.Name "stackalloc") + +data InterpolatedStringExpression = + InterpolatedStringExpressionRegular InterpolatedRegularStringExpression | + InterpolatedStringExpressionVerbatim InterpolatedVerbatimStringExpression + deriving (Eq, Ord, Read, Show) + +_InterpolatedStringExpression = (Core.Name "hydra/ext/csharp/syntax.InterpolatedStringExpression") + +_InterpolatedStringExpression_regular = (Core.Name "regular") + +_InterpolatedStringExpression_verbatim = (Core.Name "verbatim") + +newtype InterpolatedRegularStringExpression = + InterpolatedRegularStringExpression { + unInterpolatedRegularStringExpression :: String} + deriving (Eq, Ord, Read, Show) + +_InterpolatedRegularStringExpression = (Core.Name "hydra/ext/csharp/syntax.InterpolatedRegularStringExpression") + +data RegularInterpolation = + RegularInterpolation { + regularInterpolationExpression :: Expression, + regularInterpolationWidth :: (Maybe Expression), + regularInterpolationFormat :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_RegularInterpolation = (Core.Name "hydra/ext/csharp/syntax.RegularInterpolation") + +_RegularInterpolation_expression = (Core.Name "expression") + +_RegularInterpolation_width = (Core.Name "width") + +_RegularInterpolation_format = (Core.Name "format") + +newtype InterpolatedVerbatimStringExpression = + InterpolatedVerbatimStringExpression { + unInterpolatedVerbatimStringExpression :: String} + deriving (Eq, Ord, Read, Show) + +_InterpolatedVerbatimStringExpression = (Core.Name "hydra/ext/csharp/syntax.InterpolatedVerbatimStringExpression") + +data VerbatimInterpolation = + VerbatimInterpolation { + verbatimInterpolationExpression :: Expression, + verbatimInterpolationWidth :: (Maybe ConstantExpression), + verbatimInterpolationFormat :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_VerbatimInterpolation = (Core.Name "hydra/ext/csharp/syntax.VerbatimInterpolation") + +_VerbatimInterpolation_expression = (Core.Name "expression") + +_VerbatimInterpolation_width = (Core.Name "width") + +_VerbatimInterpolation_format = (Core.Name "format") + +data SimpleName = + SimpleName { + simpleNameIdentifier :: Identifier, + simpleNameTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_SimpleName = (Core.Name "hydra/ext/csharp/syntax.SimpleName") + +_SimpleName_identifier = (Core.Name "identifier") + +_SimpleName_typeArguments = (Core.Name "typeArguments") + +data TupleExpression = + TupleExpressionElements [TupleElement] | + TupleExpressionDeconstruction DeconstructionTuple + deriving (Eq, Ord, Read, Show) + +_TupleExpression = (Core.Name "hydra/ext/csharp/syntax.TupleExpression") + +_TupleExpression_elements = (Core.Name "elements") + +_TupleExpression_deconstruction = (Core.Name "deconstruction") + +data TupleElement = + TupleElement { + tupleElementName :: (Maybe Identifier), + tupleElementExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_TupleElement = (Core.Name "hydra/ext/csharp/syntax.TupleElement") + +_TupleElement_name = (Core.Name "name") + +_TupleElement_expression = (Core.Name "expression") + +newtype DeconstructionTuple = + DeconstructionTuple { + unDeconstructionTuple :: [DeconstructionElement]} + deriving (Eq, Ord, Read, Show) + +_DeconstructionTuple = (Core.Name "hydra/ext/csharp/syntax.DeconstructionTuple") + +data DeconstructionElement = + DeconstructionElementTuple DeconstructionTuple | + DeconstructionElementIdentifier Identifier + deriving (Eq, Ord, Read, Show) + +_DeconstructionElement = (Core.Name "hydra/ext/csharp/syntax.DeconstructionElement") + +_DeconstructionElement_tuple = (Core.Name "tuple") + +_DeconstructionElement_identifier = (Core.Name "identifier") + +data MemberAccess = + MemberAccess { + memberAccessHead :: MemberAccessHead, + memberAccessIdentifier :: Identifier, + memberAccessTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_MemberAccess = (Core.Name "hydra/ext/csharp/syntax.MemberAccess") + +_MemberAccess_head = (Core.Name "head") + +_MemberAccess_identifier = (Core.Name "identifier") + +_MemberAccess_typeArguments = (Core.Name "typeArguments") + +data MemberAccessHead = + MemberAccessHeadPrimary PrimaryExpression | + MemberAccessHeadPredefined PredefinedType | + MemberAccessHeadQualifiedAlias QualifiedAliasMember + deriving (Eq, Ord, Read, Show) + +_MemberAccessHead = (Core.Name "hydra/ext/csharp/syntax.MemberAccessHead") + +_MemberAccessHead_primary = (Core.Name "primary") + +_MemberAccessHead_predefined = (Core.Name "predefined") + +_MemberAccessHead_qualifiedAlias = (Core.Name "qualifiedAlias") + +data PredefinedType = + PredefinedTypeBool | + PredefinedTypeByte | + PredefinedTypeChar | + PredefinedTypeDecimal | + PredefinedTypeDouble | + PredefinedTypeFloat | + PredefinedTypeInt | + PredefinedTypeLong | + PredefinedTypeObject | + PredefinedTypeSbyte | + PredefinedTypeShort | + PredefinedTypeString | + PredefinedTypeUint | + PredefinedTypeUlong | + PredefinedTypeUshort + deriving (Eq, Ord, Read, Show) + +_PredefinedType = (Core.Name "hydra/ext/csharp/syntax.PredefinedType") + +_PredefinedType_bool = (Core.Name "bool") + +_PredefinedType_byte = (Core.Name "byte") + +_PredefinedType_char = (Core.Name "char") + +_PredefinedType_decimal = (Core.Name "decimal") + +_PredefinedType_double = (Core.Name "double") + +_PredefinedType_float = (Core.Name "float") + +_PredefinedType_int = (Core.Name "int") + +_PredefinedType_long = (Core.Name "long") + +_PredefinedType_object = (Core.Name "object") + +_PredefinedType_sbyte = (Core.Name "sbyte") + +_PredefinedType_short = (Core.Name "short") + +_PredefinedType_string = (Core.Name "string") + +_PredefinedType_uint = (Core.Name "uint") + +_PredefinedType_ulong = (Core.Name "ulong") + +_PredefinedType_ushort = (Core.Name "ushort") + +data NullConditionalMemberAccess = + NullConditionalMemberAccess { + nullConditionalMemberAccessExpression :: PrimaryExpression, + nullConditionalMemberAccessIdentifier :: Identifier, + nullConditionalMemberAccessTypeArguments :: (Maybe TypeArgumentList), + nullConditionalMemberAccessDependentAccess :: [DependentAccess]} + deriving (Eq, Ord, Read, Show) + +_NullConditionalMemberAccess = (Core.Name "hydra/ext/csharp/syntax.NullConditionalMemberAccess") + +_NullConditionalMemberAccess_expression = (Core.Name "expression") + +_NullConditionalMemberAccess_identifier = (Core.Name "identifier") + +_NullConditionalMemberAccess_typeArguments = (Core.Name "typeArguments") + +_NullConditionalMemberAccess_dependentAccess = (Core.Name "dependentAccess") + +data DependentAccess = + DependentAccessMemberAccess DependentAccessForMember | + DependentAccessElementAccess ArgumentList | + DependentAccessInvocation (Maybe ArgumentList) + deriving (Eq, Ord, Read, Show) + +_DependentAccess = (Core.Name "hydra/ext/csharp/syntax.DependentAccess") + +_DependentAccess_memberAccess = (Core.Name "memberAccess") + +_DependentAccess_elementAccess = (Core.Name "elementAccess") + +_DependentAccess_invocation = (Core.Name "invocation") + +data DependentAccessForMember = + DependentAccessForMember { + dependentAccessForMemberIdentifier :: Identifier, + dependentAccessForMemberTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_DependentAccessForMember = (Core.Name "hydra/ext/csharp/syntax.DependentAccessForMember") + +_DependentAccessForMember_identifier = (Core.Name "identifier") + +_DependentAccessForMember_typeArguments = (Core.Name "typeArguments") + +data NullConditionalProjectionInitializer = + NullConditionalProjectionInitializer { + nullConditionalProjectionInitializerExpression :: PrimaryExpression, + nullConditionalProjectionInitializerIdentifier :: Identifier, + nullConditionalProjectionInitializerTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_NullConditionalProjectionInitializer = (Core.Name "hydra/ext/csharp/syntax.NullConditionalProjectionInitializer") + +_NullConditionalProjectionInitializer_expression = (Core.Name "expression") + +_NullConditionalProjectionInitializer_identifier = (Core.Name "identifier") + +_NullConditionalProjectionInitializer_typeArguments = (Core.Name "typeArguments") + +data InvocationExpression = + InvocationExpression { + invocationExpressionExpression :: PrimaryExpression, + invocationExpressionArguments :: (Maybe ArgumentList)} + deriving (Eq, Ord, Read, Show) + +_InvocationExpression = (Core.Name "hydra/ext/csharp/syntax.InvocationExpression") + +_InvocationExpression_expression = (Core.Name "expression") + +_InvocationExpression_arguments = (Core.Name "arguments") + +data NullConditionalInvocationExpression = + NullConditionalInvocationExpression { + nullConditionalInvocationExpressionHead :: NullConditionalInvocationExpressionHead, + nullConditionalInvocationExpressionArguments :: (Maybe ArgumentList)} + deriving (Eq, Ord, Read, Show) + +_NullConditionalInvocationExpression = (Core.Name "hydra/ext/csharp/syntax.NullConditionalInvocationExpression") + +_NullConditionalInvocationExpression_head = (Core.Name "head") + +_NullConditionalInvocationExpression_arguments = (Core.Name "arguments") + +data NullConditionalInvocationExpressionHead = + NullConditionalInvocationExpressionHeadMember NullConditionalMemberAccess | + NullConditionalInvocationExpressionHeadElement NullConditionalElementAccess + deriving (Eq, Ord, Read, Show) + +_NullConditionalInvocationExpressionHead = (Core.Name "hydra/ext/csharp/syntax.NullConditionalInvocationExpressionHead") + +_NullConditionalInvocationExpressionHead_member = (Core.Name "member") + +_NullConditionalInvocationExpressionHead_element = (Core.Name "element") + +data ElementAccess = + ElementAccess { + elementAccessExpression :: PrimaryNoArrayCreationExpression, + elementAccessArguments :: ArgumentList} + deriving (Eq, Ord, Read, Show) + +_ElementAccess = (Core.Name "hydra/ext/csharp/syntax.ElementAccess") + +_ElementAccess_expression = (Core.Name "expression") + +_ElementAccess_arguments = (Core.Name "arguments") + +data NullConditionalElementAccess = + NullConditionalElementAccess { + nullConditionalElementAccessExpression :: PrimaryNoArrayCreationExpression, + nullConditionalElementAccessArguments :: ArgumentList, + nullConditionalElementAccessDependentAccess :: [DependentAccess]} + deriving (Eq, Ord, Read, Show) + +_NullConditionalElementAccess = (Core.Name "hydra/ext/csharp/syntax.NullConditionalElementAccess") + +_NullConditionalElementAccess_expression = (Core.Name "expression") + +_NullConditionalElementAccess_arguments = (Core.Name "arguments") + +_NullConditionalElementAccess_dependentAccess = (Core.Name "dependentAccess") + +data BaseAccess = + BaseAccessIdentifier BaseAccessWithIdentifier | + BaseAccessArguments ArgumentList + deriving (Eq, Ord, Read, Show) + +_BaseAccess = (Core.Name "hydra/ext/csharp/syntax.BaseAccess") + +_BaseAccess_identifier = (Core.Name "identifier") + +_BaseAccess_arguments = (Core.Name "arguments") + +data BaseAccessWithIdentifier = + BaseAccessWithIdentifier { + baseAccessWithIdentifierIdentifier :: Identifier, + baseAccessWithIdentifierTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_BaseAccessWithIdentifier = (Core.Name "hydra/ext/csharp/syntax.BaseAccessWithIdentifier") + +_BaseAccessWithIdentifier_identifier = (Core.Name "identifier") + +_BaseAccessWithIdentifier_typeArguments = (Core.Name "typeArguments") + +data ObjectCreationExpression = + ObjectCreationExpression { + objectCreationExpressionType :: Type, + objectCreationExpressionArguments :: (Maybe ArgumentList), + objectCreationExpressionInitializer :: (Maybe ObjectOrCollectionInitializer)} + deriving (Eq, Ord, Read, Show) + +_ObjectCreationExpression = (Core.Name "hydra/ext/csharp/syntax.ObjectCreationExpression") + +_ObjectCreationExpression_type = (Core.Name "type") + +_ObjectCreationExpression_arguments = (Core.Name "arguments") + +_ObjectCreationExpression_initializer = (Core.Name "initializer") + +data ObjectOrCollectionInitializer = + ObjectOrCollectionInitializerObject [MemberInitializer] | + ObjectOrCollectionInitializerCollection [ElementInitializer] + deriving (Eq, Ord, Read, Show) + +_ObjectOrCollectionInitializer = (Core.Name "hydra/ext/csharp/syntax.ObjectOrCollectionInitializer") + +_ObjectOrCollectionInitializer_object = (Core.Name "object") + +_ObjectOrCollectionInitializer_collection = (Core.Name "collection") + +data MemberInitializer = + MemberInitializer { + memberInitializerTarget :: InitializerTarget, + memberInitializerValue :: InitializerValue} + deriving (Eq, Ord, Read, Show) + +_MemberInitializer = (Core.Name "hydra/ext/csharp/syntax.MemberInitializer") + +_MemberInitializer_target = (Core.Name "target") + +_MemberInitializer_value = (Core.Name "value") + +data InitializerTarget = + InitializerTargetIdentifier Identifier | + InitializerTargetArguments ArgumentList + deriving (Eq, Ord, Read, Show) + +_InitializerTarget = (Core.Name "hydra/ext/csharp/syntax.InitializerTarget") + +_InitializerTarget_identifier = (Core.Name "identifier") + +_InitializerTarget_arguments = (Core.Name "arguments") + +data InitializerValue = + InitializerValueExpression Expression | + InitializerValueObjectOrCollection ObjectOrCollectionInitializer + deriving (Eq, Ord, Read, Show) + +_InitializerValue = (Core.Name "hydra/ext/csharp/syntax.InitializerValue") + +_InitializerValue_expression = (Core.Name "expression") + +_InitializerValue_objectOrCollection = (Core.Name "objectOrCollection") + +data ElementInitializer = + ElementInitializerSingle NonAssignmentExpression | + ElementInitializerList ExpressionList + deriving (Eq, Ord, Read, Show) + +_ElementInitializer = (Core.Name "hydra/ext/csharp/syntax.ElementInitializer") + +_ElementInitializer_single = (Core.Name "single") + +_ElementInitializer_list = (Core.Name "list") + +newtype ExpressionList = + ExpressionList { + unExpressionList :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_ExpressionList = (Core.Name "hydra/ext/csharp/syntax.ExpressionList") + +data ArrayCreationExpression = + ArrayCreationExpressionNonArrayType NonArrayTypeArrayCreationExpression | + ArrayCreationExpressionArrayType ArrayTypeArrayCreationExpression | + ArrayCreationExpressionRankSpecifier RankSpecifierArrayCreationExpression + deriving (Eq, Ord, Read, Show) + +_ArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.ArrayCreationExpression") + +_ArrayCreationExpression_nonArrayType = (Core.Name "nonArrayType") + +_ArrayCreationExpression_arrayType = (Core.Name "arrayType") + +_ArrayCreationExpression_rankSpecifier = (Core.Name "rankSpecifier") + +data NonArrayTypeArrayCreationExpression = + NonArrayTypeArrayCreationExpression { + nonArrayTypeArrayCreationExpressionType :: NonArrayType, + nonArrayTypeArrayCreationExpressionExpressions :: ExpressionList, + nonArrayTypeArrayCreationExpressionRankSpecifiers :: [RankSpecifier], + nonArrayTypeArrayCreationExpressionInitializer :: (Maybe ArrayInitializer)} + deriving (Eq, Ord, Read, Show) + +_NonArrayTypeArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.NonArrayTypeArrayCreationExpression") + +_NonArrayTypeArrayCreationExpression_type = (Core.Name "type") + +_NonArrayTypeArrayCreationExpression_expressions = (Core.Name "expressions") + +_NonArrayTypeArrayCreationExpression_rankSpecifiers = (Core.Name "rankSpecifiers") + +_NonArrayTypeArrayCreationExpression_initializer = (Core.Name "initializer") + +data ArrayTypeArrayCreationExpression = + ArrayTypeArrayCreationExpression { + arrayTypeArrayCreationExpressionType :: ArrayType, + arrayTypeArrayCreationExpressionInitializer :: ArrayInitializer} + deriving (Eq, Ord, Read, Show) + +_ArrayTypeArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.ArrayTypeArrayCreationExpression") + +_ArrayTypeArrayCreationExpression_type = (Core.Name "type") + +_ArrayTypeArrayCreationExpression_initializer = (Core.Name "initializer") + +data RankSpecifierArrayCreationExpression = + RankSpecifierArrayCreationExpression { + rankSpecifierArrayCreationExpressionRankSpecifier :: RankSpecifier, + rankSpecifierArrayCreationExpressionInitializer :: ArrayInitializer} + deriving (Eq, Ord, Read, Show) + +_RankSpecifierArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.RankSpecifierArrayCreationExpression") + +_RankSpecifierArrayCreationExpression_rankSpecifier = (Core.Name "rankSpecifier") + +_RankSpecifierArrayCreationExpression_initializer = (Core.Name "initializer") + +data DelegateCreationExpression = + DelegateCreationExpression { + delegateCreationExpressionType :: DelegateType, + delegateCreationExpressionExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_DelegateCreationExpression = (Core.Name "hydra/ext/csharp/syntax.DelegateCreationExpression") + +_DelegateCreationExpression_type = (Core.Name "type") + +_DelegateCreationExpression_expression = (Core.Name "expression") + +newtype MemberDeclaratorList = + MemberDeclaratorList { + unMemberDeclaratorList :: [MemberDeclarator]} + deriving (Eq, Ord, Read, Show) + +_MemberDeclaratorList = (Core.Name "hydra/ext/csharp/syntax.MemberDeclaratorList") + +data MemberDeclarator = + MemberDeclaratorName SimpleName | + MemberDeclaratorMemberAccess MemberAccess | + MemberDeclaratorNullConditionalProjectionInitializer NullConditionalProjectionInitializer | + MemberDeclaratorBaseAccess BaseAccess | + MemberDeclaratorAssignment AssignmentMemberDeclarator + deriving (Eq, Ord, Read, Show) + +_MemberDeclarator = (Core.Name "hydra/ext/csharp/syntax.MemberDeclarator") + +_MemberDeclarator_name = (Core.Name "name") + +_MemberDeclarator_memberAccess = (Core.Name "memberAccess") + +_MemberDeclarator_nullConditionalProjectionInitializer = (Core.Name "nullConditionalProjectionInitializer") + +_MemberDeclarator_baseAccess = (Core.Name "baseAccess") + +_MemberDeclarator_assignment = (Core.Name "assignment") + +data AssignmentMemberDeclarator = + AssignmentMemberDeclarator { + assignmentMemberDeclaratorIdentifier :: Identifier, + assignmentMemberDeclaratorExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_AssignmentMemberDeclarator = (Core.Name "hydra/ext/csharp/syntax.AssignmentMemberDeclarator") + +_AssignmentMemberDeclarator_identifier = (Core.Name "identifier") + +_AssignmentMemberDeclarator_expression = (Core.Name "expression") + +data TypeofExpression = + TypeofExpressionType Type | + TypeofExpressionUnboundTypeName UnboundTypeName | + TypeofExpressionVoid + deriving (Eq, Ord, Read, Show) + +_TypeofExpression = (Core.Name "hydra/ext/csharp/syntax.TypeofExpression") + +_TypeofExpression_type = (Core.Name "type") + +_TypeofExpression_unboundTypeName = (Core.Name "unboundTypeName") + +_TypeofExpression_void = (Core.Name "void") + +newtype UnboundTypeName = + UnboundTypeName { + unUnboundTypeName :: [UnboundTypeNamePart]} + deriving (Eq, Ord, Read, Show) + +_UnboundTypeName = (Core.Name "hydra/ext/csharp/syntax.UnboundTypeName") + +data UnboundTypeNamePart = + UnboundTypeNamePart { + unboundTypeNamePartIdentifier :: Identifier, + unboundTypeNamePartAliased :: Bool, + unboundTypeNamePartDimension :: (Maybe Int)} + deriving (Eq, Ord, Read, Show) + +_UnboundTypeNamePart = (Core.Name "hydra/ext/csharp/syntax.UnboundTypeNamePart") + +_UnboundTypeNamePart_identifier = (Core.Name "identifier") + +_UnboundTypeNamePart_aliased = (Core.Name "aliased") + +_UnboundTypeNamePart_dimension = (Core.Name "dimension") + +data DefaultValueExpression = + DefaultValueExpressionExplicitlyTyped Type | + DefaultValueExpressionDefaultLiteral + deriving (Eq, Ord, Read, Show) + +_DefaultValueExpression = (Core.Name "hydra/ext/csharp/syntax.DefaultValueExpression") + +_DefaultValueExpression_explicitlyTyped = (Core.Name "explicitlyTyped") + +_DefaultValueExpression_defaultLiteral = (Core.Name "defaultLiteral") + +data StackallocExpression = + StackallocExpression { + stackallocExpressionType :: (Maybe UnmanagedType), + stackallocExpressionExpression :: (Maybe ConstantExpression), + stackallocExpressionInitializer :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_StackallocExpression = (Core.Name "hydra/ext/csharp/syntax.StackallocExpression") + +_StackallocExpression_type = (Core.Name "type") + +_StackallocExpression_expression = (Core.Name "expression") + +_StackallocExpression_initializer = (Core.Name "initializer") + +data NamedEntity = + NamedEntity { + namedEntityTarget :: NamedEntityTarget, + namedEntityParts :: [NamedEntityPart]} + deriving (Eq, Ord, Read, Show) + +_NamedEntity = (Core.Name "hydra/ext/csharp/syntax.NamedEntity") + +_NamedEntity_target = (Core.Name "target") + +_NamedEntity_parts = (Core.Name "parts") + +data NamedEntityPart = + NamedEntityPart { + namedEntityPartIdentifier :: Identifier, + namedEntityPartTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_NamedEntityPart = (Core.Name "hydra/ext/csharp/syntax.NamedEntityPart") + +_NamedEntityPart_identifier = (Core.Name "identifier") + +_NamedEntityPart_typeArguments = (Core.Name "typeArguments") + +data NamedEntityTarget = + NamedEntityTargetName SimpleName | + NamedEntityTargetThis | + NamedEntityTargetBase | + NamedEntityTargetPredefinedType PredefinedType | + NamedEntityTargetQualifiedAliasMember QualifiedAliasMember + deriving (Eq, Ord, Read, Show) + +_NamedEntityTarget = (Core.Name "hydra/ext/csharp/syntax.NamedEntityTarget") + +_NamedEntityTarget_name = (Core.Name "name") + +_NamedEntityTarget_this = (Core.Name "this") + +_NamedEntityTarget_base = (Core.Name "base") + +_NamedEntityTarget_predefinedType = (Core.Name "predefinedType") + +_NamedEntityTarget_qualifiedAliasMember = (Core.Name "qualifiedAliasMember") + +data UnaryExpression = + UnaryExpressionPrimary PrimaryExpression | + UnaryExpressionPlus UnaryExpression | + UnaryExpressionMinus UnaryExpression | + UnaryExpressionNot UnaryExpression | + UnaryExpressionBitwiseComplement UnaryExpression | + UnaryExpressionPreIncrement UnaryExpression | + UnaryExpressionPreDecrement UnaryExpression | + UnaryExpressionCast CastExpression | + UnaryExpressionAwait UnaryExpression | + UnaryExpressionPointerIndirection UnaryExpression | + UnaryExpressionAddressOf UnaryExpression + deriving (Eq, Ord, Read, Show) + +_UnaryExpression = (Core.Name "hydra/ext/csharp/syntax.UnaryExpression") + +_UnaryExpression_primary = (Core.Name "primary") + +_UnaryExpression_plus = (Core.Name "plus") + +_UnaryExpression_minus = (Core.Name "minus") + +_UnaryExpression_not = (Core.Name "not") + +_UnaryExpression_bitwiseComplement = (Core.Name "bitwiseComplement") + +_UnaryExpression_preIncrement = (Core.Name "preIncrement") + +_UnaryExpression_preDecrement = (Core.Name "preDecrement") + +_UnaryExpression_cast = (Core.Name "cast") + +_UnaryExpression_await = (Core.Name "await") + +_UnaryExpression_pointerIndirection = (Core.Name "pointerIndirection") + +_UnaryExpression_addressOf = (Core.Name "addressOf") + +data CastExpression = + CastExpression { + castExpressionType :: Type, + castExpressionExpression :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_CastExpression = (Core.Name "hydra/ext/csharp/syntax.CastExpression") + +_CastExpression_type = (Core.Name "type") + +_CastExpression_expression = (Core.Name "expression") + +data MultiplicativeExpression = + MultiplicativeExpressionSimple UnaryExpression | + MultiplicativeExpressionBinary BinaryMultiplicativeExpression + deriving (Eq, Ord, Read, Show) + +_MultiplicativeExpression = (Core.Name "hydra/ext/csharp/syntax.MultiplicativeExpression") + +_MultiplicativeExpression_simple = (Core.Name "simple") + +_MultiplicativeExpression_binary = (Core.Name "binary") + +data BinaryMultiplicativeExpression = + BinaryMultiplicativeExpression { + binaryMultiplicativeExpressionLeft :: MultiplicativeExpression, + binaryMultiplicativeExpressionOperator :: MultiplicativeOperator, + binaryMultiplicativeExpressionRight :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryMultiplicativeExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryMultiplicativeExpression") + +_BinaryMultiplicativeExpression_left = (Core.Name "left") + +_BinaryMultiplicativeExpression_operator = (Core.Name "operator") + +_BinaryMultiplicativeExpression_right = (Core.Name "right") + +data MultiplicativeOperator = + MultiplicativeOperatorTimes | + MultiplicativeOperatorDivide | + MultiplicativeOperatorModulo + deriving (Eq, Ord, Read, Show) + +_MultiplicativeOperator = (Core.Name "hydra/ext/csharp/syntax.MultiplicativeOperator") + +_MultiplicativeOperator_times = (Core.Name "times") + +_MultiplicativeOperator_divide = (Core.Name "divide") + +_MultiplicativeOperator_modulo = (Core.Name "modulo") + +data AdditiveExpression = + AdditiveExpressionSimple MultiplicativeExpression | + AdditiveExpressionBinary BinaryAdditiveExpression + deriving (Eq, Ord, Read, Show) + +_AdditiveExpression = (Core.Name "hydra/ext/csharp/syntax.AdditiveExpression") + +_AdditiveExpression_simple = (Core.Name "simple") + +_AdditiveExpression_binary = (Core.Name "binary") + +data BinaryAdditiveExpression = + BinaryAdditiveExpression { + binaryAdditiveExpressionLeft :: AdditiveExpression, + binaryAdditiveExpressionOperator :: AdditiveOperator, + binaryAdditiveExpressionRight :: MultiplicativeExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryAdditiveExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryAdditiveExpression") + +_BinaryAdditiveExpression_left = (Core.Name "left") + +_BinaryAdditiveExpression_operator = (Core.Name "operator") + +_BinaryAdditiveExpression_right = (Core.Name "right") + +data AdditiveOperator = + AdditiveOperatorPlus | + AdditiveOperatorMinus + deriving (Eq, Ord, Read, Show) + +_AdditiveOperator = (Core.Name "hydra/ext/csharp/syntax.AdditiveOperator") + +_AdditiveOperator_plus = (Core.Name "plus") + +_AdditiveOperator_minus = (Core.Name "minus") + +data ShiftExpression = + ShiftExpressionSimple AdditiveExpression | + ShiftExpressionBinary BinaryShiftExpression + deriving (Eq, Ord, Read, Show) + +_ShiftExpression = (Core.Name "hydra/ext/csharp/syntax.ShiftExpression") + +_ShiftExpression_simple = (Core.Name "simple") + +_ShiftExpression_binary = (Core.Name "binary") + +data BinaryShiftExpression = + BinaryShiftExpression { + binaryShiftExpressionLeft :: ShiftExpression, + binaryShiftExpressionOperator :: ShiftOperator, + binaryShiftExpressionRight :: AdditiveExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryShiftExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryShiftExpression") + +_BinaryShiftExpression_left = (Core.Name "left") + +_BinaryShiftExpression_operator = (Core.Name "operator") + +_BinaryShiftExpression_right = (Core.Name "right") + +data ShiftOperator = + ShiftOperatorLeft | + ShiftOperatorRight + deriving (Eq, Ord, Read, Show) + +_ShiftOperator = (Core.Name "hydra/ext/csharp/syntax.ShiftOperator") + +_ShiftOperator_left = (Core.Name "left") + +_ShiftOperator_right = (Core.Name "right") + +data RelationalExpression = + RelationalExpressionSimple ShiftExpression | + RelationalExpressionBinary BinaryRelationalExpression | + RelationalExpressionIsType IsTypeExpression | + RelationalExpressionIsPattern IsPatternExpression | + RelationalExpressionAsType AsTypeExpression + deriving (Eq, Ord, Read, Show) + +_RelationalExpression = (Core.Name "hydra/ext/csharp/syntax.RelationalExpression") + +_RelationalExpression_simple = (Core.Name "simple") + +_RelationalExpression_binary = (Core.Name "binary") + +_RelationalExpression_isType = (Core.Name "isType") + +_RelationalExpression_isPattern = (Core.Name "isPattern") + +_RelationalExpression_asType = (Core.Name "asType") + +data BinaryRelationalExpression = + BinaryRelationalExpression { + binaryRelationalExpressionLeft :: RelationalExpression, + binaryRelationalExpressionOperator :: RelationalOperator, + binaryRelationalExpressionRight :: ShiftExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryRelationalExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryRelationalExpression") + +_BinaryRelationalExpression_left = (Core.Name "left") + +_BinaryRelationalExpression_operator = (Core.Name "operator") + +_BinaryRelationalExpression_right = (Core.Name "right") + +data RelationalOperator = + RelationalOperatorLessThan | + RelationalOperatorGreaterThan | + RelationalOperatorLessThanOrEqual | + RelationalOperatorGreaterThanOrEqual + deriving (Eq, Ord, Read, Show) + +_RelationalOperator = (Core.Name "hydra/ext/csharp/syntax.RelationalOperator") + +_RelationalOperator_lessThan = (Core.Name "lessThan") + +_RelationalOperator_greaterThan = (Core.Name "greaterThan") + +_RelationalOperator_lessThanOrEqual = (Core.Name "lessThanOrEqual") + +_RelationalOperator_greaterThanOrEqual = (Core.Name "greaterThanOrEqual") + +data IsTypeExpression = + IsTypeExpression { + isTypeExpressionExpression :: RelationalExpression, + isTypeExpressionType :: Type} + deriving (Eq, Ord, Read, Show) + +_IsTypeExpression = (Core.Name "hydra/ext/csharp/syntax.IsTypeExpression") + +_IsTypeExpression_expression = (Core.Name "expression") + +_IsTypeExpression_type = (Core.Name "type") + +data IsPatternExpression = + IsPatternExpression { + isPatternExpressionExpression :: RelationalExpression, + isPatternExpressionPattern :: Pattern} + deriving (Eq, Ord, Read, Show) + +_IsPatternExpression = (Core.Name "hydra/ext/csharp/syntax.IsPatternExpression") + +_IsPatternExpression_expression = (Core.Name "expression") + +_IsPatternExpression_pattern = (Core.Name "pattern") + +data AsTypeExpression = + AsTypeExpression { + asTypeExpressionExpression :: RelationalExpression, + asTypeExpressionType :: Type} + deriving (Eq, Ord, Read, Show) + +_AsTypeExpression = (Core.Name "hydra/ext/csharp/syntax.AsTypeExpression") + +_AsTypeExpression_expression = (Core.Name "expression") + +_AsTypeExpression_type = (Core.Name "type") + +data EqualityExpression = + EqualityExpressionSimple RelationalExpression | + EqualityExpressionBinary BinaryEqualityExpression + deriving (Eq, Ord, Read, Show) + +_EqualityExpression = (Core.Name "hydra/ext/csharp/syntax.EqualityExpression") + +_EqualityExpression_simple = (Core.Name "simple") + +_EqualityExpression_binary = (Core.Name "binary") + +data BinaryEqualityExpression = + BinaryEqualityExpression { + binaryEqualityExpressionLeft :: EqualityExpression, + binaryEqualityExpressionOperator :: EqualityOperator, + binaryEqualityExpressionRight :: RelationalExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryEqualityExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryEqualityExpression") + +_BinaryEqualityExpression_left = (Core.Name "left") + +_BinaryEqualityExpression_operator = (Core.Name "operator") + +_BinaryEqualityExpression_right = (Core.Name "right") + +data EqualityOperator = + EqualityOperatorEqual | + EqualityOperatorNotEqual + deriving (Eq, Ord, Read, Show) + +_EqualityOperator = (Core.Name "hydra/ext/csharp/syntax.EqualityOperator") + +_EqualityOperator_equal = (Core.Name "equal") + +_EqualityOperator_notEqual = (Core.Name "notEqual") + +data AndExpression = + AndExpressionSimple EqualityExpression | + AndExpressionBinary BinaryAndExpression + deriving (Eq, Ord, Read, Show) + +_AndExpression = (Core.Name "hydra/ext/csharp/syntax.AndExpression") + +_AndExpression_simple = (Core.Name "simple") + +_AndExpression_binary = (Core.Name "binary") + +data BinaryAndExpression = + BinaryAndExpression { + binaryAndExpressionLeft :: AndExpression, + binaryAndExpressionRight :: EqualityExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryAndExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryAndExpression") + +_BinaryAndExpression_left = (Core.Name "left") + +_BinaryAndExpression_right = (Core.Name "right") + +data ExclusiveOrExpression = + ExclusiveOrExpressionSimple AndExpression | + ExclusiveOrExpressionBinary BinaryExclusiveOrExpression + deriving (Eq, Ord, Read, Show) + +_ExclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.ExclusiveOrExpression") + +_ExclusiveOrExpression_simple = (Core.Name "simple") + +_ExclusiveOrExpression_binary = (Core.Name "binary") + +data BinaryExclusiveOrExpression = + BinaryExclusiveOrExpression { + binaryExclusiveOrExpressionLeft :: ExclusiveOrExpression, + binaryExclusiveOrExpressionRight :: AndExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryExclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryExclusiveOrExpression") + +_BinaryExclusiveOrExpression_left = (Core.Name "left") + +_BinaryExclusiveOrExpression_right = (Core.Name "right") + +data InclusiveOrExpression = + InclusiveOrExpressionSimple ExclusiveOrExpression | + InclusiveOrExpressionBinary BinaryInclusiveOrExpression + deriving (Eq, Ord, Read, Show) + +_InclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.InclusiveOrExpression") + +_InclusiveOrExpression_simple = (Core.Name "simple") + +_InclusiveOrExpression_binary = (Core.Name "binary") + +data BinaryInclusiveOrExpression = + BinaryInclusiveOrExpression { + binaryInclusiveOrExpressionLeft :: InclusiveOrExpression, + binaryInclusiveOrExpressionRight :: ExclusiveOrExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryInclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryInclusiveOrExpression") + +_BinaryInclusiveOrExpression_left = (Core.Name "left") + +_BinaryInclusiveOrExpression_right = (Core.Name "right") + +data ConditionalAndExpression = + ConditionalAndExpressionSimple InclusiveOrExpression | + ConditionalAndExpressionBinary BinaryConditionalAndExpression + deriving (Eq, Ord, Read, Show) + +_ConditionalAndExpression = (Core.Name "hydra/ext/csharp/syntax.ConditionalAndExpression") + +_ConditionalAndExpression_simple = (Core.Name "simple") + +_ConditionalAndExpression_binary = (Core.Name "binary") + +data BinaryConditionalAndExpression = + BinaryConditionalAndExpression { + binaryConditionalAndExpressionLeft :: ConditionalAndExpression, + binaryConditionalAndExpressionRight :: InclusiveOrExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryConditionalAndExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryConditionalAndExpression") + +_BinaryConditionalAndExpression_left = (Core.Name "left") + +_BinaryConditionalAndExpression_right = (Core.Name "right") + +data ConditionalOrExpression = + ConditionalOrExpressionSimple ConditionalAndExpression | + ConditionalOrExpressionBinary BinaryConditionalOrExpression + deriving (Eq, Ord, Read, Show) + +_ConditionalOrExpression = (Core.Name "hydra/ext/csharp/syntax.ConditionalOrExpression") + +_ConditionalOrExpression_simple = (Core.Name "simple") + +_ConditionalOrExpression_binary = (Core.Name "binary") + +data BinaryConditionalOrExpression = + BinaryConditionalOrExpression { + binaryConditionalOrExpressionLeft :: ConditionalOrExpression, + binaryConditionalOrExpressionRight :: ConditionalAndExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryConditionalOrExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryConditionalOrExpression") + +_BinaryConditionalOrExpression_left = (Core.Name "left") + +_BinaryConditionalOrExpression_right = (Core.Name "right") + +data NullCoalescingExpression = + NullCoalescingExpressionSimple ConditionalOrExpression | + NullCoalescingExpressionBinary BinaryNullCoalescingExpression | + NullCoalescingExpressionThrow NullCoalescingExpression + deriving (Eq, Ord, Read, Show) + +_NullCoalescingExpression = (Core.Name "hydra/ext/csharp/syntax.NullCoalescingExpression") + +_NullCoalescingExpression_simple = (Core.Name "simple") + +_NullCoalescingExpression_binary = (Core.Name "binary") + +_NullCoalescingExpression_throw = (Core.Name "throw") + +data BinaryNullCoalescingExpression = + BinaryNullCoalescingExpression { + binaryNullCoalescingExpressionLeft :: ConditionalOrExpression, + binaryNullCoalescingExpressionRight :: NullCoalescingExpression} + deriving (Eq, Ord, Read, Show) + +_BinaryNullCoalescingExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryNullCoalescingExpression") + +_BinaryNullCoalescingExpression_left = (Core.Name "left") + +_BinaryNullCoalescingExpression_right = (Core.Name "right") + +data DeclarationExpression = + DeclarationExpression { + declarationExpressionType :: LocalVariableType, + declarationExpressionIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_DeclarationExpression = (Core.Name "hydra/ext/csharp/syntax.DeclarationExpression") + +_DeclarationExpression_type = (Core.Name "type") + +_DeclarationExpression_identifier = (Core.Name "identifier") + +data LocalVariableType = + LocalVariableTypeType Type | + LocalVariableTypeVar + deriving (Eq, Ord, Read, Show) + +_LocalVariableType = (Core.Name "hydra/ext/csharp/syntax.LocalVariableType") + +_LocalVariableType_type = (Core.Name "type") + +_LocalVariableType_var = (Core.Name "var") + +data ConditionalExpression = + ConditionalExpressionSimple NullCoalescingExpression | + ConditionalExpressionSimpleConditional SimpleConditionalExpression | + ConditionalExpressionRefConditional RefConditionalExpression + deriving (Eq, Ord, Read, Show) + +_ConditionalExpression = (Core.Name "hydra/ext/csharp/syntax.ConditionalExpression") + +_ConditionalExpression_simple = (Core.Name "simple") + +_ConditionalExpression_simpleConditional = (Core.Name "simpleConditional") + +_ConditionalExpression_refConditional = (Core.Name "refConditional") + +data SimpleConditionalExpression = + SimpleConditionalExpression { + simpleConditionalExpressionCondition :: NullCoalescingExpression, + simpleConditionalExpressionTrue :: Expression, + simpleConditionalExpressionFalse :: Expression} + deriving (Eq, Ord, Read, Show) + +_SimpleConditionalExpression = (Core.Name "hydra/ext/csharp/syntax.SimpleConditionalExpression") + +_SimpleConditionalExpression_condition = (Core.Name "condition") + +_SimpleConditionalExpression_true = (Core.Name "true") + +_SimpleConditionalExpression_false = (Core.Name "false") + +data RefConditionalExpression = + RefConditionalExpression { + refConditionalExpressionCondition :: NullCoalescingExpression, + refConditionalExpressionTrue :: VariableReference, + refConditionalExpressionFalse :: VariableReference} + deriving (Eq, Ord, Read, Show) + +_RefConditionalExpression = (Core.Name "hydra/ext/csharp/syntax.RefConditionalExpression") + +_RefConditionalExpression_condition = (Core.Name "condition") + +_RefConditionalExpression_true = (Core.Name "true") + +_RefConditionalExpression_false = (Core.Name "false") + +data LambdaExpression = + LambdaExpression { + lambdaExpressionAsync :: Bool, + lambdaExpressionSignature :: AnonymousFunctionSignature, + lambdaExpressionBody :: AnonymousFunctionBody} + deriving (Eq, Ord, Read, Show) + +_LambdaExpression = (Core.Name "hydra/ext/csharp/syntax.LambdaExpression") + +_LambdaExpression_async = (Core.Name "async") + +_LambdaExpression_signature = (Core.Name "signature") + +_LambdaExpression_body = (Core.Name "body") + +data AnonymousMethodExpression = + AnonymousMethodExpression { + anonymousMethodExpressionAsync :: Bool, + anonymousMethodExpressionSignature :: [ExplicitAnonymousFunctionParameter], + anonymousMethodExpressionBody :: Block} + deriving (Eq, Ord, Read, Show) + +_AnonymousMethodExpression = (Core.Name "hydra/ext/csharp/syntax.AnonymousMethodExpression") + +_AnonymousMethodExpression_async = (Core.Name "async") + +_AnonymousMethodExpression_signature = (Core.Name "signature") + +_AnonymousMethodExpression_body = (Core.Name "body") + +data AnonymousFunctionSignature = + AnonymousFunctionSignatureExplicit [ExplicitAnonymousFunctionParameter] | + AnonymousFunctionSignatureImplicit [Identifier] + deriving (Eq, Ord, Read, Show) + +_AnonymousFunctionSignature = (Core.Name "hydra/ext/csharp/syntax.AnonymousFunctionSignature") + +_AnonymousFunctionSignature_explicit = (Core.Name "explicit") + +_AnonymousFunctionSignature_implicit = (Core.Name "implicit") + +data ExplicitAnonymousFunctionParameter = + ExplicitAnonymousFunctionParameter { + explicitAnonymousFunctionParameterModifier :: (Maybe AnonymousFunctionParameterModifier), + explicitAnonymousFunctionParameterType :: Type, + explicitAnonymousFunctionParameterIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_ExplicitAnonymousFunctionParameter = (Core.Name "hydra/ext/csharp/syntax.ExplicitAnonymousFunctionParameter") + +_ExplicitAnonymousFunctionParameter_modifier = (Core.Name "modifier") + +_ExplicitAnonymousFunctionParameter_type = (Core.Name "type") + +_ExplicitAnonymousFunctionParameter_identifier = (Core.Name "identifier") + +data AnonymousFunctionParameterModifier = + AnonymousFunctionParameterModifierRef | + AnonymousFunctionParameterModifierOut | + AnonymousFunctionParameterModifierIn + deriving (Eq, Ord, Read, Show) + +_AnonymousFunctionParameterModifier = (Core.Name "hydra/ext/csharp/syntax.AnonymousFunctionParameterModifier") + +_AnonymousFunctionParameterModifier_ref = (Core.Name "ref") + +_AnonymousFunctionParameterModifier_out = (Core.Name "out") + +_AnonymousFunctionParameterModifier_in = (Core.Name "in") + +data AnonymousFunctionBody = + AnonymousFunctionBodyNullConditionalInvocation NullConditionalInvocationExpression | + AnonymousFunctionBodyExpression Expression | + AnonymousFunctionBodyRef VariableReference | + AnonymousFunctionBodyBlock Block + deriving (Eq, Ord, Read, Show) + +_AnonymousFunctionBody = (Core.Name "hydra/ext/csharp/syntax.AnonymousFunctionBody") + +_AnonymousFunctionBody_nullConditionalInvocation = (Core.Name "nullConditionalInvocation") + +_AnonymousFunctionBody_expression = (Core.Name "expression") + +_AnonymousFunctionBody_ref = (Core.Name "ref") + +_AnonymousFunctionBody_block = (Core.Name "block") + +data QueryExpression = + QueryExpression { + queryExpressionFrom :: FromClause, + queryExpressionBody :: QueryBody} + deriving (Eq, Ord, Read, Show) + +_QueryExpression = (Core.Name "hydra/ext/csharp/syntax.QueryExpression") + +_QueryExpression_from = (Core.Name "from") + +_QueryExpression_body = (Core.Name "body") + +data FromClause = + FromClause { + fromClauseType :: (Maybe Type), + fromClauseIdentifier :: Identifier, + fromClauseIn :: Expression} + deriving (Eq, Ord, Read, Show) + +_FromClause = (Core.Name "hydra/ext/csharp/syntax.FromClause") + +_FromClause_type = (Core.Name "type") + +_FromClause_identifier = (Core.Name "identifier") + +_FromClause_in = (Core.Name "in") + +data QueryBody = + QueryBody { + queryBodyClauses :: [QueryBodyClause], + queryBodySelectOrGroup :: SelectOrGroupClause, + queryBodyContinuation :: (Maybe QueryContinuation)} + deriving (Eq, Ord, Read, Show) + +_QueryBody = (Core.Name "hydra/ext/csharp/syntax.QueryBody") + +_QueryBody_clauses = (Core.Name "clauses") + +_QueryBody_selectOrGroup = (Core.Name "selectOrGroup") + +_QueryBody_continuation = (Core.Name "continuation") + +data QueryBodyClause = + QueryBodyClauseFrom FromClause | + QueryBodyClauseLet LetClause | + QueryBodyClauseWhere BooleanExpression | + QueryBodyClauseJoin JoinClause | + QueryBodyClauseOrderby [Ordering_] + deriving (Eq, Ord, Read, Show) + +_QueryBodyClause = (Core.Name "hydra/ext/csharp/syntax.QueryBodyClause") + +_QueryBodyClause_from = (Core.Name "from") + +_QueryBodyClause_let = (Core.Name "let") + +_QueryBodyClause_where = (Core.Name "where") + +_QueryBodyClause_join = (Core.Name "join") + +_QueryBodyClause_orderby = (Core.Name "orderby") + +data LetClause = + LetClause { + letClauseLeft :: Identifier, + letClauseRight :: Expression} + deriving (Eq, Ord, Read, Show) + +_LetClause = (Core.Name "hydra/ext/csharp/syntax.LetClause") + +_LetClause_left = (Core.Name "left") + +_LetClause_right = (Core.Name "right") + +data JoinClause = + JoinClause { + joinClauseType :: (Maybe Type), + joinClauseIdentifier :: Identifier, + joinClauseIn :: Expression, + joinClauseOn :: Expression, + joinClauseEquals :: Expression, + joinClauseInto :: (Maybe Identifier)} + deriving (Eq, Ord, Read, Show) + +_JoinClause = (Core.Name "hydra/ext/csharp/syntax.JoinClause") + +_JoinClause_type = (Core.Name "type") + +_JoinClause_identifier = (Core.Name "identifier") + +_JoinClause_in = (Core.Name "in") + +_JoinClause_on = (Core.Name "on") + +_JoinClause_equals = (Core.Name "equals") + +_JoinClause_into = (Core.Name "into") + +data Ordering_ = + Ordering_ { + orderingExpression :: Expression, + orderingDirection :: (Maybe OrderingDirection)} + deriving (Eq, Ord, Read, Show) + +_Ordering = (Core.Name "hydra/ext/csharp/syntax.Ordering") + +_Ordering_expression = (Core.Name "expression") + +_Ordering_direction = (Core.Name "direction") + +data OrderingDirection = + OrderingDirectionAscending | + OrderingDirectionDescending + deriving (Eq, Ord, Read, Show) + +_OrderingDirection = (Core.Name "hydra/ext/csharp/syntax.OrderingDirection") + +_OrderingDirection_ascending = (Core.Name "ascending") + +_OrderingDirection_descending = (Core.Name "descending") + +data SelectOrGroupClause = + SelectOrGroupClauseSelect Expression | + SelectOrGroupClauseGroup GroupClause + deriving (Eq, Ord, Read, Show) + +_SelectOrGroupClause = (Core.Name "hydra/ext/csharp/syntax.SelectOrGroupClause") + +_SelectOrGroupClause_select = (Core.Name "select") + +_SelectOrGroupClause_group = (Core.Name "group") + +data GroupClause = + GroupClause { + groupClauseGrouped :: Expression, + groupClauseBy :: Expression} + deriving (Eq, Ord, Read, Show) + +_GroupClause = (Core.Name "hydra/ext/csharp/syntax.GroupClause") + +_GroupClause_grouped = (Core.Name "grouped") + +_GroupClause_by = (Core.Name "by") + +data QueryContinuation = + QueryContinuation { + queryContinuationInto :: Identifier, + queryContinuationBody :: QueryBody} + deriving (Eq, Ord, Read, Show) + +_QueryContinuation = (Core.Name "hydra/ext/csharp/syntax.QueryContinuation") + +_QueryContinuation_into = (Core.Name "into") + +_QueryContinuation_body = (Core.Name "body") + +data Assignment = + Assignment { + assignmentLeft :: UnaryExpression, + assignmentOperator :: AssignmentOperator, + assignmentRight :: Expression} + deriving (Eq, Ord, Read, Show) + +_Assignment = (Core.Name "hydra/ext/csharp/syntax.Assignment") + +_Assignment_left = (Core.Name "left") + +_Assignment_operator = (Core.Name "operator") + +_Assignment_right = (Core.Name "right") + +data AssignmentOperator = + AssignmentOperatorSimple Bool | + AssignmentOperatorPlusEquals | + AssignmentOperatorMinusEquals | + AssignmentOperatorTimesEquals | + AssignmentOperatorDivideEquals | + AssignmentOperatorModEquals | + AssignmentOperatorAndEquals | + AssignmentOperatorOrEquals | + AssignmentOperatorXorEquals | + AssignmentOperatorLeftShiftEquals | + AssignmentOperatorRightShiftEquals + deriving (Eq, Ord, Read, Show) + +_AssignmentOperator = (Core.Name "hydra/ext/csharp/syntax.AssignmentOperator") + +_AssignmentOperator_simple = (Core.Name "simple") + +_AssignmentOperator_plusEquals = (Core.Name "plusEquals") + +_AssignmentOperator_minusEquals = (Core.Name "minusEquals") + +_AssignmentOperator_timesEquals = (Core.Name "timesEquals") + +_AssignmentOperator_divideEquals = (Core.Name "divideEquals") + +_AssignmentOperator_modEquals = (Core.Name "modEquals") + +_AssignmentOperator_andEquals = (Core.Name "andEquals") + +_AssignmentOperator_orEquals = (Core.Name "orEquals") + +_AssignmentOperator_xorEquals = (Core.Name "xorEquals") + +_AssignmentOperator_leftShiftEquals = (Core.Name "leftShiftEquals") + +_AssignmentOperator_rightShiftEquals = (Core.Name "rightShiftEquals") + +data Expression = + ExpressionNonAssignment NonAssignmentExpression | + ExpressionAssignment Assignment + deriving (Eq, Ord, Read, Show) + +_Expression = (Core.Name "hydra/ext/csharp/syntax.Expression") + +_Expression_nonAssignment = (Core.Name "nonAssignment") + +_Expression_assignment = (Core.Name "assignment") + +data NonAssignmentExpression = + NonAssignmentExpressionDeclaration DeclarationExpression | + NonAssignmentExpressionConditional ConditionalExpression | + NonAssignmentExpressionLambda LambdaExpression | + NonAssignmentExpressionQuery QueryExpression + deriving (Eq, Ord, Read, Show) + +_NonAssignmentExpression = (Core.Name "hydra/ext/csharp/syntax.NonAssignmentExpression") + +_NonAssignmentExpression_declaration = (Core.Name "declaration") + +_NonAssignmentExpression_conditional = (Core.Name "conditional") + +_NonAssignmentExpression_lambda = (Core.Name "lambda") + +_NonAssignmentExpression_query = (Core.Name "query") + +newtype ConstantExpression = + ConstantExpression { + unConstantExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_ConstantExpression = (Core.Name "hydra/ext/csharp/syntax.ConstantExpression") + +newtype BooleanExpression = + BooleanExpression { + unBooleanExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_BooleanExpression = (Core.Name "hydra/ext/csharp/syntax.BooleanExpression") + +data Statement = + StatementLabeled LabeledStatement | + StatementDeclaration DeclarationStatement | + StatementEmbedded EmbeddedStatement + deriving (Eq, Ord, Read, Show) + +_Statement = (Core.Name "hydra/ext/csharp/syntax.Statement") + +_Statement_labeled = (Core.Name "labeled") + +_Statement_declaration = (Core.Name "declaration") + +_Statement_embedded = (Core.Name "embedded") + +data EmbeddedStatement = + EmbeddedStatementBlock Block | + EmbeddedStatementEmpty | + EmbeddedStatementExpression StatementExpression | + EmbeddedStatementSelection SelectionStatement | + EmbeddedStatementIteration IterationStatement | + EmbeddedStatementJump JumpStatement | + EmbeddedStatementTry TryStatement | + EmbeddedStatementChecked Block | + EmbeddedStatementUnchecked Block | + EmbeddedStatementLock LockStatement | + EmbeddedStatementUsing UsingStatement | + EmbeddedStatementYield YieldStatement | + EmbeddedStatementUnsafe Block | + EmbeddedStatementFixed FixedStatement + deriving (Eq, Ord, Read, Show) + +_EmbeddedStatement = (Core.Name "hydra/ext/csharp/syntax.EmbeddedStatement") + +_EmbeddedStatement_block = (Core.Name "block") + +_EmbeddedStatement_empty = (Core.Name "empty") + +_EmbeddedStatement_expression = (Core.Name "expression") + +_EmbeddedStatement_selection = (Core.Name "selection") + +_EmbeddedStatement_iteration = (Core.Name "iteration") + +_EmbeddedStatement_jump = (Core.Name "jump") + +_EmbeddedStatement_try = (Core.Name "try") + +_EmbeddedStatement_checked = (Core.Name "checked") + +_EmbeddedStatement_unchecked = (Core.Name "unchecked") + +_EmbeddedStatement_lock = (Core.Name "lock") + +_EmbeddedStatement_using = (Core.Name "using") + +_EmbeddedStatement_yield = (Core.Name "yield") + +_EmbeddedStatement_unsafe = (Core.Name "unsafe") + +_EmbeddedStatement_fixed = (Core.Name "fixed") + +newtype Block = + Block { + unBlock :: [Statement]} + deriving (Eq, Ord, Read, Show) + +_Block = (Core.Name "hydra/ext/csharp/syntax.Block") + +data LabeledStatement = + LabeledStatement { + labeledStatementLabel :: Identifier, + labeledStatementStatement :: Statement} + deriving (Eq, Ord, Read, Show) + +_LabeledStatement = (Core.Name "hydra/ext/csharp/syntax.LabeledStatement") + +_LabeledStatement_label = (Core.Name "label") + +_LabeledStatement_statement = (Core.Name "statement") + +data DeclarationStatement = + DeclarationStatementVariable LocalVariableDeclaration | + DeclarationStatementConstant LocalConstantDeclaration | + DeclarationStatementFunction LocalFunctionDeclaration + deriving (Eq, Ord, Read, Show) + +_DeclarationStatement = (Core.Name "hydra/ext/csharp/syntax.DeclarationStatement") + +_DeclarationStatement_variable = (Core.Name "variable") + +_DeclarationStatement_constant = (Core.Name "constant") + +_DeclarationStatement_function = (Core.Name "function") + +data LocalVariableDeclaration = + LocalVariableDeclarationImplicitlyTyped ImplicitlyTypedLocalVariableDeclaration | + LocalVariableDeclarationExplicitlyTyped ExplicitlyTypedLocalVariableDeclaration | + LocalVariableDeclarationRef RefLocalVariableDeclaration + deriving (Eq, Ord, Read, Show) + +_LocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.LocalVariableDeclaration") + +_LocalVariableDeclaration_implicitlyTyped = (Core.Name "implicitlyTyped") + +_LocalVariableDeclaration_explicitlyTyped = (Core.Name "explicitlyTyped") + +_LocalVariableDeclaration_ref = (Core.Name "ref") + +data ImplicitlyTypedLocalVariableDeclaration = + ImplicitlyTypedLocalVariableDeclarationVar ImplicitlyTypedLocalVariableDeclarator | + ImplicitlyTypedLocalVariableDeclarationRefVar RefVarImplicitlyTypedLocalVariableDeclaration + deriving (Eq, Ord, Read, Show) + +_ImplicitlyTypedLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.ImplicitlyTypedLocalVariableDeclaration") + +_ImplicitlyTypedLocalVariableDeclaration_var = (Core.Name "var") + +_ImplicitlyTypedLocalVariableDeclaration_refVar = (Core.Name "refVar") + +data RefVarImplicitlyTypedLocalVariableDeclaration = + RefVarImplicitlyTypedLocalVariableDeclaration { + refVarImplicitlyTypedLocalVariableDeclarationRefKind :: RefKind, + refVarImplicitlyTypedLocalVariableDeclarationDeclarator :: RefLocalVariableDeclarator} + deriving (Eq, Ord, Read, Show) + +_RefVarImplicitlyTypedLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefVarImplicitlyTypedLocalVariableDeclaration") + +_RefVarImplicitlyTypedLocalVariableDeclaration_refKind = (Core.Name "refKind") + +_RefVarImplicitlyTypedLocalVariableDeclaration_declarator = (Core.Name "declarator") + +data ImplicitlyTypedLocalVariableDeclarator = + ImplicitlyTypedLocalVariableDeclarator { + implicitlyTypedLocalVariableDeclaratorIdentifier :: Identifier, + implicitlyTypedLocalVariableDeclaratorExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_ImplicitlyTypedLocalVariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.ImplicitlyTypedLocalVariableDeclarator") + +_ImplicitlyTypedLocalVariableDeclarator_identifier = (Core.Name "identifier") + +_ImplicitlyTypedLocalVariableDeclarator_expression = (Core.Name "expression") + +data ExplicitlyTypedLocalVariableDeclaration = + ExplicitlyTypedLocalVariableDeclaration { + explicitlyTypedLocalVariableDeclarationType :: Type, + explicitlyTypedLocalVariableDeclarationDeclarators :: [ExplicitlyTypedLocalVariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_ExplicitlyTypedLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.ExplicitlyTypedLocalVariableDeclaration") + +_ExplicitlyTypedLocalVariableDeclaration_type = (Core.Name "type") + +_ExplicitlyTypedLocalVariableDeclaration_declarators = (Core.Name "declarators") + +data ExplicitlyTypedLocalVariableDeclarator = + ExplicitlyTypedLocalVariableDeclarator { + explicitlyTypedLocalVariableDeclaratorIdentifier :: Identifier, + explicitlyTypedLocalVariableDeclaratorInitializer :: (Maybe LocalVariableInitializer)} + deriving (Eq, Ord, Read, Show) + +_ExplicitlyTypedLocalVariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.ExplicitlyTypedLocalVariableDeclarator") + +_ExplicitlyTypedLocalVariableDeclarator_identifier = (Core.Name "identifier") + +_ExplicitlyTypedLocalVariableDeclarator_initializer = (Core.Name "initializer") + +data LocalVariableInitializer = + LocalVariableInitializerExpression Expression | + LocalVariableInitializerInitializer ArrayInitializer + deriving (Eq, Ord, Read, Show) + +_LocalVariableInitializer = (Core.Name "hydra/ext/csharp/syntax.LocalVariableInitializer") + +_LocalVariableInitializer_expression = (Core.Name "expression") + +_LocalVariableInitializer_initializer = (Core.Name "initializer") + +data RefLocalVariableDeclaration = + RefLocalVariableDeclaration { + refLocalVariableDeclarationRefKind :: RefKind, + refLocalVariableDeclarationType :: Type, + refLocalVariableDeclarationDeclarators :: [RefLocalVariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_RefLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefLocalVariableDeclaration") + +_RefLocalVariableDeclaration_refKind = (Core.Name "refKind") + +_RefLocalVariableDeclaration_type = (Core.Name "type") + +_RefLocalVariableDeclaration_declarators = (Core.Name "declarators") + +data RefLocalVariableDeclarator = + RefLocalVariableDeclarator { + refLocalVariableDeclaratorLeft :: Identifier, + refLocalVariableDeclaratorRight :: VariableReference} + deriving (Eq, Ord, Read, Show) + +_RefLocalVariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.RefLocalVariableDeclarator") + +_RefLocalVariableDeclarator_left = (Core.Name "left") + +_RefLocalVariableDeclarator_right = (Core.Name "right") + +data LocalConstantDeclaration = + LocalConstantDeclaration { + localConstantDeclarationType :: Type, + localConstantDeclarationDeclarators :: [ConstantDeclarator]} + deriving (Eq, Ord, Read, Show) + +_LocalConstantDeclaration = (Core.Name "hydra/ext/csharp/syntax.LocalConstantDeclaration") + +_LocalConstantDeclaration_type = (Core.Name "type") + +_LocalConstantDeclaration_declarators = (Core.Name "declarators") + +data ConstantDeclarator = + ConstantDeclarator { + constantDeclaratorIdentifier :: Identifier, + constantDeclaratorExpression :: ConstantExpression} + deriving (Eq, Ord, Read, Show) + +_ConstantDeclarator = (Core.Name "hydra/ext/csharp/syntax.ConstantDeclarator") + +_ConstantDeclarator_identifier = (Core.Name "identifier") + +_ConstantDeclarator_expression = (Core.Name "expression") + +data LocalFunctionDeclaration = + LocalFunctionDeclarationStandard StandardLocalFunctionDeclaration | + LocalFunctionDeclarationRef RefLocalFunctionDeclaration + deriving (Eq, Ord, Read, Show) + +_LocalFunctionDeclaration = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionDeclaration") + +_LocalFunctionDeclaration_standard = (Core.Name "standard") + +_LocalFunctionDeclaration_ref = (Core.Name "ref") + +data StandardLocalFunctionDeclaration = + StandardLocalFunctionDeclaration { + standardLocalFunctionDeclarationModifiers :: [LocalFunctionModifier], + standardLocalFunctionDeclarationReturnType :: ReturnType, + standardLocalFunctionDeclarationHeader :: LocalFunctionHeader, + standardLocalFunctionDeclarationBody :: LocalFunctionBody} + deriving (Eq, Ord, Read, Show) + +_StandardLocalFunctionDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardLocalFunctionDeclaration") + +_StandardLocalFunctionDeclaration_modifiers = (Core.Name "modifiers") + +_StandardLocalFunctionDeclaration_returnType = (Core.Name "returnType") + +_StandardLocalFunctionDeclaration_header = (Core.Name "header") + +_StandardLocalFunctionDeclaration_body = (Core.Name "body") + +data RefLocalFunctionDeclaration = + RefLocalFunctionDeclaration { + refLocalFunctionDeclarationModifiers :: [RefLocalFunctionModifier], + refLocalFunctionDeclarationRefKind :: RefKind, + refLocalFunctionDeclarationReturnType :: Type, + refLocalFunctionDeclarationHeader :: LocalFunctionHeader, + refLocalFunctionDeclarationBody :: RefLocalFunctionBody} + deriving (Eq, Ord, Read, Show) + +_RefLocalFunctionDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefLocalFunctionDeclaration") + +_RefLocalFunctionDeclaration_modifiers = (Core.Name "modifiers") + +_RefLocalFunctionDeclaration_refKind = (Core.Name "refKind") + +_RefLocalFunctionDeclaration_returnType = (Core.Name "returnType") + +_RefLocalFunctionDeclaration_header = (Core.Name "header") + +_RefLocalFunctionDeclaration_body = (Core.Name "body") + +data LocalFunctionHeader = + LocalFunctionHeader { + localFunctionHeaderIdentifier :: Identifier, + localFunctionHeaderTypeParameters :: (Maybe TypeParameterList), + localFunctionHeaderParameters :: FormalParameterList, + localFunctionHeaderConstraints :: [TypeParameterConstraintsClause]} + deriving (Eq, Ord, Read, Show) + +_LocalFunctionHeader = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionHeader") + +_LocalFunctionHeader_identifier = (Core.Name "identifier") + +_LocalFunctionHeader_typeParameters = (Core.Name "typeParameters") + +_LocalFunctionHeader_parameters = (Core.Name "parameters") + +_LocalFunctionHeader_constraints = (Core.Name "constraints") + +data LocalFunctionModifier = + LocalFunctionModifierRef RefLocalFunctionModifier | + LocalFunctionModifierAsync + deriving (Eq, Ord, Read, Show) + +_LocalFunctionModifier = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionModifier") + +_LocalFunctionModifier_ref = (Core.Name "ref") + +_LocalFunctionModifier_async = (Core.Name "async") + +data RefLocalFunctionModifier = + RefLocalFunctionModifierStatic | + RefLocalFunctionModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_RefLocalFunctionModifier = (Core.Name "hydra/ext/csharp/syntax.RefLocalFunctionModifier") + +_RefLocalFunctionModifier_static = (Core.Name "static") + +_RefLocalFunctionModifier_unsafe = (Core.Name "unsafe") + +data LocalFunctionBody = + LocalFunctionBodyBlock Block | + LocalFunctionBodyNullConditionalInvocation NullConditionalInvocationExpression | + LocalFunctionBodyExpression Expression + deriving (Eq, Ord, Read, Show) + +_LocalFunctionBody = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionBody") + +_LocalFunctionBody_block = (Core.Name "block") + +_LocalFunctionBody_nullConditionalInvocation = (Core.Name "nullConditionalInvocation") + +_LocalFunctionBody_expression = (Core.Name "expression") + +data RefLocalFunctionBody = + RefLocalFunctionBodyBlock Block | + RefLocalFunctionBodyRef VariableReference + deriving (Eq, Ord, Read, Show) + +_RefLocalFunctionBody = (Core.Name "hydra/ext/csharp/syntax.RefLocalFunctionBody") + +_RefLocalFunctionBody_block = (Core.Name "block") + +_RefLocalFunctionBody_ref = (Core.Name "ref") + +data StatementExpression = + StatementExpressionNullConditionalInvocation NullConditionalInvocationExpression | + StatementExpressionInvocation InvocationExpression | + StatementExpressionObjectCreation ObjectCreationExpression | + StatementExpressionAssignment Assignment | + StatementExpressionPostIncrement PrimaryExpression | + StatementExpressionPostDecrement PrimaryExpression | + StatementExpressionPreIncrement UnaryExpression | + StatementExpressionPreDecrement UnaryExpression | + StatementExpressionAwait UnaryExpression + deriving (Eq, Ord, Read, Show) + +_StatementExpression = (Core.Name "hydra/ext/csharp/syntax.StatementExpression") + +_StatementExpression_nullConditionalInvocation = (Core.Name "nullConditionalInvocation") + +_StatementExpression_invocation = (Core.Name "invocation") + +_StatementExpression_objectCreation = (Core.Name "objectCreation") + +_StatementExpression_assignment = (Core.Name "assignment") + +_StatementExpression_postIncrement = (Core.Name "postIncrement") + +_StatementExpression_postDecrement = (Core.Name "postDecrement") + +_StatementExpression_preIncrement = (Core.Name "preIncrement") + +_StatementExpression_preDecrement = (Core.Name "preDecrement") + +_StatementExpression_await = (Core.Name "await") + +data SelectionStatement = + SelectionStatementIf IfStatement | + SelectionStatementSwitch SwitchStatement + deriving (Eq, Ord, Read, Show) + +_SelectionStatement = (Core.Name "hydra/ext/csharp/syntax.SelectionStatement") + +_SelectionStatement_if = (Core.Name "if") + +_SelectionStatement_switch = (Core.Name "switch") + +data IfStatement = + IfStatement { + ifStatementCondition :: BooleanExpression, + ifStatementIfBranch :: EmbeddedStatement, + ifStatementElseBranch :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_IfStatement = (Core.Name "hydra/ext/csharp/syntax.IfStatement") + +_IfStatement_condition = (Core.Name "condition") + +_IfStatement_ifBranch = (Core.Name "ifBranch") + +_IfStatement_elseBranch = (Core.Name "elseBranch") + +data SwitchStatement = + SwitchStatement { + switchStatementExpression :: Expression, + switchStatementBranches :: [SwitchSection]} + deriving (Eq, Ord, Read, Show) + +_SwitchStatement = (Core.Name "hydra/ext/csharp/syntax.SwitchStatement") + +_SwitchStatement_expression = (Core.Name "expression") + +_SwitchStatement_branches = (Core.Name "branches") + +data SwitchSection = + SwitchSection { + switchSectionLabels :: [SwitchLabel], + switchSectionStatements :: [Statement]} + deriving (Eq, Ord, Read, Show) + +_SwitchSection = (Core.Name "hydra/ext/csharp/syntax.SwitchSection") + +_SwitchSection_labels = (Core.Name "labels") + +_SwitchSection_statements = (Core.Name "statements") + +data SwitchLabel = + SwitchLabelBranch SwitchBranch | + SwitchLabelDefault + deriving (Eq, Ord, Read, Show) + +_SwitchLabel = (Core.Name "hydra/ext/csharp/syntax.SwitchLabel") + +_SwitchLabel_branch = (Core.Name "branch") + +_SwitchLabel_default = (Core.Name "default") + +data SwitchBranch = + SwitchBranch { + switchBranchPattern :: Pattern, + switchBranchGuard :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_SwitchBranch = (Core.Name "hydra/ext/csharp/syntax.SwitchBranch") + +_SwitchBranch_pattern = (Core.Name "pattern") + +_SwitchBranch_guard = (Core.Name "guard") + +data IterationStatement = + IterationStatementWhile WhileStatement | + IterationStatementDo DoStatement | + IterationStatementFor ForStatement | + IterationStatementForeach ForeachStatement + deriving (Eq, Ord, Read, Show) + +_IterationStatement = (Core.Name "hydra/ext/csharp/syntax.IterationStatement") + +_IterationStatement_while = (Core.Name "while") + +_IterationStatement_do = (Core.Name "do") + +_IterationStatement_for = (Core.Name "for") + +_IterationStatement_foreach = (Core.Name "foreach") + +data WhileStatement = + WhileStatement { + whileStatementCondition :: BooleanExpression, + whileStatementBody :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_WhileStatement = (Core.Name "hydra/ext/csharp/syntax.WhileStatement") + +_WhileStatement_condition = (Core.Name "condition") + +_WhileStatement_body = (Core.Name "body") + +data DoStatement = + DoStatement { + doStatementBody :: EmbeddedStatement, + doStatementWhile :: BooleanExpression} + deriving (Eq, Ord, Read, Show) + +_DoStatement = (Core.Name "hydra/ext/csharp/syntax.DoStatement") + +_DoStatement_body = (Core.Name "body") + +_DoStatement_while = (Core.Name "while") + +data ForStatement = + ForStatement { + forStatementInitializer :: (Maybe ForInitializer), + forStatementCondition :: (Maybe BooleanExpression), + forStatementIterator :: (Maybe StatementExpressionList), + forStatementBody :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_ForStatement = (Core.Name "hydra/ext/csharp/syntax.ForStatement") + +_ForStatement_initializer = (Core.Name "initializer") + +_ForStatement_condition = (Core.Name "condition") + +_ForStatement_iterator = (Core.Name "iterator") + +_ForStatement_body = (Core.Name "body") + +data ForInitializer = + ForInitializerVariable LocalVariableDeclaration | + ForInitializerStatements StatementExpressionList + deriving (Eq, Ord, Read, Show) + +_ForInitializer = (Core.Name "hydra/ext/csharp/syntax.ForInitializer") + +_ForInitializer_variable = (Core.Name "variable") + +_ForInitializer_statements = (Core.Name "statements") + +newtype StatementExpressionList = + StatementExpressionList { + unStatementExpressionList :: [StatementExpression]} + deriving (Eq, Ord, Read, Show) + +_StatementExpressionList = (Core.Name "hydra/ext/csharp/syntax.StatementExpressionList") + +data ForeachStatement = + ForeachStatement { + foreachStatementKind :: (Maybe RefKind), + foreachStatementType :: LocalVariableType, + foreachStatementIdentifier :: Identifier, + foreachStatementExpression :: Expression, + foreachStatementBody :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_ForeachStatement = (Core.Name "hydra/ext/csharp/syntax.ForeachStatement") + +_ForeachStatement_kind = (Core.Name "kind") + +_ForeachStatement_type = (Core.Name "type") + +_ForeachStatement_identifier = (Core.Name "identifier") + +_ForeachStatement_expression = (Core.Name "expression") + +_ForeachStatement_body = (Core.Name "body") + +data JumpStatement = + JumpStatementBreak | + JumpStatementContinue | + JumpStatementGoto GotoStatement | + JumpStatementReturn ReturnStatement | + JumpStatementThrow (Maybe Expression) + deriving (Eq, Ord, Read, Show) + +_JumpStatement = (Core.Name "hydra/ext/csharp/syntax.JumpStatement") + +_JumpStatement_break = (Core.Name "break") + +_JumpStatement_continue = (Core.Name "continue") + +_JumpStatement_goto = (Core.Name "goto") + +_JumpStatement_return = (Core.Name "return") + +_JumpStatement_throw = (Core.Name "throw") + +data GotoStatement = + GotoStatementIdentifier Identifier | + GotoStatementCase ConstantExpression | + GotoStatementDefault + deriving (Eq, Ord, Read, Show) + +_GotoStatement = (Core.Name "hydra/ext/csharp/syntax.GotoStatement") + +_GotoStatement_identifier = (Core.Name "identifier") + +_GotoStatement_case = (Core.Name "case") + +_GotoStatement_default = (Core.Name "default") + +data ReturnStatement = + ReturnStatementSimple | + ReturnStatementValue Expression | + ReturnStatementRef VariableReference + deriving (Eq, Ord, Read, Show) + +_ReturnStatement = (Core.Name "hydra/ext/csharp/syntax.ReturnStatement") + +_ReturnStatement_simple = (Core.Name "simple") + +_ReturnStatement_value = (Core.Name "value") + +_ReturnStatement_ref = (Core.Name "ref") + +data TryStatement = + TryStatement { + tryStatementBody :: Block, + tryStatementCatches :: CatchClauses, + tryStatementFinally :: (Maybe Block)} + deriving (Eq, Ord, Read, Show) + +_TryStatement = (Core.Name "hydra/ext/csharp/syntax.TryStatement") + +_TryStatement_body = (Core.Name "body") + +_TryStatement_catches = (Core.Name "catches") + +_TryStatement_finally = (Core.Name "finally") + +data CatchClauses = + CatchClausesSpecific [SpecificCatchClause] | + CatchClausesGeneral Block + deriving (Eq, Ord, Read, Show) + +_CatchClauses = (Core.Name "hydra/ext/csharp/syntax.CatchClauses") + +_CatchClauses_specific = (Core.Name "specific") + +_CatchClauses_general = (Core.Name "general") + +data SpecificCatchClause = + SpecificCatchClause { + specificCatchClauseSpecifier :: (Maybe ExceptionSpecifier), + specificCatchClauseFilter :: (Maybe BooleanExpression), + specificCatchClauseBody :: Block} + deriving (Eq, Ord, Read, Show) + +_SpecificCatchClause = (Core.Name "hydra/ext/csharp/syntax.SpecificCatchClause") + +_SpecificCatchClause_specifier = (Core.Name "specifier") + +_SpecificCatchClause_filter = (Core.Name "filter") + +_SpecificCatchClause_body = (Core.Name "body") + +data ExceptionSpecifier = + ExceptionSpecifier { + exceptionSpecifierType :: Type, + exceptionSpecifierIdentifier :: (Maybe Identifier)} + deriving (Eq, Ord, Read, Show) + +_ExceptionSpecifier = (Core.Name "hydra/ext/csharp/syntax.ExceptionSpecifier") + +_ExceptionSpecifier_type = (Core.Name "type") + +_ExceptionSpecifier_identifier = (Core.Name "identifier") + +data LockStatement = + LockStatement { + lockStatementExpression :: Expression, + lockStatementBody :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_LockStatement = (Core.Name "hydra/ext/csharp/syntax.LockStatement") + +_LockStatement_expression = (Core.Name "expression") + +_LockStatement_body = (Core.Name "body") + +data UsingStatement = + UsingStatement { + usingStatementAcquisition :: ResourceAcquisition, + usingStatementBody :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_UsingStatement = (Core.Name "hydra/ext/csharp/syntax.UsingStatement") + +_UsingStatement_acquisition = (Core.Name "acquisition") + +_UsingStatement_body = (Core.Name "body") + +data ResourceAcquisition = + ResourceAcquisitionLocal LocalVariableDeclaration | + ResourceAcquisitionExpression Expression + deriving (Eq, Ord, Read, Show) + +_ResourceAcquisition = (Core.Name "hydra/ext/csharp/syntax.ResourceAcquisition") + +_ResourceAcquisition_local = (Core.Name "local") + +_ResourceAcquisition_expression = (Core.Name "expression") + +data YieldStatement = + YieldStatementReturn Expression | + YieldStatementBreak + deriving (Eq, Ord, Read, Show) + +_YieldStatement = (Core.Name "hydra/ext/csharp/syntax.YieldStatement") + +_YieldStatement_return = (Core.Name "return") + +_YieldStatement_break = (Core.Name "break") + +data CompilationUnit = + CompilationUnit { + compilationUnitExterns :: [Identifier], + compilationUnitUsings :: [UsingDirective], + compilationUnitAttributes :: [GlobalAttributeSection], + compilationUnitMembers :: [NamespaceMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_CompilationUnit = (Core.Name "hydra/ext/csharp/syntax.CompilationUnit") + +_CompilationUnit_externs = (Core.Name "externs") + +_CompilationUnit_usings = (Core.Name "usings") + +_CompilationUnit_attributes = (Core.Name "attributes") + +_CompilationUnit_members = (Core.Name "members") + +data NamespaceDeclaration = + NamespaceDeclaration { + namespaceDeclarationName :: [Identifier], + namespaceDeclarationBody :: NamespaceBody} + deriving (Eq, Ord, Read, Show) + +_NamespaceDeclaration = (Core.Name "hydra/ext/csharp/syntax.NamespaceDeclaration") + +_NamespaceDeclaration_name = (Core.Name "name") + +_NamespaceDeclaration_body = (Core.Name "body") + +data NamespaceBody = + NamespaceBody { + namespaceBodyExterns :: [Identifier], + namespaceBodyUsings :: [UsingDirective], + namespaceBodyMembers :: [NamespaceMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_NamespaceBody = (Core.Name "hydra/ext/csharp/syntax.NamespaceBody") + +_NamespaceBody_externs = (Core.Name "externs") + +_NamespaceBody_usings = (Core.Name "usings") + +_NamespaceBody_members = (Core.Name "members") + +data UsingDirective = + UsingDirectiveAlias UsingAliasDirective | + UsingDirectiveNamespace NamespaceName | + UsingDirectiveStatic TypeName + deriving (Eq, Ord, Read, Show) + +_UsingDirective = (Core.Name "hydra/ext/csharp/syntax.UsingDirective") + +_UsingDirective_alias = (Core.Name "alias") + +_UsingDirective_namespace = (Core.Name "namespace") + +_UsingDirective_static = (Core.Name "static") + +data UsingAliasDirective = + UsingAliasDirective { + usingAliasDirectiveAlias :: Identifier, + usingAliasDirectiveName :: NamespaceOrTypeName} + deriving (Eq, Ord, Read, Show) + +_UsingAliasDirective = (Core.Name "hydra/ext/csharp/syntax.UsingAliasDirective") + +_UsingAliasDirective_alias = (Core.Name "alias") + +_UsingAliasDirective_name = (Core.Name "name") + +data NamespaceMemberDeclaration = + NamespaceMemberDeclarationNamespace NamespaceDeclaration | + NamespaceMemberDeclarationType TypeDeclaration + deriving (Eq, Ord, Read, Show) + +_NamespaceMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.NamespaceMemberDeclaration") + +_NamespaceMemberDeclaration_namespace = (Core.Name "namespace") + +_NamespaceMemberDeclaration_type = (Core.Name "type") + +data TypeDeclaration = + TypeDeclarationClass ClassDeclaration | + TypeDeclarationStruct StructDeclaration | + TypeDeclarationInterface InterfaceDeclaration | + TypeDeclarationEnum EnumDeclaration | + TypeDeclarationDelegate DelegateDeclaration + deriving (Eq, Ord, Read, Show) + +_TypeDeclaration = (Core.Name "hydra/ext/csharp/syntax.TypeDeclaration") + +_TypeDeclaration_class = (Core.Name "class") + +_TypeDeclaration_struct = (Core.Name "struct") + +_TypeDeclaration_interface = (Core.Name "interface") + +_TypeDeclaration_enum = (Core.Name "enum") + +_TypeDeclaration_delegate = (Core.Name "delegate") + +data QualifiedAliasMember = + QualifiedAliasMember { + qualifiedAliasMemberAlias :: Identifier, + qualifiedAliasMemberMember :: Identifier, + qualifiedAliasMemberArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_QualifiedAliasMember = (Core.Name "hydra/ext/csharp/syntax.QualifiedAliasMember") + +_QualifiedAliasMember_alias = (Core.Name "alias") + +_QualifiedAliasMember_member = (Core.Name "member") + +_QualifiedAliasMember_arguments = (Core.Name "arguments") + +data ClassDeclaration = + ClassDeclaration { + classDeclarationAttributes :: (Maybe Attributes), + classDeclarationModifiers :: [ClassModifier], + classDeclarationPartial :: (), + classDeclarationName :: Identifier, + classDeclarationParameters :: (Maybe TypeParameterList), + classDeclarationBase :: (Maybe ClassBase), + classDeclarationConstraints :: [TypeParameterConstraintsClause], + classDeclarationBody :: ClassBody} + deriving (Eq, Ord, Read, Show) + +_ClassDeclaration = (Core.Name "hydra/ext/csharp/syntax.ClassDeclaration") + +_ClassDeclaration_attributes = (Core.Name "attributes") + +_ClassDeclaration_modifiers = (Core.Name "modifiers") + +_ClassDeclaration_partial = (Core.Name "partial") + +_ClassDeclaration_name = (Core.Name "name") + +_ClassDeclaration_parameters = (Core.Name "parameters") + +_ClassDeclaration_base = (Core.Name "base") + +_ClassDeclaration_constraints = (Core.Name "constraints") + +_ClassDeclaration_body = (Core.Name "body") + +data ClassModifier = + ClassModifierNew | + ClassModifierPublic | + ClassModifierProtected | + ClassModifierInternal | + ClassModifierPrivate | + ClassModifierAbstract | + ClassModifierSealed | + ClassModifierStatic | + ClassModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_ClassModifier = (Core.Name "hydra/ext/csharp/syntax.ClassModifier") + +_ClassModifier_new = (Core.Name "new") + +_ClassModifier_public = (Core.Name "public") + +_ClassModifier_protected = (Core.Name "protected") + +_ClassModifier_internal = (Core.Name "internal") + +_ClassModifier_private = (Core.Name "private") + +_ClassModifier_abstract = (Core.Name "abstract") + +_ClassModifier_sealed = (Core.Name "sealed") + +_ClassModifier_static = (Core.Name "static") + +_ClassModifier_unsafe = (Core.Name "unsafe") + +newtype TypeParameterList = + TypeParameterList { + unTypeParameterList :: [TypeParameterPart]} + deriving (Eq, Ord, Read, Show) + +_TypeParameterList = (Core.Name "hydra/ext/csharp/syntax.TypeParameterList") + +data TypeParameterPart = + TypeParameterPart { + typeParameterPartAttributes :: (Maybe Attributes), + typeParameterPartName :: TypeParameter} + deriving (Eq, Ord, Read, Show) + +_TypeParameterPart = (Core.Name "hydra/ext/csharp/syntax.TypeParameterPart") + +_TypeParameterPart_attributes = (Core.Name "attributes") + +_TypeParameterPart_name = (Core.Name "name") + +data ClassBase = + ClassBaseClass (Maybe ClassType) | + ClassBaseInterfaces [InterfaceType] + deriving (Eq, Ord, Read, Show) + +_ClassBase = (Core.Name "hydra/ext/csharp/syntax.ClassBase") + +_ClassBase_class = (Core.Name "class") + +_ClassBase_interfaces = (Core.Name "interfaces") + +data TypeParameterConstraintsClause = + TypeParameterConstraintsClause { + typeParameterConstraintsClauseParameter :: TypeParameter, + typeParameterConstraintsClauseConstraints :: [TypeParameterConstraints]} + deriving (Eq, Ord, Read, Show) + +_TypeParameterConstraintsClause = (Core.Name "hydra/ext/csharp/syntax.TypeParameterConstraintsClause") + +_TypeParameterConstraintsClause_parameter = (Core.Name "parameter") + +_TypeParameterConstraintsClause_constraints = (Core.Name "constraints") + +data TypeParameterConstraints = + TypeParameterConstraints { + typeParameterConstraintsPrimary :: (Maybe PrimaryConstraint), + typeParameterConstraintsSecondary :: (Maybe SecondaryConstraints), + typeParameterConstraintsConstructor :: Bool} + deriving (Eq, Ord, Read, Show) + +_TypeParameterConstraints = (Core.Name "hydra/ext/csharp/syntax.TypeParameterConstraints") + +_TypeParameterConstraints_primary = (Core.Name "primary") + +_TypeParameterConstraints_secondary = (Core.Name "secondary") + +_TypeParameterConstraints_constructor = (Core.Name "constructor") + +data PrimaryConstraint = + PrimaryConstraintClassType ClassType | + PrimaryConstraintClass | + PrimaryConstraintStruct | + PrimaryConstraintUnmanaged + deriving (Eq, Ord, Read, Show) + +_PrimaryConstraint = (Core.Name "hydra/ext/csharp/syntax.PrimaryConstraint") + +_PrimaryConstraint_classType = (Core.Name "classType") + +_PrimaryConstraint_class = (Core.Name "class") + +_PrimaryConstraint_struct = (Core.Name "struct") + +_PrimaryConstraint_unmanaged = (Core.Name "unmanaged") + +newtype SecondaryConstraints = + SecondaryConstraints { + unSecondaryConstraints :: [SecondaryConstraint]} + deriving (Eq, Ord, Read, Show) + +_SecondaryConstraints = (Core.Name "hydra/ext/csharp/syntax.SecondaryConstraints") + +data SecondaryConstraint = + SecondaryConstraintInterface InterfaceType | + SecondaryConstraintParameter TypeParameter + deriving (Eq, Ord, Read, Show) + +_SecondaryConstraint = (Core.Name "hydra/ext/csharp/syntax.SecondaryConstraint") + +_SecondaryConstraint_interface = (Core.Name "interface") + +_SecondaryConstraint_parameter = (Core.Name "parameter") + +newtype ClassBody = + ClassBody { + unClassBody :: [ClassMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_ClassBody = (Core.Name "hydra/ext/csharp/syntax.ClassBody") + +data ClassMemberDeclaration = + ClassMemberDeclarationConstant ConstantDeclaration | + ClassMemberDeclarationField FieldDeclaration | + ClassMemberDeclarationMethod MethodDeclaration | + ClassMemberDeclarationProperty PropertyDeclaration | + ClassMemberDeclarationEvent EventDeclaration | + ClassMemberDeclarationIndexer IndexerDeclaration | + ClassMemberDeclarationOperator OperatorDeclaration | + ClassMemberDeclarationConstructor ConstructorDeclaration | + ClassMemberDeclarationFinalizer FinalizerDeclaration | + ClassMemberDeclarationStaticConstructor StaticConstructorDeclaration | + ClassMemberDeclarationType TypeDeclaration + deriving (Eq, Ord, Read, Show) + +_ClassMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.ClassMemberDeclaration") + +_ClassMemberDeclaration_constant = (Core.Name "constant") + +_ClassMemberDeclaration_field = (Core.Name "field") + +_ClassMemberDeclaration_method = (Core.Name "method") + +_ClassMemberDeclaration_property = (Core.Name "property") + +_ClassMemberDeclaration_event = (Core.Name "event") + +_ClassMemberDeclaration_indexer = (Core.Name "indexer") + +_ClassMemberDeclaration_operator = (Core.Name "operator") + +_ClassMemberDeclaration_constructor = (Core.Name "constructor") + +_ClassMemberDeclaration_finalizer = (Core.Name "finalizer") + +_ClassMemberDeclaration_staticConstructor = (Core.Name "staticConstructor") + +_ClassMemberDeclaration_type = (Core.Name "type") + +data ConstantDeclaration = + ConstantDeclaration { + constantDeclarationAttributes :: (Maybe Attributes), + constantDeclarationModifiers :: [ConstantModifier], + constantDeclarationType :: Type, + constantDeclarationDeclarators :: [ConstantDeclarator]} + deriving (Eq, Ord, Read, Show) + +_ConstantDeclaration = (Core.Name "hydra/ext/csharp/syntax.ConstantDeclaration") + +_ConstantDeclaration_attributes = (Core.Name "attributes") + +_ConstantDeclaration_modifiers = (Core.Name "modifiers") + +_ConstantDeclaration_type = (Core.Name "type") + +_ConstantDeclaration_declarators = (Core.Name "declarators") + +data ConstantModifier = + ConstantModifierNew | + ConstantModifierPublic | + ConstantModifierProtected | + ConstantModifierInternal | + ConstantModifierPrivate + deriving (Eq, Ord, Read, Show) + +_ConstantModifier = (Core.Name "hydra/ext/csharp/syntax.ConstantModifier") + +_ConstantModifier_new = (Core.Name "new") + +_ConstantModifier_public = (Core.Name "public") + +_ConstantModifier_protected = (Core.Name "protected") + +_ConstantModifier_internal = (Core.Name "internal") + +_ConstantModifier_private = (Core.Name "private") + +data FieldDeclaration = + FieldDeclaration { + fieldDeclarationAttributes :: (Maybe Attributes), + fieldDeclarationModifiers :: [FieldModifier], + fieldDeclarationType :: Type, + fieldDeclarationDeclarators :: [VariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_FieldDeclaration = (Core.Name "hydra/ext/csharp/syntax.FieldDeclaration") + +_FieldDeclaration_attributes = (Core.Name "attributes") + +_FieldDeclaration_modifiers = (Core.Name "modifiers") + +_FieldDeclaration_type = (Core.Name "type") + +_FieldDeclaration_declarators = (Core.Name "declarators") + +data FieldModifier = + FieldModifierNew | + FieldModifierPublic | + FieldModifierProtected | + FieldModifierInternal | + FieldModifierPrivate | + FieldModifierStatic | + FieldModifierReadonly | + FieldModifierVolatile | + FieldModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_FieldModifier = (Core.Name "hydra/ext/csharp/syntax.FieldModifier") + +_FieldModifier_new = (Core.Name "new") + +_FieldModifier_public = (Core.Name "public") + +_FieldModifier_protected = (Core.Name "protected") + +_FieldModifier_internal = (Core.Name "internal") + +_FieldModifier_private = (Core.Name "private") + +_FieldModifier_static = (Core.Name "static") + +_FieldModifier_readonly = (Core.Name "readonly") + +_FieldModifier_volatile = (Core.Name "volatile") + +_FieldModifier_unsafe = (Core.Name "unsafe") + +newtype VariableDeclarators = + VariableDeclarators { + unVariableDeclarators :: [VariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_VariableDeclarators = (Core.Name "hydra/ext/csharp/syntax.VariableDeclarators") + +data VariableDeclarator = + VariableDeclarator { + variableDeclaratorIdentifier :: Identifier, + variableDeclaratorInitializer :: (Maybe VariableInitializer)} + deriving (Eq, Ord, Read, Show) + +_VariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.VariableDeclarator") + +_VariableDeclarator_identifier = (Core.Name "identifier") + +_VariableDeclarator_initializer = (Core.Name "initializer") + +data MethodDeclaration = + MethodDeclarationStandard StandardMethodDeclaration | + MethodDeclarationRefReturn RefReturnMethodDeclaration + deriving (Eq, Ord, Read, Show) + +_MethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.MethodDeclaration") + +_MethodDeclaration_standard = (Core.Name "standard") + +_MethodDeclaration_refReturn = (Core.Name "refReturn") + +data StandardMethodDeclaration = + StandardMethodDeclaration { + standardMethodDeclarationAttributes :: (Maybe Attributes), + standardMethodDeclarationModifiers :: [MethodModifier], + standardMethodDeclarationReturnType :: ReturnType, + standardMethodDeclarationHeader :: MethodHeader, + standardMethodDeclarationBody :: MethodBody} + deriving (Eq, Ord, Read, Show) + +_StandardMethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardMethodDeclaration") + +_StandardMethodDeclaration_attributes = (Core.Name "attributes") + +_StandardMethodDeclaration_modifiers = (Core.Name "modifiers") + +_StandardMethodDeclaration_returnType = (Core.Name "returnType") + +_StandardMethodDeclaration_header = (Core.Name "header") + +_StandardMethodDeclaration_body = (Core.Name "body") + +data RefReturnMethodDeclaration = + RefReturnMethodDeclaration { + refReturnMethodDeclarationAttributes :: (Maybe Attributes), + refReturnMethodDeclarationModifiers :: [RefMethodModifier], + refReturnMethodDeclarationKind :: RefKind, + refReturnMethodDeclarationReturnType :: ReturnType, + refReturnMethodDeclarationHeader :: MethodHeader, + refReturnMethodDeclarationBody :: RefMethodBody} + deriving (Eq, Ord, Read, Show) + +_RefReturnMethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefReturnMethodDeclaration") + +_RefReturnMethodDeclaration_attributes = (Core.Name "attributes") + +_RefReturnMethodDeclaration_modifiers = (Core.Name "modifiers") + +_RefReturnMethodDeclaration_kind = (Core.Name "kind") + +_RefReturnMethodDeclaration_returnType = (Core.Name "returnType") + +_RefReturnMethodDeclaration_header = (Core.Name "header") + +_RefReturnMethodDeclaration_body = (Core.Name "body") + +data MethodModifiers = + MethodModifiers { + methodModifiersModifiers :: [MethodModifier], + methodModifiersPartial :: Bool} + deriving (Eq, Ord, Read, Show) + +_MethodModifiers = (Core.Name "hydra/ext/csharp/syntax.MethodModifiers") + +_MethodModifiers_modifiers = (Core.Name "modifiers") + +_MethodModifiers_partial = (Core.Name "partial") + +data RefKind = + RefKindRef | + RefKindRefReadonly + deriving (Eq, Ord, Read, Show) + +_RefKind = (Core.Name "hydra/ext/csharp/syntax.RefKind") + +_RefKind_ref = (Core.Name "ref") + +_RefKind_refReadonly = (Core.Name "refReadonly") + +data MethodHeader = + MethodHeader { + methodHeaderName :: MemberName, + methodHeaderTypeParameters :: (Maybe TypeParameterList), + methodHeaderParameters :: (Maybe FormalParameterList), + methodHeaderConstraints :: [TypeParameterConstraintsClause]} + deriving (Eq, Ord, Read, Show) + +_MethodHeader = (Core.Name "hydra/ext/csharp/syntax.MethodHeader") + +_MethodHeader_name = (Core.Name "name") + +_MethodHeader_typeParameters = (Core.Name "typeParameters") + +_MethodHeader_parameters = (Core.Name "parameters") + +_MethodHeader_constraints = (Core.Name "constraints") + +data MethodModifier = + MethodModifierRef RefMethodModifier | + MethodModifierAsync + deriving (Eq, Ord, Read, Show) + +_MethodModifier = (Core.Name "hydra/ext/csharp/syntax.MethodModifier") + +_MethodModifier_ref = (Core.Name "ref") + +_MethodModifier_async = (Core.Name "async") + +data RefMethodModifier = + RefMethodModifierNew | + RefMethodModifierPublic | + RefMethodModifierProtected | + RefMethodModifierInternal | + RefMethodModifierPrivate | + RefMethodModifierStatic | + RefMethodModifierVirtual | + RefMethodModifierSealed | + RefMethodModifierOverride | + RefMethodModifierAbstract | + RefMethodModifierExtern | + RefMethodModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_RefMethodModifier = (Core.Name "hydra/ext/csharp/syntax.RefMethodModifier") + +_RefMethodModifier_new = (Core.Name "new") + +_RefMethodModifier_public = (Core.Name "public") + +_RefMethodModifier_protected = (Core.Name "protected") + +_RefMethodModifier_internal = (Core.Name "internal") + +_RefMethodModifier_private = (Core.Name "private") + +_RefMethodModifier_static = (Core.Name "static") + +_RefMethodModifier_virtual = (Core.Name "virtual") + +_RefMethodModifier_sealed = (Core.Name "sealed") + +_RefMethodModifier_override = (Core.Name "override") + +_RefMethodModifier_abstract = (Core.Name "abstract") + +_RefMethodModifier_extern = (Core.Name "extern") + +_RefMethodModifier_unsafe = (Core.Name "unsafe") + +data ReturnType = + ReturnTypeRef Type | + ReturnTypeVoid + deriving (Eq, Ord, Read, Show) + +_ReturnType = (Core.Name "hydra/ext/csharp/syntax.ReturnType") + +_ReturnType_ref = (Core.Name "ref") + +_ReturnType_void = (Core.Name "void") + +data MemberName = + MemberName { + memberNameInterfaceType :: (Maybe TypeName), + memberNameIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_MemberName = (Core.Name "hydra/ext/csharp/syntax.MemberName") + +_MemberName_interfaceType = (Core.Name "interfaceType") + +_MemberName_identifier = (Core.Name "identifier") + +data MethodBody = + MethodBodyBlock Block | + MethodBodyNullConditionalInvocation NullConditionalInvocationExpression | + MethodBodyExpression Expression | + MethodBodyEmpty + deriving (Eq, Ord, Read, Show) + +_MethodBody = (Core.Name "hydra/ext/csharp/syntax.MethodBody") + +_MethodBody_block = (Core.Name "block") + +_MethodBody_nullConditionalInvocation = (Core.Name "nullConditionalInvocation") + +_MethodBody_expression = (Core.Name "expression") + +_MethodBody_empty = (Core.Name "empty") + +data RefMethodBody = + RefMethodBodyBlock Block | + RefMethodBodyRef VariableReference | + RefMethodBodyEmpty + deriving (Eq, Ord, Read, Show) + +_RefMethodBody = (Core.Name "hydra/ext/csharp/syntax.RefMethodBody") + +_RefMethodBody_block = (Core.Name "block") + +_RefMethodBody_ref = (Core.Name "ref") + +_RefMethodBody_empty = (Core.Name "empty") + +data FormalParameterList = + FormalParameterList { + formalParameterListFixed :: [FixedParameter], + formalParameterListArray :: (Maybe ParameterArray)} + deriving (Eq, Ord, Read, Show) + +_FormalParameterList = (Core.Name "hydra/ext/csharp/syntax.FormalParameterList") + +_FormalParameterList_fixed = (Core.Name "fixed") + +_FormalParameterList_array = (Core.Name "array") + +data FixedParameter = + FixedParameter { + fixedParameterAttributes :: (Maybe Attributes), + fixedParameterModifier :: (Maybe ParameterModifier), + fixedParameterType :: Type, + fixedParameterIdentifier :: Identifier, + fixedParameterDefaultArgument :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_FixedParameter = (Core.Name "hydra/ext/csharp/syntax.FixedParameter") + +_FixedParameter_attributes = (Core.Name "attributes") + +_FixedParameter_modifier = (Core.Name "modifier") + +_FixedParameter_type = (Core.Name "type") + +_FixedParameter_identifier = (Core.Name "identifier") + +_FixedParameter_defaultArgument = (Core.Name "defaultArgument") + +data ParameterModifier = + ParameterModifierMode ParameterModeModifier | + ParameterModifierThis + deriving (Eq, Ord, Read, Show) + +_ParameterModifier = (Core.Name "hydra/ext/csharp/syntax.ParameterModifier") + +_ParameterModifier_mode = (Core.Name "mode") + +_ParameterModifier_this = (Core.Name "this") + +data ParameterModeModifier = + ParameterModeModifierRef | + ParameterModeModifierOut | + ParameterModeModifierIn + deriving (Eq, Ord, Read, Show) + +_ParameterModeModifier = (Core.Name "hydra/ext/csharp/syntax.ParameterModeModifier") + +_ParameterModeModifier_ref = (Core.Name "ref") + +_ParameterModeModifier_out = (Core.Name "out") + +_ParameterModeModifier_in = (Core.Name "in") + +data ParameterArray = + ParameterArray { + parameterArrayAttributes :: (Maybe Attributes), + parameterArrayType :: ArrayType, + parameterArrayIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_ParameterArray = (Core.Name "hydra/ext/csharp/syntax.ParameterArray") + +_ParameterArray_attributes = (Core.Name "attributes") + +_ParameterArray_type = (Core.Name "type") + +_ParameterArray_identifier = (Core.Name "identifier") + +data PropertyDeclaration = + PropertyDeclarationStandard StandardPropertyDeclaration | + PropertyDeclarationRefReturn RefReturnPropertyDeclaration + deriving (Eq, Ord, Read, Show) + +_PropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.PropertyDeclaration") + +_PropertyDeclaration_standard = (Core.Name "standard") + +_PropertyDeclaration_refReturn = (Core.Name "refReturn") + +data StandardPropertyDeclaration = + StandardPropertyDeclaration { + standardPropertyDeclarationAttributes :: (Maybe Attributes), + standardPropertyDeclarationModifiers :: [PropertyModifier], + standardPropertyDeclarationType :: Type, + standardPropertyDeclarationName :: MemberName, + standardPropertyDeclarationBody :: PropertyBody} + deriving (Eq, Ord, Read, Show) + +_StandardPropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardPropertyDeclaration") + +_StandardPropertyDeclaration_attributes = (Core.Name "attributes") + +_StandardPropertyDeclaration_modifiers = (Core.Name "modifiers") + +_StandardPropertyDeclaration_type = (Core.Name "type") + +_StandardPropertyDeclaration_name = (Core.Name "name") + +_StandardPropertyDeclaration_body = (Core.Name "body") + +data RefReturnPropertyDeclaration = + RefReturnPropertyDeclaration { + refReturnPropertyDeclarationAttributes :: (Maybe Attributes), + refReturnPropertyDeclarationModifiers :: [PropertyModifier], + refReturnPropertyDeclarationRefKind :: RefKind, + refReturnPropertyDeclarationType :: Type, + refReturnPropertyDeclarationName :: MemberName, + refReturnPropertyDeclarationBody :: RefPropertyBody} + deriving (Eq, Ord, Read, Show) + +_RefReturnPropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefReturnPropertyDeclaration") + +_RefReturnPropertyDeclaration_attributes = (Core.Name "attributes") + +_RefReturnPropertyDeclaration_modifiers = (Core.Name "modifiers") + +_RefReturnPropertyDeclaration_refKind = (Core.Name "refKind") + +_RefReturnPropertyDeclaration_type = (Core.Name "type") + +_RefReturnPropertyDeclaration_name = (Core.Name "name") + +_RefReturnPropertyDeclaration_body = (Core.Name "body") + +data PropertyModifier = + PropertyModifierNew | + PropertyModifierPublic | + PropertyModifierProtected | + PropertyModifierInternal | + PropertyModifierPrivate | + PropertyModifierStatic | + PropertyModifierVirtual | + PropertyModifierSealed | + PropertyModifierOverride | + PropertyModifierAbstract | + PropertyModifierExtern | + PropertyModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_PropertyModifier = (Core.Name "hydra/ext/csharp/syntax.PropertyModifier") + +_PropertyModifier_new = (Core.Name "new") + +_PropertyModifier_public = (Core.Name "public") + +_PropertyModifier_protected = (Core.Name "protected") + +_PropertyModifier_internal = (Core.Name "internal") + +_PropertyModifier_private = (Core.Name "private") + +_PropertyModifier_static = (Core.Name "static") + +_PropertyModifier_virtual = (Core.Name "virtual") + +_PropertyModifier_sealed = (Core.Name "sealed") + +_PropertyModifier_override = (Core.Name "override") + +_PropertyModifier_abstract = (Core.Name "abstract") + +_PropertyModifier_extern = (Core.Name "extern") + +_PropertyModifier_unsafe = (Core.Name "unsafe") + +data PropertyBody = + PropertyBodyBlock BlockPropertyBody | + PropertyBodyExpression Expression + deriving (Eq, Ord, Read, Show) + +_PropertyBody = (Core.Name "hydra/ext/csharp/syntax.PropertyBody") + +_PropertyBody_block = (Core.Name "block") + +_PropertyBody_expression = (Core.Name "expression") + +data BlockPropertyBody = + BlockPropertyBody { + blockPropertyBodyAccessors :: AccessorDeclarations, + blockPropertyBodyInitializer :: (Maybe VariableInitializer)} + deriving (Eq, Ord, Read, Show) + +_BlockPropertyBody = (Core.Name "hydra/ext/csharp/syntax.BlockPropertyBody") + +_BlockPropertyBody_accessors = (Core.Name "accessors") + +_BlockPropertyBody_initializer = (Core.Name "initializer") + +data RefPropertyBody = + RefPropertyBodyBlock RefGetAccessorDeclaration | + RefPropertyBodyRef VariableReference + deriving (Eq, Ord, Read, Show) + +_RefPropertyBody = (Core.Name "hydra/ext/csharp/syntax.RefPropertyBody") + +_RefPropertyBody_block = (Core.Name "block") + +_RefPropertyBody_ref = (Core.Name "ref") + +data AccessorDeclarations = + AccessorDeclarationsGet (Maybe AccessorDeclaration) | + AccessorDeclarationsSet (Maybe AccessorDeclaration) + deriving (Eq, Ord, Read, Show) + +_AccessorDeclarations = (Core.Name "hydra/ext/csharp/syntax.AccessorDeclarations") + +_AccessorDeclarations_get = (Core.Name "get") + +_AccessorDeclarations_set = (Core.Name "set") + +data AccessorDeclaration = + AccessorDeclaration { + accessorDeclarationAttributes :: (Maybe Attributes), + accessorDeclarationModifier :: (Maybe AccessorModifier), + accessorDeclarationBody :: AccessorBody} + deriving (Eq, Ord, Read, Show) + +_AccessorDeclaration = (Core.Name "hydra/ext/csharp/syntax.AccessorDeclaration") + +_AccessorDeclaration_attributes = (Core.Name "attributes") + +_AccessorDeclaration_modifier = (Core.Name "modifier") + +_AccessorDeclaration_body = (Core.Name "body") + +data AccessorModifier = + AccessorModifierProtected | + AccessorModifierInternal | + AccessorModifierPrivate | + AccessorModifierProtectedInternal | + AccessorModifierInternalProtected | + AccessorModifierProtectedPrivate | + AccessorModifierPrivateProtected + deriving (Eq, Ord, Read, Show) + +_AccessorModifier = (Core.Name "hydra/ext/csharp/syntax.AccessorModifier") + +_AccessorModifier_protected = (Core.Name "protected") + +_AccessorModifier_internal = (Core.Name "internal") + +_AccessorModifier_private = (Core.Name "private") + +_AccessorModifier_protectedInternal = (Core.Name "protectedInternal") + +_AccessorModifier_internalProtected = (Core.Name "internalProtected") + +_AccessorModifier_protectedPrivate = (Core.Name "protectedPrivate") + +_AccessorModifier_privateProtected = (Core.Name "privateProtected") + +data AccessorBody = + AccessorBodyBlock Block | + AccessorBodyExpression Expression | + AccessorBodyEmpty + deriving (Eq, Ord, Read, Show) + +_AccessorBody = (Core.Name "hydra/ext/csharp/syntax.AccessorBody") + +_AccessorBody_block = (Core.Name "block") + +_AccessorBody_expression = (Core.Name "expression") + +_AccessorBody_empty = (Core.Name "empty") + +data RefGetAccessorDeclaration = + RefGetAccessorDeclaration { + refGetAccessorDeclarationAttributes :: (Maybe Attributes), + refGetAccessorDeclarationModifier :: (Maybe AccessorModifier), + refGetAccessorDeclarationBody :: RefAccessorBody} + deriving (Eq, Ord, Read, Show) + +_RefGetAccessorDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefGetAccessorDeclaration") + +_RefGetAccessorDeclaration_attributes = (Core.Name "attributes") + +_RefGetAccessorDeclaration_modifier = (Core.Name "modifier") + +_RefGetAccessorDeclaration_body = (Core.Name "body") + +data RefAccessorBody = + RefAccessorBodyBlock Block | + RefAccessorBodyRef VariableReference | + RefAccessorBodyEmpty + deriving (Eq, Ord, Read, Show) + +_RefAccessorBody = (Core.Name "hydra/ext/csharp/syntax.RefAccessorBody") + +_RefAccessorBody_block = (Core.Name "block") + +_RefAccessorBody_ref = (Core.Name "ref") + +_RefAccessorBody_empty = (Core.Name "empty") + +data EventDeclaration = + EventDeclarationStandard StandardEventDeclaration | + EventDeclarationAccessors AccessorsEventDeclaration + deriving (Eq, Ord, Read, Show) + +_EventDeclaration = (Core.Name "hydra/ext/csharp/syntax.EventDeclaration") + +_EventDeclaration_standard = (Core.Name "standard") + +_EventDeclaration_accessors = (Core.Name "accessors") + +data StandardEventDeclaration = + StandardEventDeclaration { + standardEventDeclarationAttributes :: (Maybe Attributes), + standardEventDeclarationModifiers :: [EventModifier], + standardEventDeclarationType :: Type, + standardEventDeclarationDeclarators :: VariableDeclarators} + deriving (Eq, Ord, Read, Show) + +_StandardEventDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardEventDeclaration") + +_StandardEventDeclaration_attributes = (Core.Name "attributes") + +_StandardEventDeclaration_modifiers = (Core.Name "modifiers") + +_StandardEventDeclaration_type = (Core.Name "type") + +_StandardEventDeclaration_declarators = (Core.Name "declarators") + +data AccessorsEventDeclaration = + AccessorsEventDeclaration { + accessorsEventDeclarationAttributes :: (Maybe Attributes), + accessorsEventDeclarationModifiers :: [EventModifier], + accessorsEventDeclarationType :: Type, + accessorsEventDeclarationName :: MemberName, + accessorsEventDeclarationAccessors :: EventAccessorDeclarations} + deriving (Eq, Ord, Read, Show) + +_AccessorsEventDeclaration = (Core.Name "hydra/ext/csharp/syntax.AccessorsEventDeclaration") + +_AccessorsEventDeclaration_attributes = (Core.Name "attributes") + +_AccessorsEventDeclaration_modifiers = (Core.Name "modifiers") + +_AccessorsEventDeclaration_type = (Core.Name "type") + +_AccessorsEventDeclaration_name = (Core.Name "name") + +_AccessorsEventDeclaration_accessors = (Core.Name "accessors") + +data EventModifier = + EventModifierNew | + EventModifierPublic | + EventModifierProtected | + EventModifierInternal | + EventModifierPrivate | + EventModifierStatic | + EventModifierVirtual | + EventModifierSealed | + EventModifierOverride | + EventModifierAbstract | + EventModifierExtern | + EventModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_EventModifier = (Core.Name "hydra/ext/csharp/syntax.EventModifier") + +_EventModifier_new = (Core.Name "new") + +_EventModifier_public = (Core.Name "public") + +_EventModifier_protected = (Core.Name "protected") + +_EventModifier_internal = (Core.Name "internal") + +_EventModifier_private = (Core.Name "private") + +_EventModifier_static = (Core.Name "static") + +_EventModifier_virtual = (Core.Name "virtual") + +_EventModifier_sealed = (Core.Name "sealed") + +_EventModifier_override = (Core.Name "override") + +_EventModifier_abstract = (Core.Name "abstract") + +_EventModifier_extern = (Core.Name "extern") + +_EventModifier_unsafe = (Core.Name "unsafe") + +data EventAccessorDeclarations = + EventAccessorDeclarationsAdd AddRemoveAccessorDeclaration | + EventAccessorDeclarationsRemove AddRemoveAccessorDeclaration + deriving (Eq, Ord, Read, Show) + +_EventAccessorDeclarations = (Core.Name "hydra/ext/csharp/syntax.EventAccessorDeclarations") + +_EventAccessorDeclarations_add = (Core.Name "add") + +_EventAccessorDeclarations_remove = (Core.Name "remove") + +data AddRemoveAccessorDeclaration = + AddRemoveAccessorDeclaration { + addRemoveAccessorDeclarationAttributes :: (Maybe Attributes), + addRemoveAccessorDeclarationBody :: Block} + deriving (Eq, Ord, Read, Show) + +_AddRemoveAccessorDeclaration = (Core.Name "hydra/ext/csharp/syntax.AddRemoveAccessorDeclaration") + +_AddRemoveAccessorDeclaration_attributes = (Core.Name "attributes") + +_AddRemoveAccessorDeclaration_body = (Core.Name "body") + +data IndexerDeclaration = + IndexerDeclarationStandard StandardIndexerDeclaration | + IndexerDeclarationRef RefIndexerDeclaration + deriving (Eq, Ord, Read, Show) + +_IndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.IndexerDeclaration") + +_IndexerDeclaration_standard = (Core.Name "standard") + +_IndexerDeclaration_ref = (Core.Name "ref") + +data StandardIndexerDeclaration = + StandardIndexerDeclaration { + standardIndexerDeclarationAttributes :: (Maybe Attributes), + standardIndexerDeclarationModifiers :: [IndexerModifier], + standardIndexerDeclarationDeclarator :: IndexerDeclarator, + standardIndexerDeclarationBody :: IndexerBody} + deriving (Eq, Ord, Read, Show) + +_StandardIndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardIndexerDeclaration") + +_StandardIndexerDeclaration_attributes = (Core.Name "attributes") + +_StandardIndexerDeclaration_modifiers = (Core.Name "modifiers") + +_StandardIndexerDeclaration_declarator = (Core.Name "declarator") + +_StandardIndexerDeclaration_body = (Core.Name "body") + +data RefIndexerDeclaration = + RefIndexerDeclaration { + refIndexerDeclarationAttributes :: (Maybe Attributes), + refIndexerDeclarationModifiers :: [IndexerModifier], + refIndexerDeclarationRefKind :: RefKind, + refIndexerDeclarationDeclarator :: IndexerDeclarator, + refIndexerDeclarationBody :: RefIndexerBody} + deriving (Eq, Ord, Read, Show) + +_RefIndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefIndexerDeclaration") + +_RefIndexerDeclaration_attributes = (Core.Name "attributes") + +_RefIndexerDeclaration_modifiers = (Core.Name "modifiers") + +_RefIndexerDeclaration_refKind = (Core.Name "refKind") + +_RefIndexerDeclaration_declarator = (Core.Name "declarator") + +_RefIndexerDeclaration_body = (Core.Name "body") + +data IndexerModifier = + IndexerModifierNew | + IndexerModifierPublic | + IndexerModifierProtected | + IndexerModifierInternal | + IndexerModifierPrivate | + IndexerModifierVirtual | + IndexerModifierSealed | + IndexerModifierOverride | + IndexerModifierAbstract | + IndexerModifierExtern | + IndexerModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_IndexerModifier = (Core.Name "hydra/ext/csharp/syntax.IndexerModifier") + +_IndexerModifier_new = (Core.Name "new") + +_IndexerModifier_public = (Core.Name "public") + +_IndexerModifier_protected = (Core.Name "protected") + +_IndexerModifier_internal = (Core.Name "internal") + +_IndexerModifier_private = (Core.Name "private") + +_IndexerModifier_virtual = (Core.Name "virtual") + +_IndexerModifier_sealed = (Core.Name "sealed") + +_IndexerModifier_override = (Core.Name "override") + +_IndexerModifier_abstract = (Core.Name "abstract") + +_IndexerModifier_extern = (Core.Name "extern") + +_IndexerModifier_unsafe = (Core.Name "unsafe") + +data IndexerDeclarator = + IndexerDeclarator { + indexerDeclaratorType :: Type, + indexerDeclaratorInterface :: (Maybe InterfaceType), + indexerDeclaratorParameters :: FormalParameterList} + deriving (Eq, Ord, Read, Show) + +_IndexerDeclarator = (Core.Name "hydra/ext/csharp/syntax.IndexerDeclarator") + +_IndexerDeclarator_type = (Core.Name "type") + +_IndexerDeclarator_interface = (Core.Name "interface") + +_IndexerDeclarator_parameters = (Core.Name "parameters") + +data IndexerBody = + IndexerBodyBlock AccessorDeclarations | + IndexerBodyExpression Expression + deriving (Eq, Ord, Read, Show) + +_IndexerBody = (Core.Name "hydra/ext/csharp/syntax.IndexerBody") + +_IndexerBody_block = (Core.Name "block") + +_IndexerBody_expression = (Core.Name "expression") + +data RefIndexerBody = + RefIndexerBodyBlock RefGetAccessorDeclaration | + RefIndexerBodyRef VariableReference + deriving (Eq, Ord, Read, Show) + +_RefIndexerBody = (Core.Name "hydra/ext/csharp/syntax.RefIndexerBody") + +_RefIndexerBody_block = (Core.Name "block") + +_RefIndexerBody_ref = (Core.Name "ref") + +data OperatorDeclaration = + OperatorDeclaration { + operatorDeclarationAttributes :: (Maybe Attributes), + operatorDeclarationModifiers :: [OperatorModifier], + operatorDeclarationDeclarator :: OperatorDeclarator, + operatorDeclarationBody :: OperatorBody} + deriving (Eq, Ord, Read, Show) + +_OperatorDeclaration = (Core.Name "hydra/ext/csharp/syntax.OperatorDeclaration") + +_OperatorDeclaration_attributes = (Core.Name "attributes") + +_OperatorDeclaration_modifiers = (Core.Name "modifiers") + +_OperatorDeclaration_declarator = (Core.Name "declarator") + +_OperatorDeclaration_body = (Core.Name "body") + +data OperatorModifier = + OperatorModifierPublic | + OperatorModifierStatic | + OperatorModifierExtern | + OperatorModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_OperatorModifier = (Core.Name "hydra/ext/csharp/syntax.OperatorModifier") + +_OperatorModifier_public = (Core.Name "public") + +_OperatorModifier_static = (Core.Name "static") + +_OperatorModifier_extern = (Core.Name "extern") + +_OperatorModifier_unsafe = (Core.Name "unsafe") + +data OperatorDeclarator = + OperatorDeclaratorUnary UnaryOperatorDeclarator | + OperatorDeclaratorBinary BinaryOperatorDeclarator | + OperatorDeclaratorConversion ConversionOperatorDeclarator + deriving (Eq, Ord, Read, Show) + +_OperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.OperatorDeclarator") + +_OperatorDeclarator_unary = (Core.Name "unary") + +_OperatorDeclarator_binary = (Core.Name "binary") + +_OperatorDeclarator_conversion = (Core.Name "conversion") + +data UnaryOperatorDeclarator = + UnaryOperatorDeclarator { + unaryOperatorDeclaratorType :: Type, + unaryOperatorDeclaratorOperator :: OverloadableUnaryOperator, + unaryOperatorDeclaratorParameter :: FixedParameter} + deriving (Eq, Ord, Read, Show) + +_UnaryOperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.UnaryOperatorDeclarator") + +_UnaryOperatorDeclarator_type = (Core.Name "type") + +_UnaryOperatorDeclarator_operator = (Core.Name "operator") + +_UnaryOperatorDeclarator_parameter = (Core.Name "parameter") + +data OverloadableUnaryOperator = + OverloadableUnaryOperatorPlus | + OverloadableUnaryOperatorMinus | + OverloadableUnaryOperatorNot | + OverloadableUnaryOperatorComplement | + OverloadableUnaryOperatorIncrement | + OverloadableUnaryOperatorDecrement | + OverloadableUnaryOperatorTrue | + OverloadableUnaryOperatorFalse + deriving (Eq, Ord, Read, Show) + +_OverloadableUnaryOperator = (Core.Name "hydra/ext/csharp/syntax.OverloadableUnaryOperator") + +_OverloadableUnaryOperator_plus = (Core.Name "plus") + +_OverloadableUnaryOperator_minus = (Core.Name "minus") + +_OverloadableUnaryOperator_not = (Core.Name "not") + +_OverloadableUnaryOperator_complement = (Core.Name "complement") + +_OverloadableUnaryOperator_increment = (Core.Name "increment") + +_OverloadableUnaryOperator_decrement = (Core.Name "decrement") + +_OverloadableUnaryOperator_true = (Core.Name "true") + +_OverloadableUnaryOperator_false = (Core.Name "false") + +data BinaryOperatorDeclarator = + BinaryOperatorDeclarator { + binaryOperatorDeclaratorType :: Type, + binaryOperatorDeclaratorOperator :: OverloadableBinaryOperator, + binaryOperatorDeclaratorLeft :: FixedParameter, + binaryOperatorDeclaratorRight :: FixedParameter} + deriving (Eq, Ord, Read, Show) + +_BinaryOperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.BinaryOperatorDeclarator") + +_BinaryOperatorDeclarator_type = (Core.Name "type") + +_BinaryOperatorDeclarator_operator = (Core.Name "operator") + +_BinaryOperatorDeclarator_left = (Core.Name "left") + +_BinaryOperatorDeclarator_right = (Core.Name "right") + +data OverloadableBinaryOperator = + OverloadableBinaryOperatorAdd | + OverloadableBinaryOperatorSubtract | + OverloadableBinaryOperatorMultiply | + OverloadableBinaryOperatorDivide | + OverloadableBinaryOperatorModulus | + OverloadableBinaryOperatorAnd | + OverloadableBinaryOperatorOr | + OverloadableBinaryOperatorXor | + OverloadableBinaryOperatorLeftShift | + OverloadableBinaryOperatorRightShift | + OverloadableBinaryOperatorEqual | + OverloadableBinaryOperatorNotEqual | + OverloadableBinaryOperatorGreaterThan | + OverloadableBinaryOperatorLessThan | + OverloadableBinaryOperatorGreaterThanOrEqual | + OverloadableBinaryOperatorLessThanOrEqual + deriving (Eq, Ord, Read, Show) + +_OverloadableBinaryOperator = (Core.Name "hydra/ext/csharp/syntax.OverloadableBinaryOperator") + +_OverloadableBinaryOperator_add = (Core.Name "add") + +_OverloadableBinaryOperator_subtract = (Core.Name "subtract") + +_OverloadableBinaryOperator_multiply = (Core.Name "multiply") + +_OverloadableBinaryOperator_divide = (Core.Name "divide") + +_OverloadableBinaryOperator_modulus = (Core.Name "modulus") + +_OverloadableBinaryOperator_and = (Core.Name "and") + +_OverloadableBinaryOperator_or = (Core.Name "or") + +_OverloadableBinaryOperator_xor = (Core.Name "xor") + +_OverloadableBinaryOperator_leftShift = (Core.Name "leftShift") + +_OverloadableBinaryOperator_rightShift = (Core.Name "rightShift") + +_OverloadableBinaryOperator_equal = (Core.Name "equal") + +_OverloadableBinaryOperator_notEqual = (Core.Name "notEqual") + +_OverloadableBinaryOperator_greaterThan = (Core.Name "greaterThan") + +_OverloadableBinaryOperator_lessThan = (Core.Name "lessThan") + +_OverloadableBinaryOperator_greaterThanOrEqual = (Core.Name "greaterThanOrEqual") + +_OverloadableBinaryOperator_lessThanOrEqual = (Core.Name "lessThanOrEqual") + +data ConversionOperatorDeclarator = + ConversionOperatorDeclarator { + conversionOperatorDeclaratorKind :: ConversionKind, + conversionOperatorDeclaratorType :: Type, + conversionOperatorDeclaratorParameter :: FixedParameter} + deriving (Eq, Ord, Read, Show) + +_ConversionOperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.ConversionOperatorDeclarator") + +_ConversionOperatorDeclarator_kind = (Core.Name "kind") + +_ConversionOperatorDeclarator_type = (Core.Name "type") + +_ConversionOperatorDeclarator_parameter = (Core.Name "parameter") + +data ConversionKind = + ConversionKindImplicit | + ConversionKindExplicit + deriving (Eq, Ord, Read, Show) + +_ConversionKind = (Core.Name "hydra/ext/csharp/syntax.ConversionKind") + +_ConversionKind_implicit = (Core.Name "implicit") + +_ConversionKind_explicit = (Core.Name "explicit") + +data OperatorBody = + OperatorBodyBlock Block | + OperatorBodyExpression Expression | + OperatorBodyEmpty + deriving (Eq, Ord, Read, Show) + +_OperatorBody = (Core.Name "hydra/ext/csharp/syntax.OperatorBody") + +_OperatorBody_block = (Core.Name "block") + +_OperatorBody_expression = (Core.Name "expression") + +_OperatorBody_empty = (Core.Name "empty") + +data ConstructorDeclaration = + ConstructorDeclaration { + constructorDeclarationAttributes :: (Maybe Attributes), + constructorDeclarationModifiers :: [ConstructorModifier], + constructorDeclarationDeclarator :: ConstructorDeclarator, + constructorDeclarationBody :: ConstructorBody} + deriving (Eq, Ord, Read, Show) + +_ConstructorDeclaration = (Core.Name "hydra/ext/csharp/syntax.ConstructorDeclaration") + +_ConstructorDeclaration_attributes = (Core.Name "attributes") + +_ConstructorDeclaration_modifiers = (Core.Name "modifiers") + +_ConstructorDeclaration_declarator = (Core.Name "declarator") + +_ConstructorDeclaration_body = (Core.Name "body") + +data ConstructorModifier = + ConstructorModifierPublic | + ConstructorModifierProtected | + ConstructorModifierInternal | + ConstructorModifierPrivate | + ConstructorModifierExtern | + ConstructorModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_ConstructorModifier = (Core.Name "hydra/ext/csharp/syntax.ConstructorModifier") + +_ConstructorModifier_public = (Core.Name "public") + +_ConstructorModifier_protected = (Core.Name "protected") + +_ConstructorModifier_internal = (Core.Name "internal") + +_ConstructorModifier_private = (Core.Name "private") + +_ConstructorModifier_extern = (Core.Name "extern") + +_ConstructorModifier_unsafe = (Core.Name "unsafe") + +data ConstructorDeclarator = + ConstructorDeclarator { + constructorDeclaratorName :: Identifier, + constructorDeclaratorParameters :: (Maybe FormalParameterList), + constructorDeclaratorInitializer :: (Maybe ConstructorInitializer)} + deriving (Eq, Ord, Read, Show) + +_ConstructorDeclarator = (Core.Name "hydra/ext/csharp/syntax.ConstructorDeclarator") + +_ConstructorDeclarator_name = (Core.Name "name") + +_ConstructorDeclarator_parameters = (Core.Name "parameters") + +_ConstructorDeclarator_initializer = (Core.Name "initializer") + +data ConstructorInitializer = + ConstructorInitializerBase (Maybe ArgumentList) | + ConstructorInitializerThis (Maybe ArgumentList) + deriving (Eq, Ord, Read, Show) + +_ConstructorInitializer = (Core.Name "hydra/ext/csharp/syntax.ConstructorInitializer") + +_ConstructorInitializer_base = (Core.Name "base") + +_ConstructorInitializer_this = (Core.Name "this") + +data ConstructorBody = + ConstructorBodyBlock Block | + ConstructorBodyExpression Expression | + ConstructorBodyEmpty + deriving (Eq, Ord, Read, Show) + +_ConstructorBody = (Core.Name "hydra/ext/csharp/syntax.ConstructorBody") + +_ConstructorBody_block = (Core.Name "block") + +_ConstructorBody_expression = (Core.Name "expression") + +_ConstructorBody_empty = (Core.Name "empty") + +data StaticConstructorDeclaration = + StaticConstructorDeclaration { + staticConstructorDeclarationAttributes :: (Maybe Attributes), + staticConstructorDeclarationModifiers :: StaticConstructorModifiers, + staticConstructorDeclarationName :: Identifier, + staticConstructorDeclarationBody :: StaticConstructorBody} + deriving (Eq, Ord, Read, Show) + +_StaticConstructorDeclaration = (Core.Name "hydra/ext/csharp/syntax.StaticConstructorDeclaration") + +_StaticConstructorDeclaration_attributes = (Core.Name "attributes") + +_StaticConstructorDeclaration_modifiers = (Core.Name "modifiers") + +_StaticConstructorDeclaration_name = (Core.Name "name") + +_StaticConstructorDeclaration_body = (Core.Name "body") + +data StaticConstructorModifiers = + StaticConstructorModifiers { + staticConstructorModifiersExtern :: Bool, + staticConstructorModifiersUnsafe :: Bool} + deriving (Eq, Ord, Read, Show) + +_StaticConstructorModifiers = (Core.Name "hydra/ext/csharp/syntax.StaticConstructorModifiers") + +_StaticConstructorModifiers_extern = (Core.Name "extern") + +_StaticConstructorModifiers_unsafe = (Core.Name "unsafe") + +data StaticConstructorBody = + StaticConstructorBodyBlock Block | + StaticConstructorBodyExpression Expression | + StaticConstructorBodyEmpty + deriving (Eq, Ord, Read, Show) + +_StaticConstructorBody = (Core.Name "hydra/ext/csharp/syntax.StaticConstructorBody") + +_StaticConstructorBody_block = (Core.Name "block") + +_StaticConstructorBody_expression = (Core.Name "expression") + +_StaticConstructorBody_empty = (Core.Name "empty") + +data FinalizerDeclaration = + FinalizerDeclaration { + finalizerDeclarationAttributes :: (Maybe Attributes), + finalizerDeclarationExtern :: Bool, + finalizerDeclarationUnsafe :: Bool, + finalizerDeclarationName :: Identifier, + finalizerDeclarationBody :: FinalizerBody} + deriving (Eq, Ord, Read, Show) + +_FinalizerDeclaration = (Core.Name "hydra/ext/csharp/syntax.FinalizerDeclaration") + +_FinalizerDeclaration_attributes = (Core.Name "attributes") + +_FinalizerDeclaration_extern = (Core.Name "extern") + +_FinalizerDeclaration_unsafe = (Core.Name "unsafe") + +_FinalizerDeclaration_name = (Core.Name "name") + +_FinalizerDeclaration_body = (Core.Name "body") + +data FinalizerBody = + FinalizerBodyBlock Block | + FinalizerBodyExpression Expression | + FinalizerBodyEmpty + deriving (Eq, Ord, Read, Show) + +_FinalizerBody = (Core.Name "hydra/ext/csharp/syntax.FinalizerBody") + +_FinalizerBody_block = (Core.Name "block") + +_FinalizerBody_expression = (Core.Name "expression") + +_FinalizerBody_empty = (Core.Name "empty") + +data StructDeclaration = + StructDeclaration { + structDeclarationAttributes :: (Maybe Attributes), + structDeclarationModifiers :: [StructModifier], + structDeclarationRef :: Bool, + structDeclarationPartial :: Bool, + structDeclarationName :: Identifier, + structDeclarationParameters :: (Maybe TypeParameterList), + structDeclarationInterfaces :: [InterfaceType], + structDeclarationConstraints :: [TypeParameterConstraintsClause], + structDeclarationBody :: [StructMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_StructDeclaration = (Core.Name "hydra/ext/csharp/syntax.StructDeclaration") + +_StructDeclaration_attributes = (Core.Name "attributes") + +_StructDeclaration_modifiers = (Core.Name "modifiers") + +_StructDeclaration_ref = (Core.Name "ref") + +_StructDeclaration_partial = (Core.Name "partial") + +_StructDeclaration_name = (Core.Name "name") + +_StructDeclaration_parameters = (Core.Name "parameters") + +_StructDeclaration_interfaces = (Core.Name "interfaces") + +_StructDeclaration_constraints = (Core.Name "constraints") + +_StructDeclaration_body = (Core.Name "body") + +data StructModifier = + StructModifierNew | + StructModifierPublic | + StructModifierProtected | + StructModifierInternal | + StructModifierPrivate | + StructModifierReadonly | + StructModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_StructModifier = (Core.Name "hydra/ext/csharp/syntax.StructModifier") + +_StructModifier_new = (Core.Name "new") + +_StructModifier_public = (Core.Name "public") + +_StructModifier_protected = (Core.Name "protected") + +_StructModifier_internal = (Core.Name "internal") + +_StructModifier_private = (Core.Name "private") + +_StructModifier_readonly = (Core.Name "readonly") + +_StructModifier_unsafe = (Core.Name "unsafe") + +data StructMemberDeclaration = + StructMemberDeclarationConstant ConstantDeclaration | + StructMemberDeclarationField FieldDeclaration | + StructMemberDeclarationMethod MethodDeclaration | + StructMemberDeclarationProperty PropertyDeclaration | + StructMemberDeclarationEvent EventDeclaration | + StructMemberDeclarationIndexer IndexerDeclaration | + StructMemberDeclarationOperator OperatorDeclaration | + StructMemberDeclarationConstructor ConstructorDeclaration | + StructMemberDeclarationStaticConstructor StaticConstructorDeclaration | + StructMemberDeclarationType TypeDeclaration | + StructMemberDeclarationFixedSizeBuffer FixedSizeBufferDeclaration + deriving (Eq, Ord, Read, Show) + +_StructMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.StructMemberDeclaration") + +_StructMemberDeclaration_constant = (Core.Name "constant") + +_StructMemberDeclaration_field = (Core.Name "field") + +_StructMemberDeclaration_method = (Core.Name "method") + +_StructMemberDeclaration_property = (Core.Name "property") + +_StructMemberDeclaration_event = (Core.Name "event") + +_StructMemberDeclaration_indexer = (Core.Name "indexer") + +_StructMemberDeclaration_operator = (Core.Name "operator") + +_StructMemberDeclaration_constructor = (Core.Name "constructor") + +_StructMemberDeclaration_staticConstructor = (Core.Name "staticConstructor") + +_StructMemberDeclaration_type = (Core.Name "type") + +_StructMemberDeclaration_fixedSizeBuffer = (Core.Name "fixedSizeBuffer") + +newtype ArrayInitializer = + ArrayInitializer { + unArrayInitializer :: [VariableInitializer]} + deriving (Eq, Ord, Read, Show) + +_ArrayInitializer = (Core.Name "hydra/ext/csharp/syntax.ArrayInitializer") + +data VariableInitializer = + VariableInitializerExpression Expression | + VariableInitializerArray ArrayInitializer + deriving (Eq, Ord, Read, Show) + +_VariableInitializer = (Core.Name "hydra/ext/csharp/syntax.VariableInitializer") + +_VariableInitializer_expression = (Core.Name "expression") + +_VariableInitializer_array = (Core.Name "array") + +data InterfaceDeclaration = + InterfaceDeclaration { + interfaceDeclarationAttributes :: (Maybe Attributes), + interfaceDeclarationModifiers :: [InterfaceModifier], + interfaceDeclarationPartial :: Bool, + interfaceDeclarationName :: Identifier, + interfaceDeclarationParameters :: (Maybe VariantTypeParameters), + interfaceDeclarationBase :: [InterfaceType], + interfaceDeclarationConstraints :: [TypeParameterConstraintsClause], + interfaceDeclarationBody :: [InterfaceMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_InterfaceDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceDeclaration") + +_InterfaceDeclaration_attributes = (Core.Name "attributes") + +_InterfaceDeclaration_modifiers = (Core.Name "modifiers") + +_InterfaceDeclaration_partial = (Core.Name "partial") + +_InterfaceDeclaration_name = (Core.Name "name") + +_InterfaceDeclaration_parameters = (Core.Name "parameters") + +_InterfaceDeclaration_base = (Core.Name "base") + +_InterfaceDeclaration_constraints = (Core.Name "constraints") + +_InterfaceDeclaration_body = (Core.Name "body") + +data InterfaceModifier = + InterfaceModifierNew | + InterfaceModifierPublic | + InterfaceModifierProtected | + InterfaceModifierInternal | + InterfaceModifierPrivate | + InterfaceModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_InterfaceModifier = (Core.Name "hydra/ext/csharp/syntax.InterfaceModifier") + +_InterfaceModifier_new = (Core.Name "new") + +_InterfaceModifier_public = (Core.Name "public") + +_InterfaceModifier_protected = (Core.Name "protected") + +_InterfaceModifier_internal = (Core.Name "internal") + +_InterfaceModifier_private = (Core.Name "private") + +_InterfaceModifier_unsafe = (Core.Name "unsafe") + +newtype VariantTypeParameters = + VariantTypeParameters { + unVariantTypeParameters :: [VariantTypeParameter]} + deriving (Eq, Ord, Read, Show) + +_VariantTypeParameters = (Core.Name "hydra/ext/csharp/syntax.VariantTypeParameters") + +data VariantTypeParameter = + VariantTypeParameter { + variantTypeParameterAttributes :: (Maybe Attributes), + variantTypeParameterVariance :: (Maybe VarianceAnnotation), + variantTypeParameterParameter :: TypeParameter} + deriving (Eq, Ord, Read, Show) + +_VariantTypeParameter = (Core.Name "hydra/ext/csharp/syntax.VariantTypeParameter") + +_VariantTypeParameter_attributes = (Core.Name "attributes") + +_VariantTypeParameter_variance = (Core.Name "variance") + +_VariantTypeParameter_parameter = (Core.Name "parameter") + +data VarianceAnnotation = + VarianceAnnotationIn | + VarianceAnnotationOut + deriving (Eq, Ord, Read, Show) + +_VarianceAnnotation = (Core.Name "hydra/ext/csharp/syntax.VarianceAnnotation") + +_VarianceAnnotation_in = (Core.Name "in") + +_VarianceAnnotation_out = (Core.Name "out") + +data InterfaceMemberDeclaration = + InterfaceMemberDeclarationMethod InterfaceMethodDeclaration | + InterfaceMemberDeclarationProperty InterfacePropertyDeclaration | + InterfaceMemberDeclarationEvent InterfaceEventDeclaration | + InterfaceMemberDeclarationIndexer InterfaceIndexerDeclaration + deriving (Eq, Ord, Read, Show) + +_InterfaceMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceMemberDeclaration") + +_InterfaceMemberDeclaration_method = (Core.Name "method") + +_InterfaceMemberDeclaration_property = (Core.Name "property") + +_InterfaceMemberDeclaration_event = (Core.Name "event") + +_InterfaceMemberDeclaration_indexer = (Core.Name "indexer") + +data InterfaceMethodDeclaration = + InterfaceMethodDeclaration { + interfaceMethodDeclarationAttributes :: (Maybe Attributes), + interfaceMethodDeclarationNew :: Bool, + interfaceMethodDeclarationReturnType :: ReturnType, + interfaceMethodDeclarationRefKind :: (Maybe RefKind), + interfaceMethodDeclarationHeader :: InterfaceMethodHeader} + deriving (Eq, Ord, Read, Show) + +_InterfaceMethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceMethodDeclaration") + +_InterfaceMethodDeclaration_attributes = (Core.Name "attributes") + +_InterfaceMethodDeclaration_new = (Core.Name "new") + +_InterfaceMethodDeclaration_returnType = (Core.Name "returnType") + +_InterfaceMethodDeclaration_refKind = (Core.Name "refKind") + +_InterfaceMethodDeclaration_header = (Core.Name "header") + +data InterfaceMethodHeader = + InterfaceMethodHeader { + interfaceMethodHeaderName :: Identifier, + interfaceMethodHeaderParameters :: (Maybe FormalParameterList), + interfaceMethodHeaderTypeParameters :: (Maybe TypeParameterList), + interfaceMethodHeaderConstraints :: [TypeParameterConstraintsClause]} + deriving (Eq, Ord, Read, Show) + +_InterfaceMethodHeader = (Core.Name "hydra/ext/csharp/syntax.InterfaceMethodHeader") + +_InterfaceMethodHeader_name = (Core.Name "name") + +_InterfaceMethodHeader_parameters = (Core.Name "parameters") + +_InterfaceMethodHeader_typeParameters = (Core.Name "typeParameters") + +_InterfaceMethodHeader_constraints = (Core.Name "constraints") + +data InterfacePropertyDeclaration = + InterfacePropertyDeclaration { + interfacePropertyDeclarationAttributes :: (Maybe Attributes), + interfacePropertyDeclarationNew :: Bool, + interfacePropertyDeclarationRefKind :: (Maybe RefKind), + interfacePropertyDeclarationType :: Type, + interfacePropertyDeclarationName :: Identifier, + interfacePropertyDeclarationAccessors :: InterfaceAccessors} + deriving (Eq, Ord, Read, Show) + +_InterfacePropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfacePropertyDeclaration") + +_InterfacePropertyDeclaration_attributes = (Core.Name "attributes") + +_InterfacePropertyDeclaration_new = (Core.Name "new") + +_InterfacePropertyDeclaration_refKind = (Core.Name "refKind") + +_InterfacePropertyDeclaration_type = (Core.Name "type") + +_InterfacePropertyDeclaration_name = (Core.Name "name") + +_InterfacePropertyDeclaration_accessors = (Core.Name "accessors") + +data InterfaceAccessors = + InterfaceAccessors { + interfaceAccessorsAttributes :: (Maybe Attributes), + interfaceAccessorsGet :: (Maybe Attributes), + interfaceAccessorsSet :: (Maybe Attributes)} + deriving (Eq, Ord, Read, Show) + +_InterfaceAccessors = (Core.Name "hydra/ext/csharp/syntax.InterfaceAccessors") + +_InterfaceAccessors_attributes = (Core.Name "attributes") + +_InterfaceAccessors_get = (Core.Name "get") + +_InterfaceAccessors_set = (Core.Name "set") + +data InterfaceEventDeclaration = + InterfaceEventDeclaration { + interfaceEventDeclarationAttributes :: (Maybe Attributes), + interfaceEventDeclarationNew :: Bool, + interfaceEventDeclarationType :: Type, + interfaceEventDeclarationName :: Identifier} + deriving (Eq, Ord, Read, Show) + +_InterfaceEventDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceEventDeclaration") + +_InterfaceEventDeclaration_attributes = (Core.Name "attributes") + +_InterfaceEventDeclaration_new = (Core.Name "new") + +_InterfaceEventDeclaration_type = (Core.Name "type") + +_InterfaceEventDeclaration_name = (Core.Name "name") + +data InterfaceIndexerDeclaration = + InterfaceIndexerDeclaration { + interfaceIndexerDeclarationAttributes :: (Maybe Attributes), + interfaceIndexerDeclarationNew :: Bool, + interfaceIndexerDeclarationRefKind :: (Maybe RefKind), + interfaceIndexerDeclarationType :: Type, + interfaceIndexerDeclarationParameters :: FormalParameterList, + interfaceIndexerDeclarationAccessors :: InterfaceAccessors} + deriving (Eq, Ord, Read, Show) + +_InterfaceIndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceIndexerDeclaration") + +_InterfaceIndexerDeclaration_attributes = (Core.Name "attributes") + +_InterfaceIndexerDeclaration_new = (Core.Name "new") + +_InterfaceIndexerDeclaration_refKind = (Core.Name "refKind") + +_InterfaceIndexerDeclaration_type = (Core.Name "type") + +_InterfaceIndexerDeclaration_parameters = (Core.Name "parameters") + +_InterfaceIndexerDeclaration_accessors = (Core.Name "accessors") + +data EnumDeclaration = + EnumDeclaration { + enumDeclarationAttributes :: (Maybe Attributes), + enumDeclarationModifiers :: [EnumModifier], + enumDeclarationName :: Identifier, + enumDeclarationBase :: (Maybe EnumBase), + enumDeclarationBody :: (Maybe EnumBody)} + deriving (Eq, Ord, Read, Show) + +_EnumDeclaration = (Core.Name "hydra/ext/csharp/syntax.EnumDeclaration") + +_EnumDeclaration_attributes = (Core.Name "attributes") + +_EnumDeclaration_modifiers = (Core.Name "modifiers") + +_EnumDeclaration_name = (Core.Name "name") + +_EnumDeclaration_base = (Core.Name "base") + +_EnumDeclaration_body = (Core.Name "body") + +data EnumBase = + EnumBaseType IntegralType | + EnumBaseName TypeName + deriving (Eq, Ord, Read, Show) + +_EnumBase = (Core.Name "hydra/ext/csharp/syntax.EnumBase") + +_EnumBase_type = (Core.Name "type") + +_EnumBase_name = (Core.Name "name") + +newtype EnumBody = + EnumBody { + unEnumBody :: [EnumMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_EnumBody = (Core.Name "hydra/ext/csharp/syntax.EnumBody") + +data EnumModifier = + EnumModifierNew | + EnumModifierPublic | + EnumModifierProtected | + EnumModifierInternal | + EnumModifierPrivate + deriving (Eq, Ord, Read, Show) + +_EnumModifier = (Core.Name "hydra/ext/csharp/syntax.EnumModifier") + +_EnumModifier_new = (Core.Name "new") + +_EnumModifier_public = (Core.Name "public") + +_EnumModifier_protected = (Core.Name "protected") + +_EnumModifier_internal = (Core.Name "internal") + +_EnumModifier_private = (Core.Name "private") + +data EnumMemberDeclaration = + EnumMemberDeclaration { + enumMemberDeclarationAttributes :: (Maybe Attributes), + enumMemberDeclarationName :: Identifier, + enumMemberDeclarationValue :: (Maybe ConstantExpression)} + deriving (Eq, Ord, Read, Show) + +_EnumMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.EnumMemberDeclaration") + +_EnumMemberDeclaration_attributes = (Core.Name "attributes") + +_EnumMemberDeclaration_name = (Core.Name "name") + +_EnumMemberDeclaration_value = (Core.Name "value") + +data DelegateDeclaration = + DelegateDeclaration { + delegateDeclarationAttributes :: (Maybe Attributes), + delegateDeclarationModifiers :: [DelegateModifier], + delegateDeclarationReturnType :: ReturnType, + delegateDeclarationRefKind :: (Maybe RefKind), + delegateDeclarationRefReturnType :: (Maybe Type), + delegateDeclarationHeader :: DelegateHeader} + deriving (Eq, Ord, Read, Show) + +_DelegateDeclaration = (Core.Name "hydra/ext/csharp/syntax.DelegateDeclaration") + +_DelegateDeclaration_attributes = (Core.Name "attributes") + +_DelegateDeclaration_modifiers = (Core.Name "modifiers") + +_DelegateDeclaration_returnType = (Core.Name "returnType") + +_DelegateDeclaration_refKind = (Core.Name "refKind") + +_DelegateDeclaration_refReturnType = (Core.Name "refReturnType") + +_DelegateDeclaration_header = (Core.Name "header") + +data DelegateHeader = + DelegateHeader { + delegateHeaderName :: Identifier, + delegateHeaderTypeParameters :: (Maybe VariantTypeParameters), + delegateHeaderParameters :: (Maybe FormalParameterList), + delegateHeaderConstraints :: [TypeParameterConstraintsClause]} + deriving (Eq, Ord, Read, Show) + +_DelegateHeader = (Core.Name "hydra/ext/csharp/syntax.DelegateHeader") + +_DelegateHeader_name = (Core.Name "name") + +_DelegateHeader_typeParameters = (Core.Name "typeParameters") + +_DelegateHeader_parameters = (Core.Name "parameters") + +_DelegateHeader_constraints = (Core.Name "constraints") + +data DelegateModifier = + DelegateModifierNew | + DelegateModifierPublic | + DelegateModifierProtected | + DelegateModifierInternal | + DelegateModifierPrivate | + DelegateModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_DelegateModifier = (Core.Name "hydra/ext/csharp/syntax.DelegateModifier") + +_DelegateModifier_new = (Core.Name "new") + +_DelegateModifier_public = (Core.Name "public") + +_DelegateModifier_protected = (Core.Name "protected") + +_DelegateModifier_internal = (Core.Name "internal") + +_DelegateModifier_private = (Core.Name "private") + +_DelegateModifier_unsafe = (Core.Name "unsafe") + +data GlobalAttributeSection = + GlobalAttributeSection { + globalAttributeSectionTarget :: Identifier, + globalAttributeSectionAttributes :: AttributeList} + deriving (Eq, Ord, Read, Show) + +_GlobalAttributeSection = (Core.Name "hydra/ext/csharp/syntax.GlobalAttributeSection") + +_GlobalAttributeSection_target = (Core.Name "target") + +_GlobalAttributeSection_attributes = (Core.Name "attributes") + +newtype Attributes = + Attributes { + unAttributes :: [AttributeSection]} + deriving (Eq, Ord, Read, Show) + +_Attributes = (Core.Name "hydra/ext/csharp/syntax.Attributes") + +data AttributeSection = + AttributeSection { + attributeSectionTarget :: (Maybe AttributeTarget), + attributeSectionAttributes :: AttributeList} + deriving (Eq, Ord, Read, Show) + +_AttributeSection = (Core.Name "hydra/ext/csharp/syntax.AttributeSection") + +_AttributeSection_target = (Core.Name "target") + +_AttributeSection_attributes = (Core.Name "attributes") + +data AttributeTarget = + AttributeTargetIdentifier Identifier | + AttributeTargetKeyword Keyword + deriving (Eq, Ord, Read, Show) + +_AttributeTarget = (Core.Name "hydra/ext/csharp/syntax.AttributeTarget") + +_AttributeTarget_identifier = (Core.Name "identifier") + +_AttributeTarget_keyword = (Core.Name "keyword") + +newtype AttributeList = + AttributeList { + unAttributeList :: [Attribute]} + deriving (Eq, Ord, Read, Show) + +_AttributeList = (Core.Name "hydra/ext/csharp/syntax.AttributeList") + +data Attribute = + Attribute { + attributeName :: AttributeName, + attributeArguments :: (Maybe AttributeArguments)} + deriving (Eq, Ord, Read, Show) + +_Attribute = (Core.Name "hydra/ext/csharp/syntax.Attribute") + +_Attribute_name = (Core.Name "name") + +_Attribute_arguments = (Core.Name "arguments") + +newtype AttributeName = + AttributeName { + unAttributeName :: TypeName} + deriving (Eq, Ord, Read, Show) + +_AttributeName = (Core.Name "hydra/ext/csharp/syntax.AttributeName") + +data AttributeArguments = + AttributeArguments { + attributeArgumentsPositonal :: (Maybe PositionalArgumentList), + attributeArgumentsNamed :: (Maybe NamedArgumentList)} + deriving (Eq, Ord, Read, Show) + +_AttributeArguments = (Core.Name "hydra/ext/csharp/syntax.AttributeArguments") + +_AttributeArguments_positonal = (Core.Name "positonal") + +_AttributeArguments_named = (Core.Name "named") + +newtype PositionalArgumentList = + PositionalArgumentList { + unPositionalArgumentList :: [PositionalArgument]} + deriving (Eq, Ord, Read, Show) + +_PositionalArgumentList = (Core.Name "hydra/ext/csharp/syntax.PositionalArgumentList") + +data PositionalArgument = + PositionalArgument { + positionalArgumentName :: (Maybe Identifier), + positionalArgumentValue :: AttributeArgumentExpression} + deriving (Eq, Ord, Read, Show) + +_PositionalArgument = (Core.Name "hydra/ext/csharp/syntax.PositionalArgument") + +_PositionalArgument_name = (Core.Name "name") + +_PositionalArgument_value = (Core.Name "value") + +newtype NamedArgumentList = + NamedArgumentList { + unNamedArgumentList :: [NamedArgument]} + deriving (Eq, Ord, Read, Show) + +_NamedArgumentList = (Core.Name "hydra/ext/csharp/syntax.NamedArgumentList") + +data NamedArgument = + NamedArgument { + namedArgumentName :: Identifier, + namedArgumentValue :: AttributeArgumentExpression} + deriving (Eq, Ord, Read, Show) + +_NamedArgument = (Core.Name "hydra/ext/csharp/syntax.NamedArgument") + +_NamedArgument_name = (Core.Name "name") + +_NamedArgument_value = (Core.Name "value") + +newtype AttributeArgumentExpression = + AttributeArgumentExpression { + unAttributeArgumentExpression :: NonAssignmentExpression} + deriving (Eq, Ord, Read, Show) + +_AttributeArgumentExpression = (Core.Name "hydra/ext/csharp/syntax.AttributeArgumentExpression") + +data PointerType = + PointerTypeValueType (Maybe ValueType) | + PointerTypePointerDepth Int + deriving (Eq, Ord, Read, Show) + +_PointerType = (Core.Name "hydra/ext/csharp/syntax.PointerType") + +_PointerType_valueType = (Core.Name "valueType") + +_PointerType_pointerDepth = (Core.Name "pointerDepth") + +data PointerMemberAccess = + PointerMemberAccess { + pointerMemberAccessPointer :: PrimaryExpression, + pointerMemberAccessMember :: Identifier, + pointerMemberAccessTypeArguments :: (Maybe TypeArgumentList)} + deriving (Eq, Ord, Read, Show) + +_PointerMemberAccess = (Core.Name "hydra/ext/csharp/syntax.PointerMemberAccess") + +_PointerMemberAccess_pointer = (Core.Name "pointer") + +_PointerMemberAccess_member = (Core.Name "member") + +_PointerMemberAccess_typeArguments = (Core.Name "typeArguments") + +data PointerElementAccess = + PointerElementAccess { + pointerElementAccessPointer :: PrimaryNoArrayCreationExpression, + pointerElementAccessIndex :: Expression} + deriving (Eq, Ord, Read, Show) + +_PointerElementAccess = (Core.Name "hydra/ext/csharp/syntax.PointerElementAccess") + +_PointerElementAccess_pointer = (Core.Name "pointer") + +_PointerElementAccess_index = (Core.Name "index") + +data FixedStatement = + FixedStatement { + fixedStatementPointerType :: PointerType, + fixedStatementDeclarators :: [FixedPointerDeclarator], + fixedStatementStatement :: EmbeddedStatement} + deriving (Eq, Ord, Read, Show) + +_FixedStatement = (Core.Name "hydra/ext/csharp/syntax.FixedStatement") + +_FixedStatement_pointerType = (Core.Name "pointerType") + +_FixedStatement_declarators = (Core.Name "declarators") + +_FixedStatement_statement = (Core.Name "statement") + +data FixedPointerDeclarator = + FixedPointerDeclaratorReference VariableReference | + FixedPointerDeclaratorExpression Expression + deriving (Eq, Ord, Read, Show) + +_FixedPointerDeclarator = (Core.Name "hydra/ext/csharp/syntax.FixedPointerDeclarator") + +_FixedPointerDeclarator_reference = (Core.Name "reference") + +_FixedPointerDeclarator_expression = (Core.Name "expression") + +data FixedSizeBufferDeclaration = + FixedSizeBufferDeclaration { + fixedSizeBufferDeclarationAttributes :: (Maybe Attributes), + fixedSizeBufferDeclarationModifiers :: [FixedSizeBufferModifier], + fixedSizeBufferDeclarationElementType :: Type, + fixedSizeBufferDeclarationDeclarators :: [FixedSizeBufferDeclarator]} + deriving (Eq, Ord, Read, Show) + +_FixedSizeBufferDeclaration = (Core.Name "hydra/ext/csharp/syntax.FixedSizeBufferDeclaration") + +_FixedSizeBufferDeclaration_attributes = (Core.Name "attributes") + +_FixedSizeBufferDeclaration_modifiers = (Core.Name "modifiers") + +_FixedSizeBufferDeclaration_elementType = (Core.Name "elementType") + +_FixedSizeBufferDeclaration_declarators = (Core.Name "declarators") + +data FixedSizeBufferModifier = + FixedSizeBufferModifierNew | + FixedSizeBufferModifierPublic | + FixedSizeBufferModifierInternal | + FixedSizeBufferModifierPrivate | + FixedSizeBufferModifierUnsafe + deriving (Eq, Ord, Read, Show) + +_FixedSizeBufferModifier = (Core.Name "hydra/ext/csharp/syntax.FixedSizeBufferModifier") + +_FixedSizeBufferModifier_new = (Core.Name "new") + +_FixedSizeBufferModifier_public = (Core.Name "public") + +_FixedSizeBufferModifier_internal = (Core.Name "internal") + +_FixedSizeBufferModifier_private = (Core.Name "private") + +_FixedSizeBufferModifier_unsafe = (Core.Name "unsafe") + +data FixedSizeBufferDeclarator = + FixedSizeBufferDeclarator { + fixedSizeBufferDeclaratorName :: Identifier, + fixedSizeBufferDeclaratorSize :: ConstantExpression} + deriving (Eq, Ord, Read, Show) + +_FixedSizeBufferDeclarator = (Core.Name "hydra/ext/csharp/syntax.FixedSizeBufferDeclarator") + +_FixedSizeBufferDeclarator_name = (Core.Name "name") + +_FixedSizeBufferDeclarator_size = (Core.Name "size") diff --git a/src/gen-main/haskell/Hydra/Ext/Cypher/Features.hs b/src/gen-main/haskell/Hydra/Ext/Cypher/Features.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Cypher/Features.hs @@ -0,0 +1,1360 @@ +-- | A model for characterizing OpenCypher queries and implementations in terms of included features.Based on the OpenCypher grammar and the list of standard Cypher functions at https://neo4j.com/docs/cypher-manual/current/functions. Current as of August 2024. + +module Hydra.Ext.Cypher.Features where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | A set of features which characterize an OpenCypher query or implementation. Any features which are omitted from the set are assumed to be unsupported or nonrequired. +data CypherFeatures = + CypherFeatures { + -- | Arithmetic operations + cypherFeaturesArithmetic :: ArithmeticFeatures, + -- | Various kinds of atomic expressions + cypherFeaturesAtom :: AtomFeatures, + -- | Comparison operators and functions + cypherFeaturesComparison :: ComparisonFeatures, + -- | Delete operations + cypherFeaturesDelete :: DeleteFeatures, + -- | Standard Cypher functions + cypherFeaturesFunction :: FunctionFeatures, + -- | List functionality + cypherFeaturesList :: ListFeatures, + -- | Various types of literal values + cypherFeaturesLiteral :: LiteralFeatures, + -- | Logical operations + cypherFeaturesLogical :: LogicalFeatures, + -- | Match queries + cypherFeaturesMatch :: MatchFeatures, + -- | Merge operations + cypherFeaturesMerge :: MergeFeatures, + -- | Node patterns + cypherFeaturesNodePattern :: NodePatternFeatures, + -- | IS NULL / IS NOT NULL checks + cypherFeaturesNull :: NullFeatures, + -- | Path functions only found in OpenCypher + cypherFeaturesPath :: PathFeatures, + -- | Procedure calls + cypherFeaturesProcedureCall :: ProcedureCallFeatures, + -- | Projections + cypherFeaturesProjection :: ProjectionFeatures, + -- | Quantifier expressions + cypherFeaturesQuantifier :: QuantifierFeatures, + -- | Range literals within relationship patterns + cypherFeaturesRangeLiteral :: RangeLiteralFeatures, + -- | Specific syntax related to reading data from the graph. + cypherFeaturesReading :: ReadingFeatures, + -- | Relationship directions / arrow patterns + cypherFeaturesRelationshipDirection :: RelationshipDirectionFeatures, + -- | Relationship patterns + cypherFeaturesRelationshipPattern :: RelationshipPatternFeatures, + -- | REMOVE operations + cypherFeaturesRemove :: RemoveFeatures, + -- | Set definitions + cypherFeaturesSet :: SetFeatures, + -- | String functions/keywords only found in OpenCypher + cypherFeaturesString :: StringFeatures, + -- | Specific syntax related to updating data in the graph + cypherFeaturesUpdating :: UpdatingFeatures} + deriving (Eq, Ord, Read, Show) + +_CypherFeatures = (Core.Name "hydra/ext/cypher/features.CypherFeatures") + +_CypherFeatures_arithmetic = (Core.Name "arithmetic") + +_CypherFeatures_atom = (Core.Name "atom") + +_CypherFeatures_comparison = (Core.Name "comparison") + +_CypherFeatures_delete = (Core.Name "delete") + +_CypherFeatures_function = (Core.Name "function") + +_CypherFeatures_list = (Core.Name "list") + +_CypherFeatures_literal = (Core.Name "literal") + +_CypherFeatures_logical = (Core.Name "logical") + +_CypherFeatures_match = (Core.Name "match") + +_CypherFeatures_merge = (Core.Name "merge") + +_CypherFeatures_nodePattern = (Core.Name "nodePattern") + +_CypherFeatures_null = (Core.Name "null") + +_CypherFeatures_path = (Core.Name "path") + +_CypherFeatures_procedureCall = (Core.Name "procedureCall") + +_CypherFeatures_projection = (Core.Name "projection") + +_CypherFeatures_quantifier = (Core.Name "quantifier") + +_CypherFeatures_rangeLiteral = (Core.Name "rangeLiteral") + +_CypherFeatures_reading = (Core.Name "reading") + +_CypherFeatures_relationshipDirection = (Core.Name "relationshipDirection") + +_CypherFeatures_relationshipPattern = (Core.Name "relationshipPattern") + +_CypherFeatures_remove = (Core.Name "remove") + +_CypherFeatures_set = (Core.Name "set") + +_CypherFeatures_string = (Core.Name "string") + +_CypherFeatures_updating = (Core.Name "updating") + +-- | Arithmetic operations +data ArithmeticFeatures = + ArithmeticFeatures { + -- | The + operator + arithmeticFeaturesPlus :: Bool, + -- | The - operator + arithmeticFeaturesMinus :: Bool, + -- | The * operator + arithmeticFeaturesMultiply :: Bool, + -- | The / operator + arithmeticFeaturesDivide :: Bool, + -- | The % operator + arithmeticFeaturesModulus :: Bool, + -- | The ^ operator + arithmeticFeaturesPowerOf :: Bool} + deriving (Eq, Ord, Read, Show) + +_ArithmeticFeatures = (Core.Name "hydra/ext/cypher/features.ArithmeticFeatures") + +_ArithmeticFeatures_plus = (Core.Name "plus") + +_ArithmeticFeatures_minus = (Core.Name "minus") + +_ArithmeticFeatures_multiply = (Core.Name "multiply") + +_ArithmeticFeatures_divide = (Core.Name "divide") + +_ArithmeticFeatures_modulus = (Core.Name "modulus") + +_ArithmeticFeatures_powerOf = (Core.Name "powerOf") + +-- | Various kinds of atomic expressions +data AtomFeatures = + AtomFeatures { + -- | CASE expressions + atomFeaturesCaseExpression :: Bool, + -- | The COUNT (*) expression + atomFeaturesCount :: Bool, + -- | Existential subqueries + atomFeaturesExistentialSubquery :: Bool, + -- | Function invocation + atomFeaturesFunctionInvocation :: Bool, + -- | Parameter expressions + atomFeaturesParameter :: Bool, + -- | Pattern comprehensions + atomFeaturesPatternComprehension :: Bool, + -- | Relationship patterns as subexpressions + atomFeaturesPatternPredicate :: Bool, + -- | Variable expressions (note: included by most if not all implementations). + atomFeaturesVariable :: Bool} + deriving (Eq, Ord, Read, Show) + +_AtomFeatures = (Core.Name "hydra/ext/cypher/features.AtomFeatures") + +_AtomFeatures_caseExpression = (Core.Name "caseExpression") + +_AtomFeatures_count = (Core.Name "count") + +_AtomFeatures_existentialSubquery = (Core.Name "existentialSubquery") + +_AtomFeatures_functionInvocation = (Core.Name "functionInvocation") + +_AtomFeatures_parameter = (Core.Name "parameter") + +_AtomFeatures_patternComprehension = (Core.Name "patternComprehension") + +_AtomFeatures_patternPredicate = (Core.Name "patternPredicate") + +_AtomFeatures_variable = (Core.Name "variable") + +-- | Comparison operators and functions +data ComparisonFeatures = + ComparisonFeatures { + -- | The = comparison operator + comparisonFeaturesEqual :: Bool, + -- | The > comparison operator + comparisonFeaturesGreaterThan :: Bool, + -- | The >= comparison operator + comparisonFeaturesGreaterThanOrEqual :: Bool, + -- | The < comparison operator + comparisonFeaturesLessThan :: Bool, + -- | The <= comparison operator + comparisonFeaturesLessThanOrEqual :: Bool, + -- | The <> comparison operator + comparisonFeaturesNotEqual :: Bool} + deriving (Eq, Ord, Read, Show) + +_ComparisonFeatures = (Core.Name "hydra/ext/cypher/features.ComparisonFeatures") + +_ComparisonFeatures_equal = (Core.Name "equal") + +_ComparisonFeatures_greaterThan = (Core.Name "greaterThan") + +_ComparisonFeatures_greaterThanOrEqual = (Core.Name "greaterThanOrEqual") + +_ComparisonFeatures_lessThan = (Core.Name "lessThan") + +_ComparisonFeatures_lessThanOrEqual = (Core.Name "lessThanOrEqual") + +_ComparisonFeatures_notEqual = (Core.Name "notEqual") + +-- | Delete operations +data DeleteFeatures = + DeleteFeatures { + -- | The basic DELETE clause + deleteFeaturesDelete :: Bool, + -- | The DETACH DELETE clause + deleteFeaturesDetachDelete :: Bool} + deriving (Eq, Ord, Read, Show) + +_DeleteFeatures = (Core.Name "hydra/ext/cypher/features.DeleteFeatures") + +_DeleteFeatures_delete = (Core.Name "delete") + +_DeleteFeatures_detachDelete = (Core.Name "detachDelete") + +-- | Standard Cypher functions +data FunctionFeatures = + FunctionFeatures { + -- | Aggregate functions + functionFeaturesAggregateFunction :: AggregateFunctionFeatures, + -- | Database functions + functionFeaturesDatabaseFunction :: DatabaseFunctionFeatures, + -- | GenAI functions + functionFeaturesGenAIFunction :: GenAIFunctionFeatures, + -- | Graph functions + functionFeaturesGraphFunction :: GraphFunctionFeatures, + -- | List functions + functionFeaturesListFunction :: ListFunctionFeatures, + -- | Load CSV functions + functionFeaturesLoadCSVFunction :: LoadCSVFunctionFeatures, + -- | Logarithmic functions + functionFeaturesLogarithmicFunction :: LogarithmicFunctionFeatures, + -- | Numeric functions + functionFeaturesNumericFunction :: NumericFunctionFeatures, + -- | Predicate functions + functionFeaturesPredicateFunction :: PredicateFunctionFeatures, + -- | Scalar functions + functionFeaturesScalarFunction :: ScalarFunctionFeatures, + -- | Spatial functions + functionFeaturesSpatialFunction :: SpatialFunctionFeatures, + -- | String functions + functionFeaturesStringFunction :: StringFunctionFeatures, + -- | Temporal duration functions + functionFeaturesTemporalDurationFunction :: TemporalDurationFunctionFeatures, + -- | Temporal instant functions + functionFeaturesTemporalInstantFunction :: TemporalInstantFunctionFeatures, + -- | Trigonometric functions + functionFeaturesTrigonometricFunction :: TrigonometricFunctionFeatures, + -- | Vector functions + functionFeaturesVectorFunction :: VectorFunctionFeatures} + deriving (Eq, Ord, Read, Show) + +_FunctionFeatures = (Core.Name "hydra/ext/cypher/features.FunctionFeatures") + +_FunctionFeatures_aggregateFunction = (Core.Name "aggregateFunction") + +_FunctionFeatures_databaseFunction = (Core.Name "databaseFunction") + +_FunctionFeatures_genAIFunction = (Core.Name "genAIFunction") + +_FunctionFeatures_graphFunction = (Core.Name "graphFunction") + +_FunctionFeatures_listFunction = (Core.Name "listFunction") + +_FunctionFeatures_loadCSVFunction = (Core.Name "loadCSVFunction") + +_FunctionFeatures_logarithmicFunction = (Core.Name "logarithmicFunction") + +_FunctionFeatures_numericFunction = (Core.Name "numericFunction") + +_FunctionFeatures_predicateFunction = (Core.Name "predicateFunction") + +_FunctionFeatures_scalarFunction = (Core.Name "scalarFunction") + +_FunctionFeatures_spatialFunction = (Core.Name "spatialFunction") + +_FunctionFeatures_stringFunction = (Core.Name "stringFunction") + +_FunctionFeatures_temporalDurationFunction = (Core.Name "temporalDurationFunction") + +_FunctionFeatures_temporalInstantFunction = (Core.Name "temporalInstantFunction") + +_FunctionFeatures_trigonometricFunction = (Core.Name "trigonometricFunction") + +_FunctionFeatures_vectorFunction = (Core.Name "vectorFunction") + +-- | Aggregate functions +data AggregateFunctionFeatures = + AggregateFunctionFeatures { + -- | The avg() function / AVG. Returns the average of a set of DURATION values.; Returns the average of a set of FLOAT values.; Returns the average of a set of INTEGER values. + aggregateFunctionFeaturesAvg :: Bool, + -- | The collect() function / COLLECT. Returns a list containing the values returned by an expression. + aggregateFunctionFeaturesCollect :: Bool, + -- | The count() function / COUNT. Returns the number of values or rows. + aggregateFunctionFeaturesCount :: Bool, + -- | The max() function / MAX. Returns the maximum value in a set of values. + aggregateFunctionFeaturesMax :: Bool, + -- | The min() function / MIN. Returns the minimum value in a set of values. + aggregateFunctionFeaturesMin :: Bool, + -- | The percentileCont() function. Returns the percentile of a value over a group using linear interpolation. + aggregateFunctionFeaturesPercentileCont :: Bool, + -- | The percentileDisc() function. Returns the nearest FLOAT value to the given percentile over a group using a rounding method.; Returns the nearest INTEGER value to the given percentile over a group using a rounding method. + aggregateFunctionFeaturesPercentileDisc :: Bool, + -- | The stdev() function. Returns the standard deviation for the given value over a group for a sample of a population. + aggregateFunctionFeaturesStdev :: Bool, + -- | The stdevp() function. Returns the standard deviation for the given value over a group for an entire population. + aggregateFunctionFeaturesStdevp :: Bool, + -- | The sum() function / SUM. Returns the sum of a set of DURATION values.; Returns the sum of a set of FLOAT values.; Returns the sum of a set of INTEGER values. + aggregateFunctionFeaturesSum :: Bool} + deriving (Eq, Ord, Read, Show) + +_AggregateFunctionFeatures = (Core.Name "hydra/ext/cypher/features.AggregateFunctionFeatures") + +_AggregateFunctionFeatures_avg = (Core.Name "avg") + +_AggregateFunctionFeatures_collect = (Core.Name "collect") + +_AggregateFunctionFeatures_count = (Core.Name "count") + +_AggregateFunctionFeatures_max = (Core.Name "max") + +_AggregateFunctionFeatures_min = (Core.Name "min") + +_AggregateFunctionFeatures_percentileCont = (Core.Name "percentileCont") + +_AggregateFunctionFeatures_percentileDisc = (Core.Name "percentileDisc") + +_AggregateFunctionFeatures_stdev = (Core.Name "stdev") + +_AggregateFunctionFeatures_stdevp = (Core.Name "stdevp") + +_AggregateFunctionFeatures_sum = (Core.Name "sum") + +-- | Database functions +data DatabaseFunctionFeatures = + DatabaseFunctionFeatures { + -- | The db.nameFromElementId() function. Resolves the database name from the given element id. Introduced in 5.12. + databaseFunctionFeaturesDb_nameFromElementId :: Bool} + deriving (Eq, Ord, Read, Show) + +_DatabaseFunctionFeatures = (Core.Name "hydra/ext/cypher/features.DatabaseFunctionFeatures") + +_DatabaseFunctionFeatures_db_nameFromElementId = (Core.Name "db.nameFromElementId") + +-- | GenAI functions +data GenAIFunctionFeatures = + GenAIFunctionFeatures { + -- | The genai.vector.encode() function. Encode a given resource as a vector using the named provider. Introduced in 5.17. + genAIFunctionFeaturesGenai_vector_encode :: Bool} + deriving (Eq, Ord, Read, Show) + +_GenAIFunctionFeatures = (Core.Name "hydra/ext/cypher/features.GenAIFunctionFeatures") + +_GenAIFunctionFeatures_genai_vector_encode = (Core.Name "genai.vector.encode") + +-- | Graph functions +data GraphFunctionFeatures = + GraphFunctionFeatures { + -- | The graph.byElementId() function. Resolves the constituent graph to which a given element id belongs. Introduced in 5.13. + graphFunctionFeaturesGraph_byElementId :: Bool, + -- | The graph.byName() function. Resolves a constituent graph by name. + graphFunctionFeaturesGraph_byName :: Bool, + -- | The graph.names() function. Returns a list containing the names of all graphs in the current composite database. + graphFunctionFeaturesGraph_names :: Bool, + -- | The graph.propertiesByName() function. Returns a map containing the properties associated with the given graph. + graphFunctionFeaturesGraph_propertiesByName :: Bool} + deriving (Eq, Ord, Read, Show) + +_GraphFunctionFeatures = (Core.Name "hydra/ext/cypher/features.GraphFunctionFeatures") + +_GraphFunctionFeatures_graph_byElementId = (Core.Name "graph.byElementId") + +_GraphFunctionFeatures_graph_byName = (Core.Name "graph.byName") + +_GraphFunctionFeatures_graph_names = (Core.Name "graph.names") + +_GraphFunctionFeatures_graph_propertiesByName = (Core.Name "graph.propertiesByName") + +-- | List functions +data ListFunctionFeatures = + ListFunctionFeatures { + -- | The keys() function. Returns a LIST containing the STRING representations for all the property names of a MAP.; Returns a LIST containing the STRING representations for all the property names of a NODE.; Returns a LIST containing the STRING representations for all the property names of a RELATIONSHIP. + listFunctionFeaturesKeys :: Bool, + -- | The labels() function. Returns a LIST containing the STRING representations for all the labels of a NODE. + listFunctionFeaturesLabels :: Bool, + -- | The nodes() function. Returns a LIST containing all the NODE values in a PATH. + listFunctionFeaturesNodes :: Bool, + -- | The range() function. Returns a LIST comprising all INTEGER values within a specified range.; Returns a LIST comprising all INTEGER values within a specified range created with step length. + listFunctionFeaturesRange :: Bool, + -- | The reduce() function. Runs an expression against individual elements of a LIST, storing the result of the expression in an accumulator. + listFunctionFeaturesReduce :: Bool, + -- | The relationships() function. Returns a LIST containing all the RELATIONSHIP values in a PATH. + listFunctionFeaturesRelationships :: Bool, + -- | The reverse() function. Returns a LIST in which the order of all elements in the given LIST have been reversed. + listFunctionFeaturesReverse :: Bool, + -- | The tail() function. Returns all but the first element in a LIST. + listFunctionFeaturesTail :: Bool, + -- | The toBooleanList() function. Converts a LIST of values to a LIST values. If any values are not convertible to BOOLEAN they will be null in the LIST returned. + listFunctionFeaturesToBooleanList :: Bool, + -- | The toFloatList() function. Converts a LIST to a LIST values. If any values are not convertible to FLOAT they will be null in the LIST returned. + listFunctionFeaturesToFloatList :: Bool, + -- | The toIntegerList() function. Converts a LIST to a LIST values. If any values are not convertible to INTEGER they will be null in the LIST returned. + listFunctionFeaturesToIntegerList :: Bool, + -- | The toStringList() function. Converts a LIST to a LIST values. If any values are not convertible to STRING they will be null in the LIST returned. + listFunctionFeaturesToStringList :: Bool} + deriving (Eq, Ord, Read, Show) + +_ListFunctionFeatures = (Core.Name "hydra/ext/cypher/features.ListFunctionFeatures") + +_ListFunctionFeatures_keys = (Core.Name "keys") + +_ListFunctionFeatures_labels = (Core.Name "labels") + +_ListFunctionFeatures_nodes = (Core.Name "nodes") + +_ListFunctionFeatures_range = (Core.Name "range") + +_ListFunctionFeatures_reduce = (Core.Name "reduce") + +_ListFunctionFeatures_relationships = (Core.Name "relationships") + +_ListFunctionFeatures_reverse = (Core.Name "reverse") + +_ListFunctionFeatures_tail = (Core.Name "tail") + +_ListFunctionFeatures_toBooleanList = (Core.Name "toBooleanList") + +_ListFunctionFeatures_toFloatList = (Core.Name "toFloatList") + +_ListFunctionFeatures_toIntegerList = (Core.Name "toIntegerList") + +_ListFunctionFeatures_toStringList = (Core.Name "toStringList") + +-- | Load CSV functions +data LoadCSVFunctionFeatures = + LoadCSVFunctionFeatures { + -- | The file() function. Returns the absolute path of the file that LOAD CSV is using. + loadCSVFunctionFeaturesFile :: Bool, + -- | The linenumber() function. Returns the line number that LOAD CSV is currently using. + loadCSVFunctionFeaturesLinenumber :: Bool} + deriving (Eq, Ord, Read, Show) + +_LoadCSVFunctionFeatures = (Core.Name "hydra/ext/cypher/features.LoadCSVFunctionFeatures") + +_LoadCSVFunctionFeatures_file = (Core.Name "file") + +_LoadCSVFunctionFeatures_linenumber = (Core.Name "linenumber") + +-- | Logarithmic functions +data LogarithmicFunctionFeatures = + LogarithmicFunctionFeatures { + -- | The e() function. Returns the base of the natural logarithm, e. + logarithmicFunctionFeaturesE :: Bool, + -- | The exp() function. Returns e^n, where e is the base of the natural logarithm, and n is the value of the argument expression. + logarithmicFunctionFeaturesExp :: Bool, + -- | The log() function. Returns the natural logarithm of a FLOAT. + logarithmicFunctionFeaturesLog :: Bool, + -- | The log10() function. Returns the common logarithm (base 10) of a FLOAT. + logarithmicFunctionFeaturesLog10 :: Bool, + -- | The sqrt() function. Returns the square root of a FLOAT. + logarithmicFunctionFeaturesSqrt :: Bool} + deriving (Eq, Ord, Read, Show) + +_LogarithmicFunctionFeatures = (Core.Name "hydra/ext/cypher/features.LogarithmicFunctionFeatures") + +_LogarithmicFunctionFeatures_e = (Core.Name "e") + +_LogarithmicFunctionFeatures_exp = (Core.Name "exp") + +_LogarithmicFunctionFeatures_log = (Core.Name "log") + +_LogarithmicFunctionFeatures_log10 = (Core.Name "log10") + +_LogarithmicFunctionFeatures_sqrt = (Core.Name "sqrt") + +-- | Numeric functions +data NumericFunctionFeatures = + NumericFunctionFeatures { + -- | The abs() function. Returns the absolute value of a FLOAT.; Returns the absolute value of an INTEGER. + numericFunctionFeaturesAbs :: Bool, + -- | The ceil() function. Returns the smallest FLOAT that is greater than or equal to a number and equal to an INTEGER. + numericFunctionFeaturesCeil :: Bool, + -- | The floor() function. Returns the largest FLOAT that is less than or equal to a number and equal to an INTEGER. + numericFunctionFeaturesFloor :: Bool, + -- | The isNaN() function. Returns true if the floating point number is NaN.; Returns true if the integer number is NaN. + numericFunctionFeaturesIsNaN :: Bool, + -- | The rand() function. Returns a random FLOAT in the range from 0 (inclusive) to 1 (exclusive). + numericFunctionFeaturesRand :: Bool, + -- | The round() function. Returns the value of a number rounded to the nearest INTEGER.; Returns the value of a number rounded to the specified precision using rounding mode HALF_UP.; Returns the value of a number rounded to the specified precision with the specified rounding mode. + numericFunctionFeaturesRound :: Bool, + -- | The sign() function. Returns the signum of a FLOAT: 0 if the number is 0, -1 for any negative number, and 1 for any positive number.; Returns the signum of an INTEGER: 0 if the number is 0, -1 for any negative number, and 1 for any positive number. + numericFunctionFeaturesSign :: Bool} + deriving (Eq, Ord, Read, Show) + +_NumericFunctionFeatures = (Core.Name "hydra/ext/cypher/features.NumericFunctionFeatures") + +_NumericFunctionFeatures_abs = (Core.Name "abs") + +_NumericFunctionFeatures_ceil = (Core.Name "ceil") + +_NumericFunctionFeatures_floor = (Core.Name "floor") + +_NumericFunctionFeatures_isNaN = (Core.Name "isNaN") + +_NumericFunctionFeatures_rand = (Core.Name "rand") + +_NumericFunctionFeatures_round = (Core.Name "round") + +_NumericFunctionFeatures_sign = (Core.Name "sign") + +-- | Predicate functions +data PredicateFunctionFeatures = + PredicateFunctionFeatures { + -- | The all() function. Returns true if the predicate holds for all elements in the given LIST. + predicateFunctionFeaturesAll :: Bool, + -- | The any() function. Returns true if the predicate holds for at least one element in the given LIST. + predicateFunctionFeaturesAny :: Bool, + -- | The exists() function. Returns true if a match for the pattern exists in the graph. + predicateFunctionFeaturesExists :: Bool, + -- | The isEmpty() function. Checks whether a LIST is empty.; Checks whether a MAP is empty.; Checks whether a STRING is empty. + predicateFunctionFeaturesIsEmpty :: Bool, + -- | The none() function. Returns true if the predicate holds for no element in the given LIST. + predicateFunctionFeaturesNone :: Bool, + -- | The single() function. Returns true if the predicate holds for exactly one of the elements in the given LIST. + predicateFunctionFeaturesSingle :: Bool} + deriving (Eq, Ord, Read, Show) + +_PredicateFunctionFeatures = (Core.Name "hydra/ext/cypher/features.PredicateFunctionFeatures") + +_PredicateFunctionFeatures_all = (Core.Name "all") + +_PredicateFunctionFeatures_any = (Core.Name "any") + +_PredicateFunctionFeatures_exists = (Core.Name "exists") + +_PredicateFunctionFeatures_isEmpty = (Core.Name "isEmpty") + +_PredicateFunctionFeatures_none = (Core.Name "none") + +_PredicateFunctionFeatures_single = (Core.Name "single") + +-- | Scalar functions +data ScalarFunctionFeatures = + ScalarFunctionFeatures { + -- | The char_length() function. Returns the number of Unicode characters in a STRING. + scalarFunctionFeaturesChar_length :: Bool, + -- | The character_length() function. Returns the number of Unicode characters in a STRING. + scalarFunctionFeaturesCharacter_length :: Bool, + -- | The coalesce() function. Returns the first non-null value in a list of expressions. + scalarFunctionFeaturesCoalesce :: Bool, + -- | The elementId() function. Returns a node identifier, unique within a specific transaction and DBMS.; Returns a relationship identifier, unique within a specific transaction and DBMS. + scalarFunctionFeaturesElementId :: Bool, + -- | The endNode() function. Returns a relationship identifier, unique within a specific transaction and DBMS. + scalarFunctionFeaturesEndNode :: Bool, + -- | The head() function. Returns the first element in a LIST. + scalarFunctionFeaturesHead :: Bool, + -- | The id() function. [Deprecated] Returns the id of a NODE. Replaced by elementId().; [Deprecated] Returns the id of a RELATIONSHIP. Replaced by elementId(). + scalarFunctionFeaturesId :: Bool, + -- | The last() function. Returns the last element in a LIST. + scalarFunctionFeaturesLast :: Bool, + -- | The length() function. Returns the length of a PATH. + scalarFunctionFeaturesLength :: Bool, + -- | The nullIf() function. Returns null if the two given parameters are equivalent, otherwise returns the value of the first parameter. + scalarFunctionFeaturesNullIf :: Bool, + -- | The properties() function. Returns a MAP containing all the properties of a MAP.; Returns a MAP containing all the properties of a NODE.; Returns a MAP containing all the properties of a RELATIONSHIP. + scalarFunctionFeaturesProperties :: Bool, + -- | The randomUUID() function. Generates a random UUID. + scalarFunctionFeaturesRandomUUID :: Bool, + -- | The size() function. Returns the number of items in a LIST.; Returns the number of Unicode characters in a STRING. + scalarFunctionFeaturesSize :: Bool, + -- | The startNode() function. Returns the start NODE of a RELATIONSHIP. + scalarFunctionFeaturesStartNode :: Bool, + -- | The toBoolean() function. Converts a STRING value to a BOOLEAN value.; Converts a BOOLEAN value to a BOOLEAN value.; Converts an INTEGER value to a BOOLEAN value. + scalarFunctionFeaturesToBoolean :: Bool, + -- | The toBooleanOrNull() function. Converts a value to a BOOLEAN value, or null if the value cannot be converted. + scalarFunctionFeaturesToBooleanOrNull :: Bool, + -- | The toFloat() function. Converts an INTEGER value to a FLOAT value.; Converts a STRING value to a FLOAT value. + scalarFunctionFeaturesToFloat :: Bool, + -- | The toFloatOrNull() function. Converts a value to a FLOAT value, or null if the value cannot be converted. + scalarFunctionFeaturesToFloatOrNull :: Bool, + -- | The toInteger() function. Converts a FLOAT value to an INTEGER value.; Converts a BOOLEAN value to an INTEGER value.; Converts a STRING value to an INTEGER value. + scalarFunctionFeaturesToInteger :: Bool, + -- | The toIntegerOrNull() function. Converts a value to an INTEGER value, or null if the value cannot be converted. + scalarFunctionFeaturesToIntegerOrNull :: Bool, + -- | The type() function. Returns a STRING representation of the RELATIONSHIP type. + scalarFunctionFeaturesType :: Bool, + -- | The valueType() function. Returns a STRING representation of the most precise value type that the given expression evaluates to. + scalarFunctionFeaturesValueType :: Bool} + deriving (Eq, Ord, Read, Show) + +_ScalarFunctionFeatures = (Core.Name "hydra/ext/cypher/features.ScalarFunctionFeatures") + +_ScalarFunctionFeatures_char_length = (Core.Name "char_length") + +_ScalarFunctionFeatures_character_length = (Core.Name "character_length") + +_ScalarFunctionFeatures_coalesce = (Core.Name "coalesce") + +_ScalarFunctionFeatures_elementId = (Core.Name "elementId") + +_ScalarFunctionFeatures_endNode = (Core.Name "endNode") + +_ScalarFunctionFeatures_head = (Core.Name "head") + +_ScalarFunctionFeatures_id = (Core.Name "id") + +_ScalarFunctionFeatures_last = (Core.Name "last") + +_ScalarFunctionFeatures_length = (Core.Name "length") + +_ScalarFunctionFeatures_nullIf = (Core.Name "nullIf") + +_ScalarFunctionFeatures_properties = (Core.Name "properties") + +_ScalarFunctionFeatures_randomUUID = (Core.Name "randomUUID") + +_ScalarFunctionFeatures_size = (Core.Name "size") + +_ScalarFunctionFeatures_startNode = (Core.Name "startNode") + +_ScalarFunctionFeatures_toBoolean = (Core.Name "toBoolean") + +_ScalarFunctionFeatures_toBooleanOrNull = (Core.Name "toBooleanOrNull") + +_ScalarFunctionFeatures_toFloat = (Core.Name "toFloat") + +_ScalarFunctionFeatures_toFloatOrNull = (Core.Name "toFloatOrNull") + +_ScalarFunctionFeatures_toInteger = (Core.Name "toInteger") + +_ScalarFunctionFeatures_toIntegerOrNull = (Core.Name "toIntegerOrNull") + +_ScalarFunctionFeatures_type = (Core.Name "type") + +_ScalarFunctionFeatures_valueType = (Core.Name "valueType") + +-- | Spatial functions +data SpatialFunctionFeatures = + SpatialFunctionFeatures { + -- | The point.distance() function. Returns a FLOAT representing the geodesic distance between any two points in the same CRS. + spatialFunctionFeaturesPoint_distance :: Bool, + -- | The point() function. Returns a 2D point object, given two coordinate values in the Cartesian coordinate system.; Returns a 3D point object, given three coordinate values in the Cartesian coordinate system.; Returns a 2D point object, given two coordinate values in the WGS 84 geographic coordinate system.; Returns a 3D point object, given three coordinate values in the WGS 84 geographic coordinate system. + spatialFunctionFeaturesPoint :: Bool, + -- | The point.withinBBox() function. Returns true if the provided point is within the bounding box defined by the two provided points, lowerLeft and upperRight. + spatialFunctionFeaturesPoint_withinBBox :: Bool} + deriving (Eq, Ord, Read, Show) + +_SpatialFunctionFeatures = (Core.Name "hydra/ext/cypher/features.SpatialFunctionFeatures") + +_SpatialFunctionFeatures_point_distance = (Core.Name "point.distance") + +_SpatialFunctionFeatures_point = (Core.Name "point") + +_SpatialFunctionFeatures_point_withinBBox = (Core.Name "point.withinBBox") + +-- | String functions +data StringFunctionFeatures = + StringFunctionFeatures { + -- | The btrim() function. Returns the given STRING with leading and trailing whitespace removed.; Returns the given STRING with leading and trailing trimCharacterString characters removed. Introduced in 5.20. + stringFunctionFeaturesBtrim :: Bool, + -- | The left() function. Returns a STRING containing the specified number (INTEGER) of leftmost characters in the given STRING. + stringFunctionFeaturesLeft :: Bool, + -- | The lower() function. Returns the given STRING in lowercase. This function is an alias to the toLower() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21. + stringFunctionFeaturesLower :: Bool, + -- | The ltrim() function. Returns the given STRING with leading whitespace removed.; Returns the given STRING with leading trimCharacterString characters removed. Introduced in 5.20. + stringFunctionFeaturesLtrim :: Bool, + -- | The normalize() function. Returns the given STRING normalized according to the normalization CypherFunctionForm NFC. Introduced in 5.17.; Returns the given STRING normalized according to the specified normalization CypherFunctionForm. Introduced in 5.17. + stringFunctionFeaturesNormalize :: Bool, + -- | The replace() function. Returns a STRING in which all occurrences of a specified search STRING in the given STRING have been replaced by another (specified) replacement STRING. + stringFunctionFeaturesReplace :: Bool, + -- | The reverse() function. Returns a STRING in which the order of all characters in the given STRING have been reversed. + stringFunctionFeaturesReverse :: Bool, + -- | The right() function. Returns a STRING containing the specified number of rightmost characters in the given STRING. + stringFunctionFeaturesRight :: Bool, + -- | The rtrim() function. Returns the given STRING with trailing whitespace removed.; Returns the given STRING with trailing trimCharacterString characters removed. Introduced in 5.20. + stringFunctionFeaturesRtrim :: Bool, + -- | The split() function. Returns a LIST resulting from the splitting of the given STRING around matches of the given delimiter.; Returns a LIST resulting from the splitting of the given STRING around matches of any of the given delimiters. + stringFunctionFeaturesSplit :: Bool, + -- | The substring() function. Returns a substring of the given STRING, beginning with a 0-based index start.; Returns a substring of a given length from the given STRING, beginning with a 0-based index start. + stringFunctionFeaturesSubstring :: Bool, + -- | The toLower() function. Returns the given STRING in lowercase. + stringFunctionFeaturesToLower :: Bool, + -- | The toString() function. Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING. + stringFunctionFeaturesToString :: Bool, + -- | The toStringOrNull() function. Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING, or null if the value cannot be converted. + stringFunctionFeaturesToStringOrNull :: Bool, + -- | The toUpper() function. Returns the given STRING in uppercase. + stringFunctionFeaturesToUpper :: Bool, + -- | The trim() function. Returns the given STRING with leading and trailing whitespace removed.; Returns the given STRING with the leading and/or trailing trimCharacterString character removed. Introduced in 5.20. + stringFunctionFeaturesTrim :: Bool, + -- | The upper() function. Returns the given STRING in uppercase. This function is an alias to the toUpper() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21. + stringFunctionFeaturesUpper :: Bool} + deriving (Eq, Ord, Read, Show) + +_StringFunctionFeatures = (Core.Name "hydra/ext/cypher/features.StringFunctionFeatures") + +_StringFunctionFeatures_btrim = (Core.Name "btrim") + +_StringFunctionFeatures_left = (Core.Name "left") + +_StringFunctionFeatures_lower = (Core.Name "lower") + +_StringFunctionFeatures_ltrim = (Core.Name "ltrim") + +_StringFunctionFeatures_normalize = (Core.Name "normalize") + +_StringFunctionFeatures_replace = (Core.Name "replace") + +_StringFunctionFeatures_reverse = (Core.Name "reverse") + +_StringFunctionFeatures_right = (Core.Name "right") + +_StringFunctionFeatures_rtrim = (Core.Name "rtrim") + +_StringFunctionFeatures_split = (Core.Name "split") + +_StringFunctionFeatures_substring = (Core.Name "substring") + +_StringFunctionFeatures_toLower = (Core.Name "toLower") + +_StringFunctionFeatures_toString = (Core.Name "toString") + +_StringFunctionFeatures_toStringOrNull = (Core.Name "toStringOrNull") + +_StringFunctionFeatures_toUpper = (Core.Name "toUpper") + +_StringFunctionFeatures_trim = (Core.Name "trim") + +_StringFunctionFeatures_upper = (Core.Name "upper") + +-- | Temporal duration functions +data TemporalDurationFunctionFeatures = + TemporalDurationFunctionFeatures { + -- | The duration() function. Constructs a DURATION value. + temporalDurationFunctionFeaturesDuration :: Bool, + -- | The duration.between() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in logical units. + temporalDurationFunctionFeaturesDuration_between :: Bool, + -- | The duration.inDays() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in days. + temporalDurationFunctionFeaturesDuration_inDays :: Bool, + -- | The duration.inMonths() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in months. + temporalDurationFunctionFeaturesDuration_inMonths :: Bool, + -- | The duration.inSeconds() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in seconds. + temporalDurationFunctionFeaturesDuration_inSeconds :: Bool} + deriving (Eq, Ord, Read, Show) + +_TemporalDurationFunctionFeatures = (Core.Name "hydra/ext/cypher/features.TemporalDurationFunctionFeatures") + +_TemporalDurationFunctionFeatures_duration = (Core.Name "duration") + +_TemporalDurationFunctionFeatures_duration_between = (Core.Name "duration.between") + +_TemporalDurationFunctionFeatures_duration_inDays = (Core.Name "duration.inDays") + +_TemporalDurationFunctionFeatures_duration_inMonths = (Core.Name "duration.inMonths") + +_TemporalDurationFunctionFeatures_duration_inSeconds = (Core.Name "duration.inSeconds") + +-- | Temporal instant functions +data TemporalInstantFunctionFeatures = + TemporalInstantFunctionFeatures { + -- | The date() function. Creates a DATE instant. + temporalInstantFunctionFeaturesDate :: Bool, + -- | The date.realtime() function. Returns the current DATE instant using the realtime clock. + temporalInstantFunctionFeaturesDate_realtime :: Bool, + -- | The date.statement() function. Returns the current DATE instant using the statement clock. + temporalInstantFunctionFeaturesDate_statement :: Bool, + -- | The date.transaction() function. Returns the current DATE instant using the transaction clock. + temporalInstantFunctionFeaturesDate_transaction :: Bool, + -- | The date.truncate() function. Truncates the given temporal value to a DATE instant using the specified unit. + temporalInstantFunctionFeaturesDate_truncate :: Bool, + -- | The datetime() function. Creates a ZONED DATETIME instant. + temporalInstantFunctionFeaturesDatetime :: Bool, + -- | The datetime.fromepoch() function. Creates a ZONED DATETIME given the seconds and nanoseconds since the start of the epoch. + temporalInstantFunctionFeaturesDatetime_fromepoch :: Bool, + -- | The datetime.fromepochmillis() function. Creates a ZONED DATETIME given the milliseconds since the start of the epoch. + temporalInstantFunctionFeaturesDatetime_fromepochmillis :: Bool, + -- | The datetime.realtime() function. Returns the current ZONED DATETIME instant using the realtime clock. + temporalInstantFunctionFeaturesDatetime_realtime :: Bool, + -- | The datetime.statement() function. Returns the current ZONED DATETIME instant using the statement clock. + temporalInstantFunctionFeaturesDatetime_statement :: Bool, + -- | The datetime.transaction() function. Returns the current ZONED DATETIME instant using the transaction clock. + temporalInstantFunctionFeaturesDatetime_transaction :: Bool, + -- | The datetime.truncate() function. Truncates the given temporal value to a ZONED DATETIME instant using the specified unit. + temporalInstantFunctionFeaturesDatetime_truncate :: Bool, + -- | The localdatetime() function. Creates a LOCAL DATETIME instant. + temporalInstantFunctionFeaturesLocaldatetime :: Bool, + -- | The localdatetime.realtime() function. Returns the current LOCAL DATETIME instant using the realtime clock. + temporalInstantFunctionFeaturesLocaldatetime_realtime :: Bool, + -- | The localdatetime.statement() function. Returns the current LOCAL DATETIME instant using the statement clock. + temporalInstantFunctionFeaturesLocaldatetime_statement :: Bool, + -- | The localdatetime.transaction() function. Returns the current LOCAL DATETIME instant using the transaction clock. + temporalInstantFunctionFeaturesLocaldatetime_transaction :: Bool, + -- | The localdatetime.truncate() function. Truncates the given temporal value to a LOCAL DATETIME instant using the specified unit. + temporalInstantFunctionFeaturesLocaldatetime_truncate :: Bool, + -- | The localtime() function. Creates a LOCAL TIME instant. + temporalInstantFunctionFeaturesLocaltime :: Bool, + -- | The localtime.realtime() function. Returns the current LOCAL TIME instant using the realtime clock. + temporalInstantFunctionFeaturesLocaltime_realtime :: Bool, + -- | The localtime.statement() function. Returns the current LOCAL TIME instant using the statement clock. + temporalInstantFunctionFeaturesLocaltime_statement :: Bool, + -- | The localtime.transaction() function. Returns the current LOCAL TIME instant using the transaction clock. + temporalInstantFunctionFeaturesLocaltime_transaction :: Bool, + -- | The localtime.truncate() function. Truncates the given temporal value to a LOCAL TIME instant using the specified unit. + temporalInstantFunctionFeaturesLocaltime_truncate :: Bool, + -- | The time() function. Creates a ZONED TIME instant. + temporalInstantFunctionFeaturesTime :: Bool, + -- | The time.realtime() function. Returns the current ZONED TIME instant using the realtime clock. + temporalInstantFunctionFeaturesTime_realtime :: Bool, + -- | The time.statement() function. Returns the current ZONED TIME instant using the statement clock. + temporalInstantFunctionFeaturesTime_statement :: Bool, + -- | The time.transaction() function. Returns the current ZONED TIME instant using the transaction clock. + temporalInstantFunctionFeaturesTime_transaction :: Bool, + -- | The time.truncate() function. Truncates the given temporal value to a ZONED TIME instant using the specified unit. + temporalInstantFunctionFeaturesTime_truncate :: Bool} + deriving (Eq, Ord, Read, Show) + +_TemporalInstantFunctionFeatures = (Core.Name "hydra/ext/cypher/features.TemporalInstantFunctionFeatures") + +_TemporalInstantFunctionFeatures_date = (Core.Name "date") + +_TemporalInstantFunctionFeatures_date_realtime = (Core.Name "date.realtime") + +_TemporalInstantFunctionFeatures_date_statement = (Core.Name "date.statement") + +_TemporalInstantFunctionFeatures_date_transaction = (Core.Name "date.transaction") + +_TemporalInstantFunctionFeatures_date_truncate = (Core.Name "date.truncate") + +_TemporalInstantFunctionFeatures_datetime = (Core.Name "datetime") + +_TemporalInstantFunctionFeatures_datetime_fromepoch = (Core.Name "datetime.fromepoch") + +_TemporalInstantFunctionFeatures_datetime_fromepochmillis = (Core.Name "datetime.fromepochmillis") + +_TemporalInstantFunctionFeatures_datetime_realtime = (Core.Name "datetime.realtime") + +_TemporalInstantFunctionFeatures_datetime_statement = (Core.Name "datetime.statement") + +_TemporalInstantFunctionFeatures_datetime_transaction = (Core.Name "datetime.transaction") + +_TemporalInstantFunctionFeatures_datetime_truncate = (Core.Name "datetime.truncate") + +_TemporalInstantFunctionFeatures_localdatetime = (Core.Name "localdatetime") + +_TemporalInstantFunctionFeatures_localdatetime_realtime = (Core.Name "localdatetime.realtime") + +_TemporalInstantFunctionFeatures_localdatetime_statement = (Core.Name "localdatetime.statement") + +_TemporalInstantFunctionFeatures_localdatetime_transaction = (Core.Name "localdatetime.transaction") + +_TemporalInstantFunctionFeatures_localdatetime_truncate = (Core.Name "localdatetime.truncate") + +_TemporalInstantFunctionFeatures_localtime = (Core.Name "localtime") + +_TemporalInstantFunctionFeatures_localtime_realtime = (Core.Name "localtime.realtime") + +_TemporalInstantFunctionFeatures_localtime_statement = (Core.Name "localtime.statement") + +_TemporalInstantFunctionFeatures_localtime_transaction = (Core.Name "localtime.transaction") + +_TemporalInstantFunctionFeatures_localtime_truncate = (Core.Name "localtime.truncate") + +_TemporalInstantFunctionFeatures_time = (Core.Name "time") + +_TemporalInstantFunctionFeatures_time_realtime = (Core.Name "time.realtime") + +_TemporalInstantFunctionFeatures_time_statement = (Core.Name "time.statement") + +_TemporalInstantFunctionFeatures_time_transaction = (Core.Name "time.transaction") + +_TemporalInstantFunctionFeatures_time_truncate = (Core.Name "time.truncate") + +-- | Trigonometric functions +data TrigonometricFunctionFeatures = + TrigonometricFunctionFeatures { + -- | The acos() function. Returns the arccosine of a FLOAT in radians. + trigonometricFunctionFeaturesAcos :: Bool, + -- | The asin() function. Returns the arcsine of a FLOAT in radians. + trigonometricFunctionFeaturesAsin :: Bool, + -- | The atan() function. Returns the arctangent of a FLOAT in radians. + trigonometricFunctionFeaturesAtan :: Bool, + -- | The atan2() function. Returns the arctangent2 of a set of coordinates in radians. + trigonometricFunctionFeaturesAtan2 :: Bool, + -- | The cos() function. Returns the cosine of a FLOAT. + trigonometricFunctionFeaturesCos :: Bool, + -- | The cot() function. Returns the cotangent of a FLOAT. + trigonometricFunctionFeaturesCot :: Bool, + -- | The degrees() function. Converts radians to degrees. + trigonometricFunctionFeaturesDegrees :: Bool, + -- | The haversin() function. Returns half the versine of a number. + trigonometricFunctionFeaturesHaversin :: Bool, + -- | The pi() function. Returns the mathematical constant pi. + trigonometricFunctionFeaturesPi :: Bool, + -- | The radians() function. Converts degrees to radians. + trigonometricFunctionFeaturesRadians :: Bool, + -- | The sin() function. Returns the sine of a FLOAT. + trigonometricFunctionFeaturesSin :: Bool, + -- | The tan() function. Returns the tangent of a FLOAT. + trigonometricFunctionFeaturesTan :: Bool} + deriving (Eq, Ord, Read, Show) + +_TrigonometricFunctionFeatures = (Core.Name "hydra/ext/cypher/features.TrigonometricFunctionFeatures") + +_TrigonometricFunctionFeatures_acos = (Core.Name "acos") + +_TrigonometricFunctionFeatures_asin = (Core.Name "asin") + +_TrigonometricFunctionFeatures_atan = (Core.Name "atan") + +_TrigonometricFunctionFeatures_atan2 = (Core.Name "atan2") + +_TrigonometricFunctionFeatures_cos = (Core.Name "cos") + +_TrigonometricFunctionFeatures_cot = (Core.Name "cot") + +_TrigonometricFunctionFeatures_degrees = (Core.Name "degrees") + +_TrigonometricFunctionFeatures_haversin = (Core.Name "haversin") + +_TrigonometricFunctionFeatures_pi = (Core.Name "pi") + +_TrigonometricFunctionFeatures_radians = (Core.Name "radians") + +_TrigonometricFunctionFeatures_sin = (Core.Name "sin") + +_TrigonometricFunctionFeatures_tan = (Core.Name "tan") + +-- | Vector functions +data VectorFunctionFeatures = + VectorFunctionFeatures { + -- | The vector.similarity.cosine() function. Returns a FLOAT representing the similarity between the argument vectors based on their cosine. + vectorFunctionFeaturesVector_similarity_cosine :: Bool, + -- | The vector.similarity.euclidean() function. Returns a FLOAT representing the similarity between the argument vectors based on their Euclidean distance. + vectorFunctionFeaturesVector_similarity_euclidean :: Bool} + deriving (Eq, Ord, Read, Show) + +_VectorFunctionFeatures = (Core.Name "hydra/ext/cypher/features.VectorFunctionFeatures") + +_VectorFunctionFeatures_vector_similarity_cosine = (Core.Name "vector.similarity.cosine") + +_VectorFunctionFeatures_vector_similarity_euclidean = (Core.Name "vector.similarity.euclidean") + +-- | List functionality +data ListFeatures = + ListFeatures { + -- | Basic list comprehensions + listFeaturesListComprehension :: Bool, + -- | List range comprehensions (e.g. [1..10]) + listFeaturesListRange :: Bool} + deriving (Eq, Ord, Read, Show) + +_ListFeatures = (Core.Name "hydra/ext/cypher/features.ListFeatures") + +_ListFeatures_listComprehension = (Core.Name "listComprehension") + +_ListFeatures_listRange = (Core.Name "listRange") + +-- | Various types of literal values +data LiteralFeatures = + LiteralFeatures { + -- | Boolean literals (note: included by most if not all implementations). + literalFeaturesBoolean :: Bool, + -- | Double-precision floating-point literals + literalFeaturesDouble :: Bool, + -- | Integer literals + literalFeaturesInteger :: Bool, + -- | List literals + literalFeaturesList :: Bool, + -- | Map literals + literalFeaturesMap :: Bool, + -- | The NULL literal + literalFeaturesNull :: Bool, + -- | String literals (note: included by most if not all implementations). + literalFeaturesString :: Bool} + deriving (Eq, Ord, Read, Show) + +_LiteralFeatures = (Core.Name "hydra/ext/cypher/features.LiteralFeatures") + +_LiteralFeatures_boolean = (Core.Name "boolean") + +_LiteralFeatures_double = (Core.Name "double") + +_LiteralFeatures_integer = (Core.Name "integer") + +_LiteralFeatures_list = (Core.Name "list") + +_LiteralFeatures_map = (Core.Name "map") + +_LiteralFeatures_null = (Core.Name "null") + +_LiteralFeatures_string = (Core.Name "string") + +-- | Logical operations +data LogicalFeatures = + LogicalFeatures { + -- | The AND operator + logicalFeaturesAnd :: Bool, + -- | The NOT operator + logicalFeaturesNot :: Bool, + -- | The OR operator + logicalFeaturesOr :: Bool, + -- | The XOR operator + logicalFeaturesXor :: Bool} + deriving (Eq, Ord, Read, Show) + +_LogicalFeatures = (Core.Name "hydra/ext/cypher/features.LogicalFeatures") + +_LogicalFeatures_and = (Core.Name "and") + +_LogicalFeatures_not = (Core.Name "not") + +_LogicalFeatures_or = (Core.Name "or") + +_LogicalFeatures_xor = (Core.Name "xor") + +-- | Match queries +data MatchFeatures = + MatchFeatures { + -- | The basic (non-optional) MATCH clause + matchFeaturesMatch :: Bool, + -- | OPTIONAL MATCH + matchFeaturesOptionalMatch :: Bool} + deriving (Eq, Ord, Read, Show) + +_MatchFeatures = (Core.Name "hydra/ext/cypher/features.MatchFeatures") + +_MatchFeatures_match = (Core.Name "match") + +_MatchFeatures_optionalMatch = (Core.Name "optionalMatch") + +-- | Merge operations +data MergeFeatures = + MergeFeatures { + -- | The basic MERGE clause + mergeFeaturesMerge :: Bool, + -- | MERGE with the ON CREATE action + mergeFeaturesMergeOnCreate :: Bool, + -- | MERGE with the ON MATCH action + mergeFeaturesMergeOnMatch :: Bool} + deriving (Eq, Ord, Read, Show) + +_MergeFeatures = (Core.Name "hydra/ext/cypher/features.MergeFeatures") + +_MergeFeatures_merge = (Core.Name "merge") + +_MergeFeatures_mergeOnCreate = (Core.Name "mergeOnCreate") + +_MergeFeatures_mergeOnMatch = (Core.Name "mergeOnMatch") + +-- | Node patterns +data NodePatternFeatures = + NodePatternFeatures { + -- | Specifying multiple labels in a node pattern + nodePatternFeaturesMultipleLabels :: Bool, + -- | Specifying a parameter as part of a node pattern + nodePatternFeaturesParameter :: Bool, + -- | Specifying a key/value map of properties in a node pattern + nodePatternFeaturesPropertyMap :: Bool, + -- | Binding a variable to a node in a node pattern (note: included by most if not all implementations). + nodePatternFeaturesVariableNode :: Bool, + -- | Omitting labels from a node pattern + nodePatternFeaturesWildcardLabel :: Bool} + deriving (Eq, Ord, Read, Show) + +_NodePatternFeatures = (Core.Name "hydra/ext/cypher/features.NodePatternFeatures") + +_NodePatternFeatures_multipleLabels = (Core.Name "multipleLabels") + +_NodePatternFeatures_parameter = (Core.Name "parameter") + +_NodePatternFeatures_propertyMap = (Core.Name "propertyMap") + +_NodePatternFeatures_variableNode = (Core.Name "variableNode") + +_NodePatternFeatures_wildcardLabel = (Core.Name "wildcardLabel") + +-- | IS NULL / IS NOT NULL checks +data NullFeatures = + NullFeatures { + -- | The IS NULL operator + nullFeaturesIsNull :: Bool, + -- | The IS NOT NULL operator + nullFeaturesIsNotNull :: Bool} + deriving (Eq, Ord, Read, Show) + +_NullFeatures = (Core.Name "hydra/ext/cypher/features.NullFeatures") + +_NullFeatures_isNull = (Core.Name "isNull") + +_NullFeatures_isNotNull = (Core.Name "isNotNull") + +-- | Path functions only found in OpenCypher +data PathFeatures = + PathFeatures { + -- | The shortestPath() function + pathFeaturesShortestPath :: Bool} + deriving (Eq, Ord, Read, Show) + +_PathFeatures = (Core.Name "hydra/ext/cypher/features.PathFeatures") + +_PathFeatures_shortestPath = (Core.Name "shortestPath") + +-- | Procedure calls +data ProcedureCallFeatures = + ProcedureCallFeatures { + -- | CALL within a query + procedureCallFeaturesInQueryCall :: Bool, + -- | Standalone / top-level CALL + procedureCallFeaturesStandaloneCall :: Bool, + -- | The YIELD clause in CALL + procedureCallFeaturesYield :: Bool} + deriving (Eq, Ord, Read, Show) + +_ProcedureCallFeatures = (Core.Name "hydra/ext/cypher/features.ProcedureCallFeatures") + +_ProcedureCallFeatures_inQueryCall = (Core.Name "inQueryCall") + +_ProcedureCallFeatures_standaloneCall = (Core.Name "standaloneCall") + +_ProcedureCallFeatures_yield = (Core.Name "yield") + +-- | Projections +data ProjectionFeatures = + ProjectionFeatures { + -- | The LIMIT clause + projectionFeaturesLimit :: Bool, + -- | The ORDER BY clause + projectionFeaturesOrderBy :: Bool, + -- | The DISTINCT keyword + projectionFeaturesProjectDistinct :: Bool, + -- | The * projection + projectionFeaturesProjectAll :: Bool, + -- | The AS keyword + projectionFeaturesProjectAs :: Bool, + -- | The SKIP clause + projectionFeaturesSkip :: Bool, + -- | The ASC/ASCENDING and DESC/DESCENDING keywords + projectionFeaturesSortOrder :: Bool} + deriving (Eq, Ord, Read, Show) + +_ProjectionFeatures = (Core.Name "hydra/ext/cypher/features.ProjectionFeatures") + +_ProjectionFeatures_limit = (Core.Name "limit") + +_ProjectionFeatures_orderBy = (Core.Name "orderBy") + +_ProjectionFeatures_projectDistinct = (Core.Name "projectDistinct") + +_ProjectionFeatures_projectAll = (Core.Name "projectAll") + +_ProjectionFeatures_projectAs = (Core.Name "projectAs") + +_ProjectionFeatures_skip = (Core.Name "skip") + +_ProjectionFeatures_sortOrder = (Core.Name "sortOrder") + +-- | Quantifier expressions +data QuantifierFeatures = + QuantifierFeatures { + -- | The ALL quantifier + quantifierFeaturesAll :: Bool, + -- | The ANY quantifier + quantifierFeaturesAny :: Bool, + -- | The NONE quantifier + quantifierFeaturesNone :: Bool, + -- | The SINGLE quantifier + quantifierFeaturesSingle :: Bool} + deriving (Eq, Ord, Read, Show) + +_QuantifierFeatures = (Core.Name "hydra/ext/cypher/features.QuantifierFeatures") + +_QuantifierFeatures_all = (Core.Name "all") + +_QuantifierFeatures_any = (Core.Name "any") + +_QuantifierFeatures_none = (Core.Name "none") + +_QuantifierFeatures_single = (Core.Name "single") + +-- | Range literals within relationship patterns +data RangeLiteralFeatures = + RangeLiteralFeatures { + -- | Range literals with both lower and upper bounds + rangeLiteralFeaturesBounds :: Bool, + -- | Range literals providing an exact number of repetitions + rangeLiteralFeaturesExactRange :: Bool, + -- | Range literals with a lower bound (only) + rangeLiteralFeaturesLowerBound :: Bool, + -- | The * range literal + rangeLiteralFeaturesStarRange :: Bool, + -- | Range literals with an upper bound (only) + rangeLiteralFeaturesUpperBound :: Bool} + deriving (Eq, Ord, Read, Show) + +_RangeLiteralFeatures = (Core.Name "hydra/ext/cypher/features.RangeLiteralFeatures") + +_RangeLiteralFeatures_bounds = (Core.Name "bounds") + +_RangeLiteralFeatures_exactRange = (Core.Name "exactRange") + +_RangeLiteralFeatures_lowerBound = (Core.Name "lowerBound") + +_RangeLiteralFeatures_starRange = (Core.Name "starRange") + +_RangeLiteralFeatures_upperBound = (Core.Name "upperBound") + +-- | Specific syntax related to reading data from the graph. +data ReadingFeatures = + ReadingFeatures { + -- | The UNION operator + readingFeaturesUnion :: Bool, + -- | The UNION ALL operator + readingFeaturesUnionAll :: Bool, + -- | The UNWIND clause + readingFeaturesUnwind :: Bool} + deriving (Eq, Ord, Read, Show) + +_ReadingFeatures = (Core.Name "hydra/ext/cypher/features.ReadingFeatures") + +_ReadingFeatures_union = (Core.Name "union") + +_ReadingFeatures_unionAll = (Core.Name "unionAll") + +_ReadingFeatures_unwind = (Core.Name "unwind") + +-- | Relationship directions / arrow patterns +data RelationshipDirectionFeatures = + RelationshipDirectionFeatures { + -- | The two-headed arrow (<-[]->) relationship direction + relationshipDirectionFeaturesBoth :: Bool, + -- | The left arrow (<-[]-) relationship direction + relationshipDirectionFeaturesLeft :: Bool, + -- | The headless arrow (-[]-) relationship direction + relationshipDirectionFeaturesNeither :: Bool, + -- | The right arrow (-[]->) relationship direction + relationshipDirectionFeaturesRight :: Bool} + deriving (Eq, Ord, Read, Show) + +_RelationshipDirectionFeatures = (Core.Name "hydra/ext/cypher/features.RelationshipDirectionFeatures") + +_RelationshipDirectionFeatures_both = (Core.Name "both") + +_RelationshipDirectionFeatures_left = (Core.Name "left") + +_RelationshipDirectionFeatures_neither = (Core.Name "neither") + +_RelationshipDirectionFeatures_right = (Core.Name "right") + +-- | Relationship patterns +data RelationshipPatternFeatures = + RelationshipPatternFeatures { + -- | Specifying a disjunction of multiple types in a relationship pattern + relationshipPatternFeaturesMultipleTypes :: Bool, + -- | Binding a variable to a relationship in a relationship pattern (note: included by most if not all implementations). + relationshipPatternFeaturesVariableRelationship :: Bool, + -- | Omitting types from a relationship pattern + relationshipPatternFeaturesWildcardType :: Bool} + deriving (Eq, Ord, Read, Show) + +_RelationshipPatternFeatures = (Core.Name "hydra/ext/cypher/features.RelationshipPatternFeatures") + +_RelationshipPatternFeatures_multipleTypes = (Core.Name "multipleTypes") + +_RelationshipPatternFeatures_variableRelationship = (Core.Name "variableRelationship") + +_RelationshipPatternFeatures_wildcardType = (Core.Name "wildcardType") + +-- | REMOVE operations +data RemoveFeatures = + RemoveFeatures { + -- | REMOVE Variable:NodeLabels + removeFeaturesByLabel :: Bool, + -- | REMOVE PropertyExpression + removeFeaturesByProperty :: Bool} + deriving (Eq, Ord, Read, Show) + +_RemoveFeatures = (Core.Name "hydra/ext/cypher/features.RemoveFeatures") + +_RemoveFeatures_byLabel = (Core.Name "byLabel") + +_RemoveFeatures_byProperty = (Core.Name "byProperty") + +-- | Set definitions +data SetFeatures = + SetFeatures { + -- | Defining a set using PropertyExpression = Expression + setFeaturesPropertyEquals :: Bool, + -- | Defining a set using Variable = Expression + setFeaturesVariableEquals :: Bool, + -- | Defining a set using Variable += Expression + setFeaturesVariablePlusEquals :: Bool, + -- | Defining a set using Variable:NodeLabels + setFeaturesVariableWithNodeLabels :: Bool} + deriving (Eq, Ord, Read, Show) + +_SetFeatures = (Core.Name "hydra/ext/cypher/features.SetFeatures") + +_SetFeatures_propertyEquals = (Core.Name "propertyEquals") + +_SetFeatures_variableEquals = (Core.Name "variableEquals") + +_SetFeatures_variablePlusEquals = (Core.Name "variablePlusEquals") + +_SetFeatures_variableWithNodeLabels = (Core.Name "variableWithNodeLabels") + +-- | String functions/keywords only found in OpenCypher +data StringFeatures = + StringFeatures { + -- | The contains() function / CONTAINS + stringFeaturesContains :: Bool, + -- | The endsWith() function / ENDS WITH + stringFeaturesEndsWith :: Bool, + -- | The in() function / IN + stringFeaturesIn :: Bool, + -- | The startsWith() function / STARTS WITH + stringFeaturesStartsWith :: Bool} + deriving (Eq, Ord, Read, Show) + +_StringFeatures = (Core.Name "hydra/ext/cypher/features.StringFeatures") + +_StringFeatures_contains = (Core.Name "contains") + +_StringFeatures_endsWith = (Core.Name "endsWith") + +_StringFeatures_in = (Core.Name "in") + +_StringFeatures_startsWith = (Core.Name "startsWith") + +-- | Specific syntax related to updating data in the graph +data UpdatingFeatures = + UpdatingFeatures { + -- | The CREATE clause + updatingFeaturesCreate :: Bool, + -- | The SET clause + updatingFeaturesSet :: Bool, + -- | Multi-part queries using WITH + updatingFeaturesWith :: Bool} + deriving (Eq, Ord, Read, Show) + +_UpdatingFeatures = (Core.Name "hydra/ext/cypher/features.UpdatingFeatures") + +_UpdatingFeatures_create = (Core.Name "create") + +_UpdatingFeatures_set = (Core.Name "set") + +_UpdatingFeatures_with = (Core.Name "with") diff --git a/src/gen-main/haskell/Hydra/Ext/Cypher/OpenCypher.hs b/src/gen-main/haskell/Hydra/Ext/Cypher/OpenCypher.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Cypher/OpenCypher.hs @@ -0,0 +1,1306 @@ +-- | A Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at: +-- | https://opencypher.org/resources/ + +module Hydra.Ext.Cypher.OpenCypher where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +data Query = + QueryRegular RegularQuery | + QueryStandalone StandaloneCall + deriving (Eq, Ord, Read, Show) + +_Query = (Core.Name "hydra/ext/cypher/openCypher.Query") + +_Query_regular = (Core.Name "regular") + +_Query_standalone = (Core.Name "standalone") + +data RegularQuery = + RegularQuery { + regularQueryHead :: SingleQuery, + regularQueryRest :: [Union]} + deriving (Eq, Ord, Read, Show) + +_RegularQuery = (Core.Name "hydra/ext/cypher/openCypher.RegularQuery") + +_RegularQuery_head = (Core.Name "head") + +_RegularQuery_rest = (Core.Name "rest") + +data Union = + Union { + unionAll :: Bool, + unionQuery :: SingleQuery} + deriving (Eq, Ord, Read, Show) + +_Union = (Core.Name "hydra/ext/cypher/openCypher.Union") + +_Union_all = (Core.Name "all") + +_Union_query = (Core.Name "query") + +data SingleQuery = + SingleQuerySinglePart SinglePartQuery | + SingleQueryMultiPart MultiPartQuery + deriving (Eq, Ord, Read, Show) + +_SingleQuery = (Core.Name "hydra/ext/cypher/openCypher.SingleQuery") + +_SingleQuery_singlePart = (Core.Name "singlePart") + +_SingleQuery_multiPart = (Core.Name "multiPart") + +data SinglePartQuery = + SinglePartQuery { + singlePartQueryReading :: [ReadingClause], + singlePartQueryUpdating :: [UpdatingClause], + singlePartQueryReturn :: (Maybe Return)} + deriving (Eq, Ord, Read, Show) + +_SinglePartQuery = (Core.Name "hydra/ext/cypher/openCypher.SinglePartQuery") + +_SinglePartQuery_reading = (Core.Name "reading") + +_SinglePartQuery_updating = (Core.Name "updating") + +_SinglePartQuery_return = (Core.Name "return") + +data WithClause = + WithClause { + withClauseReading :: [ReadingClause], + withClauseUpdating :: [UpdatingClause], + withClauseWith :: With} + deriving (Eq, Ord, Read, Show) + +_WithClause = (Core.Name "hydra/ext/cypher/openCypher.WithClause") + +_WithClause_reading = (Core.Name "reading") + +_WithClause_updating = (Core.Name "updating") + +_WithClause_with = (Core.Name "with") + +data MultiPartQuery = + MultiPartQuery { + multiPartQueryWith :: [WithClause], + multiPartQueryBody :: SinglePartQuery} + deriving (Eq, Ord, Read, Show) + +_MultiPartQuery = (Core.Name "hydra/ext/cypher/openCypher.MultiPartQuery") + +_MultiPartQuery_with = (Core.Name "with") + +_MultiPartQuery_body = (Core.Name "body") + +data UpdatingClause = + UpdatingClauseCreate Create | + UpdatingClauseMerge Merge | + UpdatingClauseDelete Delete | + UpdatingClauseSet Set_ | + UpdatingClauseRemove Remove + deriving (Eq, Ord, Read, Show) + +_UpdatingClause = (Core.Name "hydra/ext/cypher/openCypher.UpdatingClause") + +_UpdatingClause_create = (Core.Name "create") + +_UpdatingClause_merge = (Core.Name "merge") + +_UpdatingClause_delete = (Core.Name "delete") + +_UpdatingClause_set = (Core.Name "set") + +_UpdatingClause_remove = (Core.Name "remove") + +data ReadingClause = + ReadingClauseMatch Match | + ReadingClauseUnwind Unwind | + ReadingClauseInQueryCall InQueryCall + deriving (Eq, Ord, Read, Show) + +_ReadingClause = (Core.Name "hydra/ext/cypher/openCypher.ReadingClause") + +_ReadingClause_match = (Core.Name "match") + +_ReadingClause_unwind = (Core.Name "unwind") + +_ReadingClause_inQueryCall = (Core.Name "inQueryCall") + +data Match = + Match { + matchOptional :: Bool, + matchPattern :: Pattern, + matchWhere :: (Maybe Where)} + deriving (Eq, Ord, Read, Show) + +_Match = (Core.Name "hydra/ext/cypher/openCypher.Match") + +_Match_optional = (Core.Name "optional") + +_Match_pattern = (Core.Name "pattern") + +_Match_where = (Core.Name "where") + +data Unwind = + Unwind { + unwindExpression :: Expression, + unwindVariable :: Variable} + deriving (Eq, Ord, Read, Show) + +_Unwind = (Core.Name "hydra/ext/cypher/openCypher.Unwind") + +_Unwind_expression = (Core.Name "expression") + +_Unwind_variable = (Core.Name "variable") + +data Merge = + Merge { + mergePatternPart :: PatternPart, + mergeActions :: [MergeAction]} + deriving (Eq, Ord, Read, Show) + +_Merge = (Core.Name "hydra/ext/cypher/openCypher.Merge") + +_Merge_patternPart = (Core.Name "patternPart") + +_Merge_actions = (Core.Name "actions") + +data MatchOrCreate = + MatchOrCreateMatch | + MatchOrCreateCreate + deriving (Eq, Ord, Read, Show) + +_MatchOrCreate = (Core.Name "hydra/ext/cypher/openCypher.MatchOrCreate") + +_MatchOrCreate_match = (Core.Name "match") + +_MatchOrCreate_create = (Core.Name "create") + +data MergeAction = + MergeAction { + mergeActionAction :: MatchOrCreate, + mergeActionSet :: Set_} + deriving (Eq, Ord, Read, Show) + +_MergeAction = (Core.Name "hydra/ext/cypher/openCypher.MergeAction") + +_MergeAction_action = (Core.Name "action") + +_MergeAction_set = (Core.Name "set") + +newtype Create = + Create { + unCreate :: Pattern} + deriving (Eq, Ord, Read, Show) + +_Create = (Core.Name "hydra/ext/cypher/openCypher.Create") + +newtype Set_ = + Set_ { + unSet :: [SetItem]} + deriving (Eq, Ord, Read, Show) + +_Set = (Core.Name "hydra/ext/cypher/openCypher.Set") + +data SetItem = + SetItemProperty PropertyEquals | + SetItemVariableEqual VariableEquals | + SetItemVariablePlusEqual VariablePlusEquals | + SetItemVariableLabels VariableAndNodeLabels + deriving (Eq, Ord, Read, Show) + +_SetItem = (Core.Name "hydra/ext/cypher/openCypher.SetItem") + +_SetItem_property = (Core.Name "property") + +_SetItem_variableEqual = (Core.Name "variableEqual") + +_SetItem_variablePlusEqual = (Core.Name "variablePlusEqual") + +_SetItem_variableLabels = (Core.Name "variableLabels") + +data PropertyEquals = + PropertyEquals { + propertyEqualsLhs :: PropertyExpression, + propertyEqualsRhs :: Expression} + deriving (Eq, Ord, Read, Show) + +_PropertyEquals = (Core.Name "hydra/ext/cypher/openCypher.PropertyEquals") + +_PropertyEquals_lhs = (Core.Name "lhs") + +_PropertyEquals_rhs = (Core.Name "rhs") + +data VariableEquals = + VariableEquals { + variableEqualsLhs :: Variable, + variableEqualsRhs :: Expression} + deriving (Eq, Ord, Read, Show) + +_VariableEquals = (Core.Name "hydra/ext/cypher/openCypher.VariableEquals") + +_VariableEquals_lhs = (Core.Name "lhs") + +_VariableEquals_rhs = (Core.Name "rhs") + +data VariablePlusEquals = + VariablePlusEquals { + variablePlusEqualsLhs :: Variable, + variablePlusEqualsRhs :: Expression} + deriving (Eq, Ord, Read, Show) + +_VariablePlusEquals = (Core.Name "hydra/ext/cypher/openCypher.VariablePlusEquals") + +_VariablePlusEquals_lhs = (Core.Name "lhs") + +_VariablePlusEquals_rhs = (Core.Name "rhs") + +data VariableAndNodeLabels = + VariableAndNodeLabels { + variableAndNodeLabelsVariable :: Variable, + variableAndNodeLabelsLabels :: NodeLabels} + deriving (Eq, Ord, Read, Show) + +_VariableAndNodeLabels = (Core.Name "hydra/ext/cypher/openCypher.VariableAndNodeLabels") + +_VariableAndNodeLabels_variable = (Core.Name "variable") + +_VariableAndNodeLabels_labels = (Core.Name "labels") + +data Delete = + Delete { + deleteDetach :: Bool, + deleteExpressions :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_Delete = (Core.Name "hydra/ext/cypher/openCypher.Delete") + +_Delete_detach = (Core.Name "detach") + +_Delete_expressions = (Core.Name "expressions") + +newtype Remove = + Remove { + unRemove :: [RemoveItem]} + deriving (Eq, Ord, Read, Show) + +_Remove = (Core.Name "hydra/ext/cypher/openCypher.Remove") + +data RemoveItem = + RemoveItemVariableLabels VariableAndNodeLabels | + RemoveItemProperty PropertyExpression + deriving (Eq, Ord, Read, Show) + +_RemoveItem = (Core.Name "hydra/ext/cypher/openCypher.RemoveItem") + +_RemoveItem_variableLabels = (Core.Name "variableLabels") + +_RemoveItem_property = (Core.Name "property") + +data InQueryCall = + InQueryCall { + inQueryCallCall :: ExplicitProcedureInvocation, + inQueryCallYieldItems :: (Maybe YieldItems)} + deriving (Eq, Ord, Read, Show) + +_InQueryCall = (Core.Name "hydra/ext/cypher/openCypher.InQueryCall") + +_InQueryCall_call = (Core.Name "call") + +_InQueryCall_yieldItems = (Core.Name "yieldItems") + +data ProcedureInvocation = + ProcedureInvocationExplicit ExplicitProcedureInvocation | + ProcedureInvocationImplicit ImplicitProcedureInvocation + deriving (Eq, Ord, Read, Show) + +_ProcedureInvocation = (Core.Name "hydra/ext/cypher/openCypher.ProcedureInvocation") + +_ProcedureInvocation_explicit = (Core.Name "explicit") + +_ProcedureInvocation_implicit = (Core.Name "implicit") + +data StarOrYieldItems = + StarOrYieldItemsStar | + StarOrYieldItemsItems YieldItems + deriving (Eq, Ord, Read, Show) + +_StarOrYieldItems = (Core.Name "hydra/ext/cypher/openCypher.StarOrYieldItems") + +_StarOrYieldItems_star = (Core.Name "star") + +_StarOrYieldItems_items = (Core.Name "items") + +data StandaloneCall = + StandaloneCall { + standaloneCallCall :: ProcedureInvocation, + standaloneCallYieldItems :: (Maybe StarOrYieldItems)} + deriving (Eq, Ord, Read, Show) + +_StandaloneCall = (Core.Name "hydra/ext/cypher/openCypher.StandaloneCall") + +_StandaloneCall_call = (Core.Name "call") + +_StandaloneCall_yieldItems = (Core.Name "yieldItems") + +data YieldItems = + YieldItems { + yieldItemsItems :: [YieldItem], + yieldItemsWhere :: (Maybe Where)} + deriving (Eq, Ord, Read, Show) + +_YieldItems = (Core.Name "hydra/ext/cypher/openCypher.YieldItems") + +_YieldItems_items = (Core.Name "items") + +_YieldItems_where = (Core.Name "where") + +data YieldItem = + YieldItem { + yieldItemField :: (Maybe ProcedureResultField), + yieldItemVariable :: Variable} + deriving (Eq, Ord, Read, Show) + +_YieldItem = (Core.Name "hydra/ext/cypher/openCypher.YieldItem") + +_YieldItem_field = (Core.Name "field") + +_YieldItem_variable = (Core.Name "variable") + +data With = + With { + withProjection :: ProjectionBody, + withWhere :: (Maybe Where)} + deriving (Eq, Ord, Read, Show) + +_With = (Core.Name "hydra/ext/cypher/openCypher.With") + +_With_projection = (Core.Name "projection") + +_With_where = (Core.Name "where") + +newtype Return = + Return { + unReturn :: ProjectionBody} + deriving (Eq, Ord, Read, Show) + +_Return = (Core.Name "hydra/ext/cypher/openCypher.Return") + +data ProjectionBody = + ProjectionBody { + projectionBodyDistinct :: Bool, + projectionBodyProjectionItems :: ProjectionItems, + projectionBodyOrder :: (Maybe Order), + projectionBodySkip :: (Maybe Skip), + projectionBodyLimit :: (Maybe Limit)} + deriving (Eq, Ord, Read, Show) + +_ProjectionBody = (Core.Name "hydra/ext/cypher/openCypher.ProjectionBody") + +_ProjectionBody_distinct = (Core.Name "distinct") + +_ProjectionBody_projectionItems = (Core.Name "projectionItems") + +_ProjectionBody_order = (Core.Name "order") + +_ProjectionBody_skip = (Core.Name "skip") + +_ProjectionBody_limit = (Core.Name "limit") + +data ProjectionItems = + ProjectionItems { + projectionItemsStar :: Bool, + projectionItemsExplicit :: [ProjectionItem]} + deriving (Eq, Ord, Read, Show) + +_ProjectionItems = (Core.Name "hydra/ext/cypher/openCypher.ProjectionItems") + +_ProjectionItems_star = (Core.Name "star") + +_ProjectionItems_explicit = (Core.Name "explicit") + +data ProjectionItem = + ProjectionItem { + projectionItemExpression :: Expression, + projectionItemVariable :: (Maybe Variable)} + deriving (Eq, Ord, Read, Show) + +_ProjectionItem = (Core.Name "hydra/ext/cypher/openCypher.ProjectionItem") + +_ProjectionItem_expression = (Core.Name "expression") + +_ProjectionItem_variable = (Core.Name "variable") + +newtype Order = + Order { + unOrder :: [SortItem]} + deriving (Eq, Ord, Read, Show) + +_Order = (Core.Name "hydra/ext/cypher/openCypher.Order") + +newtype Skip = + Skip { + unSkip :: Expression} + deriving (Eq, Ord, Read, Show) + +_Skip = (Core.Name "hydra/ext/cypher/openCypher.Skip") + +newtype Limit = + Limit { + unLimit :: Expression} + deriving (Eq, Ord, Read, Show) + +_Limit = (Core.Name "hydra/ext/cypher/openCypher.Limit") + +data SortOrder = + SortOrderAscending | + SortOrderDescending + deriving (Eq, Ord, Read, Show) + +_SortOrder = (Core.Name "hydra/ext/cypher/openCypher.SortOrder") + +_SortOrder_ascending = (Core.Name "ascending") + +_SortOrder_descending = (Core.Name "descending") + +data SortItem = + SortItem { + sortItemExpression :: Expression, + sortItemOrder :: (Maybe SortOrder)} + deriving (Eq, Ord, Read, Show) + +_SortItem = (Core.Name "hydra/ext/cypher/openCypher.SortItem") + +_SortItem_expression = (Core.Name "expression") + +_SortItem_order = (Core.Name "order") + +newtype Where = + Where { + unWhere :: Expression} + deriving (Eq, Ord, Read, Show) + +_Where = (Core.Name "hydra/ext/cypher/openCypher.Where") + +newtype Pattern = + Pattern { + unPattern :: [PatternPart]} + deriving (Eq, Ord, Read, Show) + +_Pattern = (Core.Name "hydra/ext/cypher/openCypher.Pattern") + +data PatternPart = + PatternPart { + patternPartVariable :: (Maybe Variable), + patternPartPattern :: AnonymousPatternPart} + deriving (Eq, Ord, Read, Show) + +_PatternPart = (Core.Name "hydra/ext/cypher/openCypher.PatternPart") + +_PatternPart_variable = (Core.Name "variable") + +_PatternPart_pattern = (Core.Name "pattern") + +newtype AnonymousPatternPart = + AnonymousPatternPart { + unAnonymousPatternPart :: PatternElement} + deriving (Eq, Ord, Read, Show) + +_AnonymousPatternPart = (Core.Name "hydra/ext/cypher/openCypher.AnonymousPatternPart") + +data NodePatternChain = + NodePatternChain { + nodePatternChainNodePattern :: NodePattern, + nodePatternChainChain :: [PatternElementChain]} + deriving (Eq, Ord, Read, Show) + +_NodePatternChain = (Core.Name "hydra/ext/cypher/openCypher.NodePatternChain") + +_NodePatternChain_nodePattern = (Core.Name "nodePattern") + +_NodePatternChain_chain = (Core.Name "chain") + +data PatternElement = + PatternElementChained NodePatternChain | + PatternElementParenthesized PatternElement + deriving (Eq, Ord, Read, Show) + +_PatternElement = (Core.Name "hydra/ext/cypher/openCypher.PatternElement") + +_PatternElement_chained = (Core.Name "chained") + +_PatternElement_parenthesized = (Core.Name "parenthesized") + +data RelationshipsPattern = + RelationshipsPattern { + relationshipsPatternNodePattern :: NodePattern, + relationshipsPatternChain :: [PatternElementChain]} + deriving (Eq, Ord, Read, Show) + +_RelationshipsPattern = (Core.Name "hydra/ext/cypher/openCypher.RelationshipsPattern") + +_RelationshipsPattern_nodePattern = (Core.Name "nodePattern") + +_RelationshipsPattern_chain = (Core.Name "chain") + +data NodePattern = + NodePattern { + nodePatternVariable :: (Maybe Variable), + nodePatternLabels :: (Maybe NodeLabels), + nodePatternProperties :: (Maybe Properties)} + deriving (Eq, Ord, Read, Show) + +_NodePattern = (Core.Name "hydra/ext/cypher/openCypher.NodePattern") + +_NodePattern_variable = (Core.Name "variable") + +_NodePattern_labels = (Core.Name "labels") + +_NodePattern_properties = (Core.Name "properties") + +data PatternElementChain = + PatternElementChain { + patternElementChainRelationship :: RelationshipPattern, + patternElementChainNode :: NodePattern} + deriving (Eq, Ord, Read, Show) + +_PatternElementChain = (Core.Name "hydra/ext/cypher/openCypher.PatternElementChain") + +_PatternElementChain_relationship = (Core.Name "relationship") + +_PatternElementChain_node = (Core.Name "node") + +data RelationshipPattern = + RelationshipPattern { + relationshipPatternLeftArrow :: Bool, + relationshipPatternDetail :: (Maybe RelationshipDetail), + relationshipPatternRightArrow :: Bool} + deriving (Eq, Ord, Read, Show) + +_RelationshipPattern = (Core.Name "hydra/ext/cypher/openCypher.RelationshipPattern") + +_RelationshipPattern_leftArrow = (Core.Name "leftArrow") + +_RelationshipPattern_detail = (Core.Name "detail") + +_RelationshipPattern_rightArrow = (Core.Name "rightArrow") + +data RelationshipDetail = + RelationshipDetail { + relationshipDetailVariable :: (Maybe Variable), + relationshipDetailTypes :: (Maybe RelationshipTypes), + relationshipDetailRange :: (Maybe RangeLiteral), + relationshipDetailProperties :: (Maybe Properties)} + deriving (Eq, Ord, Read, Show) + +_RelationshipDetail = (Core.Name "hydra/ext/cypher/openCypher.RelationshipDetail") + +_RelationshipDetail_variable = (Core.Name "variable") + +_RelationshipDetail_types = (Core.Name "types") + +_RelationshipDetail_range = (Core.Name "range") + +_RelationshipDetail_properties = (Core.Name "properties") + +data Properties = + PropertiesMap MapLiteral | + PropertiesParameter Parameter + deriving (Eq, Ord, Read, Show) + +_Properties = (Core.Name "hydra/ext/cypher/openCypher.Properties") + +_Properties_map = (Core.Name "map") + +_Properties_parameter = (Core.Name "parameter") + +newtype RelationshipTypes = + RelationshipTypes { + unRelationshipTypes :: [RelTypeName]} + deriving (Eq, Ord, Read, Show) + +_RelationshipTypes = (Core.Name "hydra/ext/cypher/openCypher.RelationshipTypes") + +newtype NodeLabels = + NodeLabels { + unNodeLabels :: [NodeLabel]} + deriving (Eq, Ord, Read, Show) + +_NodeLabels = (Core.Name "hydra/ext/cypher/openCypher.NodeLabels") + +newtype NodeLabel = + NodeLabel { + unNodeLabel :: String} + deriving (Eq, Ord, Read, Show) + +_NodeLabel = (Core.Name "hydra/ext/cypher/openCypher.NodeLabel") + +data RangeLiteral = + RangeLiteral { + rangeLiteralStart :: (Maybe Integer), + rangeLiteralEnd :: (Maybe Integer)} + deriving (Eq, Ord, Read, Show) + +_RangeLiteral = (Core.Name "hydra/ext/cypher/openCypher.RangeLiteral") + +_RangeLiteral_start = (Core.Name "start") + +_RangeLiteral_end = (Core.Name "end") + +newtype RelTypeName = + RelTypeName { + unRelTypeName :: String} + deriving (Eq, Ord, Read, Show) + +_RelTypeName = (Core.Name "hydra/ext/cypher/openCypher.RelTypeName") + +data PropertyExpression = + PropertyExpression { + propertyExpressionAtom :: Atom, + propertyExpressionLookups :: [PropertyLookup]} + deriving (Eq, Ord, Read, Show) + +_PropertyExpression = (Core.Name "hydra/ext/cypher/openCypher.PropertyExpression") + +_PropertyExpression_atom = (Core.Name "atom") + +_PropertyExpression_lookups = (Core.Name "lookups") + +newtype Expression = + Expression { + unExpression :: OrExpression} + deriving (Eq, Ord, Read, Show) + +_Expression = (Core.Name "hydra/ext/cypher/openCypher.Expression") + +newtype OrExpression = + OrExpression { + unOrExpression :: [XorExpression]} + deriving (Eq, Ord, Read, Show) + +_OrExpression = (Core.Name "hydra/ext/cypher/openCypher.OrExpression") + +newtype XorExpression = + XorExpression { + unXorExpression :: [AndExpression]} + deriving (Eq, Ord, Read, Show) + +_XorExpression = (Core.Name "hydra/ext/cypher/openCypher.XorExpression") + +newtype AndExpression = + AndExpression { + unAndExpression :: [NotExpression]} + deriving (Eq, Ord, Read, Show) + +_AndExpression = (Core.Name "hydra/ext/cypher/openCypher.AndExpression") + +data NotExpression = + NotExpression { + notExpressionNot :: Bool, + notExpressionExpression :: ComparisonExpression} + deriving (Eq, Ord, Read, Show) + +_NotExpression = (Core.Name "hydra/ext/cypher/openCypher.NotExpression") + +_NotExpression_not = (Core.Name "not") + +_NotExpression_expression = (Core.Name "expression") + +data ComparisonExpression = + ComparisonExpression { + comparisonExpressionLeft :: StringListNullPredicateExpression, + comparisonExpressionRight :: [PartialComparisonExpression]} + deriving (Eq, Ord, Read, Show) + +_ComparisonExpression = (Core.Name "hydra/ext/cypher/openCypher.ComparisonExpression") + +_ComparisonExpression_left = (Core.Name "left") + +_ComparisonExpression_right = (Core.Name "right") + +data ComparisonOperator = + ComparisonOperatorEq | + ComparisonOperatorNeq | + ComparisonOperatorLt | + ComparisonOperatorGt | + ComparisonOperatorLte | + ComparisonOperatorGte + deriving (Eq, Ord, Read, Show) + +_ComparisonOperator = (Core.Name "hydra/ext/cypher/openCypher.ComparisonOperator") + +_ComparisonOperator_eq = (Core.Name "eq") + +_ComparisonOperator_neq = (Core.Name "neq") + +_ComparisonOperator_lt = (Core.Name "lt") + +_ComparisonOperator_gt = (Core.Name "gt") + +_ComparisonOperator_lte = (Core.Name "lte") + +_ComparisonOperator_gte = (Core.Name "gte") + +data PartialComparisonExpression = + PartialComparisonExpression { + partialComparisonExpressionOperator :: ComparisonOperator, + partialComparisonExpressionRight :: StringListNullPredicateExpression} + deriving (Eq, Ord, Read, Show) + +_PartialComparisonExpression = (Core.Name "hydra/ext/cypher/openCypher.PartialComparisonExpression") + +_PartialComparisonExpression_operator = (Core.Name "operator") + +_PartialComparisonExpression_right = (Core.Name "right") + +data StringListNullPredicateExpression = + StringListNullPredicateExpression { + stringListNullPredicateExpressionLeft :: AddOrSubtractExpression, + stringListNullPredicateExpressionRight :: [StringListNullPredicateRightHandSide]} + deriving (Eq, Ord, Read, Show) + +_StringListNullPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.StringListNullPredicateExpression") + +_StringListNullPredicateExpression_left = (Core.Name "left") + +_StringListNullPredicateExpression_right = (Core.Name "right") + +data StringListNullPredicateRightHandSide = + StringListNullPredicateRightHandSideString StringPredicateExpression | + StringListNullPredicateRightHandSideList ListPredicateExpression | + StringListNullPredicateRightHandSideNull NullPredicateExpression + deriving (Eq, Ord, Read, Show) + +_StringListNullPredicateRightHandSide = (Core.Name "hydra/ext/cypher/openCypher.StringListNullPredicateRightHandSide") + +_StringListNullPredicateRightHandSide_string = (Core.Name "string") + +_StringListNullPredicateRightHandSide_list = (Core.Name "list") + +_StringListNullPredicateRightHandSide_null = (Core.Name "null") + +data StringPredicateExpression = + StringPredicateExpression { + stringPredicateExpressionOperator :: StringPredicateOperator, + stringPredicateExpressionExpression :: AddOrSubtractExpression} + deriving (Eq, Ord, Read, Show) + +_StringPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.StringPredicateExpression") + +_StringPredicateExpression_operator = (Core.Name "operator") + +_StringPredicateExpression_expression = (Core.Name "expression") + +data StringPredicateOperator = + StringPredicateOperatorStartsWith | + StringPredicateOperatorEndsWith | + StringPredicateOperatorContains + deriving (Eq, Ord, Read, Show) + +_StringPredicateOperator = (Core.Name "hydra/ext/cypher/openCypher.StringPredicateOperator") + +_StringPredicateOperator_startsWith = (Core.Name "startsWith") + +_StringPredicateOperator_endsWith = (Core.Name "endsWith") + +_StringPredicateOperator_contains = (Core.Name "contains") + +newtype ListPredicateExpression = + ListPredicateExpression { + unListPredicateExpression :: AddOrSubtractExpression} + deriving (Eq, Ord, Read, Show) + +_ListPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.ListPredicateExpression") + +newtype NullPredicateExpression = + NullPredicateExpression { + unNullPredicateExpression :: Bool} + deriving (Eq, Ord, Read, Show) + +_NullPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.NullPredicateExpression") + +data AddOrSubtractExpression = + AddOrSubtractExpression { + addOrSubtractExpressionLeft :: MultiplyDivideModuloExpression, + addOrSubtractExpressionRight :: [AddOrSubtractRightHandSide]} + deriving (Eq, Ord, Read, Show) + +_AddOrSubtractExpression = (Core.Name "hydra/ext/cypher/openCypher.AddOrSubtractExpression") + +_AddOrSubtractExpression_left = (Core.Name "left") + +_AddOrSubtractExpression_right = (Core.Name "right") + +data AddOrSubtractRightHandSide = + AddOrSubtractRightHandSide { + addOrSubtractRightHandSideOperator :: AddOrSubtractOperator, + addOrSubtractRightHandSideExpression :: MultiplyDivideModuloExpression} + deriving (Eq, Ord, Read, Show) + +_AddOrSubtractRightHandSide = (Core.Name "hydra/ext/cypher/openCypher.AddOrSubtractRightHandSide") + +_AddOrSubtractRightHandSide_operator = (Core.Name "operator") + +_AddOrSubtractRightHandSide_expression = (Core.Name "expression") + +data AddOrSubtractOperator = + AddOrSubtractOperatorAdd | + AddOrSubtractOperatorSubtract + deriving (Eq, Ord, Read, Show) + +_AddOrSubtractOperator = (Core.Name "hydra/ext/cypher/openCypher.AddOrSubtractOperator") + +_AddOrSubtractOperator_add = (Core.Name "add") + +_AddOrSubtractOperator_subtract = (Core.Name "subtract") + +data MultiplyDivideModuloExpression = + MultiplyDivideModuloExpression { + multiplyDivideModuloExpressionLeft :: PowerOfExpression, + multiplyDivideModuloExpressionRight :: [MultiplyDivideModuloRightHandSide]} + deriving (Eq, Ord, Read, Show) + +_MultiplyDivideModuloExpression = (Core.Name "hydra/ext/cypher/openCypher.MultiplyDivideModuloExpression") + +_MultiplyDivideModuloExpression_left = (Core.Name "left") + +_MultiplyDivideModuloExpression_right = (Core.Name "right") + +data MultiplyDivideModuloRightHandSide = + MultiplyDivideModuloRightHandSide { + multiplyDivideModuloRightHandSideOperator :: MultiplyDivideModuloOperator, + multiplyDivideModuloRightHandSideExpression :: PowerOfExpression} + deriving (Eq, Ord, Read, Show) + +_MultiplyDivideModuloRightHandSide = (Core.Name "hydra/ext/cypher/openCypher.MultiplyDivideModuloRightHandSide") + +_MultiplyDivideModuloRightHandSide_operator = (Core.Name "operator") + +_MultiplyDivideModuloRightHandSide_expression = (Core.Name "expression") + +data MultiplyDivideModuloOperator = + MultiplyDivideModuloOperatorMultiply | + MultiplyDivideModuloOperatorDivide | + MultiplyDivideModuloOperatorModulo + deriving (Eq, Ord, Read, Show) + +_MultiplyDivideModuloOperator = (Core.Name "hydra/ext/cypher/openCypher.MultiplyDivideModuloOperator") + +_MultiplyDivideModuloOperator_multiply = (Core.Name "multiply") + +_MultiplyDivideModuloOperator_divide = (Core.Name "divide") + +_MultiplyDivideModuloOperator_modulo = (Core.Name "modulo") + +newtype PowerOfExpression = + PowerOfExpression { + unPowerOfExpression :: [UnaryAddOrSubtractExpression]} + deriving (Eq, Ord, Read, Show) + +_PowerOfExpression = (Core.Name "hydra/ext/cypher/openCypher.PowerOfExpression") + +data UnaryAddOrSubtractExpression = + UnaryAddOrSubtractExpression { + unaryAddOrSubtractExpressionOperator :: (Maybe AddOrSubtractOperator), + unaryAddOrSubtractExpressionExpression :: NonArithmeticOperatorExpression} + deriving (Eq, Ord, Read, Show) + +_UnaryAddOrSubtractExpression = (Core.Name "hydra/ext/cypher/openCypher.UnaryAddOrSubtractExpression") + +_UnaryAddOrSubtractExpression_operator = (Core.Name "operator") + +_UnaryAddOrSubtractExpression_expression = (Core.Name "expression") + +data ListOperatorExpressionOrPropertyLookup = + ListOperatorExpressionOrPropertyLookupList ListOperatorExpression | + ListOperatorExpressionOrPropertyLookupProperty PropertyLookup + deriving (Eq, Ord, Read, Show) + +_ListOperatorExpressionOrPropertyLookup = (Core.Name "hydra/ext/cypher/openCypher.ListOperatorExpressionOrPropertyLookup") + +_ListOperatorExpressionOrPropertyLookup_list = (Core.Name "list") + +_ListOperatorExpressionOrPropertyLookup_property = (Core.Name "property") + +data NonArithmeticOperatorExpression = + NonArithmeticOperatorExpression { + nonArithmeticOperatorExpressionAtom :: Atom, + nonArithmeticOperatorExpressionListsAndLookups :: [ListOperatorExpressionOrPropertyLookup], + nonArithmeticOperatorExpressionLabels :: (Maybe NodeLabels)} + deriving (Eq, Ord, Read, Show) + +_NonArithmeticOperatorExpression = (Core.Name "hydra/ext/cypher/openCypher.NonArithmeticOperatorExpression") + +_NonArithmeticOperatorExpression_atom = (Core.Name "atom") + +_NonArithmeticOperatorExpression_listsAndLookups = (Core.Name "listsAndLookups") + +_NonArithmeticOperatorExpression_labels = (Core.Name "labels") + +data RangeExpression = + RangeExpression { + rangeExpressionStart :: (Maybe Expression), + rangeExpressionEnd :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_RangeExpression = (Core.Name "hydra/ext/cypher/openCypher.RangeExpression") + +_RangeExpression_start = (Core.Name "start") + +_RangeExpression_end = (Core.Name "end") + +data ListOperatorExpression = + ListOperatorExpressionSingle Expression | + ListOperatorExpressionRange RangeExpression + deriving (Eq, Ord, Read, Show) + +_ListOperatorExpression = (Core.Name "hydra/ext/cypher/openCypher.ListOperatorExpression") + +_ListOperatorExpression_single = (Core.Name "single") + +_ListOperatorExpression_range = (Core.Name "range") + +newtype PropertyLookup = + PropertyLookup { + unPropertyLookup :: PropertyKeyName} + deriving (Eq, Ord, Read, Show) + +_PropertyLookup = (Core.Name "hydra/ext/cypher/openCypher.PropertyLookup") + +data Atom = + AtomLiteral Literal | + AtomParameter Parameter | + AtomCase CaseExpression | + AtomCountStar | + AtomListComprehension ListComprehension | + AtomPatternComprehension PatternComprehension | + AtomQuantifier Quantifier | + AtomPatternPredicate PatternPredicate | + AtomParenthesized ParenthesizedExpression | + AtomFunctionInvocation FunctionInvocation | + AtomExistentialSubquery ExistentialSubquery | + AtomVariable Variable + deriving (Eq, Ord, Read, Show) + +_Atom = (Core.Name "hydra/ext/cypher/openCypher.Atom") + +_Atom_literal = (Core.Name "literal") + +_Atom_parameter = (Core.Name "parameter") + +_Atom_case = (Core.Name "case") + +_Atom_countStar = (Core.Name "countStar") + +_Atom_listComprehension = (Core.Name "listComprehension") + +_Atom_patternComprehension = (Core.Name "patternComprehension") + +_Atom_quantifier = (Core.Name "quantifier") + +_Atom_patternPredicate = (Core.Name "patternPredicate") + +_Atom_parenthesized = (Core.Name "parenthesized") + +_Atom_functionInvocation = (Core.Name "functionInvocation") + +_Atom_existentialSubquery = (Core.Name "existentialSubquery") + +_Atom_variable = (Core.Name "variable") + +data CaseExpression = + CaseExpression { + caseExpressionExpression :: (Maybe Expression), + caseExpressionAlternatives :: [CaseAlternative], + caseExpressionElse :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_CaseExpression = (Core.Name "hydra/ext/cypher/openCypher.CaseExpression") + +_CaseExpression_expression = (Core.Name "expression") + +_CaseExpression_alternatives = (Core.Name "alternatives") + +_CaseExpression_else = (Core.Name "else") + +data CaseAlternative = + CaseAlternative { + caseAlternativeCondition :: Expression, + caseAlternativeResult :: Expression} + deriving (Eq, Ord, Read, Show) + +_CaseAlternative = (Core.Name "hydra/ext/cypher/openCypher.CaseAlternative") + +_CaseAlternative_condition = (Core.Name "condition") + +_CaseAlternative_result = (Core.Name "result") + +data ListComprehension = + ListComprehension { + listComprehensionLeft :: FilterExpression, + listComprehensionRight :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_ListComprehension = (Core.Name "hydra/ext/cypher/openCypher.ListComprehension") + +_ListComprehension_left = (Core.Name "left") + +_ListComprehension_right = (Core.Name "right") + +data PatternComprehension = + PatternComprehension { + patternComprehensionVariable :: (Maybe Variable), + patternComprehensionPattern :: RelationshipsPattern, + patternComprehensionWhere :: (Maybe Where), + patternComprehensionRight :: Expression} + deriving (Eq, Ord, Read, Show) + +_PatternComprehension = (Core.Name "hydra/ext/cypher/openCypher.PatternComprehension") + +_PatternComprehension_variable = (Core.Name "variable") + +_PatternComprehension_pattern = (Core.Name "pattern") + +_PatternComprehension_where = (Core.Name "where") + +_PatternComprehension_right = (Core.Name "right") + +data Quantifier = + Quantifier { + quantifierOperator :: QuantifierOperator, + quantifierExpression :: FilterExpression} + deriving (Eq, Ord, Read, Show) + +_Quantifier = (Core.Name "hydra/ext/cypher/openCypher.Quantifier") + +_Quantifier_operator = (Core.Name "operator") + +_Quantifier_expression = (Core.Name "expression") + +data QuantifierOperator = + QuantifierOperatorAll | + QuantifierOperatorAny | + QuantifierOperatorNone | + QuantifierOperatorSingle + deriving (Eq, Ord, Read, Show) + +_QuantifierOperator = (Core.Name "hydra/ext/cypher/openCypher.QuantifierOperator") + +_QuantifierOperator_all = (Core.Name "all") + +_QuantifierOperator_any = (Core.Name "any") + +_QuantifierOperator_none = (Core.Name "none") + +_QuantifierOperator_single = (Core.Name "single") + +data FilterExpression = + FilterExpression { + filterExpressionIdInColl :: IdInColl, + filterExpressionWhere :: (Maybe Where)} + deriving (Eq, Ord, Read, Show) + +_FilterExpression = (Core.Name "hydra/ext/cypher/openCypher.FilterExpression") + +_FilterExpression_idInColl = (Core.Name "idInColl") + +_FilterExpression_where = (Core.Name "where") + +newtype PatternPredicate = + PatternPredicate { + unPatternPredicate :: RelationshipsPattern} + deriving (Eq, Ord, Read, Show) + +_PatternPredicate = (Core.Name "hydra/ext/cypher/openCypher.PatternPredicate") + +newtype ParenthesizedExpression = + ParenthesizedExpression { + unParenthesizedExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_ParenthesizedExpression = (Core.Name "hydra/ext/cypher/openCypher.ParenthesizedExpression") + +data IdInColl = + IdInColl { + idInCollVariable :: Variable, + idInCollExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_IdInColl = (Core.Name "hydra/ext/cypher/openCypher.IdInColl") + +_IdInColl_variable = (Core.Name "variable") + +_IdInColl_expression = (Core.Name "expression") + +data FunctionInvocation = + FunctionInvocation { + functionInvocationName :: QualifiedName, + functionInvocationDistinct :: Bool, + functionInvocationArguments :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_FunctionInvocation = (Core.Name "hydra/ext/cypher/openCypher.FunctionInvocation") + +_FunctionInvocation_name = (Core.Name "name") + +_FunctionInvocation_distinct = (Core.Name "distinct") + +_FunctionInvocation_arguments = (Core.Name "arguments") + +data QualifiedName = + QualifiedName { + qualifiedNameNamespace :: String, + qualifiedNameLocal :: String} + deriving (Eq, Ord, Read, Show) + +_QualifiedName = (Core.Name "hydra/ext/cypher/openCypher.QualifiedName") + +_QualifiedName_namespace = (Core.Name "namespace") + +_QualifiedName_local = (Core.Name "local") + +data PatternWhere = + PatternWhere { + patternWherePattern :: Pattern, + patternWhereWhere :: (Maybe Where)} + deriving (Eq, Ord, Read, Show) + +_PatternWhere = (Core.Name "hydra/ext/cypher/openCypher.PatternWhere") + +_PatternWhere_pattern = (Core.Name "pattern") + +_PatternWhere_where = (Core.Name "where") + +data ExistentialSubquery = + ExistentialSubqueryRegular RegularQuery | + ExistentialSubqueryPattern PatternWhere + deriving (Eq, Ord, Read, Show) + +_ExistentialSubquery = (Core.Name "hydra/ext/cypher/openCypher.ExistentialSubquery") + +_ExistentialSubquery_regular = (Core.Name "regular") + +_ExistentialSubquery_pattern = (Core.Name "pattern") + +data ExplicitProcedureInvocation = + ExplicitProcedureInvocation { + explicitProcedureInvocationName :: QualifiedName, + explicitProcedureInvocationArguments :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_ExplicitProcedureInvocation = (Core.Name "hydra/ext/cypher/openCypher.ExplicitProcedureInvocation") + +_ExplicitProcedureInvocation_name = (Core.Name "name") + +_ExplicitProcedureInvocation_arguments = (Core.Name "arguments") + +newtype ImplicitProcedureInvocation = + ImplicitProcedureInvocation { + unImplicitProcedureInvocation :: QualifiedName} + deriving (Eq, Ord, Read, Show) + +_ImplicitProcedureInvocation = (Core.Name "hydra/ext/cypher/openCypher.ImplicitProcedureInvocation") + +newtype ProcedureResultField = + ProcedureResultField { + unProcedureResultField :: String} + deriving (Eq, Ord, Read, Show) + +_ProcedureResultField = (Core.Name "hydra/ext/cypher/openCypher.ProcedureResultField") + +newtype Variable = + Variable { + unVariable :: String} + deriving (Eq, Ord, Read, Show) + +_Variable = (Core.Name "hydra/ext/cypher/openCypher.Variable") + +data Literal = + LiteralBoolean Bool | + LiteralNull | + LiteralNumber NumberLiteral | + LiteralString StringLiteral | + LiteralList ListLiteral | + LiteralMap MapLiteral + deriving (Eq, Ord, Read, Show) + +_Literal = (Core.Name "hydra/ext/cypher/openCypher.Literal") + +_Literal_boolean = (Core.Name "boolean") + +_Literal_null = (Core.Name "null") + +_Literal_number = (Core.Name "number") + +_Literal_string = (Core.Name "string") + +_Literal_list = (Core.Name "list") + +_Literal_map = (Core.Name "map") + +data NumberLiteral = + NumberLiteralDouble Double | + NumberLiteralInteger Integer + deriving (Eq, Ord, Read, Show) + +_NumberLiteral = (Core.Name "hydra/ext/cypher/openCypher.NumberLiteral") + +_NumberLiteral_double = (Core.Name "double") + +_NumberLiteral_integer = (Core.Name "integer") + +newtype StringLiteral = + StringLiteral { + unStringLiteral :: String} + deriving (Eq, Ord, Read, Show) + +_StringLiteral = (Core.Name "hydra/ext/cypher/openCypher.StringLiteral") + +newtype ListLiteral = + ListLiteral { + unListLiteral :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_ListLiteral = (Core.Name "hydra/ext/cypher/openCypher.ListLiteral") + +newtype MapLiteral = + MapLiteral { + unMapLiteral :: [KeyValuePair]} + deriving (Eq, Ord, Read, Show) + +_MapLiteral = (Core.Name "hydra/ext/cypher/openCypher.MapLiteral") + +data KeyValuePair = + KeyValuePair { + keyValuePairKey :: PropertyKeyName, + keyValuePairValue :: Expression} + deriving (Eq, Ord, Read, Show) + +_KeyValuePair = (Core.Name "hydra/ext/cypher/openCypher.KeyValuePair") + +_KeyValuePair_key = (Core.Name "key") + +_KeyValuePair_value = (Core.Name "value") + +newtype PropertyKeyName = + PropertyKeyName { + unPropertyKeyName :: String} + deriving (Eq, Ord, Read, Show) + +_PropertyKeyName = (Core.Name "hydra/ext/cypher/openCypher.PropertyKeyName") + +data Parameter = + ParameterSymbolic String | + ParameterInteger Integer + deriving (Eq, Ord, Read, Show) + +_Parameter = (Core.Name "hydra/ext/cypher/openCypher.Parameter") + +_Parameter_symbolic = (Core.Name "symbolic") + +_Parameter_integer = (Core.Name "integer") diff --git a/src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs b/src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs @@ -0,0 +1,917 @@ +-- | A Haskell syntax model, loosely based on Language.Haskell.Tools.AST + +module Hydra.Ext.Haskell.Ast where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | A pattern-matching alternative +data Alternative = + Alternative { + alternativePattern :: Pattern, + alternativeRhs :: CaseRhs, + alternativeBinds :: (Maybe LocalBindings)} + deriving (Eq, Ord, Read, Show) + +_Alternative = (Core.Name "hydra/ext/haskell/ast.Alternative") + +_Alternative_pattern = (Core.Name "pattern") + +_Alternative_rhs = (Core.Name "rhs") + +_Alternative_binds = (Core.Name "binds") + +-- | A type assertion +data Assertion = + AssertionClass Assertion_Class | + AssertionTuple [Assertion] + deriving (Eq, Ord, Read, Show) + +_Assertion = (Core.Name "hydra/ext/haskell/ast.Assertion") + +_Assertion_class = (Core.Name "class") + +_Assertion_tuple = (Core.Name "tuple") + +data Assertion_Class = + Assertion_Class { + assertion_ClassName :: Name, + assertion_ClassTypes :: [Type]} + deriving (Eq, Ord, Read, Show) + +_Assertion_Class = (Core.Name "hydra/ext/haskell/ast.Assertion.Class") + +_Assertion_Class_name = (Core.Name "name") + +_Assertion_Class_types = (Core.Name "types") + +-- | The right-hand side of a pattern-matching alternative +newtype CaseRhs = + CaseRhs { + unCaseRhs :: Expression} + deriving (Eq, Ord, Read, Show) + +_CaseRhs = (Core.Name "hydra/ext/haskell/ast.CaseRhs") + +-- | A data constructor +data Constructor = + ConstructorOrdinary Constructor_Ordinary | + ConstructorRecord Constructor_Record + deriving (Eq, Ord, Read, Show) + +_Constructor = (Core.Name "hydra/ext/haskell/ast.Constructor") + +_Constructor_ordinary = (Core.Name "ordinary") + +_Constructor_record = (Core.Name "record") + +-- | An ordinary (positional) data constructor +data Constructor_Ordinary = + Constructor_Ordinary { + constructor_OrdinaryName :: Name, + constructor_OrdinaryFields :: [Type]} + deriving (Eq, Ord, Read, Show) + +_Constructor_Ordinary = (Core.Name "hydra/ext/haskell/ast.Constructor.Ordinary") + +_Constructor_Ordinary_name = (Core.Name "name") + +_Constructor_Ordinary_fields = (Core.Name "fields") + +-- | A record-style data constructor +data Constructor_Record = + Constructor_Record { + constructor_RecordName :: Name, + constructor_RecordFields :: [FieldWithComments]} + deriving (Eq, Ord, Read, Show) + +_Constructor_Record = (Core.Name "hydra/ext/haskell/ast.Constructor.Record") + +_Constructor_Record_name = (Core.Name "name") + +_Constructor_Record_fields = (Core.Name "fields") + +-- | A data constructor together with any comments +data ConstructorWithComments = + ConstructorWithComments { + constructorWithCommentsBody :: Constructor, + constructorWithCommentsComments :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_ConstructorWithComments = (Core.Name "hydra/ext/haskell/ast.ConstructorWithComments") + +_ConstructorWithComments_body = (Core.Name "body") + +_ConstructorWithComments_comments = (Core.Name "comments") + +-- | A data type declaration +data DataDeclaration = + DataDeclaration { + dataDeclarationKeyword :: DataDeclaration_Keyword, + dataDeclarationContext :: [Assertion], + dataDeclarationHead :: DeclarationHead, + dataDeclarationConstructors :: [ConstructorWithComments], + dataDeclarationDeriving :: [Deriving]} + deriving (Eq, Ord, Read, Show) + +_DataDeclaration = (Core.Name "hydra/ext/haskell/ast.DataDeclaration") + +_DataDeclaration_keyword = (Core.Name "keyword") + +_DataDeclaration_context = (Core.Name "context") + +_DataDeclaration_head = (Core.Name "head") + +_DataDeclaration_constructors = (Core.Name "constructors") + +_DataDeclaration_deriving = (Core.Name "deriving") + +-- | The 'data' versus 'newtype keyword +data DataDeclaration_Keyword = + DataDeclaration_KeywordData | + DataDeclaration_KeywordNewtype + deriving (Eq, Ord, Read, Show) + +_DataDeclaration_Keyword = (Core.Name "hydra/ext/haskell/ast.DataDeclaration.Keyword") + +_DataDeclaration_Keyword_data = (Core.Name "data") + +_DataDeclaration_Keyword_newtype = (Core.Name "newtype") + +-- | A data declaration together with any comments +data DeclarationWithComments = + DeclarationWithComments { + declarationWithCommentsBody :: Declaration, + declarationWithCommentsComments :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_DeclarationWithComments = (Core.Name "hydra/ext/haskell/ast.DeclarationWithComments") + +_DeclarationWithComments_body = (Core.Name "body") + +_DeclarationWithComments_comments = (Core.Name "comments") + +-- | A data or value declaration +data Declaration = + DeclarationData DataDeclaration | + DeclarationType TypeDeclaration | + DeclarationValueBinding ValueBinding | + DeclarationTypedBinding TypedBinding + deriving (Eq, Ord, Read, Show) + +_Declaration = (Core.Name "hydra/ext/haskell/ast.Declaration") + +_Declaration_data = (Core.Name "data") + +_Declaration_type = (Core.Name "type") + +_Declaration_valueBinding = (Core.Name "valueBinding") + +_Declaration_typedBinding = (Core.Name "typedBinding") + +-- | The left-hand side of a declaration +data DeclarationHead = + DeclarationHeadApplication DeclarationHead_Application | + DeclarationHeadParens DeclarationHead | + DeclarationHeadSimple Name + deriving (Eq, Ord, Read, Show) + +_DeclarationHead = (Core.Name "hydra/ext/haskell/ast.DeclarationHead") + +_DeclarationHead_application = (Core.Name "application") + +_DeclarationHead_parens = (Core.Name "parens") + +_DeclarationHead_simple = (Core.Name "simple") + +-- | An application-style declaration head +data DeclarationHead_Application = + DeclarationHead_Application { + declarationHead_ApplicationFunction :: DeclarationHead, + declarationHead_ApplicationOperand :: Variable} + deriving (Eq, Ord, Read, Show) + +_DeclarationHead_Application = (Core.Name "hydra/ext/haskell/ast.DeclarationHead.Application") + +_DeclarationHead_Application_function = (Core.Name "function") + +_DeclarationHead_Application_operand = (Core.Name "operand") + +-- | A 'deriving' statement +newtype Deriving = + Deriving { + unDeriving :: [Name]} + deriving (Eq, Ord, Read, Show) + +_Deriving = (Core.Name "hydra/ext/haskell/ast.Deriving") + +-- | An export statement +data Export = + ExportDeclaration ImportExportSpec | + ExportModule ModuleName + deriving (Eq, Ord, Read, Show) + +_Export = (Core.Name "hydra/ext/haskell/ast.Export") + +_Export_declaration = (Core.Name "declaration") + +_Export_module = (Core.Name "module") + +-- | A data expression +data Expression = + ExpressionApplication Expression_Application | + ExpressionCase Expression_Case | + ExpressionConstructRecord Expression_ConstructRecord | + ExpressionDo [Statement] | + ExpressionIf Expression_If | + ExpressionInfixApplication Expression_InfixApplication | + ExpressionLiteral Literal | + ExpressionLambda Expression_Lambda | + ExpressionLeftSection Expression_Section | + ExpressionLet Expression_Let | + ExpressionList [Expression] | + ExpressionParens Expression | + ExpressionPrefixApplication Expression_PrefixApplication | + ExpressionRightSection Expression_Section | + ExpressionTuple [Expression] | + ExpressionTypeSignature Expression_TypeSignature | + ExpressionUpdateRecord Expression_UpdateRecord | + ExpressionVariable Name + deriving (Eq, Ord, Read, Show) + +_Expression = (Core.Name "hydra/ext/haskell/ast.Expression") + +_Expression_application = (Core.Name "application") + +_Expression_case = (Core.Name "case") + +_Expression_constructRecord = (Core.Name "constructRecord") + +_Expression_do = (Core.Name "do") + +_Expression_if = (Core.Name "if") + +_Expression_infixApplication = (Core.Name "infixApplication") + +_Expression_literal = (Core.Name "literal") + +_Expression_lambda = (Core.Name "lambda") + +_Expression_leftSection = (Core.Name "leftSection") + +_Expression_let = (Core.Name "let") + +_Expression_list = (Core.Name "list") + +_Expression_parens = (Core.Name "parens") + +_Expression_prefixApplication = (Core.Name "prefixApplication") + +_Expression_rightSection = (Core.Name "rightSection") + +_Expression_tuple = (Core.Name "tuple") + +_Expression_typeSignature = (Core.Name "typeSignature") + +_Expression_updateRecord = (Core.Name "updateRecord") + +_Expression_variable = (Core.Name "variable") + +-- | An application expression +data Expression_Application = + Expression_Application { + expression_ApplicationFunction :: Expression, + expression_ApplicationArgument :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_Application = (Core.Name "hydra/ext/haskell/ast.Expression.Application") + +_Expression_Application_function = (Core.Name "function") + +_Expression_Application_argument = (Core.Name "argument") + +-- | A case expression +data Expression_Case = + Expression_Case { + expression_CaseCase :: Expression, + expression_CaseAlternatives :: [Alternative]} + deriving (Eq, Ord, Read, Show) + +_Expression_Case = (Core.Name "hydra/ext/haskell/ast.Expression.Case") + +_Expression_Case_case = (Core.Name "case") + +_Expression_Case_alternatives = (Core.Name "alternatives") + +-- | A record constructor expression +data Expression_ConstructRecord = + Expression_ConstructRecord { + expression_ConstructRecordName :: Name, + expression_ConstructRecordFields :: [FieldUpdate]} + deriving (Eq, Ord, Read, Show) + +_Expression_ConstructRecord = (Core.Name "hydra/ext/haskell/ast.Expression.ConstructRecord") + +_Expression_ConstructRecord_name = (Core.Name "name") + +_Expression_ConstructRecord_fields = (Core.Name "fields") + +-- | An 'if' expression +data Expression_If = + Expression_If { + expression_IfCondition :: Expression, + expression_IfThen :: Expression, + expression_IfElse :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_If = (Core.Name "hydra/ext/haskell/ast.Expression.If") + +_Expression_If_condition = (Core.Name "condition") + +_Expression_If_then = (Core.Name "then") + +_Expression_If_else = (Core.Name "else") + +-- | An infix application expression +data Expression_InfixApplication = + Expression_InfixApplication { + expression_InfixApplicationLhs :: Expression, + expression_InfixApplicationOperator :: Operator, + expression_InfixApplicationRhs :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_InfixApplication = (Core.Name "hydra/ext/haskell/ast.Expression.InfixApplication") + +_Expression_InfixApplication_lhs = (Core.Name "lhs") + +_Expression_InfixApplication_operator = (Core.Name "operator") + +_Expression_InfixApplication_rhs = (Core.Name "rhs") + +-- | A lambda expression +data Expression_Lambda = + Expression_Lambda { + expression_LambdaBindings :: [Pattern], + expression_LambdaInner :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_Lambda = (Core.Name "hydra/ext/haskell/ast.Expression.Lambda") + +_Expression_Lambda_bindings = (Core.Name "bindings") + +_Expression_Lambda_inner = (Core.Name "inner") + +-- | A 'let' expression +data Expression_Let = + Expression_Let { + expression_LetBindings :: [LocalBinding], + expression_LetInner :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_Let = (Core.Name "hydra/ext/haskell/ast.Expression.Let") + +_Expression_Let_bindings = (Core.Name "bindings") + +_Expression_Let_inner = (Core.Name "inner") + +-- | A prefix expression +data Expression_PrefixApplication = + Expression_PrefixApplication { + expression_PrefixApplicationOperator :: Operator, + expression_PrefixApplicationRhs :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_PrefixApplication = (Core.Name "hydra/ext/haskell/ast.Expression.PrefixApplication") + +_Expression_PrefixApplication_operator = (Core.Name "operator") + +_Expression_PrefixApplication_rhs = (Core.Name "rhs") + +-- | A section expression +data Expression_Section = + Expression_Section { + expression_SectionOperator :: Operator, + expression_SectionExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_Expression_Section = (Core.Name "hydra/ext/haskell/ast.Expression.Section") + +_Expression_Section_operator = (Core.Name "operator") + +_Expression_Section_expression = (Core.Name "expression") + +-- | A type signature expression +data Expression_TypeSignature = + Expression_TypeSignature { + expression_TypeSignatureInner :: Expression, + expression_TypeSignatureType :: Type} + deriving (Eq, Ord, Read, Show) + +_Expression_TypeSignature = (Core.Name "hydra/ext/haskell/ast.Expression.TypeSignature") + +_Expression_TypeSignature_inner = (Core.Name "inner") + +_Expression_TypeSignature_type = (Core.Name "type") + +-- | An update record expression +data Expression_UpdateRecord = + Expression_UpdateRecord { + expression_UpdateRecordInner :: Expression, + expression_UpdateRecordFields :: [FieldUpdate]} + deriving (Eq, Ord, Read, Show) + +_Expression_UpdateRecord = (Core.Name "hydra/ext/haskell/ast.Expression.UpdateRecord") + +_Expression_UpdateRecord_inner = (Core.Name "inner") + +_Expression_UpdateRecord_fields = (Core.Name "fields") + +-- | A field (name/type pair) +data Field = + Field { + fieldName :: Name, + fieldType :: Type} + deriving (Eq, Ord, Read, Show) + +_Field = (Core.Name "hydra/ext/haskell/ast.Field") + +_Field_name = (Core.Name "name") + +_Field_type = (Core.Name "type") + +-- | A field together with any comments +data FieldWithComments = + FieldWithComments { + fieldWithCommentsField :: Field, + fieldWithCommentsComments :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_FieldWithComments = (Core.Name "hydra/ext/haskell/ast.FieldWithComments") + +_FieldWithComments_field = (Core.Name "field") + +_FieldWithComments_comments = (Core.Name "comments") + +-- | A field name and value +data FieldUpdate = + FieldUpdate { + fieldUpdateName :: Name, + fieldUpdateValue :: Expression} + deriving (Eq, Ord, Read, Show) + +_FieldUpdate = (Core.Name "hydra/ext/haskell/ast.FieldUpdate") + +_FieldUpdate_name = (Core.Name "name") + +_FieldUpdate_value = (Core.Name "value") + +-- | An import statement +data Import = + Import { + importQualified :: Bool, + importModule :: ModuleName, + importAs :: (Maybe ModuleName), + importSpec :: (Maybe Import_Spec)} + deriving (Eq, Ord, Read, Show) + +_Import = (Core.Name "hydra/ext/haskell/ast.Import") + +_Import_qualified = (Core.Name "qualified") + +_Import_module = (Core.Name "module") + +_Import_as = (Core.Name "as") + +_Import_spec = (Core.Name "spec") + +-- | An import specification +data Import_Spec = + Import_SpecList [ImportExportSpec] | + Import_SpecHiding [ImportExportSpec] + deriving (Eq, Ord, Read, Show) + +_Import_Spec = (Core.Name "hydra/ext/haskell/ast.Import.Spec") + +_Import_Spec_list = (Core.Name "list") + +_Import_Spec_hiding = (Core.Name "hiding") + +-- | An import modifier ('pattern' or 'type') +data ImportModifier = + ImportModifierPattern | + ImportModifierType + deriving (Eq, Ord, Read, Show) + +_ImportModifier = (Core.Name "hydra/ext/haskell/ast.ImportModifier") + +_ImportModifier_pattern = (Core.Name "pattern") + +_ImportModifier_type = (Core.Name "type") + +-- | An import or export specification +data ImportExportSpec = + ImportExportSpec { + importExportSpecModifier :: (Maybe ImportModifier), + importExportSpecName :: Name, + importExportSpecSubspec :: (Maybe ImportExportSpec_Subspec)} + deriving (Eq, Ord, Read, Show) + +_ImportExportSpec = (Core.Name "hydra/ext/haskell/ast.ImportExportSpec") + +_ImportExportSpec_modifier = (Core.Name "modifier") + +_ImportExportSpec_name = (Core.Name "name") + +_ImportExportSpec_subspec = (Core.Name "subspec") + +data ImportExportSpec_Subspec = + ImportExportSpec_SubspecAll | + ImportExportSpec_SubspecList [Name] + deriving (Eq, Ord, Read, Show) + +_ImportExportSpec_Subspec = (Core.Name "hydra/ext/haskell/ast.ImportExportSpec.Subspec") + +_ImportExportSpec_Subspec_all = (Core.Name "all") + +_ImportExportSpec_Subspec_list = (Core.Name "list") + +-- | A literal value +data Literal = + LiteralChar Int | + LiteralDouble Double | + LiteralFloat Float | + LiteralInt Int | + LiteralInteger Integer | + LiteralString String + deriving (Eq, Ord, Read, Show) + +_Literal = (Core.Name "hydra/ext/haskell/ast.Literal") + +_Literal_char = (Core.Name "char") + +_Literal_double = (Core.Name "double") + +_Literal_float = (Core.Name "float") + +_Literal_int = (Core.Name "int") + +_Literal_integer = (Core.Name "integer") + +_Literal_string = (Core.Name "string") + +data LocalBinding = + LocalBindingSignature TypeSignature | + LocalBindingValue ValueBinding + deriving (Eq, Ord, Read, Show) + +_LocalBinding = (Core.Name "hydra/ext/haskell/ast.LocalBinding") + +_LocalBinding_signature = (Core.Name "signature") + +_LocalBinding_value = (Core.Name "value") + +newtype LocalBindings = + LocalBindings { + unLocalBindings :: [LocalBinding]} + deriving (Eq, Ord, Read, Show) + +_LocalBindings = (Core.Name "hydra/ext/haskell/ast.LocalBindings") + +data Module = + Module { + moduleHead :: (Maybe ModuleHead), + moduleImports :: [Import], + moduleDeclarations :: [DeclarationWithComments]} + deriving (Eq, Ord, Read, Show) + +_Module = (Core.Name "hydra/ext/haskell/ast.Module") + +_Module_head = (Core.Name "head") + +_Module_imports = (Core.Name "imports") + +_Module_declarations = (Core.Name "declarations") + +data ModuleHead = + ModuleHead { + moduleHeadComments :: (Maybe String), + moduleHeadName :: ModuleName, + moduleHeadExports :: [Export]} + deriving (Eq, Ord, Read, Show) + +_ModuleHead = (Core.Name "hydra/ext/haskell/ast.ModuleHead") + +_ModuleHead_comments = (Core.Name "comments") + +_ModuleHead_name = (Core.Name "name") + +_ModuleHead_exports = (Core.Name "exports") + +newtype ModuleName = + ModuleName { + unModuleName :: String} + deriving (Eq, Ord, Read, Show) + +_ModuleName = (Core.Name "hydra/ext/haskell/ast.ModuleName") + +data Name = + NameImplicit QualifiedName | + NameNormal QualifiedName | + NameParens QualifiedName + deriving (Eq, Ord, Read, Show) + +_Name = (Core.Name "hydra/ext/haskell/ast.Name") + +_Name_implicit = (Core.Name "implicit") + +_Name_normal = (Core.Name "normal") + +_Name_parens = (Core.Name "parens") + +newtype NamePart = + NamePart { + unNamePart :: String} + deriving (Eq, Ord, Read, Show) + +_NamePart = (Core.Name "hydra/ext/haskell/ast.NamePart") + +data Operator = + OperatorBacktick QualifiedName | + OperatorNormal QualifiedName + deriving (Eq, Ord, Read, Show) + +_Operator = (Core.Name "hydra/ext/haskell/ast.Operator") + +_Operator_backtick = (Core.Name "backtick") + +_Operator_normal = (Core.Name "normal") + +data Pattern = + PatternApplication Pattern_Application | + PatternAs Pattern_As | + PatternList [Pattern] | + PatternLiteral Literal | + PatternName Name | + PatternParens Pattern | + PatternRecord Pattern_Record | + PatternTuple [Pattern] | + PatternTyped Pattern_Typed | + PatternWildcard + deriving (Eq, Ord, Read, Show) + +_Pattern = (Core.Name "hydra/ext/haskell/ast.Pattern") + +_Pattern_application = (Core.Name "application") + +_Pattern_as = (Core.Name "as") + +_Pattern_list = (Core.Name "list") + +_Pattern_literal = (Core.Name "literal") + +_Pattern_name = (Core.Name "name") + +_Pattern_parens = (Core.Name "parens") + +_Pattern_record = (Core.Name "record") + +_Pattern_tuple = (Core.Name "tuple") + +_Pattern_typed = (Core.Name "typed") + +_Pattern_wildcard = (Core.Name "wildcard") + +data Pattern_Application = + Pattern_Application { + pattern_ApplicationName :: Name, + pattern_ApplicationArgs :: [Pattern]} + deriving (Eq, Ord, Read, Show) + +_Pattern_Application = (Core.Name "hydra/ext/haskell/ast.Pattern.Application") + +_Pattern_Application_name = (Core.Name "name") + +_Pattern_Application_args = (Core.Name "args") + +data Pattern_As = + Pattern_As { + pattern_AsName :: Name, + pattern_AsInner :: Pattern} + deriving (Eq, Ord, Read, Show) + +_Pattern_As = (Core.Name "hydra/ext/haskell/ast.Pattern.As") + +_Pattern_As_name = (Core.Name "name") + +_Pattern_As_inner = (Core.Name "inner") + +data Pattern_Record = + Pattern_Record { + pattern_RecordName :: Name, + pattern_RecordFields :: [PatternField]} + deriving (Eq, Ord, Read, Show) + +_Pattern_Record = (Core.Name "hydra/ext/haskell/ast.Pattern.Record") + +_Pattern_Record_name = (Core.Name "name") + +_Pattern_Record_fields = (Core.Name "fields") + +data Pattern_Typed = + Pattern_Typed { + pattern_TypedInner :: Pattern, + pattern_TypedType :: Type} + deriving (Eq, Ord, Read, Show) + +_Pattern_Typed = (Core.Name "hydra/ext/haskell/ast.Pattern.Typed") + +_Pattern_Typed_inner = (Core.Name "inner") + +_Pattern_Typed_type = (Core.Name "type") + +data PatternField = + PatternField { + patternFieldName :: Name, + patternFieldPattern :: Pattern} + deriving (Eq, Ord, Read, Show) + +_PatternField = (Core.Name "hydra/ext/haskell/ast.PatternField") + +_PatternField_name = (Core.Name "name") + +_PatternField_pattern = (Core.Name "pattern") + +data QualifiedName = + QualifiedName { + qualifiedNameQualifiers :: [NamePart], + qualifiedNameUnqualified :: NamePart} + deriving (Eq, Ord, Read, Show) + +_QualifiedName = (Core.Name "hydra/ext/haskell/ast.QualifiedName") + +_QualifiedName_qualifiers = (Core.Name "qualifiers") + +_QualifiedName_unqualified = (Core.Name "unqualified") + +newtype RightHandSide = + RightHandSide { + unRightHandSide :: Expression} + deriving (Eq, Ord, Read, Show) + +_RightHandSide = (Core.Name "hydra/ext/haskell/ast.RightHandSide") + +newtype Statement = + Statement { + unStatement :: Expression} + deriving (Eq, Ord, Read, Show) + +_Statement = (Core.Name "hydra/ext/haskell/ast.Statement") + +data Type = + TypeApplication Type_Application | + TypeCtx Type_Context | + TypeFunction Type_Function | + TypeInfix Type_Infix | + TypeList Type | + TypeParens Type | + TypeTuple [Type] | + TypeVariable Name + deriving (Eq, Ord, Read, Show) + +_Type = (Core.Name "hydra/ext/haskell/ast.Type") + +_Type_application = (Core.Name "application") + +_Type_ctx = (Core.Name "ctx") + +_Type_function = (Core.Name "function") + +_Type_infix = (Core.Name "infix") + +_Type_list = (Core.Name "list") + +_Type_parens = (Core.Name "parens") + +_Type_tuple = (Core.Name "tuple") + +_Type_variable = (Core.Name "variable") + +data Type_Application = + Type_Application { + type_ApplicationContext :: Type, + type_ApplicationArgument :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Application = (Core.Name "hydra/ext/haskell/ast.Type.Application") + +_Type_Application_context = (Core.Name "context") + +_Type_Application_argument = (Core.Name "argument") + +data Type_Context = + Type_Context { + type_ContextCtx :: Assertion, + type_ContextType :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Context = (Core.Name "hydra/ext/haskell/ast.Type.Context") + +_Type_Context_ctx = (Core.Name "ctx") + +_Type_Context_type = (Core.Name "type") + +data Type_Function = + Type_Function { + type_FunctionDomain :: Type, + type_FunctionCodomain :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Function = (Core.Name "hydra/ext/haskell/ast.Type.Function") + +_Type_Function_domain = (Core.Name "domain") + +_Type_Function_codomain = (Core.Name "codomain") + +data Type_Infix = + Type_Infix { + type_InfixLhs :: Type, + type_InfixOperator :: Operator, + type_InfixRhs :: Operator} + deriving (Eq, Ord, Read, Show) + +_Type_Infix = (Core.Name "hydra/ext/haskell/ast.Type.Infix") + +_Type_Infix_lhs = (Core.Name "lhs") + +_Type_Infix_operator = (Core.Name "operator") + +_Type_Infix_rhs = (Core.Name "rhs") + +data TypeDeclaration = + TypeDeclaration { + typeDeclarationName :: DeclarationHead, + typeDeclarationType :: Type} + deriving (Eq, Ord, Read, Show) + +_TypeDeclaration = (Core.Name "hydra/ext/haskell/ast.TypeDeclaration") + +_TypeDeclaration_name = (Core.Name "name") + +_TypeDeclaration_type = (Core.Name "type") + +data TypeSignature = + TypeSignature { + typeSignatureName :: Name, + typeSignatureType :: Type} + deriving (Eq, Ord, Read, Show) + +_TypeSignature = (Core.Name "hydra/ext/haskell/ast.TypeSignature") + +_TypeSignature_name = (Core.Name "name") + +_TypeSignature_type = (Core.Name "type") + +data TypedBinding = + TypedBinding { + typedBindingTypeSignature :: TypeSignature, + typedBindingValueBinding :: ValueBinding} + deriving (Eq, Ord, Read, Show) + +_TypedBinding = (Core.Name "hydra/ext/haskell/ast.TypedBinding") + +_TypedBinding_typeSignature = (Core.Name "typeSignature") + +_TypedBinding_valueBinding = (Core.Name "valueBinding") + +data ValueBinding = + ValueBindingSimple ValueBinding_Simple + deriving (Eq, Ord, Read, Show) + +_ValueBinding = (Core.Name "hydra/ext/haskell/ast.ValueBinding") + +_ValueBinding_simple = (Core.Name "simple") + +data ValueBinding_Simple = + ValueBinding_Simple { + valueBinding_SimplePattern :: Pattern, + valueBinding_SimpleRhs :: RightHandSide, + valueBinding_SimpleLocalBindings :: (Maybe LocalBindings)} + deriving (Eq, Ord, Read, Show) + +_ValueBinding_Simple = (Core.Name "hydra/ext/haskell/ast.ValueBinding.Simple") + +_ValueBinding_Simple_pattern = (Core.Name "pattern") + +_ValueBinding_Simple_rhs = (Core.Name "rhs") + +_ValueBinding_Simple_localBindings = (Core.Name "localBindings") + +newtype Variable = + Variable { + unVariable :: Name} + deriving (Eq, Ord, Read, Show) + +_Variable = (Core.Name "hydra/ext/haskell/ast.Variable") diff --git a/src/gen-main/haskell/Hydra/Ext/Java/Language.hs b/src/gen-main/haskell/Hydra/Ext/Java/Language.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Java/Language.hs @@ -0,0 +1,237 @@ +-- | Language constraints for Java + +module Hydra.Ext.Java.Language where + +import qualified Hydra.Basics as Basics +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Lib.Equality as Equality +import qualified Hydra.Lib.Lists as Lists +import qualified Hydra.Lib.Sets as Sets +import qualified Hydra.Mantle as Mantle +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | The maximum supported length of a tuple in Hydra-Java. Note: if this constant is changed, also change Tuples.java correspondingly +javaMaxTupleLength :: Int +javaMaxTupleLength = 9 + +-- | Language constraints for Java +javaLanguage :: Coders.Language +javaLanguage = Coders.Language { + Coders.languageName = (Coders.LanguageName "hydra/ext/java"), + Coders.languageConstraints = Coders.LanguageConstraints { + Coders.languageConstraintsEliminationVariants = (Sets.fromList Basics.eliminationVariants), + Coders.languageConstraintsLiteralVariants = (Sets.fromList [ + Mantle.LiteralVariantBoolean, + Mantle.LiteralVariantFloat, + Mantle.LiteralVariantInteger, + Mantle.LiteralVariantString]), + Coders.languageConstraintsFloatTypes = (Sets.fromList [ + Core.FloatTypeFloat32, + Core.FloatTypeFloat64]), + Coders.languageConstraintsFunctionVariants = (Sets.fromList Basics.functionVariants), + Coders.languageConstraintsIntegerTypes = (Sets.fromList [ + Core.IntegerTypeBigint, + Core.IntegerTypeInt8, + Core.IntegerTypeInt16, + Core.IntegerTypeInt32, + Core.IntegerTypeInt64, + Core.IntegerTypeUint16]), + Coders.languageConstraintsTermVariants = (Sets.fromList [ + Mantle.TermVariantApplication, + Mantle.TermVariantFunction, + Mantle.TermVariantLet, + Mantle.TermVariantList, + Mantle.TermVariantLiteral, + Mantle.TermVariantMap, + Mantle.TermVariantOptional, + Mantle.TermVariantProduct, + Mantle.TermVariantRecord, + Mantle.TermVariantSet, + Mantle.TermVariantUnion, + Mantle.TermVariantVariable, + Mantle.TermVariantWrap]), + Coders.languageConstraintsTypeVariants = (Sets.fromList [ + Mantle.TypeVariantAnnotated, + Mantle.TypeVariantApplication, + Mantle.TypeVariantFunction, + Mantle.TypeVariantLambda, + Mantle.TypeVariantList, + Mantle.TypeVariantLiteral, + Mantle.TypeVariantMap, + Mantle.TypeVariantOptional, + Mantle.TypeVariantProduct, + Mantle.TypeVariantRecord, + Mantle.TypeVariantSet, + Mantle.TypeVariantUnion, + Mantle.TypeVariantVariable, + Mantle.TypeVariantWrap]), + Coders.languageConstraintsTypes = (\x -> case x of + Core.TypeProduct v319 -> (Equality.ltInt32 (Lists.length v319) javaMaxTupleLength) + _ -> True)}} + +-- | A set of reserved words in Java +reservedWords :: (Set String) +reservedWords = (Sets.fromList (Lists.concat [ + specialNames, + classNames, + keywords, + literals])) + where + specialNames = [ + "Elements"] + classNames = [ + "AbstractMethodError", + "Appendable", + "ArithmeticException", + "ArrayIndexOutOfBoundsException", + "ArrayStoreException", + "AssertionError", + "AutoCloseable", + "Boolean", + "BootstrapMethodError", + "Byte", + "CharSequence", + "Character", + "Class", + "ClassCastException", + "ClassCircularityError", + "ClassFormatError", + "ClassLoader", + "ClassNotFoundException", + "ClassValue", + "CloneNotSupportedException", + "Cloneable", + "Comparable", + "Compiler", + "Deprecated", + "Double", + "Enum", + "EnumConstantNotPresentException", + "Error", + "Exception", + "ExceptionInInitializerError", + "Float", + "IllegalAccessError", + "IllegalAccessException", + "IllegalArgumentException", + "IllegalMonitorStateException", + "IllegalStateException", + "IllegalThreadStateException", + "IncompatibleClassChangeError", + "IndexOutOfBoundsException", + "InheritableThreadLocal", + "InstantiationError", + "InstantiationException", + "Integer", + "InternalError", + "InterruptedException", + "Iterable", + "LinkageError", + "Long", + "Math", + "NegativeArraySizeException", + "NoClassDefFoundError", + "NoSuchFieldError", + "NoSuchFieldException", + "NoSuchMethodError", + "NoSuchMethodException", + "NullPointerException", + "Number", + "NumberFormatException", + "Object", + "OutOfMemoryError", + "Override", + "Package", + "Process", + "ProcessBuilder", + "Readable", + "ReflectiveOperationException", + "Runnable", + "Runtime", + "RuntimeException", + "RuntimePermission", + "SafeVarargs", + "SecurityException", + "SecurityManager", + "Short", + "StackOverflowError", + "StackTraceElement", + "StrictMath", + "String", + "StringBuffer", + "StringBuilder", + "StringIndexOutOfBoundsException", + "SuppressWarnings", + "System", + "Thread", + "ThreadDeath", + "ThreadGroup", + "ThreadLocal", + "Throwable", + "TypeNotPresentException", + "UnknownError", + "UnsatisfiedLinkError", + "UnsupportedClassVersionError", + "UnsupportedOperationException", + "VerifyError", + "VirtualMachineError", + "Void"] + keywords = [ + "abstract", + "assert", + "boolean", + "break", + "byte", + "case", + "catch", + "char", + "class", + "const", + "continue", + "default", + "do", + "double", + "else", + "enum", + "extends", + "final", + "finally", + "float", + "for", + "goto", + "if", + "implements", + "import", + "instanceof", + "int", + "interface", + "long", + "native", + "new", + "package", + "private", + "protected", + "public", + "return", + "short", + "static", + "strictfp", + "super", + "switch", + "synchronized", + "this", + "throw", + "throws", + "transient", + "try", + "void", + "volatile", + "while"] + literals = [ + "false", + "null", + "true"] diff --git a/src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs b/src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs @@ -0,0 +1,3276 @@ +-- | A Java syntax module. Based on the Oracle Java SE 12 BNF: +-- | https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html +-- | Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments. + +module Hydra.Ext.Java.Syntax where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +newtype Identifier = + Identifier { + unIdentifier :: String} + deriving (Eq, Ord, Read, Show) + +_Identifier = (Core.Name "hydra/ext/java/syntax.Identifier") + +newtype TypeIdentifier = + TypeIdentifier { + unTypeIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_TypeIdentifier = (Core.Name "hydra/ext/java/syntax.TypeIdentifier") + +data Literal = + LiteralNull | + LiteralInteger IntegerLiteral | + LiteralFloatingPoint FloatingPointLiteral | + LiteralBoolean Bool | + LiteralCharacter Int | + LiteralString StringLiteral + deriving (Eq, Ord, Read, Show) + +_Literal = (Core.Name "hydra/ext/java/syntax.Literal") + +_Literal_null = (Core.Name "null") + +_Literal_integer = (Core.Name "integer") + +_Literal_floatingPoint = (Core.Name "floatingPoint") + +_Literal_boolean = (Core.Name "boolean") + +_Literal_character = (Core.Name "character") + +_Literal_string = (Core.Name "string") + +-- | Note: this is an approximation which ignores encoding +newtype IntegerLiteral = + IntegerLiteral { + unIntegerLiteral :: Integer} + deriving (Eq, Ord, Read, Show) + +_IntegerLiteral = (Core.Name "hydra/ext/java/syntax.IntegerLiteral") + +-- | Note: this is an approximation which ignores encoding +newtype FloatingPointLiteral = + FloatingPointLiteral { + unFloatingPointLiteral :: Double} + deriving (Eq, Ord, Read, Show) + +_FloatingPointLiteral = (Core.Name "hydra/ext/java/syntax.FloatingPointLiteral") + +-- | Note: this is an approximation which ignores encoding +newtype StringLiteral = + StringLiteral { + unStringLiteral :: String} + deriving (Eq, Ord, Read, Show) + +_StringLiteral = (Core.Name "hydra/ext/java/syntax.StringLiteral") + +data Type = + TypePrimitive PrimitiveTypeWithAnnotations | + TypeReference ReferenceType + deriving (Eq, Ord, Read, Show) + +_Type = (Core.Name "hydra/ext/java/syntax.Type") + +_Type_primitive = (Core.Name "primitive") + +_Type_reference = (Core.Name "reference") + +data PrimitiveTypeWithAnnotations = + PrimitiveTypeWithAnnotations { + primitiveTypeWithAnnotationsType :: PrimitiveType, + primitiveTypeWithAnnotationsAnnotations :: [Annotation]} + deriving (Eq, Ord, Read, Show) + +_PrimitiveTypeWithAnnotations = (Core.Name "hydra/ext/java/syntax.PrimitiveTypeWithAnnotations") + +_PrimitiveTypeWithAnnotations_type = (Core.Name "type") + +_PrimitiveTypeWithAnnotations_annotations = (Core.Name "annotations") + +data PrimitiveType = + PrimitiveTypeNumeric NumericType | + PrimitiveTypeBoolean + deriving (Eq, Ord, Read, Show) + +_PrimitiveType = (Core.Name "hydra/ext/java/syntax.PrimitiveType") + +_PrimitiveType_numeric = (Core.Name "numeric") + +_PrimitiveType_boolean = (Core.Name "boolean") + +data NumericType = + NumericTypeIntegral IntegralType | + NumericTypeFloatingPoint FloatingPointType + deriving (Eq, Ord, Read, Show) + +_NumericType = (Core.Name "hydra/ext/java/syntax.NumericType") + +_NumericType_integral = (Core.Name "integral") + +_NumericType_floatingPoint = (Core.Name "floatingPoint") + +data IntegralType = + IntegralTypeByte | + IntegralTypeShort | + IntegralTypeInt | + IntegralTypeLong | + IntegralTypeChar + deriving (Eq, Ord, Read, Show) + +_IntegralType = (Core.Name "hydra/ext/java/syntax.IntegralType") + +_IntegralType_byte = (Core.Name "byte") + +_IntegralType_short = (Core.Name "short") + +_IntegralType_int = (Core.Name "int") + +_IntegralType_long = (Core.Name "long") + +_IntegralType_char = (Core.Name "char") + +data FloatingPointType = + FloatingPointTypeFloat | + FloatingPointTypeDouble + deriving (Eq, Ord, Read, Show) + +_FloatingPointType = (Core.Name "hydra/ext/java/syntax.FloatingPointType") + +_FloatingPointType_float = (Core.Name "float") + +_FloatingPointType_double = (Core.Name "double") + +data ReferenceType = + ReferenceTypeClassOrInterface ClassOrInterfaceType | + ReferenceTypeVariable TypeVariable | + ReferenceTypeArray ArrayType + deriving (Eq, Ord, Read, Show) + +_ReferenceType = (Core.Name "hydra/ext/java/syntax.ReferenceType") + +_ReferenceType_classOrInterface = (Core.Name "classOrInterface") + +_ReferenceType_variable = (Core.Name "variable") + +_ReferenceType_array = (Core.Name "array") + +data ClassOrInterfaceType = + ClassOrInterfaceTypeClass ClassType | + ClassOrInterfaceTypeInterface InterfaceType + deriving (Eq, Ord, Read, Show) + +_ClassOrInterfaceType = (Core.Name "hydra/ext/java/syntax.ClassOrInterfaceType") + +_ClassOrInterfaceType_class = (Core.Name "class") + +_ClassOrInterfaceType_interface = (Core.Name "interface") + +data ClassType = + ClassType { + classTypeAnnotations :: [Annotation], + classTypeQualifier :: ClassTypeQualifier, + classTypeIdentifier :: TypeIdentifier, + classTypeArguments :: [TypeArgument]} + deriving (Eq, Ord, Read, Show) + +_ClassType = (Core.Name "hydra/ext/java/syntax.ClassType") + +_ClassType_annotations = (Core.Name "annotations") + +_ClassType_qualifier = (Core.Name "qualifier") + +_ClassType_identifier = (Core.Name "identifier") + +_ClassType_arguments = (Core.Name "arguments") + +data ClassTypeQualifier = + ClassTypeQualifierNone | + ClassTypeQualifierPackage PackageName | + ClassTypeQualifierParent ClassOrInterfaceType + deriving (Eq, Ord, Read, Show) + +_ClassTypeQualifier = (Core.Name "hydra/ext/java/syntax.ClassTypeQualifier") + +_ClassTypeQualifier_none = (Core.Name "none") + +_ClassTypeQualifier_package = (Core.Name "package") + +_ClassTypeQualifier_parent = (Core.Name "parent") + +newtype InterfaceType = + InterfaceType { + unInterfaceType :: ClassType} + deriving (Eq, Ord, Read, Show) + +_InterfaceType = (Core.Name "hydra/ext/java/syntax.InterfaceType") + +data TypeVariable = + TypeVariable { + typeVariableAnnotations :: [Annotation], + typeVariableIdentifier :: TypeIdentifier} + deriving (Eq, Ord, Read, Show) + +_TypeVariable = (Core.Name "hydra/ext/java/syntax.TypeVariable") + +_TypeVariable_annotations = (Core.Name "annotations") + +_TypeVariable_identifier = (Core.Name "identifier") + +data ArrayType = + ArrayType { + arrayTypeDims :: Dims, + arrayTypeVariant :: ArrayType_Variant} + deriving (Eq, Ord, Read, Show) + +_ArrayType = (Core.Name "hydra/ext/java/syntax.ArrayType") + +_ArrayType_dims = (Core.Name "dims") + +_ArrayType_variant = (Core.Name "variant") + +data ArrayType_Variant = + ArrayType_VariantPrimitive PrimitiveTypeWithAnnotations | + ArrayType_VariantClassOrInterface ClassOrInterfaceType | + ArrayType_VariantVariable TypeVariable + deriving (Eq, Ord, Read, Show) + +_ArrayType_Variant = (Core.Name "hydra/ext/java/syntax.ArrayType.Variant") + +_ArrayType_Variant_primitive = (Core.Name "primitive") + +_ArrayType_Variant_classOrInterface = (Core.Name "classOrInterface") + +_ArrayType_Variant_variable = (Core.Name "variable") + +newtype Dims = + Dims { + unDims :: [[Annotation]]} + deriving (Eq, Ord, Read, Show) + +_Dims = (Core.Name "hydra/ext/java/syntax.Dims") + +data TypeParameter = + TypeParameter { + typeParameterModifiers :: [TypeParameterModifier], + typeParameterIdentifier :: TypeIdentifier, + typeParameterBound :: (Maybe TypeBound)} + deriving (Eq, Ord, Read, Show) + +_TypeParameter = (Core.Name "hydra/ext/java/syntax.TypeParameter") + +_TypeParameter_modifiers = (Core.Name "modifiers") + +_TypeParameter_identifier = (Core.Name "identifier") + +_TypeParameter_bound = (Core.Name "bound") + +newtype TypeParameterModifier = + TypeParameterModifier { + unTypeParameterModifier :: Annotation} + deriving (Eq, Ord, Read, Show) + +_TypeParameterModifier = (Core.Name "hydra/ext/java/syntax.TypeParameterModifier") + +data TypeBound = + TypeBoundVariable TypeVariable | + TypeBoundClassOrInterface TypeBound_ClassOrInterface + deriving (Eq, Ord, Read, Show) + +_TypeBound = (Core.Name "hydra/ext/java/syntax.TypeBound") + +_TypeBound_variable = (Core.Name "variable") + +_TypeBound_classOrInterface = (Core.Name "classOrInterface") + +data TypeBound_ClassOrInterface = + TypeBound_ClassOrInterface { + typeBound_ClassOrInterfaceType :: ClassOrInterfaceType, + typeBound_ClassOrInterfaceAdditional :: [AdditionalBound]} + deriving (Eq, Ord, Read, Show) + +_TypeBound_ClassOrInterface = (Core.Name "hydra/ext/java/syntax.TypeBound.ClassOrInterface") + +_TypeBound_ClassOrInterface_type = (Core.Name "type") + +_TypeBound_ClassOrInterface_additional = (Core.Name "additional") + +newtype AdditionalBound = + AdditionalBound { + unAdditionalBound :: InterfaceType} + deriving (Eq, Ord, Read, Show) + +_AdditionalBound = (Core.Name "hydra/ext/java/syntax.AdditionalBound") + +data TypeArgument = + TypeArgumentReference ReferenceType | + TypeArgumentWildcard Wildcard + deriving (Eq, Ord, Read, Show) + +_TypeArgument = (Core.Name "hydra/ext/java/syntax.TypeArgument") + +_TypeArgument_reference = (Core.Name "reference") + +_TypeArgument_wildcard = (Core.Name "wildcard") + +data Wildcard = + Wildcard { + wildcardAnnotations :: [Annotation], + wildcardWildcard :: (Maybe WildcardBounds)} + deriving (Eq, Ord, Read, Show) + +_Wildcard = (Core.Name "hydra/ext/java/syntax.Wildcard") + +_Wildcard_annotations = (Core.Name "annotations") + +_Wildcard_wildcard = (Core.Name "wildcard") + +data WildcardBounds = + WildcardBoundsExtends ReferenceType | + WildcardBoundsSuper ReferenceType + deriving (Eq, Ord, Read, Show) + +_WildcardBounds = (Core.Name "hydra/ext/java/syntax.WildcardBounds") + +_WildcardBounds_extends = (Core.Name "extends") + +_WildcardBounds_super = (Core.Name "super") + +data ModuleName = + ModuleName { + moduleNameIdentifier :: Identifier, + moduleNameName :: (Maybe ModuleName)} + deriving (Eq, Ord, Read, Show) + +_ModuleName = (Core.Name "hydra/ext/java/syntax.ModuleName") + +_ModuleName_identifier = (Core.Name "identifier") + +_ModuleName_name = (Core.Name "name") + +newtype PackageName = + PackageName { + unPackageName :: [Identifier]} + deriving (Eq, Ord, Read, Show) + +_PackageName = (Core.Name "hydra/ext/java/syntax.PackageName") + +data TypeName = + TypeName { + typeNameIdentifier :: TypeIdentifier, + typeNameQualifier :: (Maybe PackageOrTypeName)} + deriving (Eq, Ord, Read, Show) + +_TypeName = (Core.Name "hydra/ext/java/syntax.TypeName") + +_TypeName_identifier = (Core.Name "identifier") + +_TypeName_qualifier = (Core.Name "qualifier") + +data ExpressionName = + ExpressionName { + expressionNameQualifier :: (Maybe AmbiguousName), + expressionNameIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_ExpressionName = (Core.Name "hydra/ext/java/syntax.ExpressionName") + +_ExpressionName_qualifier = (Core.Name "qualifier") + +_ExpressionName_identifier = (Core.Name "identifier") + +newtype MethodName = + MethodName { + unMethodName :: Identifier} + deriving (Eq, Ord, Read, Show) + +_MethodName = (Core.Name "hydra/ext/java/syntax.MethodName") + +newtype PackageOrTypeName = + PackageOrTypeName { + unPackageOrTypeName :: [Identifier]} + deriving (Eq, Ord, Read, Show) + +_PackageOrTypeName = (Core.Name "hydra/ext/java/syntax.PackageOrTypeName") + +newtype AmbiguousName = + AmbiguousName { + unAmbiguousName :: [Identifier]} + deriving (Eq, Ord, Read, Show) + +_AmbiguousName = (Core.Name "hydra/ext/java/syntax.AmbiguousName") + +data CompilationUnit = + CompilationUnitOrdinary OrdinaryCompilationUnit | + CompilationUnitModular ModularCompilationUnit + deriving (Eq, Ord, Read, Show) + +_CompilationUnit = (Core.Name "hydra/ext/java/syntax.CompilationUnit") + +_CompilationUnit_ordinary = (Core.Name "ordinary") + +_CompilationUnit_modular = (Core.Name "modular") + +data OrdinaryCompilationUnit = + OrdinaryCompilationUnit { + ordinaryCompilationUnitPackage :: (Maybe PackageDeclaration), + ordinaryCompilationUnitImports :: [ImportDeclaration], + ordinaryCompilationUnitTypes :: [TypeDeclarationWithComments]} + deriving (Eq, Ord, Read, Show) + +_OrdinaryCompilationUnit = (Core.Name "hydra/ext/java/syntax.OrdinaryCompilationUnit") + +_OrdinaryCompilationUnit_package = (Core.Name "package") + +_OrdinaryCompilationUnit_imports = (Core.Name "imports") + +_OrdinaryCompilationUnit_types = (Core.Name "types") + +data ModularCompilationUnit = + ModularCompilationUnit { + modularCompilationUnitImports :: [ImportDeclaration], + modularCompilationUnitModule :: ModuleDeclaration} + deriving (Eq, Ord, Read, Show) + +_ModularCompilationUnit = (Core.Name "hydra/ext/java/syntax.ModularCompilationUnit") + +_ModularCompilationUnit_imports = (Core.Name "imports") + +_ModularCompilationUnit_module = (Core.Name "module") + +data PackageDeclaration = + PackageDeclaration { + packageDeclarationModifiers :: [PackageModifier], + packageDeclarationIdentifiers :: [Identifier]} + deriving (Eq, Ord, Read, Show) + +_PackageDeclaration = (Core.Name "hydra/ext/java/syntax.PackageDeclaration") + +_PackageDeclaration_modifiers = (Core.Name "modifiers") + +_PackageDeclaration_identifiers = (Core.Name "identifiers") + +newtype PackageModifier = + PackageModifier { + unPackageModifier :: Annotation} + deriving (Eq, Ord, Read, Show) + +_PackageModifier = (Core.Name "hydra/ext/java/syntax.PackageModifier") + +data ImportDeclaration = + ImportDeclarationSingleType SingleTypeImportDeclaration | + ImportDeclarationTypeImportOnDemand TypeImportOnDemandDeclaration | + ImportDeclarationSingleStaticImport SingleStaticImportDeclaration | + ImportDeclarationStaticImportOnDemand StaticImportOnDemandDeclaration + deriving (Eq, Ord, Read, Show) + +_ImportDeclaration = (Core.Name "hydra/ext/java/syntax.ImportDeclaration") + +_ImportDeclaration_singleType = (Core.Name "singleType") + +_ImportDeclaration_typeImportOnDemand = (Core.Name "typeImportOnDemand") + +_ImportDeclaration_singleStaticImport = (Core.Name "singleStaticImport") + +_ImportDeclaration_staticImportOnDemand = (Core.Name "staticImportOnDemand") + +newtype SingleTypeImportDeclaration = + SingleTypeImportDeclaration { + unSingleTypeImportDeclaration :: TypeName} + deriving (Eq, Ord, Read, Show) + +_SingleTypeImportDeclaration = (Core.Name "hydra/ext/java/syntax.SingleTypeImportDeclaration") + +newtype TypeImportOnDemandDeclaration = + TypeImportOnDemandDeclaration { + unTypeImportOnDemandDeclaration :: PackageOrTypeName} + deriving (Eq, Ord, Read, Show) + +_TypeImportOnDemandDeclaration = (Core.Name "hydra/ext/java/syntax.TypeImportOnDemandDeclaration") + +data SingleStaticImportDeclaration = + SingleStaticImportDeclaration { + singleStaticImportDeclarationTypeName :: TypeName, + singleStaticImportDeclarationIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_SingleStaticImportDeclaration = (Core.Name "hydra/ext/java/syntax.SingleStaticImportDeclaration") + +_SingleStaticImportDeclaration_typeName = (Core.Name "typeName") + +_SingleStaticImportDeclaration_identifier = (Core.Name "identifier") + +newtype StaticImportOnDemandDeclaration = + StaticImportOnDemandDeclaration { + unStaticImportOnDemandDeclaration :: TypeName} + deriving (Eq, Ord, Read, Show) + +_StaticImportOnDemandDeclaration = (Core.Name "hydra/ext/java/syntax.StaticImportOnDemandDeclaration") + +data TypeDeclaration = + TypeDeclarationClass ClassDeclaration | + TypeDeclarationInterface InterfaceDeclaration | + TypeDeclarationNone + deriving (Eq, Ord, Read, Show) + +_TypeDeclaration = (Core.Name "hydra/ext/java/syntax.TypeDeclaration") + +_TypeDeclaration_class = (Core.Name "class") + +_TypeDeclaration_interface = (Core.Name "interface") + +_TypeDeclaration_none = (Core.Name "none") + +data TypeDeclarationWithComments = + TypeDeclarationWithComments { + typeDeclarationWithCommentsValue :: TypeDeclaration, + typeDeclarationWithCommentsComments :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_TypeDeclarationWithComments = (Core.Name "hydra/ext/java/syntax.TypeDeclarationWithComments") + +_TypeDeclarationWithComments_value = (Core.Name "value") + +_TypeDeclarationWithComments_comments = (Core.Name "comments") + +data ModuleDeclaration = + ModuleDeclaration { + moduleDeclarationAnnotations :: [Annotation], + moduleDeclarationOpen :: Bool, + moduleDeclarationIdentifiers :: [Identifier], + moduleDeclarationDirectives :: [[ModuleDirective]]} + deriving (Eq, Ord, Read, Show) + +_ModuleDeclaration = (Core.Name "hydra/ext/java/syntax.ModuleDeclaration") + +_ModuleDeclaration_annotations = (Core.Name "annotations") + +_ModuleDeclaration_open = (Core.Name "open") + +_ModuleDeclaration_identifiers = (Core.Name "identifiers") + +_ModuleDeclaration_directives = (Core.Name "directives") + +data ModuleDirective = + ModuleDirectiveRequires ModuleDirective_Requires | + ModuleDirectiveExports ModuleDirective_ExportsOrOpens | + ModuleDirectiveOpens ModuleDirective_ExportsOrOpens | + ModuleDirectiveUses TypeName | + ModuleDirectiveProvides ModuleDirective_Provides + deriving (Eq, Ord, Read, Show) + +_ModuleDirective = (Core.Name "hydra/ext/java/syntax.ModuleDirective") + +_ModuleDirective_requires = (Core.Name "requires") + +_ModuleDirective_exports = (Core.Name "exports") + +_ModuleDirective_opens = (Core.Name "opens") + +_ModuleDirective_uses = (Core.Name "uses") + +_ModuleDirective_provides = (Core.Name "provides") + +data ModuleDirective_Requires = + ModuleDirective_Requires { + moduleDirective_RequiresModifiers :: [RequiresModifier], + moduleDirective_RequiresModule :: ModuleName} + deriving (Eq, Ord, Read, Show) + +_ModuleDirective_Requires = (Core.Name "hydra/ext/java/syntax.ModuleDirective.Requires") + +_ModuleDirective_Requires_modifiers = (Core.Name "modifiers") + +_ModuleDirective_Requires_module = (Core.Name "module") + +data ModuleDirective_ExportsOrOpens = + ModuleDirective_ExportsOrOpens { + moduleDirective_ExportsOrOpensPackage :: PackageName, + -- | At least one module + moduleDirective_ExportsOrOpensModules :: [ModuleName]} + deriving (Eq, Ord, Read, Show) + +_ModuleDirective_ExportsOrOpens = (Core.Name "hydra/ext/java/syntax.ModuleDirective.ExportsOrOpens") + +_ModuleDirective_ExportsOrOpens_package = (Core.Name "package") + +_ModuleDirective_ExportsOrOpens_modules = (Core.Name "modules") + +data ModuleDirective_Provides = + ModuleDirective_Provides { + moduleDirective_ProvidesTo :: TypeName, + -- | At least one type + moduleDirective_ProvidesWith :: [TypeName]} + deriving (Eq, Ord, Read, Show) + +_ModuleDirective_Provides = (Core.Name "hydra/ext/java/syntax.ModuleDirective.Provides") + +_ModuleDirective_Provides_to = (Core.Name "to") + +_ModuleDirective_Provides_with = (Core.Name "with") + +data RequiresModifier = + RequiresModifierTransitive | + RequiresModifierStatic + deriving (Eq, Ord, Read, Show) + +_RequiresModifier = (Core.Name "hydra/ext/java/syntax.RequiresModifier") + +_RequiresModifier_transitive = (Core.Name "transitive") + +_RequiresModifier_static = (Core.Name "static") + +data ClassDeclaration = + ClassDeclarationNormal NormalClassDeclaration | + ClassDeclarationEnum EnumDeclaration + deriving (Eq, Ord, Read, Show) + +_ClassDeclaration = (Core.Name "hydra/ext/java/syntax.ClassDeclaration") + +_ClassDeclaration_normal = (Core.Name "normal") + +_ClassDeclaration_enum = (Core.Name "enum") + +data NormalClassDeclaration = + NormalClassDeclaration { + normalClassDeclarationModifiers :: [ClassModifier], + normalClassDeclarationIdentifier :: TypeIdentifier, + normalClassDeclarationParameters :: [TypeParameter], + normalClassDeclarationExtends :: (Maybe ClassType), + normalClassDeclarationImplements :: [InterfaceType], + normalClassDeclarationBody :: ClassBody} + deriving (Eq, Ord, Read, Show) + +_NormalClassDeclaration = (Core.Name "hydra/ext/java/syntax.NormalClassDeclaration") + +_NormalClassDeclaration_modifiers = (Core.Name "modifiers") + +_NormalClassDeclaration_identifier = (Core.Name "identifier") + +_NormalClassDeclaration_parameters = (Core.Name "parameters") + +_NormalClassDeclaration_extends = (Core.Name "extends") + +_NormalClassDeclaration_implements = (Core.Name "implements") + +_NormalClassDeclaration_body = (Core.Name "body") + +data ClassModifier = + ClassModifierAnnotation Annotation | + ClassModifierPublic | + ClassModifierProtected | + ClassModifierPrivate | + ClassModifierAbstract | + ClassModifierStatic | + ClassModifierFinal | + ClassModifierStrictfp + deriving (Eq, Ord, Read, Show) + +_ClassModifier = (Core.Name "hydra/ext/java/syntax.ClassModifier") + +_ClassModifier_annotation = (Core.Name "annotation") + +_ClassModifier_public = (Core.Name "public") + +_ClassModifier_protected = (Core.Name "protected") + +_ClassModifier_private = (Core.Name "private") + +_ClassModifier_abstract = (Core.Name "abstract") + +_ClassModifier_static = (Core.Name "static") + +_ClassModifier_final = (Core.Name "final") + +_ClassModifier_strictfp = (Core.Name "strictfp") + +newtype ClassBody = + ClassBody { + unClassBody :: [ClassBodyDeclarationWithComments]} + deriving (Eq, Ord, Read, Show) + +_ClassBody = (Core.Name "hydra/ext/java/syntax.ClassBody") + +data ClassBodyDeclaration = + ClassBodyDeclarationClassMember ClassMemberDeclaration | + ClassBodyDeclarationInstanceInitializer InstanceInitializer | + ClassBodyDeclarationStaticInitializer StaticInitializer | + ClassBodyDeclarationConstructorDeclaration ConstructorDeclaration + deriving (Eq, Ord, Read, Show) + +_ClassBodyDeclaration = (Core.Name "hydra/ext/java/syntax.ClassBodyDeclaration") + +_ClassBodyDeclaration_classMember = (Core.Name "classMember") + +_ClassBodyDeclaration_instanceInitializer = (Core.Name "instanceInitializer") + +_ClassBodyDeclaration_staticInitializer = (Core.Name "staticInitializer") + +_ClassBodyDeclaration_constructorDeclaration = (Core.Name "constructorDeclaration") + +data ClassBodyDeclarationWithComments = + ClassBodyDeclarationWithComments { + classBodyDeclarationWithCommentsValue :: ClassBodyDeclaration, + classBodyDeclarationWithCommentsComments :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_ClassBodyDeclarationWithComments = (Core.Name "hydra/ext/java/syntax.ClassBodyDeclarationWithComments") + +_ClassBodyDeclarationWithComments_value = (Core.Name "value") + +_ClassBodyDeclarationWithComments_comments = (Core.Name "comments") + +data ClassMemberDeclaration = + ClassMemberDeclarationField FieldDeclaration | + ClassMemberDeclarationMethod MethodDeclaration | + ClassMemberDeclarationClass ClassDeclaration | + ClassMemberDeclarationInterface InterfaceDeclaration | + ClassMemberDeclarationNone + deriving (Eq, Ord, Read, Show) + +_ClassMemberDeclaration = (Core.Name "hydra/ext/java/syntax.ClassMemberDeclaration") + +_ClassMemberDeclaration_field = (Core.Name "field") + +_ClassMemberDeclaration_method = (Core.Name "method") + +_ClassMemberDeclaration_class = (Core.Name "class") + +_ClassMemberDeclaration_interface = (Core.Name "interface") + +_ClassMemberDeclaration_none = (Core.Name "none") + +data FieldDeclaration = + FieldDeclaration { + fieldDeclarationModifiers :: [FieldModifier], + fieldDeclarationUnannType :: UnannType, + fieldDeclarationVariableDeclarators :: [VariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_FieldDeclaration = (Core.Name "hydra/ext/java/syntax.FieldDeclaration") + +_FieldDeclaration_modifiers = (Core.Name "modifiers") + +_FieldDeclaration_unannType = (Core.Name "unannType") + +_FieldDeclaration_variableDeclarators = (Core.Name "variableDeclarators") + +data FieldModifier = + FieldModifierAnnotation Annotation | + FieldModifierPublic | + FieldModifierProtected | + FieldModifierPrivate | + FieldModifierStatic | + FieldModifierFinal | + FieldModifierTransient | + FieldModifierVolatile + deriving (Eq, Ord, Read, Show) + +_FieldModifier = (Core.Name "hydra/ext/java/syntax.FieldModifier") + +_FieldModifier_annotation = (Core.Name "annotation") + +_FieldModifier_public = (Core.Name "public") + +_FieldModifier_protected = (Core.Name "protected") + +_FieldModifier_private = (Core.Name "private") + +_FieldModifier_static = (Core.Name "static") + +_FieldModifier_final = (Core.Name "final") + +_FieldModifier_transient = (Core.Name "transient") + +_FieldModifier_volatile = (Core.Name "volatile") + +data VariableDeclarator = + VariableDeclarator { + variableDeclaratorId :: VariableDeclaratorId, + variableDeclaratorInitializer :: (Maybe VariableInitializer)} + deriving (Eq, Ord, Read, Show) + +_VariableDeclarator = (Core.Name "hydra/ext/java/syntax.VariableDeclarator") + +_VariableDeclarator_id = (Core.Name "id") + +_VariableDeclarator_initializer = (Core.Name "initializer") + +data VariableDeclaratorId = + VariableDeclaratorId { + variableDeclaratorIdIdentifier :: Identifier, + variableDeclaratorIdDims :: (Maybe Dims)} + deriving (Eq, Ord, Read, Show) + +_VariableDeclaratorId = (Core.Name "hydra/ext/java/syntax.VariableDeclaratorId") + +_VariableDeclaratorId_identifier = (Core.Name "identifier") + +_VariableDeclaratorId_dims = (Core.Name "dims") + +data VariableInitializer = + VariableInitializerExpression Expression | + VariableInitializerArrayInitializer ArrayInitializer + deriving (Eq, Ord, Read, Show) + +_VariableInitializer = (Core.Name "hydra/ext/java/syntax.VariableInitializer") + +_VariableInitializer_expression = (Core.Name "expression") + +_VariableInitializer_arrayInitializer = (Core.Name "arrayInitializer") + +-- | A Type which does not allow annotations +newtype UnannType = + UnannType { + unUnannType :: Type} + deriving (Eq, Ord, Read, Show) + +_UnannType = (Core.Name "hydra/ext/java/syntax.UnannType") + +-- | A ClassType which does not allow annotations +newtype UnannClassType = + UnannClassType { + unUnannClassType :: ClassType} + deriving (Eq, Ord, Read, Show) + +_UnannClassType = (Core.Name "hydra/ext/java/syntax.UnannClassType") + +data MethodDeclaration = + MethodDeclaration { + -- | Note: simple methods cannot have annotations + methodDeclarationAnnotations :: [Annotation], + methodDeclarationModifiers :: [MethodModifier], + methodDeclarationHeader :: MethodHeader, + methodDeclarationBody :: MethodBody} + deriving (Eq, Ord, Read, Show) + +_MethodDeclaration = (Core.Name "hydra/ext/java/syntax.MethodDeclaration") + +_MethodDeclaration_annotations = (Core.Name "annotations") + +_MethodDeclaration_modifiers = (Core.Name "modifiers") + +_MethodDeclaration_header = (Core.Name "header") + +_MethodDeclaration_body = (Core.Name "body") + +data MethodModifier = + MethodModifierAnnotation Annotation | + MethodModifierPublic | + MethodModifierProtected | + MethodModifierPrivate | + MethodModifierAbstract | + MethodModifierStatic | + MethodModifierFinal | + MethodModifierSynchronized | + MethodModifierNative | + MethodModifierStrictfb + deriving (Eq, Ord, Read, Show) + +_MethodModifier = (Core.Name "hydra/ext/java/syntax.MethodModifier") + +_MethodModifier_annotation = (Core.Name "annotation") + +_MethodModifier_public = (Core.Name "public") + +_MethodModifier_protected = (Core.Name "protected") + +_MethodModifier_private = (Core.Name "private") + +_MethodModifier_abstract = (Core.Name "abstract") + +_MethodModifier_static = (Core.Name "static") + +_MethodModifier_final = (Core.Name "final") + +_MethodModifier_synchronized = (Core.Name "synchronized") + +_MethodModifier_native = (Core.Name "native") + +_MethodModifier_strictfb = (Core.Name "strictfb") + +data MethodHeader = + MethodHeader { + methodHeaderParameters :: [TypeParameter], + methodHeaderResult :: Result, + methodHeaderDeclarator :: MethodDeclarator, + methodHeaderThrows :: (Maybe Throws)} + deriving (Eq, Ord, Read, Show) + +_MethodHeader = (Core.Name "hydra/ext/java/syntax.MethodHeader") + +_MethodHeader_parameters = (Core.Name "parameters") + +_MethodHeader_result = (Core.Name "result") + +_MethodHeader_declarator = (Core.Name "declarator") + +_MethodHeader_throws = (Core.Name "throws") + +data Result = + ResultType UnannType | + ResultVoid + deriving (Eq, Ord, Read, Show) + +_Result = (Core.Name "hydra/ext/java/syntax.Result") + +_Result_type = (Core.Name "type") + +_Result_void = (Core.Name "void") + +data MethodDeclarator = + MethodDeclarator { + methodDeclaratorIdentifier :: Identifier, + methodDeclaratorReceiverParameter :: (Maybe ReceiverParameter), + methodDeclaratorFormalParameters :: [FormalParameter]} + deriving (Eq, Ord, Read, Show) + +_MethodDeclarator = (Core.Name "hydra/ext/java/syntax.MethodDeclarator") + +_MethodDeclarator_identifier = (Core.Name "identifier") + +_MethodDeclarator_receiverParameter = (Core.Name "receiverParameter") + +_MethodDeclarator_formalParameters = (Core.Name "formalParameters") + +data ReceiverParameter = + ReceiverParameter { + receiverParameterAnnotations :: [Annotation], + receiverParameterUnannType :: UnannType, + receiverParameterIdentifier :: (Maybe Identifier)} + deriving (Eq, Ord, Read, Show) + +_ReceiverParameter = (Core.Name "hydra/ext/java/syntax.ReceiverParameter") + +_ReceiverParameter_annotations = (Core.Name "annotations") + +_ReceiverParameter_unannType = (Core.Name "unannType") + +_ReceiverParameter_identifier = (Core.Name "identifier") + +data FormalParameter = + FormalParameterSimple FormalParameter_Simple | + FormalParameterVariableArity VariableArityParameter + deriving (Eq, Ord, Read, Show) + +_FormalParameter = (Core.Name "hydra/ext/java/syntax.FormalParameter") + +_FormalParameter_simple = (Core.Name "simple") + +_FormalParameter_variableArity = (Core.Name "variableArity") + +data FormalParameter_Simple = + FormalParameter_Simple { + formalParameter_SimpleModifiers :: [VariableModifier], + formalParameter_SimpleType :: UnannType, + formalParameter_SimpleId :: VariableDeclaratorId} + deriving (Eq, Ord, Read, Show) + +_FormalParameter_Simple = (Core.Name "hydra/ext/java/syntax.FormalParameter.Simple") + +_FormalParameter_Simple_modifiers = (Core.Name "modifiers") + +_FormalParameter_Simple_type = (Core.Name "type") + +_FormalParameter_Simple_id = (Core.Name "id") + +data VariableArityParameter = + VariableArityParameter { + variableArityParameterModifiers :: VariableModifier, + variableArityParameterType :: UnannType, + variableArityParameterAnnotations :: [Annotation], + variableArityParameterIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_VariableArityParameter = (Core.Name "hydra/ext/java/syntax.VariableArityParameter") + +_VariableArityParameter_modifiers = (Core.Name "modifiers") + +_VariableArityParameter_type = (Core.Name "type") + +_VariableArityParameter_annotations = (Core.Name "annotations") + +_VariableArityParameter_identifier = (Core.Name "identifier") + +data VariableModifier = + VariableModifierAnnotation Annotation | + VariableModifierFinal + deriving (Eq, Ord, Read, Show) + +_VariableModifier = (Core.Name "hydra/ext/java/syntax.VariableModifier") + +_VariableModifier_annotation = (Core.Name "annotation") + +_VariableModifier_final = (Core.Name "final") + +newtype Throws = + Throws { + unThrows :: [ExceptionType]} + deriving (Eq, Ord, Read, Show) + +_Throws = (Core.Name "hydra/ext/java/syntax.Throws") + +data ExceptionType = + ExceptionTypeClass ClassType | + ExceptionTypeVariable TypeVariable + deriving (Eq, Ord, Read, Show) + +_ExceptionType = (Core.Name "hydra/ext/java/syntax.ExceptionType") + +_ExceptionType_class = (Core.Name "class") + +_ExceptionType_variable = (Core.Name "variable") + +data MethodBody = + MethodBodyBlock Block | + MethodBodyNone + deriving (Eq, Ord, Read, Show) + +_MethodBody = (Core.Name "hydra/ext/java/syntax.MethodBody") + +_MethodBody_block = (Core.Name "block") + +_MethodBody_none = (Core.Name "none") + +newtype InstanceInitializer = + InstanceInitializer { + unInstanceInitializer :: Block} + deriving (Eq, Ord, Read, Show) + +_InstanceInitializer = (Core.Name "hydra/ext/java/syntax.InstanceInitializer") + +newtype StaticInitializer = + StaticInitializer { + unStaticInitializer :: Block} + deriving (Eq, Ord, Read, Show) + +_StaticInitializer = (Core.Name "hydra/ext/java/syntax.StaticInitializer") + +data ConstructorDeclaration = + ConstructorDeclaration { + constructorDeclarationModifiers :: [ConstructorModifier], + constructorDeclarationConstructor :: ConstructorDeclarator, + constructorDeclarationThrows :: (Maybe Throws), + constructorDeclarationBody :: ConstructorBody} + deriving (Eq, Ord, Read, Show) + +_ConstructorDeclaration = (Core.Name "hydra/ext/java/syntax.ConstructorDeclaration") + +_ConstructorDeclaration_modifiers = (Core.Name "modifiers") + +_ConstructorDeclaration_constructor = (Core.Name "constructor") + +_ConstructorDeclaration_throws = (Core.Name "throws") + +_ConstructorDeclaration_body = (Core.Name "body") + +data ConstructorModifier = + ConstructorModifierAnnotation Annotation | + ConstructorModifierPublic | + ConstructorModifierProtected | + ConstructorModifierPrivate + deriving (Eq, Ord, Read, Show) + +_ConstructorModifier = (Core.Name "hydra/ext/java/syntax.ConstructorModifier") + +_ConstructorModifier_annotation = (Core.Name "annotation") + +_ConstructorModifier_public = (Core.Name "public") + +_ConstructorModifier_protected = (Core.Name "protected") + +_ConstructorModifier_private = (Core.Name "private") + +data ConstructorDeclarator = + ConstructorDeclarator { + constructorDeclaratorParameters :: [TypeParameter], + constructorDeclaratorName :: SimpleTypeName, + constructorDeclaratorReceiverParameter :: (Maybe ReceiverParameter), + constructorDeclaratorFormalParameters :: [FormalParameter]} + deriving (Eq, Ord, Read, Show) + +_ConstructorDeclarator = (Core.Name "hydra/ext/java/syntax.ConstructorDeclarator") + +_ConstructorDeclarator_parameters = (Core.Name "parameters") + +_ConstructorDeclarator_name = (Core.Name "name") + +_ConstructorDeclarator_receiverParameter = (Core.Name "receiverParameter") + +_ConstructorDeclarator_formalParameters = (Core.Name "formalParameters") + +newtype SimpleTypeName = + SimpleTypeName { + unSimpleTypeName :: TypeIdentifier} + deriving (Eq, Ord, Read, Show) + +_SimpleTypeName = (Core.Name "hydra/ext/java/syntax.SimpleTypeName") + +data ConstructorBody = + ConstructorBody { + constructorBodyInvocation :: (Maybe ExplicitConstructorInvocation), + constructorBodyStatements :: [BlockStatement]} + deriving (Eq, Ord, Read, Show) + +_ConstructorBody = (Core.Name "hydra/ext/java/syntax.ConstructorBody") + +_ConstructorBody_invocation = (Core.Name "invocation") + +_ConstructorBody_statements = (Core.Name "statements") + +data ExplicitConstructorInvocation = + ExplicitConstructorInvocation { + explicitConstructorInvocationTypeArguments :: [TypeArgument], + explicitConstructorInvocationArguments :: [Expression], + explicitConstructorInvocationVariant :: ExplicitConstructorInvocation_Variant} + deriving (Eq, Ord, Read, Show) + +_ExplicitConstructorInvocation = (Core.Name "hydra/ext/java/syntax.ExplicitConstructorInvocation") + +_ExplicitConstructorInvocation_typeArguments = (Core.Name "typeArguments") + +_ExplicitConstructorInvocation_arguments = (Core.Name "arguments") + +_ExplicitConstructorInvocation_variant = (Core.Name "variant") + +data ExplicitConstructorInvocation_Variant = + ExplicitConstructorInvocation_VariantThis | + ExplicitConstructorInvocation_VariantSuper (Maybe ExpressionName) | + ExplicitConstructorInvocation_VariantPrimary Primary + deriving (Eq, Ord, Read, Show) + +_ExplicitConstructorInvocation_Variant = (Core.Name "hydra/ext/java/syntax.ExplicitConstructorInvocation.Variant") + +_ExplicitConstructorInvocation_Variant_this = (Core.Name "this") + +_ExplicitConstructorInvocation_Variant_super = (Core.Name "super") + +_ExplicitConstructorInvocation_Variant_primary = (Core.Name "primary") + +data EnumDeclaration = + EnumDeclaration { + enumDeclarationModifiers :: [ClassModifier], + enumDeclarationIdentifier :: TypeIdentifier, + enumDeclarationImplements :: [InterfaceType], + enumDeclarationBody :: EnumBody} + deriving (Eq, Ord, Read, Show) + +_EnumDeclaration = (Core.Name "hydra/ext/java/syntax.EnumDeclaration") + +_EnumDeclaration_modifiers = (Core.Name "modifiers") + +_EnumDeclaration_identifier = (Core.Name "identifier") + +_EnumDeclaration_implements = (Core.Name "implements") + +_EnumDeclaration_body = (Core.Name "body") + +newtype EnumBody = + EnumBody { + unEnumBody :: [EnumBody_Element]} + deriving (Eq, Ord, Read, Show) + +_EnumBody = (Core.Name "hydra/ext/java/syntax.EnumBody") + +data EnumBody_Element = + EnumBody_Element { + enumBody_ElementConstants :: [EnumConstant], + enumBody_ElementBodyDeclarations :: [ClassBodyDeclaration]} + deriving (Eq, Ord, Read, Show) + +_EnumBody_Element = (Core.Name "hydra/ext/java/syntax.EnumBody.Element") + +_EnumBody_Element_constants = (Core.Name "constants") + +_EnumBody_Element_bodyDeclarations = (Core.Name "bodyDeclarations") + +data EnumConstant = + EnumConstant { + enumConstantModifiers :: [EnumConstantModifier], + enumConstantIdentifier :: Identifier, + enumConstantArguments :: [[Expression]], + enumConstantBody :: (Maybe ClassBody)} + deriving (Eq, Ord, Read, Show) + +_EnumConstant = (Core.Name "hydra/ext/java/syntax.EnumConstant") + +_EnumConstant_modifiers = (Core.Name "modifiers") + +_EnumConstant_identifier = (Core.Name "identifier") + +_EnumConstant_arguments = (Core.Name "arguments") + +_EnumConstant_body = (Core.Name "body") + +newtype EnumConstantModifier = + EnumConstantModifier { + unEnumConstantModifier :: Annotation} + deriving (Eq, Ord, Read, Show) + +_EnumConstantModifier = (Core.Name "hydra/ext/java/syntax.EnumConstantModifier") + +data InterfaceDeclaration = + InterfaceDeclarationNormalInterface NormalInterfaceDeclaration | + InterfaceDeclarationAnnotationType AnnotationTypeDeclaration + deriving (Eq, Ord, Read, Show) + +_InterfaceDeclaration = (Core.Name "hydra/ext/java/syntax.InterfaceDeclaration") + +_InterfaceDeclaration_normalInterface = (Core.Name "normalInterface") + +_InterfaceDeclaration_annotationType = (Core.Name "annotationType") + +data NormalInterfaceDeclaration = + NormalInterfaceDeclaration { + normalInterfaceDeclarationModifiers :: [InterfaceModifier], + normalInterfaceDeclarationIdentifier :: TypeIdentifier, + normalInterfaceDeclarationParameters :: [TypeParameter], + normalInterfaceDeclarationExtends :: [InterfaceType], + normalInterfaceDeclarationBody :: InterfaceBody} + deriving (Eq, Ord, Read, Show) + +_NormalInterfaceDeclaration = (Core.Name "hydra/ext/java/syntax.NormalInterfaceDeclaration") + +_NormalInterfaceDeclaration_modifiers = (Core.Name "modifiers") + +_NormalInterfaceDeclaration_identifier = (Core.Name "identifier") + +_NormalInterfaceDeclaration_parameters = (Core.Name "parameters") + +_NormalInterfaceDeclaration_extends = (Core.Name "extends") + +_NormalInterfaceDeclaration_body = (Core.Name "body") + +data InterfaceModifier = + InterfaceModifierAnnotation Annotation | + InterfaceModifierPublic | + InterfaceModifierProtected | + InterfaceModifierPrivate | + InterfaceModifierAbstract | + InterfaceModifierStatic | + InterfaceModifierStrictfb + deriving (Eq, Ord, Read, Show) + +_InterfaceModifier = (Core.Name "hydra/ext/java/syntax.InterfaceModifier") + +_InterfaceModifier_annotation = (Core.Name "annotation") + +_InterfaceModifier_public = (Core.Name "public") + +_InterfaceModifier_protected = (Core.Name "protected") + +_InterfaceModifier_private = (Core.Name "private") + +_InterfaceModifier_abstract = (Core.Name "abstract") + +_InterfaceModifier_static = (Core.Name "static") + +_InterfaceModifier_strictfb = (Core.Name "strictfb") + +newtype InterfaceBody = + InterfaceBody { + unInterfaceBody :: [InterfaceMemberDeclaration]} + deriving (Eq, Ord, Read, Show) + +_InterfaceBody = (Core.Name "hydra/ext/java/syntax.InterfaceBody") + +data InterfaceMemberDeclaration = + InterfaceMemberDeclarationConstant ConstantDeclaration | + InterfaceMemberDeclarationInterfaceMethod InterfaceMethodDeclaration | + InterfaceMemberDeclarationClass ClassDeclaration | + InterfaceMemberDeclarationInterface InterfaceDeclaration + deriving (Eq, Ord, Read, Show) + +_InterfaceMemberDeclaration = (Core.Name "hydra/ext/java/syntax.InterfaceMemberDeclaration") + +_InterfaceMemberDeclaration_constant = (Core.Name "constant") + +_InterfaceMemberDeclaration_interfaceMethod = (Core.Name "interfaceMethod") + +_InterfaceMemberDeclaration_class = (Core.Name "class") + +_InterfaceMemberDeclaration_interface = (Core.Name "interface") + +data ConstantDeclaration = + ConstantDeclaration { + constantDeclarationModifiers :: [ConstantModifier], + constantDeclarationType :: UnannType, + constantDeclarationVariables :: [VariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_ConstantDeclaration = (Core.Name "hydra/ext/java/syntax.ConstantDeclaration") + +_ConstantDeclaration_modifiers = (Core.Name "modifiers") + +_ConstantDeclaration_type = (Core.Name "type") + +_ConstantDeclaration_variables = (Core.Name "variables") + +data ConstantModifier = + ConstantModifierAnnotation Annotation | + ConstantModifierPublic | + ConstantModifierStatic | + ConstantModifierFinal + deriving (Eq, Ord, Read, Show) + +_ConstantModifier = (Core.Name "hydra/ext/java/syntax.ConstantModifier") + +_ConstantModifier_annotation = (Core.Name "annotation") + +_ConstantModifier_public = (Core.Name "public") + +_ConstantModifier_static = (Core.Name "static") + +_ConstantModifier_final = (Core.Name "final") + +data InterfaceMethodDeclaration = + InterfaceMethodDeclaration { + interfaceMethodDeclarationModifiers :: [InterfaceMethodModifier], + interfaceMethodDeclarationHeader :: MethodHeader, + interfaceMethodDeclarationBody :: MethodBody} + deriving (Eq, Ord, Read, Show) + +_InterfaceMethodDeclaration = (Core.Name "hydra/ext/java/syntax.InterfaceMethodDeclaration") + +_InterfaceMethodDeclaration_modifiers = (Core.Name "modifiers") + +_InterfaceMethodDeclaration_header = (Core.Name "header") + +_InterfaceMethodDeclaration_body = (Core.Name "body") + +data InterfaceMethodModifier = + InterfaceMethodModifierAnnotation Annotation | + InterfaceMethodModifierPublic | + InterfaceMethodModifierPrivate | + InterfaceMethodModifierAbstract | + InterfaceMethodModifierDefault | + InterfaceMethodModifierStatic | + InterfaceMethodModifierStrictfp + deriving (Eq, Ord, Read, Show) + +_InterfaceMethodModifier = (Core.Name "hydra/ext/java/syntax.InterfaceMethodModifier") + +_InterfaceMethodModifier_annotation = (Core.Name "annotation") + +_InterfaceMethodModifier_public = (Core.Name "public") + +_InterfaceMethodModifier_private = (Core.Name "private") + +_InterfaceMethodModifier_abstract = (Core.Name "abstract") + +_InterfaceMethodModifier_default = (Core.Name "default") + +_InterfaceMethodModifier_static = (Core.Name "static") + +_InterfaceMethodModifier_strictfp = (Core.Name "strictfp") + +data AnnotationTypeDeclaration = + AnnotationTypeDeclaration { + annotationTypeDeclarationModifiers :: [InterfaceModifier], + annotationTypeDeclarationIdentifier :: TypeIdentifier, + annotationTypeDeclarationBody :: AnnotationTypeBody} + deriving (Eq, Ord, Read, Show) + +_AnnotationTypeDeclaration = (Core.Name "hydra/ext/java/syntax.AnnotationTypeDeclaration") + +_AnnotationTypeDeclaration_modifiers = (Core.Name "modifiers") + +_AnnotationTypeDeclaration_identifier = (Core.Name "identifier") + +_AnnotationTypeDeclaration_body = (Core.Name "body") + +newtype AnnotationTypeBody = + AnnotationTypeBody { + unAnnotationTypeBody :: [[AnnotationTypeMemberDeclaration]]} + deriving (Eq, Ord, Read, Show) + +_AnnotationTypeBody = (Core.Name "hydra/ext/java/syntax.AnnotationTypeBody") + +data AnnotationTypeMemberDeclaration = + AnnotationTypeMemberDeclarationAnnotationType AnnotationTypeElementDeclaration | + AnnotationTypeMemberDeclarationConstant ConstantDeclaration | + AnnotationTypeMemberDeclarationClass ClassDeclaration | + AnnotationTypeMemberDeclarationInterface InterfaceDeclaration + deriving (Eq, Ord, Read, Show) + +_AnnotationTypeMemberDeclaration = (Core.Name "hydra/ext/java/syntax.AnnotationTypeMemberDeclaration") + +_AnnotationTypeMemberDeclaration_annotationType = (Core.Name "annotationType") + +_AnnotationTypeMemberDeclaration_constant = (Core.Name "constant") + +_AnnotationTypeMemberDeclaration_class = (Core.Name "class") + +_AnnotationTypeMemberDeclaration_interface = (Core.Name "interface") + +data AnnotationTypeElementDeclaration = + AnnotationTypeElementDeclaration { + annotationTypeElementDeclarationModifiers :: [AnnotationTypeElementModifier], + annotationTypeElementDeclarationType :: UnannType, + annotationTypeElementDeclarationIdentifier :: Identifier, + annotationTypeElementDeclarationDims :: (Maybe Dims), + annotationTypeElementDeclarationDefault :: (Maybe DefaultValue)} + deriving (Eq, Ord, Read, Show) + +_AnnotationTypeElementDeclaration = (Core.Name "hydra/ext/java/syntax.AnnotationTypeElementDeclaration") + +_AnnotationTypeElementDeclaration_modifiers = (Core.Name "modifiers") + +_AnnotationTypeElementDeclaration_type = (Core.Name "type") + +_AnnotationTypeElementDeclaration_identifier = (Core.Name "identifier") + +_AnnotationTypeElementDeclaration_dims = (Core.Name "dims") + +_AnnotationTypeElementDeclaration_default = (Core.Name "default") + +data AnnotationTypeElementModifier = + AnnotationTypeElementModifierPublic Annotation | + AnnotationTypeElementModifierAbstract + deriving (Eq, Ord, Read, Show) + +_AnnotationTypeElementModifier = (Core.Name "hydra/ext/java/syntax.AnnotationTypeElementModifier") + +_AnnotationTypeElementModifier_public = (Core.Name "public") + +_AnnotationTypeElementModifier_abstract = (Core.Name "abstract") + +newtype DefaultValue = + DefaultValue { + unDefaultValue :: ElementValue} + deriving (Eq, Ord, Read, Show) + +_DefaultValue = (Core.Name "hydra/ext/java/syntax.DefaultValue") + +data Annotation = + AnnotationNormal NormalAnnotation | + AnnotationMarker MarkerAnnotation | + AnnotationSingleElement SingleElementAnnotation + deriving (Eq, Ord, Read, Show) + +_Annotation = (Core.Name "hydra/ext/java/syntax.Annotation") + +_Annotation_normal = (Core.Name "normal") + +_Annotation_marker = (Core.Name "marker") + +_Annotation_singleElement = (Core.Name "singleElement") + +data NormalAnnotation = + NormalAnnotation { + normalAnnotationTypeName :: TypeName, + normalAnnotationPairs :: [ElementValuePair]} + deriving (Eq, Ord, Read, Show) + +_NormalAnnotation = (Core.Name "hydra/ext/java/syntax.NormalAnnotation") + +_NormalAnnotation_typeName = (Core.Name "typeName") + +_NormalAnnotation_pairs = (Core.Name "pairs") + +data ElementValuePair = + ElementValuePair { + elementValuePairKey :: Identifier, + elementValuePairValue :: ElementValue} + deriving (Eq, Ord, Read, Show) + +_ElementValuePair = (Core.Name "hydra/ext/java/syntax.ElementValuePair") + +_ElementValuePair_key = (Core.Name "key") + +_ElementValuePair_value = (Core.Name "value") + +data ElementValue = + ElementValueConditionalExpression ConditionalExpression | + ElementValueElementValueArrayInitializer ElementValueArrayInitializer | + ElementValueAnnotation Annotation + deriving (Eq, Ord, Read, Show) + +_ElementValue = (Core.Name "hydra/ext/java/syntax.ElementValue") + +_ElementValue_conditionalExpression = (Core.Name "conditionalExpression") + +_ElementValue_elementValueArrayInitializer = (Core.Name "elementValueArrayInitializer") + +_ElementValue_annotation = (Core.Name "annotation") + +newtype ElementValueArrayInitializer = + ElementValueArrayInitializer { + unElementValueArrayInitializer :: [ElementValue]} + deriving (Eq, Ord, Read, Show) + +_ElementValueArrayInitializer = (Core.Name "hydra/ext/java/syntax.ElementValueArrayInitializer") + +newtype MarkerAnnotation = + MarkerAnnotation { + unMarkerAnnotation :: TypeName} + deriving (Eq, Ord, Read, Show) + +_MarkerAnnotation = (Core.Name "hydra/ext/java/syntax.MarkerAnnotation") + +data SingleElementAnnotation = + SingleElementAnnotation { + singleElementAnnotationName :: TypeName, + singleElementAnnotationValue :: (Maybe ElementValue)} + deriving (Eq, Ord, Read, Show) + +_SingleElementAnnotation = (Core.Name "hydra/ext/java/syntax.SingleElementAnnotation") + +_SingleElementAnnotation_name = (Core.Name "name") + +_SingleElementAnnotation_value = (Core.Name "value") + +newtype ArrayInitializer = + ArrayInitializer { + unArrayInitializer :: [[VariableInitializer]]} + deriving (Eq, Ord, Read, Show) + +_ArrayInitializer = (Core.Name "hydra/ext/java/syntax.ArrayInitializer") + +newtype Block = + Block { + unBlock :: [BlockStatement]} + deriving (Eq, Ord, Read, Show) + +_Block = (Core.Name "hydra/ext/java/syntax.Block") + +data BlockStatement = + BlockStatementLocalVariableDeclaration LocalVariableDeclarationStatement | + BlockStatementClass ClassDeclaration | + BlockStatementStatement Statement + deriving (Eq, Ord, Read, Show) + +_BlockStatement = (Core.Name "hydra/ext/java/syntax.BlockStatement") + +_BlockStatement_localVariableDeclaration = (Core.Name "localVariableDeclaration") + +_BlockStatement_class = (Core.Name "class") + +_BlockStatement_statement = (Core.Name "statement") + +newtype LocalVariableDeclarationStatement = + LocalVariableDeclarationStatement { + unLocalVariableDeclarationStatement :: LocalVariableDeclaration} + deriving (Eq, Ord, Read, Show) + +_LocalVariableDeclarationStatement = (Core.Name "hydra/ext/java/syntax.LocalVariableDeclarationStatement") + +data LocalVariableDeclaration = + LocalVariableDeclaration { + localVariableDeclarationModifiers :: [VariableModifier], + localVariableDeclarationType :: LocalVariableType, + localVariableDeclarationDeclarators :: [VariableDeclarator]} + deriving (Eq, Ord, Read, Show) + +_LocalVariableDeclaration = (Core.Name "hydra/ext/java/syntax.LocalVariableDeclaration") + +_LocalVariableDeclaration_modifiers = (Core.Name "modifiers") + +_LocalVariableDeclaration_type = (Core.Name "type") + +_LocalVariableDeclaration_declarators = (Core.Name "declarators") + +data LocalVariableType = + LocalVariableTypeType UnannType | + LocalVariableTypeVar + deriving (Eq, Ord, Read, Show) + +_LocalVariableType = (Core.Name "hydra/ext/java/syntax.LocalVariableType") + +_LocalVariableType_type = (Core.Name "type") + +_LocalVariableType_var = (Core.Name "var") + +data Statement = + StatementWithoutTrailing StatementWithoutTrailingSubstatement | + StatementLabeled LabeledStatement | + StatementIfThen IfThenStatement | + StatementIfThenElse IfThenElseStatement | + StatementWhile WhileStatement | + StatementFor ForStatement + deriving (Eq, Ord, Read, Show) + +_Statement = (Core.Name "hydra/ext/java/syntax.Statement") + +_Statement_withoutTrailing = (Core.Name "withoutTrailing") + +_Statement_labeled = (Core.Name "labeled") + +_Statement_ifThen = (Core.Name "ifThen") + +_Statement_ifThenElse = (Core.Name "ifThenElse") + +_Statement_while = (Core.Name "while") + +_Statement_for = (Core.Name "for") + +data StatementNoShortIf = + StatementNoShortIfWithoutTrailing StatementWithoutTrailingSubstatement | + StatementNoShortIfLabeled LabeledStatementNoShortIf | + StatementNoShortIfIfThenElse IfThenElseStatementNoShortIf | + StatementNoShortIfWhile WhileStatementNoShortIf | + StatementNoShortIfFor ForStatementNoShortIf + deriving (Eq, Ord, Read, Show) + +_StatementNoShortIf = (Core.Name "hydra/ext/java/syntax.StatementNoShortIf") + +_StatementNoShortIf_withoutTrailing = (Core.Name "withoutTrailing") + +_StatementNoShortIf_labeled = (Core.Name "labeled") + +_StatementNoShortIf_ifThenElse = (Core.Name "ifThenElse") + +_StatementNoShortIf_while = (Core.Name "while") + +_StatementNoShortIf_for = (Core.Name "for") + +data StatementWithoutTrailingSubstatement = + StatementWithoutTrailingSubstatementBlock Block | + StatementWithoutTrailingSubstatementEmpty EmptyStatement | + StatementWithoutTrailingSubstatementExpression ExpressionStatement | + StatementWithoutTrailingSubstatementAssert AssertStatement | + StatementWithoutTrailingSubstatementSwitch SwitchStatement | + StatementWithoutTrailingSubstatementDo DoStatement | + StatementWithoutTrailingSubstatementBreak BreakStatement | + StatementWithoutTrailingSubstatementContinue ContinueStatement | + StatementWithoutTrailingSubstatementReturn ReturnStatement | + StatementWithoutTrailingSubstatementSynchronized SynchronizedStatement | + StatementWithoutTrailingSubstatementThrow ThrowStatement | + StatementWithoutTrailingSubstatementTry TryStatement + deriving (Eq, Ord, Read, Show) + +_StatementWithoutTrailingSubstatement = (Core.Name "hydra/ext/java/syntax.StatementWithoutTrailingSubstatement") + +_StatementWithoutTrailingSubstatement_block = (Core.Name "block") + +_StatementWithoutTrailingSubstatement_empty = (Core.Name "empty") + +_StatementWithoutTrailingSubstatement_expression = (Core.Name "expression") + +_StatementWithoutTrailingSubstatement_assert = (Core.Name "assert") + +_StatementWithoutTrailingSubstatement_switch = (Core.Name "switch") + +_StatementWithoutTrailingSubstatement_do = (Core.Name "do") + +_StatementWithoutTrailingSubstatement_break = (Core.Name "break") + +_StatementWithoutTrailingSubstatement_continue = (Core.Name "continue") + +_StatementWithoutTrailingSubstatement_return = (Core.Name "return") + +_StatementWithoutTrailingSubstatement_synchronized = (Core.Name "synchronized") + +_StatementWithoutTrailingSubstatement_throw = (Core.Name "throw") + +_StatementWithoutTrailingSubstatement_try = (Core.Name "try") + +data EmptyStatement = + EmptyStatement {} + deriving (Eq, Ord, Read, Show) + +_EmptyStatement = (Core.Name "hydra/ext/java/syntax.EmptyStatement") + +data LabeledStatement = + LabeledStatement { + labeledStatementIdentifier :: Identifier, + labeledStatementStatement :: Statement} + deriving (Eq, Ord, Read, Show) + +_LabeledStatement = (Core.Name "hydra/ext/java/syntax.LabeledStatement") + +_LabeledStatement_identifier = (Core.Name "identifier") + +_LabeledStatement_statement = (Core.Name "statement") + +data LabeledStatementNoShortIf = + LabeledStatementNoShortIf { + labeledStatementNoShortIfIdentifier :: Identifier, + labeledStatementNoShortIfStatement :: StatementNoShortIf} + deriving (Eq, Ord, Read, Show) + +_LabeledStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.LabeledStatementNoShortIf") + +_LabeledStatementNoShortIf_identifier = (Core.Name "identifier") + +_LabeledStatementNoShortIf_statement = (Core.Name "statement") + +newtype ExpressionStatement = + ExpressionStatement { + unExpressionStatement :: StatementExpression} + deriving (Eq, Ord, Read, Show) + +_ExpressionStatement = (Core.Name "hydra/ext/java/syntax.ExpressionStatement") + +data StatementExpression = + StatementExpressionAssignment Assignment | + StatementExpressionPreIncrement PreIncrementExpression | + StatementExpressionPreDecrement PreDecrementExpression | + StatementExpressionPostIncrement PostIncrementExpression | + StatementExpressionPostDecrement PostDecrementExpression | + StatementExpressionMethodInvocation MethodInvocation | + StatementExpressionClassInstanceCreation ClassInstanceCreationExpression + deriving (Eq, Ord, Read, Show) + +_StatementExpression = (Core.Name "hydra/ext/java/syntax.StatementExpression") + +_StatementExpression_assignment = (Core.Name "assignment") + +_StatementExpression_preIncrement = (Core.Name "preIncrement") + +_StatementExpression_preDecrement = (Core.Name "preDecrement") + +_StatementExpression_postIncrement = (Core.Name "postIncrement") + +_StatementExpression_postDecrement = (Core.Name "postDecrement") + +_StatementExpression_methodInvocation = (Core.Name "methodInvocation") + +_StatementExpression_classInstanceCreation = (Core.Name "classInstanceCreation") + +data IfThenStatement = + IfThenStatement { + ifThenStatementExpression :: Expression, + ifThenStatementStatement :: Statement} + deriving (Eq, Ord, Read, Show) + +_IfThenStatement = (Core.Name "hydra/ext/java/syntax.IfThenStatement") + +_IfThenStatement_expression = (Core.Name "expression") + +_IfThenStatement_statement = (Core.Name "statement") + +data IfThenElseStatement = + IfThenElseStatement { + ifThenElseStatementCond :: (Maybe Expression), + ifThenElseStatementThen :: StatementNoShortIf, + ifThenElseStatementElse :: Statement} + deriving (Eq, Ord, Read, Show) + +_IfThenElseStatement = (Core.Name "hydra/ext/java/syntax.IfThenElseStatement") + +_IfThenElseStatement_cond = (Core.Name "cond") + +_IfThenElseStatement_then = (Core.Name "then") + +_IfThenElseStatement_else = (Core.Name "else") + +data IfThenElseStatementNoShortIf = + IfThenElseStatementNoShortIf { + ifThenElseStatementNoShortIfCond :: (Maybe Expression), + ifThenElseStatementNoShortIfThen :: StatementNoShortIf, + ifThenElseStatementNoShortIfElse :: StatementNoShortIf} + deriving (Eq, Ord, Read, Show) + +_IfThenElseStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.IfThenElseStatementNoShortIf") + +_IfThenElseStatementNoShortIf_cond = (Core.Name "cond") + +_IfThenElseStatementNoShortIf_then = (Core.Name "then") + +_IfThenElseStatementNoShortIf_else = (Core.Name "else") + +data AssertStatement = + AssertStatementSingle Expression | + AssertStatementPair AssertStatement_Pair + deriving (Eq, Ord, Read, Show) + +_AssertStatement = (Core.Name "hydra/ext/java/syntax.AssertStatement") + +_AssertStatement_single = (Core.Name "single") + +_AssertStatement_pair = (Core.Name "pair") + +data AssertStatement_Pair = + AssertStatement_Pair { + assertStatement_PairFirst :: Expression, + assertStatement_PairSecond :: Expression} + deriving (Eq, Ord, Read, Show) + +_AssertStatement_Pair = (Core.Name "hydra/ext/java/syntax.AssertStatement.Pair") + +_AssertStatement_Pair_first = (Core.Name "first") + +_AssertStatement_Pair_second = (Core.Name "second") + +data SwitchStatement = + SwitchStatement { + switchStatementCond :: Expression, + switchStatementBlock :: SwitchBlock} + deriving (Eq, Ord, Read, Show) + +_SwitchStatement = (Core.Name "hydra/ext/java/syntax.SwitchStatement") + +_SwitchStatement_cond = (Core.Name "cond") + +_SwitchStatement_block = (Core.Name "block") + +newtype SwitchBlock = + SwitchBlock { + unSwitchBlock :: [SwitchBlock_Pair]} + deriving (Eq, Ord, Read, Show) + +_SwitchBlock = (Core.Name "hydra/ext/java/syntax.SwitchBlock") + +data SwitchBlock_Pair = + SwitchBlock_Pair { + switchBlock_PairStatements :: [SwitchBlockStatementGroup], + switchBlock_PairLabels :: [SwitchLabel]} + deriving (Eq, Ord, Read, Show) + +_SwitchBlock_Pair = (Core.Name "hydra/ext/java/syntax.SwitchBlock.Pair") + +_SwitchBlock_Pair_statements = (Core.Name "statements") + +_SwitchBlock_Pair_labels = (Core.Name "labels") + +data SwitchBlockStatementGroup = + SwitchBlockStatementGroup { + switchBlockStatementGroupLabels :: [SwitchLabel], + switchBlockStatementGroupStatements :: [BlockStatement]} + deriving (Eq, Ord, Read, Show) + +_SwitchBlockStatementGroup = (Core.Name "hydra/ext/java/syntax.SwitchBlockStatementGroup") + +_SwitchBlockStatementGroup_labels = (Core.Name "labels") + +_SwitchBlockStatementGroup_statements = (Core.Name "statements") + +data SwitchLabel = + SwitchLabelConstant ConstantExpression | + SwitchLabelEnumConstant EnumConstantName | + SwitchLabelDefault + deriving (Eq, Ord, Read, Show) + +_SwitchLabel = (Core.Name "hydra/ext/java/syntax.SwitchLabel") + +_SwitchLabel_constant = (Core.Name "constant") + +_SwitchLabel_enumConstant = (Core.Name "enumConstant") + +_SwitchLabel_default = (Core.Name "default") + +newtype EnumConstantName = + EnumConstantName { + unEnumConstantName :: Identifier} + deriving (Eq, Ord, Read, Show) + +_EnumConstantName = (Core.Name "hydra/ext/java/syntax.EnumConstantName") + +data WhileStatement = + WhileStatement { + whileStatementCond :: (Maybe Expression), + whileStatementBody :: Statement} + deriving (Eq, Ord, Read, Show) + +_WhileStatement = (Core.Name "hydra/ext/java/syntax.WhileStatement") + +_WhileStatement_cond = (Core.Name "cond") + +_WhileStatement_body = (Core.Name "body") + +data WhileStatementNoShortIf = + WhileStatementNoShortIf { + whileStatementNoShortIfCond :: (Maybe Expression), + whileStatementNoShortIfBody :: StatementNoShortIf} + deriving (Eq, Ord, Read, Show) + +_WhileStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.WhileStatementNoShortIf") + +_WhileStatementNoShortIf_cond = (Core.Name "cond") + +_WhileStatementNoShortIf_body = (Core.Name "body") + +data DoStatement = + DoStatement { + doStatementBody :: Statement, + doStatementConde :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_DoStatement = (Core.Name "hydra/ext/java/syntax.DoStatement") + +_DoStatement_body = (Core.Name "body") + +_DoStatement_conde = (Core.Name "conde") + +data ForStatement = + ForStatementBasic BasicForStatement | + ForStatementEnhanced EnhancedForStatement + deriving (Eq, Ord, Read, Show) + +_ForStatement = (Core.Name "hydra/ext/java/syntax.ForStatement") + +_ForStatement_basic = (Core.Name "basic") + +_ForStatement_enhanced = (Core.Name "enhanced") + +data ForStatementNoShortIf = + ForStatementNoShortIfBasic BasicForStatementNoShortIf | + ForStatementNoShortIfEnhanced EnhancedForStatementNoShortIf + deriving (Eq, Ord, Read, Show) + +_ForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.ForStatementNoShortIf") + +_ForStatementNoShortIf_basic = (Core.Name "basic") + +_ForStatementNoShortIf_enhanced = (Core.Name "enhanced") + +data BasicForStatement = + BasicForStatement { + basicForStatementCond :: ForCond, + basicForStatementBody :: Statement} + deriving (Eq, Ord, Read, Show) + +_BasicForStatement = (Core.Name "hydra/ext/java/syntax.BasicForStatement") + +_BasicForStatement_cond = (Core.Name "cond") + +_BasicForStatement_body = (Core.Name "body") + +data ForCond = + ForCond { + forCondInit :: (Maybe ForInit), + forCondCond :: (Maybe Expression), + forCondUpdate :: (Maybe ForUpdate)} + deriving (Eq, Ord, Read, Show) + +_ForCond = (Core.Name "hydra/ext/java/syntax.ForCond") + +_ForCond_init = (Core.Name "init") + +_ForCond_cond = (Core.Name "cond") + +_ForCond_update = (Core.Name "update") + +data BasicForStatementNoShortIf = + BasicForStatementNoShortIf { + basicForStatementNoShortIfCond :: ForCond, + basicForStatementNoShortIfBody :: StatementNoShortIf} + deriving (Eq, Ord, Read, Show) + +_BasicForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.BasicForStatementNoShortIf") + +_BasicForStatementNoShortIf_cond = (Core.Name "cond") + +_BasicForStatementNoShortIf_body = (Core.Name "body") + +data ForInit = + ForInitStatements [StatementExpression] | + ForInitLocalVariable LocalVariableDeclaration + deriving (Eq, Ord, Read, Show) + +_ForInit = (Core.Name "hydra/ext/java/syntax.ForInit") + +_ForInit_statements = (Core.Name "statements") + +_ForInit_localVariable = (Core.Name "localVariable") + +newtype ForUpdate = + ForUpdate { + unForUpdate :: [StatementExpression]} + deriving (Eq, Ord, Read, Show) + +_ForUpdate = (Core.Name "hydra/ext/java/syntax.ForUpdate") + +data EnhancedForStatement = + EnhancedForStatement { + enhancedForStatementCond :: EnhancedForCond, + enhancedForStatementBody :: Statement} + deriving (Eq, Ord, Read, Show) + +_EnhancedForStatement = (Core.Name "hydra/ext/java/syntax.EnhancedForStatement") + +_EnhancedForStatement_cond = (Core.Name "cond") + +_EnhancedForStatement_body = (Core.Name "body") + +data EnhancedForCond = + EnhancedForCond { + enhancedForCondModifiers :: [VariableModifier], + enhancedForCondType :: LocalVariableType, + enhancedForCondId :: VariableDeclaratorId, + enhancedForCondExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_EnhancedForCond = (Core.Name "hydra/ext/java/syntax.EnhancedForCond") + +_EnhancedForCond_modifiers = (Core.Name "modifiers") + +_EnhancedForCond_type = (Core.Name "type") + +_EnhancedForCond_id = (Core.Name "id") + +_EnhancedForCond_expression = (Core.Name "expression") + +data EnhancedForStatementNoShortIf = + EnhancedForStatementNoShortIf { + enhancedForStatementNoShortIfCond :: EnhancedForCond, + enhancedForStatementNoShortIfBody :: StatementNoShortIf} + deriving (Eq, Ord, Read, Show) + +_EnhancedForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.EnhancedForStatementNoShortIf") + +_EnhancedForStatementNoShortIf_cond = (Core.Name "cond") + +_EnhancedForStatementNoShortIf_body = (Core.Name "body") + +newtype BreakStatement = + BreakStatement { + unBreakStatement :: (Maybe Identifier)} + deriving (Eq, Ord, Read, Show) + +_BreakStatement = (Core.Name "hydra/ext/java/syntax.BreakStatement") + +newtype ContinueStatement = + ContinueStatement { + unContinueStatement :: (Maybe Identifier)} + deriving (Eq, Ord, Read, Show) + +_ContinueStatement = (Core.Name "hydra/ext/java/syntax.ContinueStatement") + +newtype ReturnStatement = + ReturnStatement { + unReturnStatement :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_ReturnStatement = (Core.Name "hydra/ext/java/syntax.ReturnStatement") + +newtype ThrowStatement = + ThrowStatement { + unThrowStatement :: Expression} + deriving (Eq, Ord, Read, Show) + +_ThrowStatement = (Core.Name "hydra/ext/java/syntax.ThrowStatement") + +data SynchronizedStatement = + SynchronizedStatement { + synchronizedStatementExpression :: Expression, + synchronizedStatementBlock :: Block} + deriving (Eq, Ord, Read, Show) + +_SynchronizedStatement = (Core.Name "hydra/ext/java/syntax.SynchronizedStatement") + +_SynchronizedStatement_expression = (Core.Name "expression") + +_SynchronizedStatement_block = (Core.Name "block") + +data TryStatement = + TryStatementSimple TryStatement_Simple | + TryStatementWithFinally TryStatement_WithFinally | + TryStatementWithResources TryWithResourcesStatement + deriving (Eq, Ord, Read, Show) + +_TryStatement = (Core.Name "hydra/ext/java/syntax.TryStatement") + +_TryStatement_simple = (Core.Name "simple") + +_TryStatement_withFinally = (Core.Name "withFinally") + +_TryStatement_withResources = (Core.Name "withResources") + +data TryStatement_Simple = + TryStatement_Simple { + tryStatement_SimpleBlock :: Block, + tryStatement_SimpleCatches :: Catches} + deriving (Eq, Ord, Read, Show) + +_TryStatement_Simple = (Core.Name "hydra/ext/java/syntax.TryStatement.Simple") + +_TryStatement_Simple_block = (Core.Name "block") + +_TryStatement_Simple_catches = (Core.Name "catches") + +data TryStatement_WithFinally = + TryStatement_WithFinally { + tryStatement_WithFinallyBlock :: Block, + tryStatement_WithFinallyCatches :: (Maybe Catches), + tryStatement_WithFinallyFinally :: Finally} + deriving (Eq, Ord, Read, Show) + +_TryStatement_WithFinally = (Core.Name "hydra/ext/java/syntax.TryStatement.WithFinally") + +_TryStatement_WithFinally_block = (Core.Name "block") + +_TryStatement_WithFinally_catches = (Core.Name "catches") + +_TryStatement_WithFinally_finally = (Core.Name "finally") + +newtype Catches = + Catches { + unCatches :: [CatchClause]} + deriving (Eq, Ord, Read, Show) + +_Catches = (Core.Name "hydra/ext/java/syntax.Catches") + +data CatchClause = + CatchClause { + catchClauseParameter :: (Maybe CatchFormalParameter), + catchClauseBlock :: Block} + deriving (Eq, Ord, Read, Show) + +_CatchClause = (Core.Name "hydra/ext/java/syntax.CatchClause") + +_CatchClause_parameter = (Core.Name "parameter") + +_CatchClause_block = (Core.Name "block") + +data CatchFormalParameter = + CatchFormalParameter { + catchFormalParameterModifiers :: [VariableModifier], + catchFormalParameterType :: CatchType, + catchFormalParameterId :: VariableDeclaratorId} + deriving (Eq, Ord, Read, Show) + +_CatchFormalParameter = (Core.Name "hydra/ext/java/syntax.CatchFormalParameter") + +_CatchFormalParameter_modifiers = (Core.Name "modifiers") + +_CatchFormalParameter_type = (Core.Name "type") + +_CatchFormalParameter_id = (Core.Name "id") + +data CatchType = + CatchType { + catchTypeType :: UnannClassType, + catchTypeTypes :: [ClassType]} + deriving (Eq, Ord, Read, Show) + +_CatchType = (Core.Name "hydra/ext/java/syntax.CatchType") + +_CatchType_type = (Core.Name "type") + +_CatchType_types = (Core.Name "types") + +newtype Finally = + Finally { + unFinally :: Block} + deriving (Eq, Ord, Read, Show) + +_Finally = (Core.Name "hydra/ext/java/syntax.Finally") + +data TryWithResourcesStatement = + TryWithResourcesStatement { + tryWithResourcesStatementResourceSpecification :: ResourceSpecification, + tryWithResourcesStatementBlock :: Block, + tryWithResourcesStatementCatches :: (Maybe Catches), + tryWithResourcesStatementFinally :: (Maybe Finally)} + deriving (Eq, Ord, Read, Show) + +_TryWithResourcesStatement = (Core.Name "hydra/ext/java/syntax.TryWithResourcesStatement") + +_TryWithResourcesStatement_resourceSpecification = (Core.Name "resourceSpecification") + +_TryWithResourcesStatement_block = (Core.Name "block") + +_TryWithResourcesStatement_catches = (Core.Name "catches") + +_TryWithResourcesStatement_finally = (Core.Name "finally") + +newtype ResourceSpecification = + ResourceSpecification { + unResourceSpecification :: [Resource]} + deriving (Eq, Ord, Read, Show) + +_ResourceSpecification = (Core.Name "hydra/ext/java/syntax.ResourceSpecification") + +data Resource = + ResourceLocal Resource_Local | + ResourceVariable VariableAccess + deriving (Eq, Ord, Read, Show) + +_Resource = (Core.Name "hydra/ext/java/syntax.Resource") + +_Resource_local = (Core.Name "local") + +_Resource_variable = (Core.Name "variable") + +data Resource_Local = + Resource_Local { + resource_LocalModifiers :: [VariableModifier], + resource_LocalType :: LocalVariableType, + resource_LocalIdentifier :: Identifier, + resource_LocalExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_Resource_Local = (Core.Name "hydra/ext/java/syntax.Resource.Local") + +_Resource_Local_modifiers = (Core.Name "modifiers") + +_Resource_Local_type = (Core.Name "type") + +_Resource_Local_identifier = (Core.Name "identifier") + +_Resource_Local_expression = (Core.Name "expression") + +data VariableAccess = + VariableAccessExpressionName ExpressionName | + VariableAccessFieldAccess FieldAccess + deriving (Eq, Ord, Read, Show) + +_VariableAccess = (Core.Name "hydra/ext/java/syntax.VariableAccess") + +_VariableAccess_expressionName = (Core.Name "expressionName") + +_VariableAccess_fieldAccess = (Core.Name "fieldAccess") + +data Primary = + PrimaryNoNewArray PrimaryNoNewArray | + PrimaryArrayCreation ArrayCreationExpression + deriving (Eq, Ord, Read, Show) + +_Primary = (Core.Name "hydra/ext/java/syntax.Primary") + +_Primary_noNewArray = (Core.Name "noNewArray") + +_Primary_arrayCreation = (Core.Name "arrayCreation") + +data PrimaryNoNewArray = + PrimaryNoNewArrayLiteral Literal | + PrimaryNoNewArrayClassLiteral ClassLiteral | + PrimaryNoNewArrayThis | + PrimaryNoNewArrayDotThis TypeName | + PrimaryNoNewArrayParens Expression | + PrimaryNoNewArrayClassInstance ClassInstanceCreationExpression | + PrimaryNoNewArrayFieldAccess FieldAccess | + PrimaryNoNewArrayArrayAccess ArrayAccess | + PrimaryNoNewArrayMethodInvocation MethodInvocation | + PrimaryNoNewArrayMethodReference MethodReference + deriving (Eq, Ord, Read, Show) + +_PrimaryNoNewArray = (Core.Name "hydra/ext/java/syntax.PrimaryNoNewArray") + +_PrimaryNoNewArray_literal = (Core.Name "literal") + +_PrimaryNoNewArray_classLiteral = (Core.Name "classLiteral") + +_PrimaryNoNewArray_this = (Core.Name "this") + +_PrimaryNoNewArray_dotThis = (Core.Name "dotThis") + +_PrimaryNoNewArray_parens = (Core.Name "parens") + +_PrimaryNoNewArray_classInstance = (Core.Name "classInstance") + +_PrimaryNoNewArray_fieldAccess = (Core.Name "fieldAccess") + +_PrimaryNoNewArray_arrayAccess = (Core.Name "arrayAccess") + +_PrimaryNoNewArray_methodInvocation = (Core.Name "methodInvocation") + +_PrimaryNoNewArray_methodReference = (Core.Name "methodReference") + +data ClassLiteral = + ClassLiteralType TypeNameArray | + ClassLiteralNumericType NumericTypeArray | + ClassLiteralBoolean BooleanArray | + ClassLiteralVoid + deriving (Eq, Ord, Read, Show) + +_ClassLiteral = (Core.Name "hydra/ext/java/syntax.ClassLiteral") + +_ClassLiteral_type = (Core.Name "type") + +_ClassLiteral_numericType = (Core.Name "numericType") + +_ClassLiteral_boolean = (Core.Name "boolean") + +_ClassLiteral_void = (Core.Name "void") + +data TypeNameArray = + TypeNameArraySimple TypeName | + TypeNameArrayArray TypeNameArray + deriving (Eq, Ord, Read, Show) + +_TypeNameArray = (Core.Name "hydra/ext/java/syntax.TypeNameArray") + +_TypeNameArray_simple = (Core.Name "simple") + +_TypeNameArray_array = (Core.Name "array") + +data NumericTypeArray = + NumericTypeArraySimple NumericType | + NumericTypeArrayArray NumericTypeArray + deriving (Eq, Ord, Read, Show) + +_NumericTypeArray = (Core.Name "hydra/ext/java/syntax.NumericTypeArray") + +_NumericTypeArray_simple = (Core.Name "simple") + +_NumericTypeArray_array = (Core.Name "array") + +data BooleanArray = + BooleanArraySimple | + BooleanArrayArray BooleanArray + deriving (Eq, Ord, Read, Show) + +_BooleanArray = (Core.Name "hydra/ext/java/syntax.BooleanArray") + +_BooleanArray_simple = (Core.Name "simple") + +_BooleanArray_array = (Core.Name "array") + +data ClassInstanceCreationExpression = + ClassInstanceCreationExpression { + classInstanceCreationExpressionQualifier :: (Maybe ClassInstanceCreationExpression_Qualifier), + classInstanceCreationExpressionExpression :: UnqualifiedClassInstanceCreationExpression} + deriving (Eq, Ord, Read, Show) + +_ClassInstanceCreationExpression = (Core.Name "hydra/ext/java/syntax.ClassInstanceCreationExpression") + +_ClassInstanceCreationExpression_qualifier = (Core.Name "qualifier") + +_ClassInstanceCreationExpression_expression = (Core.Name "expression") + +data ClassInstanceCreationExpression_Qualifier = + ClassInstanceCreationExpression_QualifierExpression ExpressionName | + ClassInstanceCreationExpression_QualifierPrimary Primary + deriving (Eq, Ord, Read, Show) + +_ClassInstanceCreationExpression_Qualifier = (Core.Name "hydra/ext/java/syntax.ClassInstanceCreationExpression.Qualifier") + +_ClassInstanceCreationExpression_Qualifier_expression = (Core.Name "expression") + +_ClassInstanceCreationExpression_Qualifier_primary = (Core.Name "primary") + +data UnqualifiedClassInstanceCreationExpression = + UnqualifiedClassInstanceCreationExpression { + unqualifiedClassInstanceCreationExpressionTypeArguments :: [TypeArgument], + unqualifiedClassInstanceCreationExpressionClassOrInterface :: ClassOrInterfaceTypeToInstantiate, + unqualifiedClassInstanceCreationExpressionArguments :: [Expression], + unqualifiedClassInstanceCreationExpressionBody :: (Maybe ClassBody)} + deriving (Eq, Ord, Read, Show) + +_UnqualifiedClassInstanceCreationExpression = (Core.Name "hydra/ext/java/syntax.UnqualifiedClassInstanceCreationExpression") + +_UnqualifiedClassInstanceCreationExpression_typeArguments = (Core.Name "typeArguments") + +_UnqualifiedClassInstanceCreationExpression_classOrInterface = (Core.Name "classOrInterface") + +_UnqualifiedClassInstanceCreationExpression_arguments = (Core.Name "arguments") + +_UnqualifiedClassInstanceCreationExpression_body = (Core.Name "body") + +data ClassOrInterfaceTypeToInstantiate = + ClassOrInterfaceTypeToInstantiate { + classOrInterfaceTypeToInstantiateIdentifiers :: [AnnotatedIdentifier], + classOrInterfaceTypeToInstantiateTypeArguments :: (Maybe TypeArgumentsOrDiamond)} + deriving (Eq, Ord, Read, Show) + +_ClassOrInterfaceTypeToInstantiate = (Core.Name "hydra/ext/java/syntax.ClassOrInterfaceTypeToInstantiate") + +_ClassOrInterfaceTypeToInstantiate_identifiers = (Core.Name "identifiers") + +_ClassOrInterfaceTypeToInstantiate_typeArguments = (Core.Name "typeArguments") + +data AnnotatedIdentifier = + AnnotatedIdentifier { + annotatedIdentifierAnnotations :: [Annotation], + annotatedIdentifierIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_AnnotatedIdentifier = (Core.Name "hydra/ext/java/syntax.AnnotatedIdentifier") + +_AnnotatedIdentifier_annotations = (Core.Name "annotations") + +_AnnotatedIdentifier_identifier = (Core.Name "identifier") + +data TypeArgumentsOrDiamond = + TypeArgumentsOrDiamondArguments [TypeArgument] | + TypeArgumentsOrDiamondDiamond + deriving (Eq, Ord, Read, Show) + +_TypeArgumentsOrDiamond = (Core.Name "hydra/ext/java/syntax.TypeArgumentsOrDiamond") + +_TypeArgumentsOrDiamond_arguments = (Core.Name "arguments") + +_TypeArgumentsOrDiamond_diamond = (Core.Name "diamond") + +data FieldAccess = + FieldAccess { + fieldAccessQualifier :: FieldAccess_Qualifier, + fieldAccessIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_FieldAccess = (Core.Name "hydra/ext/java/syntax.FieldAccess") + +_FieldAccess_qualifier = (Core.Name "qualifier") + +_FieldAccess_identifier = (Core.Name "identifier") + +data FieldAccess_Qualifier = + FieldAccess_QualifierPrimary Primary | + FieldAccess_QualifierSuper | + FieldAccess_QualifierTyped TypeName + deriving (Eq, Ord, Read, Show) + +_FieldAccess_Qualifier = (Core.Name "hydra/ext/java/syntax.FieldAccess.Qualifier") + +_FieldAccess_Qualifier_primary = (Core.Name "primary") + +_FieldAccess_Qualifier_super = (Core.Name "super") + +_FieldAccess_Qualifier_typed = (Core.Name "typed") + +data ArrayAccess = + ArrayAccess { + arrayAccessExpression :: (Maybe Expression), + arrayAccessVariant :: ArrayAccess_Variant} + deriving (Eq, Ord, Read, Show) + +_ArrayAccess = (Core.Name "hydra/ext/java/syntax.ArrayAccess") + +_ArrayAccess_expression = (Core.Name "expression") + +_ArrayAccess_variant = (Core.Name "variant") + +data ArrayAccess_Variant = + ArrayAccess_VariantName ExpressionName | + ArrayAccess_VariantPrimary PrimaryNoNewArray + deriving (Eq, Ord, Read, Show) + +_ArrayAccess_Variant = (Core.Name "hydra/ext/java/syntax.ArrayAccess.Variant") + +_ArrayAccess_Variant_name = (Core.Name "name") + +_ArrayAccess_Variant_primary = (Core.Name "primary") + +data MethodInvocation = + MethodInvocation { + methodInvocationHeader :: MethodInvocation_Header, + methodInvocationArguments :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_MethodInvocation = (Core.Name "hydra/ext/java/syntax.MethodInvocation") + +_MethodInvocation_header = (Core.Name "header") + +_MethodInvocation_arguments = (Core.Name "arguments") + +data MethodInvocation_Header = + MethodInvocation_HeaderSimple MethodName | + MethodInvocation_HeaderComplex MethodInvocation_Complex + deriving (Eq, Ord, Read, Show) + +_MethodInvocation_Header = (Core.Name "hydra/ext/java/syntax.MethodInvocation.Header") + +_MethodInvocation_Header_simple = (Core.Name "simple") + +_MethodInvocation_Header_complex = (Core.Name "complex") + +data MethodInvocation_Complex = + MethodInvocation_Complex { + methodInvocation_ComplexVariant :: MethodInvocation_Variant, + methodInvocation_ComplexTypeArguments :: [TypeArgument], + methodInvocation_ComplexIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_MethodInvocation_Complex = (Core.Name "hydra/ext/java/syntax.MethodInvocation.Complex") + +_MethodInvocation_Complex_variant = (Core.Name "variant") + +_MethodInvocation_Complex_typeArguments = (Core.Name "typeArguments") + +_MethodInvocation_Complex_identifier = (Core.Name "identifier") + +data MethodInvocation_Variant = + MethodInvocation_VariantType TypeName | + MethodInvocation_VariantExpression ExpressionName | + MethodInvocation_VariantPrimary Primary | + MethodInvocation_VariantSuper | + MethodInvocation_VariantTypeSuper TypeName + deriving (Eq, Ord, Read, Show) + +_MethodInvocation_Variant = (Core.Name "hydra/ext/java/syntax.MethodInvocation.Variant") + +_MethodInvocation_Variant_type = (Core.Name "type") + +_MethodInvocation_Variant_expression = (Core.Name "expression") + +_MethodInvocation_Variant_primary = (Core.Name "primary") + +_MethodInvocation_Variant_super = (Core.Name "super") + +_MethodInvocation_Variant_typeSuper = (Core.Name "typeSuper") + +data MethodReference = + MethodReferenceExpression MethodReference_Expression | + MethodReferencePrimary MethodReference_Primary | + MethodReferenceReferenceType MethodReference_ReferenceType | + MethodReferenceSuper MethodReference_Super | + MethodReferenceNew MethodReference_New | + MethodReferenceArray MethodReference_Array + deriving (Eq, Ord, Read, Show) + +_MethodReference = (Core.Name "hydra/ext/java/syntax.MethodReference") + +_MethodReference_expression = (Core.Name "expression") + +_MethodReference_primary = (Core.Name "primary") + +_MethodReference_referenceType = (Core.Name "referenceType") + +_MethodReference_super = (Core.Name "super") + +_MethodReference_new = (Core.Name "new") + +_MethodReference_array = (Core.Name "array") + +data MethodReference_Expression = + MethodReference_Expression { + methodReference_ExpressionName :: ExpressionName, + methodReference_ExpressionTypeArguments :: [TypeArgument], + methodReference_ExpressionIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_MethodReference_Expression = (Core.Name "hydra/ext/java/syntax.MethodReference.Expression") + +_MethodReference_Expression_name = (Core.Name "name") + +_MethodReference_Expression_typeArguments = (Core.Name "typeArguments") + +_MethodReference_Expression_identifier = (Core.Name "identifier") + +data MethodReference_Primary = + MethodReference_Primary { + methodReference_PrimaryPrimary :: Primary, + methodReference_PrimaryTypeArguments :: [TypeArgument], + methodReference_PrimaryIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_MethodReference_Primary = (Core.Name "hydra/ext/java/syntax.MethodReference.Primary") + +_MethodReference_Primary_primary = (Core.Name "primary") + +_MethodReference_Primary_typeArguments = (Core.Name "typeArguments") + +_MethodReference_Primary_identifier = (Core.Name "identifier") + +data MethodReference_ReferenceType = + MethodReference_ReferenceType { + methodReference_ReferenceTypeReferenceType :: ReferenceType, + methodReference_ReferenceTypeTypeArguments :: [TypeArgument], + methodReference_ReferenceTypeIdentifier :: Identifier} + deriving (Eq, Ord, Read, Show) + +_MethodReference_ReferenceType = (Core.Name "hydra/ext/java/syntax.MethodReference.ReferenceType") + +_MethodReference_ReferenceType_referenceType = (Core.Name "referenceType") + +_MethodReference_ReferenceType_typeArguments = (Core.Name "typeArguments") + +_MethodReference_ReferenceType_identifier = (Core.Name "identifier") + +data MethodReference_Super = + MethodReference_Super { + methodReference_SuperTypeArguments :: [TypeArgument], + methodReference_SuperIdentifier :: Identifier, + methodReference_SuperSuper :: Bool} + deriving (Eq, Ord, Read, Show) + +_MethodReference_Super = (Core.Name "hydra/ext/java/syntax.MethodReference.Super") + +_MethodReference_Super_typeArguments = (Core.Name "typeArguments") + +_MethodReference_Super_identifier = (Core.Name "identifier") + +_MethodReference_Super_super = (Core.Name "super") + +data MethodReference_New = + MethodReference_New { + methodReference_NewClassType :: ClassType, + methodReference_NewTypeArguments :: [TypeArgument]} + deriving (Eq, Ord, Read, Show) + +_MethodReference_New = (Core.Name "hydra/ext/java/syntax.MethodReference.New") + +_MethodReference_New_classType = (Core.Name "classType") + +_MethodReference_New_typeArguments = (Core.Name "typeArguments") + +newtype MethodReference_Array = + MethodReference_Array { + unMethodReference_Array :: ArrayType} + deriving (Eq, Ord, Read, Show) + +_MethodReference_Array = (Core.Name "hydra/ext/java/syntax.MethodReference.Array") + +data ArrayCreationExpression = + ArrayCreationExpressionPrimitive ArrayCreationExpression_Primitive | + ArrayCreationExpressionClassOrInterface ArrayCreationExpression_ClassOrInterface | + ArrayCreationExpressionPrimitiveArray ArrayCreationExpression_PrimitiveArray | + ArrayCreationExpressionClassOrInterfaceArray ArrayCreationExpression_ClassOrInterfaceArray + deriving (Eq, Ord, Read, Show) + +_ArrayCreationExpression = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression") + +_ArrayCreationExpression_primitive = (Core.Name "primitive") + +_ArrayCreationExpression_classOrInterface = (Core.Name "classOrInterface") + +_ArrayCreationExpression_primitiveArray = (Core.Name "primitiveArray") + +_ArrayCreationExpression_classOrInterfaceArray = (Core.Name "classOrInterfaceArray") + +data ArrayCreationExpression_Primitive = + ArrayCreationExpression_Primitive { + arrayCreationExpression_PrimitiveType :: PrimitiveTypeWithAnnotations, + arrayCreationExpression_PrimitiveDimExprs :: [DimExpr], + arrayCreationExpression_PrimitiveDims :: (Maybe Dims)} + deriving (Eq, Ord, Read, Show) + +_ArrayCreationExpression_Primitive = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.Primitive") + +_ArrayCreationExpression_Primitive_type = (Core.Name "type") + +_ArrayCreationExpression_Primitive_dimExprs = (Core.Name "dimExprs") + +_ArrayCreationExpression_Primitive_dims = (Core.Name "dims") + +data ArrayCreationExpression_ClassOrInterface = + ArrayCreationExpression_ClassOrInterface { + arrayCreationExpression_ClassOrInterfaceType :: ClassOrInterfaceType, + arrayCreationExpression_ClassOrInterfaceDimExprs :: [DimExpr], + arrayCreationExpression_ClassOrInterfaceDims :: (Maybe Dims)} + deriving (Eq, Ord, Read, Show) + +_ArrayCreationExpression_ClassOrInterface = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.ClassOrInterface") + +_ArrayCreationExpression_ClassOrInterface_type = (Core.Name "type") + +_ArrayCreationExpression_ClassOrInterface_dimExprs = (Core.Name "dimExprs") + +_ArrayCreationExpression_ClassOrInterface_dims = (Core.Name "dims") + +data ArrayCreationExpression_PrimitiveArray = + ArrayCreationExpression_PrimitiveArray { + arrayCreationExpression_PrimitiveArrayType :: PrimitiveTypeWithAnnotations, + arrayCreationExpression_PrimitiveArrayDims :: [Dims], + arrayCreationExpression_PrimitiveArrayArray :: ArrayInitializer} + deriving (Eq, Ord, Read, Show) + +_ArrayCreationExpression_PrimitiveArray = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.PrimitiveArray") + +_ArrayCreationExpression_PrimitiveArray_type = (Core.Name "type") + +_ArrayCreationExpression_PrimitiveArray_dims = (Core.Name "dims") + +_ArrayCreationExpression_PrimitiveArray_array = (Core.Name "array") + +data ArrayCreationExpression_ClassOrInterfaceArray = + ArrayCreationExpression_ClassOrInterfaceArray { + arrayCreationExpression_ClassOrInterfaceArrayType :: ClassOrInterfaceType, + arrayCreationExpression_ClassOrInterfaceArrayDims :: [Dims], + arrayCreationExpression_ClassOrInterfaceArrayArray :: ArrayInitializer} + deriving (Eq, Ord, Read, Show) + +_ArrayCreationExpression_ClassOrInterfaceArray = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.ClassOrInterfaceArray") + +_ArrayCreationExpression_ClassOrInterfaceArray_type = (Core.Name "type") + +_ArrayCreationExpression_ClassOrInterfaceArray_dims = (Core.Name "dims") + +_ArrayCreationExpression_ClassOrInterfaceArray_array = (Core.Name "array") + +data DimExpr = + DimExpr { + dimExprAnnotations :: [Annotation], + dimExprExpression :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_DimExpr = (Core.Name "hydra/ext/java/syntax.DimExpr") + +_DimExpr_annotations = (Core.Name "annotations") + +_DimExpr_expression = (Core.Name "expression") + +data Expression = + ExpressionLambda LambdaExpression | + ExpressionAssignment AssignmentExpression + deriving (Eq, Ord, Read, Show) + +_Expression = (Core.Name "hydra/ext/java/syntax.Expression") + +_Expression_lambda = (Core.Name "lambda") + +_Expression_assignment = (Core.Name "assignment") + +data LambdaExpression = + LambdaExpression { + lambdaExpressionParameters :: LambdaParameters, + lambdaExpressionBody :: LambdaBody} + deriving (Eq, Ord, Read, Show) + +_LambdaExpression = (Core.Name "hydra/ext/java/syntax.LambdaExpression") + +_LambdaExpression_parameters = (Core.Name "parameters") + +_LambdaExpression_body = (Core.Name "body") + +data LambdaParameters = + LambdaParametersTuple [LambdaParameters] | + LambdaParametersSingle Identifier + deriving (Eq, Ord, Read, Show) + +_LambdaParameters = (Core.Name "hydra/ext/java/syntax.LambdaParameters") + +_LambdaParameters_tuple = (Core.Name "tuple") + +_LambdaParameters_single = (Core.Name "single") + +data LambdaParameter = + LambdaParameterNormal LambdaParameter_Normal | + LambdaParameterVariableArity VariableArityParameter + deriving (Eq, Ord, Read, Show) + +_LambdaParameter = (Core.Name "hydra/ext/java/syntax.LambdaParameter") + +_LambdaParameter_normal = (Core.Name "normal") + +_LambdaParameter_variableArity = (Core.Name "variableArity") + +data LambdaParameter_Normal = + LambdaParameter_Normal { + lambdaParameter_NormalModifiers :: [VariableModifier], + lambdaParameter_NormalType :: LambdaParameterType, + lambdaParameter_NormalId :: VariableDeclaratorId} + deriving (Eq, Ord, Read, Show) + +_LambdaParameter_Normal = (Core.Name "hydra/ext/java/syntax.LambdaParameter.Normal") + +_LambdaParameter_Normal_modifiers = (Core.Name "modifiers") + +_LambdaParameter_Normal_type = (Core.Name "type") + +_LambdaParameter_Normal_id = (Core.Name "id") + +data LambdaParameterType = + LambdaParameterTypeType UnannType | + LambdaParameterTypeVar + deriving (Eq, Ord, Read, Show) + +_LambdaParameterType = (Core.Name "hydra/ext/java/syntax.LambdaParameterType") + +_LambdaParameterType_type = (Core.Name "type") + +_LambdaParameterType_var = (Core.Name "var") + +data LambdaBody = + LambdaBodyExpression Expression | + LambdaBodyBlock Block + deriving (Eq, Ord, Read, Show) + +_LambdaBody = (Core.Name "hydra/ext/java/syntax.LambdaBody") + +_LambdaBody_expression = (Core.Name "expression") + +_LambdaBody_block = (Core.Name "block") + +data AssignmentExpression = + AssignmentExpressionConditional ConditionalExpression | + AssignmentExpressionAssignment Assignment + deriving (Eq, Ord, Read, Show) + +_AssignmentExpression = (Core.Name "hydra/ext/java/syntax.AssignmentExpression") + +_AssignmentExpression_conditional = (Core.Name "conditional") + +_AssignmentExpression_assignment = (Core.Name "assignment") + +data Assignment = + Assignment { + assignmentLhs :: LeftHandSide, + assignmentOp :: AssignmentOperator, + assignmentExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_Assignment = (Core.Name "hydra/ext/java/syntax.Assignment") + +_Assignment_lhs = (Core.Name "lhs") + +_Assignment_op = (Core.Name "op") + +_Assignment_expression = (Core.Name "expression") + +data LeftHandSide = + LeftHandSideExpressionName ExpressionName | + LeftHandSideFieldAccess FieldAccess | + LeftHandSideArrayAccess ArrayAccess + deriving (Eq, Ord, Read, Show) + +_LeftHandSide = (Core.Name "hydra/ext/java/syntax.LeftHandSide") + +_LeftHandSide_expressionName = (Core.Name "expressionName") + +_LeftHandSide_fieldAccess = (Core.Name "fieldAccess") + +_LeftHandSide_arrayAccess = (Core.Name "arrayAccess") + +data AssignmentOperator = + AssignmentOperatorSimple | + AssignmentOperatorTimes | + AssignmentOperatorDiv | + AssignmentOperatorMod | + AssignmentOperatorPlus | + AssignmentOperatorMinus | + AssignmentOperatorShiftLeft | + AssignmentOperatorShiftRight | + AssignmentOperatorShiftRightZeroFill | + AssignmentOperatorAnd | + AssignmentOperatorXor | + AssignmentOperatorOr + deriving (Eq, Ord, Read, Show) + +_AssignmentOperator = (Core.Name "hydra/ext/java/syntax.AssignmentOperator") + +_AssignmentOperator_simple = (Core.Name "simple") + +_AssignmentOperator_times = (Core.Name "times") + +_AssignmentOperator_div = (Core.Name "div") + +_AssignmentOperator_mod = (Core.Name "mod") + +_AssignmentOperator_plus = (Core.Name "plus") + +_AssignmentOperator_minus = (Core.Name "minus") + +_AssignmentOperator_shiftLeft = (Core.Name "shiftLeft") + +_AssignmentOperator_shiftRight = (Core.Name "shiftRight") + +_AssignmentOperator_shiftRightZeroFill = (Core.Name "shiftRightZeroFill") + +_AssignmentOperator_and = (Core.Name "and") + +_AssignmentOperator_xor = (Core.Name "xor") + +_AssignmentOperator_or = (Core.Name "or") + +data ConditionalExpression = + ConditionalExpressionSimple ConditionalOrExpression | + ConditionalExpressionTernaryCond ConditionalExpression_TernaryCond | + ConditionalExpressionTernaryLambda ConditionalExpression_TernaryLambda + deriving (Eq, Ord, Read, Show) + +_ConditionalExpression = (Core.Name "hydra/ext/java/syntax.ConditionalExpression") + +_ConditionalExpression_simple = (Core.Name "simple") + +_ConditionalExpression_ternaryCond = (Core.Name "ternaryCond") + +_ConditionalExpression_ternaryLambda = (Core.Name "ternaryLambda") + +data ConditionalExpression_TernaryCond = + ConditionalExpression_TernaryCond { + conditionalExpression_TernaryCondCond :: ConditionalOrExpression, + conditionalExpression_TernaryCondIfTrue :: Expression, + conditionalExpression_TernaryCondIfFalse :: ConditionalExpression} + deriving (Eq, Ord, Read, Show) + +_ConditionalExpression_TernaryCond = (Core.Name "hydra/ext/java/syntax.ConditionalExpression.TernaryCond") + +_ConditionalExpression_TernaryCond_cond = (Core.Name "cond") + +_ConditionalExpression_TernaryCond_ifTrue = (Core.Name "ifTrue") + +_ConditionalExpression_TernaryCond_ifFalse = (Core.Name "ifFalse") + +data ConditionalExpression_TernaryLambda = + ConditionalExpression_TernaryLambda { + conditionalExpression_TernaryLambdaCond :: ConditionalOrExpression, + conditionalExpression_TernaryLambdaIfTrue :: Expression, + conditionalExpression_TernaryLambdaIfFalse :: LambdaExpression} + deriving (Eq, Ord, Read, Show) + +_ConditionalExpression_TernaryLambda = (Core.Name "hydra/ext/java/syntax.ConditionalExpression.TernaryLambda") + +_ConditionalExpression_TernaryLambda_cond = (Core.Name "cond") + +_ConditionalExpression_TernaryLambda_ifTrue = (Core.Name "ifTrue") + +_ConditionalExpression_TernaryLambda_ifFalse = (Core.Name "ifFalse") + +newtype ConditionalOrExpression = + ConditionalOrExpression { + unConditionalOrExpression :: [ConditionalAndExpression]} + deriving (Eq, Ord, Read, Show) + +_ConditionalOrExpression = (Core.Name "hydra/ext/java/syntax.ConditionalOrExpression") + +newtype ConditionalAndExpression = + ConditionalAndExpression { + unConditionalAndExpression :: [InclusiveOrExpression]} + deriving (Eq, Ord, Read, Show) + +_ConditionalAndExpression = (Core.Name "hydra/ext/java/syntax.ConditionalAndExpression") + +newtype InclusiveOrExpression = + InclusiveOrExpression { + unInclusiveOrExpression :: [ExclusiveOrExpression]} + deriving (Eq, Ord, Read, Show) + +_InclusiveOrExpression = (Core.Name "hydra/ext/java/syntax.InclusiveOrExpression") + +newtype ExclusiveOrExpression = + ExclusiveOrExpression { + unExclusiveOrExpression :: [AndExpression]} + deriving (Eq, Ord, Read, Show) + +_ExclusiveOrExpression = (Core.Name "hydra/ext/java/syntax.ExclusiveOrExpression") + +newtype AndExpression = + AndExpression { + unAndExpression :: [EqualityExpression]} + deriving (Eq, Ord, Read, Show) + +_AndExpression = (Core.Name "hydra/ext/java/syntax.AndExpression") + +data EqualityExpression = + EqualityExpressionUnary RelationalExpression | + EqualityExpressionEqual EqualityExpression_Binary | + EqualityExpressionNotEqual EqualityExpression_Binary + deriving (Eq, Ord, Read, Show) + +_EqualityExpression = (Core.Name "hydra/ext/java/syntax.EqualityExpression") + +_EqualityExpression_unary = (Core.Name "unary") + +_EqualityExpression_equal = (Core.Name "equal") + +_EqualityExpression_notEqual = (Core.Name "notEqual") + +data EqualityExpression_Binary = + EqualityExpression_Binary { + equalityExpression_BinaryLhs :: EqualityExpression, + equalityExpression_BinaryRhs :: RelationalExpression} + deriving (Eq, Ord, Read, Show) + +_EqualityExpression_Binary = (Core.Name "hydra/ext/java/syntax.EqualityExpression.Binary") + +_EqualityExpression_Binary_lhs = (Core.Name "lhs") + +_EqualityExpression_Binary_rhs = (Core.Name "rhs") + +data RelationalExpression = + RelationalExpressionSimple ShiftExpression | + RelationalExpressionLessThan RelationalExpression_LessThan | + RelationalExpressionGreaterThan RelationalExpression_GreaterThan | + RelationalExpressionLessThanEqual RelationalExpression_LessThanEqual | + RelationalExpressionGreaterThanEqual RelationalExpression_GreaterThanEqual | + RelationalExpressionInstanceof RelationalExpression_InstanceOf + deriving (Eq, Ord, Read, Show) + +_RelationalExpression = (Core.Name "hydra/ext/java/syntax.RelationalExpression") + +_RelationalExpression_simple = (Core.Name "simple") + +_RelationalExpression_lessThan = (Core.Name "lessThan") + +_RelationalExpression_greaterThan = (Core.Name "greaterThan") + +_RelationalExpression_lessThanEqual = (Core.Name "lessThanEqual") + +_RelationalExpression_greaterThanEqual = (Core.Name "greaterThanEqual") + +_RelationalExpression_instanceof = (Core.Name "instanceof") + +data RelationalExpression_LessThan = + RelationalExpression_LessThan { + relationalExpression_LessThanLhs :: RelationalExpression, + relationalExpression_LessThanRhs :: ShiftExpression} + deriving (Eq, Ord, Read, Show) + +_RelationalExpression_LessThan = (Core.Name "hydra/ext/java/syntax.RelationalExpression.LessThan") + +_RelationalExpression_LessThan_lhs = (Core.Name "lhs") + +_RelationalExpression_LessThan_rhs = (Core.Name "rhs") + +data RelationalExpression_GreaterThan = + RelationalExpression_GreaterThan { + relationalExpression_GreaterThanLhs :: RelationalExpression, + relationalExpression_GreaterThanRhs :: ShiftExpression} + deriving (Eq, Ord, Read, Show) + +_RelationalExpression_GreaterThan = (Core.Name "hydra/ext/java/syntax.RelationalExpression.GreaterThan") + +_RelationalExpression_GreaterThan_lhs = (Core.Name "lhs") + +_RelationalExpression_GreaterThan_rhs = (Core.Name "rhs") + +data RelationalExpression_LessThanEqual = + RelationalExpression_LessThanEqual { + relationalExpression_LessThanEqualLhs :: RelationalExpression, + relationalExpression_LessThanEqualRhs :: ShiftExpression} + deriving (Eq, Ord, Read, Show) + +_RelationalExpression_LessThanEqual = (Core.Name "hydra/ext/java/syntax.RelationalExpression.LessThanEqual") + +_RelationalExpression_LessThanEqual_lhs = (Core.Name "lhs") + +_RelationalExpression_LessThanEqual_rhs = (Core.Name "rhs") + +data RelationalExpression_GreaterThanEqual = + RelationalExpression_GreaterThanEqual { + relationalExpression_GreaterThanEqualLhs :: RelationalExpression, + relationalExpression_GreaterThanEqualRhs :: ShiftExpression} + deriving (Eq, Ord, Read, Show) + +_RelationalExpression_GreaterThanEqual = (Core.Name "hydra/ext/java/syntax.RelationalExpression.GreaterThanEqual") + +_RelationalExpression_GreaterThanEqual_lhs = (Core.Name "lhs") + +_RelationalExpression_GreaterThanEqual_rhs = (Core.Name "rhs") + +data RelationalExpression_InstanceOf = + RelationalExpression_InstanceOf { + relationalExpression_InstanceOfLhs :: RelationalExpression, + relationalExpression_InstanceOfRhs :: ReferenceType} + deriving (Eq, Ord, Read, Show) + +_RelationalExpression_InstanceOf = (Core.Name "hydra/ext/java/syntax.RelationalExpression.InstanceOf") + +_RelationalExpression_InstanceOf_lhs = (Core.Name "lhs") + +_RelationalExpression_InstanceOf_rhs = (Core.Name "rhs") + +data ShiftExpression = + ShiftExpressionUnary AdditiveExpression | + ShiftExpressionShiftLeft ShiftExpression_Binary | + ShiftExpressionShiftRight ShiftExpression_Binary | + ShiftExpressionShiftRightZeroFill ShiftExpression_Binary + deriving (Eq, Ord, Read, Show) + +_ShiftExpression = (Core.Name "hydra/ext/java/syntax.ShiftExpression") + +_ShiftExpression_unary = (Core.Name "unary") + +_ShiftExpression_shiftLeft = (Core.Name "shiftLeft") + +_ShiftExpression_shiftRight = (Core.Name "shiftRight") + +_ShiftExpression_shiftRightZeroFill = (Core.Name "shiftRightZeroFill") + +data ShiftExpression_Binary = + ShiftExpression_Binary { + shiftExpression_BinaryLhs :: ShiftExpression, + shiftExpression_BinaryRhs :: AdditiveExpression} + deriving (Eq, Ord, Read, Show) + +_ShiftExpression_Binary = (Core.Name "hydra/ext/java/syntax.ShiftExpression.Binary") + +_ShiftExpression_Binary_lhs = (Core.Name "lhs") + +_ShiftExpression_Binary_rhs = (Core.Name "rhs") + +data AdditiveExpression = + AdditiveExpressionUnary MultiplicativeExpression | + AdditiveExpressionPlus AdditiveExpression_Binary | + AdditiveExpressionMinus AdditiveExpression_Binary + deriving (Eq, Ord, Read, Show) + +_AdditiveExpression = (Core.Name "hydra/ext/java/syntax.AdditiveExpression") + +_AdditiveExpression_unary = (Core.Name "unary") + +_AdditiveExpression_plus = (Core.Name "plus") + +_AdditiveExpression_minus = (Core.Name "minus") + +data AdditiveExpression_Binary = + AdditiveExpression_Binary { + additiveExpression_BinaryLhs :: AdditiveExpression, + additiveExpression_BinaryRhs :: MultiplicativeExpression} + deriving (Eq, Ord, Read, Show) + +_AdditiveExpression_Binary = (Core.Name "hydra/ext/java/syntax.AdditiveExpression.Binary") + +_AdditiveExpression_Binary_lhs = (Core.Name "lhs") + +_AdditiveExpression_Binary_rhs = (Core.Name "rhs") + +data MultiplicativeExpression = + MultiplicativeExpressionUnary UnaryExpression | + MultiplicativeExpressionTimes MultiplicativeExpression_Binary | + MultiplicativeExpressionDivide MultiplicativeExpression_Binary | + MultiplicativeExpressionMod MultiplicativeExpression_Binary + deriving (Eq, Ord, Read, Show) + +_MultiplicativeExpression = (Core.Name "hydra/ext/java/syntax.MultiplicativeExpression") + +_MultiplicativeExpression_unary = (Core.Name "unary") + +_MultiplicativeExpression_times = (Core.Name "times") + +_MultiplicativeExpression_divide = (Core.Name "divide") + +_MultiplicativeExpression_mod = (Core.Name "mod") + +data MultiplicativeExpression_Binary = + MultiplicativeExpression_Binary { + multiplicativeExpression_BinaryLhs :: MultiplicativeExpression, + multiplicativeExpression_BinaryRhs :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_MultiplicativeExpression_Binary = (Core.Name "hydra/ext/java/syntax.MultiplicativeExpression.Binary") + +_MultiplicativeExpression_Binary_lhs = (Core.Name "lhs") + +_MultiplicativeExpression_Binary_rhs = (Core.Name "rhs") + +data UnaryExpression = + UnaryExpressionPreIncrement PreIncrementExpression | + UnaryExpressionPreDecrement PreDecrementExpression | + UnaryExpressionPlus UnaryExpression | + UnaryExpressionMinus UnaryExpression | + UnaryExpressionOther UnaryExpressionNotPlusMinus + deriving (Eq, Ord, Read, Show) + +_UnaryExpression = (Core.Name "hydra/ext/java/syntax.UnaryExpression") + +_UnaryExpression_preIncrement = (Core.Name "preIncrement") + +_UnaryExpression_preDecrement = (Core.Name "preDecrement") + +_UnaryExpression_plus = (Core.Name "plus") + +_UnaryExpression_minus = (Core.Name "minus") + +_UnaryExpression_other = (Core.Name "other") + +newtype PreIncrementExpression = + PreIncrementExpression { + unPreIncrementExpression :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_PreIncrementExpression = (Core.Name "hydra/ext/java/syntax.PreIncrementExpression") + +newtype PreDecrementExpression = + PreDecrementExpression { + unPreDecrementExpression :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_PreDecrementExpression = (Core.Name "hydra/ext/java/syntax.PreDecrementExpression") + +data UnaryExpressionNotPlusMinus = + UnaryExpressionNotPlusMinusPostfix PostfixExpression | + UnaryExpressionNotPlusMinusTilde UnaryExpression | + UnaryExpressionNotPlusMinusNot UnaryExpression | + UnaryExpressionNotPlusMinusCast CastExpression + deriving (Eq, Ord, Read, Show) + +_UnaryExpressionNotPlusMinus = (Core.Name "hydra/ext/java/syntax.UnaryExpressionNotPlusMinus") + +_UnaryExpressionNotPlusMinus_postfix = (Core.Name "postfix") + +_UnaryExpressionNotPlusMinus_tilde = (Core.Name "tilde") + +_UnaryExpressionNotPlusMinus_not = (Core.Name "not") + +_UnaryExpressionNotPlusMinus_cast = (Core.Name "cast") + +data PostfixExpression = + PostfixExpressionPrimary Primary | + PostfixExpressionName ExpressionName | + PostfixExpressionPostIncrement PostIncrementExpression | + PostfixExpressionPostDecrement PostDecrementExpression + deriving (Eq, Ord, Read, Show) + +_PostfixExpression = (Core.Name "hydra/ext/java/syntax.PostfixExpression") + +_PostfixExpression_primary = (Core.Name "primary") + +_PostfixExpression_name = (Core.Name "name") + +_PostfixExpression_postIncrement = (Core.Name "postIncrement") + +_PostfixExpression_postDecrement = (Core.Name "postDecrement") + +newtype PostIncrementExpression = + PostIncrementExpression { + unPostIncrementExpression :: PostfixExpression} + deriving (Eq, Ord, Read, Show) + +_PostIncrementExpression = (Core.Name "hydra/ext/java/syntax.PostIncrementExpression") + +newtype PostDecrementExpression = + PostDecrementExpression { + unPostDecrementExpression :: PostfixExpression} + deriving (Eq, Ord, Read, Show) + +_PostDecrementExpression = (Core.Name "hydra/ext/java/syntax.PostDecrementExpression") + +data CastExpression = + CastExpressionPrimitive CastExpression_Primitive | + CastExpressionNotPlusMinus CastExpression_NotPlusMinus | + CastExpressionLambda CastExpression_Lambda + deriving (Eq, Ord, Read, Show) + +_CastExpression = (Core.Name "hydra/ext/java/syntax.CastExpression") + +_CastExpression_primitive = (Core.Name "primitive") + +_CastExpression_notPlusMinus = (Core.Name "notPlusMinus") + +_CastExpression_lambda = (Core.Name "lambda") + +data CastExpression_Primitive = + CastExpression_Primitive { + castExpression_PrimitiveType :: PrimitiveTypeWithAnnotations, + castExpression_PrimitiveExpression :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_CastExpression_Primitive = (Core.Name "hydra/ext/java/syntax.CastExpression.Primitive") + +_CastExpression_Primitive_type = (Core.Name "type") + +_CastExpression_Primitive_expression = (Core.Name "expression") + +data CastExpression_NotPlusMinus = + CastExpression_NotPlusMinus { + castExpression_NotPlusMinusRefAndBounds :: CastExpression_RefAndBounds, + castExpression_NotPlusMinusExpression :: UnaryExpression} + deriving (Eq, Ord, Read, Show) + +_CastExpression_NotPlusMinus = (Core.Name "hydra/ext/java/syntax.CastExpression.NotPlusMinus") + +_CastExpression_NotPlusMinus_refAndBounds = (Core.Name "refAndBounds") + +_CastExpression_NotPlusMinus_expression = (Core.Name "expression") + +data CastExpression_Lambda = + CastExpression_Lambda { + castExpression_LambdaRefAndBounds :: CastExpression_RefAndBounds, + castExpression_LambdaExpression :: LambdaExpression} + deriving (Eq, Ord, Read, Show) + +_CastExpression_Lambda = (Core.Name "hydra/ext/java/syntax.CastExpression.Lambda") + +_CastExpression_Lambda_refAndBounds = (Core.Name "refAndBounds") + +_CastExpression_Lambda_expression = (Core.Name "expression") + +data CastExpression_RefAndBounds = + CastExpression_RefAndBounds { + castExpression_RefAndBoundsType :: ReferenceType, + castExpression_RefAndBoundsBounds :: [AdditionalBound]} + deriving (Eq, Ord, Read, Show) + +_CastExpression_RefAndBounds = (Core.Name "hydra/ext/java/syntax.CastExpression.RefAndBounds") + +_CastExpression_RefAndBounds_type = (Core.Name "type") + +_CastExpression_RefAndBounds_bounds = (Core.Name "bounds") + +newtype ConstantExpression = + ConstantExpression { + unConstantExpression :: Expression} + deriving (Eq, Ord, Read, Show) + +_ConstantExpression = (Core.Name "hydra/ext/java/syntax.ConstantExpression") diff --git a/src/gen-main/haskell/Hydra/Ext/Org/Apache/Avro/Schema.hs b/src/gen-main/haskell/Hydra/Ext/Org/Apache/Avro/Schema.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Org/Apache/Avro/Schema.hs @@ -0,0 +1,222 @@ +-- | A model for Avro schemas. Based on the Avro 1.11.1 specification: +-- | https://avro.apache.org/docs/1.11.1/specification + +module Hydra.Ext.Org.Apache.Avro.Schema where + +import qualified Hydra.Core as Core +import qualified Hydra.Json as Json +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +data Array = + Array { + arrayItems :: Schema} + deriving (Eq, Ord, Read, Show) + +_Array = (Core.Name "hydra/ext/org/apache/avro/schema.Array") + +_Array_items = (Core.Name "items") + +data Enum_ = + Enum_ { + -- | a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* (the same requirement as for names) + enumSymbols :: [String], + -- | A default value for this enumeration, used during resolution when the reader encounters a symbol from the writer that isn't defined in the reader's schema. The value provided here must be a JSON string that's a member of the symbols array + enumDefault :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_Enum = (Core.Name "hydra/ext/org/apache/avro/schema.Enum") + +_Enum_symbols = (Core.Name "symbols") + +_Enum_default = (Core.Name "default") + +data Field = + Field { + -- | a JSON string providing the name of the field + fieldName :: String, + -- | a JSON string describing this field for users + fieldDoc :: (Maybe String), + -- | a schema + fieldType :: Schema, + -- | default value for this field, only used when reading instances that lack the field for schema evolution purposes + fieldDefault :: (Maybe Json.Value), + -- | specifies how this field impacts sort ordering of this record + fieldOrder :: (Maybe Order), + -- | a JSON array of strings, providing alternate names for this field + fieldAliases :: (Maybe [String]), + -- | Any additional key/value pairs attached to the field + fieldAnnotations :: (Map String Json.Value)} + deriving (Eq, Ord, Read, Show) + +_Field = (Core.Name "hydra/ext/org/apache/avro/schema.Field") + +_Field_name = (Core.Name "name") + +_Field_doc = (Core.Name "doc") + +_Field_type = (Core.Name "type") + +_Field_default = (Core.Name "default") + +_Field_order = (Core.Name "order") + +_Field_aliases = (Core.Name "aliases") + +_Field_annotations = (Core.Name "annotations") + +data Fixed = + Fixed { + -- | an integer, specifying the number of bytes per value + fixedSize :: Int} + deriving (Eq, Ord, Read, Show) + +_Fixed = (Core.Name "hydra/ext/org/apache/avro/schema.Fixed") + +_Fixed_size = (Core.Name "size") + +data Map_ = + Map_ { + mapValues :: Schema} + deriving (Eq, Ord, Read, Show) + +_Map = (Core.Name "hydra/ext/org/apache/avro/schema.Map") + +_Map_values = (Core.Name "values") + +data Named = + Named { + -- | a string naming this schema + namedName :: String, + -- | a string that qualifies the name + namedNamespace :: (Maybe String), + -- | a JSON array of strings, providing alternate names for this schema + namedAliases :: (Maybe [String]), + -- | a JSON string providing documentation to the user of this schema + namedDoc :: (Maybe String), + namedType :: NamedType, + -- | Any additional key/value pairs attached to the type + namedAnnotations :: (Map String Json.Value)} + deriving (Eq, Ord, Read, Show) + +_Named = (Core.Name "hydra/ext/org/apache/avro/schema.Named") + +_Named_name = (Core.Name "name") + +_Named_namespace = (Core.Name "namespace") + +_Named_aliases = (Core.Name "aliases") + +_Named_doc = (Core.Name "doc") + +_Named_type = (Core.Name "type") + +_Named_annotations = (Core.Name "annotations") + +data NamedType = + NamedTypeEnum Enum_ | + NamedTypeFixed Fixed | + NamedTypeRecord Record + deriving (Eq, Ord, Read, Show) + +_NamedType = (Core.Name "hydra/ext/org/apache/avro/schema.NamedType") + +_NamedType_enum = (Core.Name "enum") + +_NamedType_fixed = (Core.Name "fixed") + +_NamedType_record = (Core.Name "record") + +data Order = + OrderAscending | + OrderDescending | + OrderIgnore + deriving (Eq, Ord, Read, Show) + +_Order = (Core.Name "hydra/ext/org/apache/avro/schema.Order") + +_Order_ascending = (Core.Name "ascending") + +_Order_descending = (Core.Name "descending") + +_Order_ignore = (Core.Name "ignore") + +data Primitive = + -- | no value + PrimitiveNull | + -- | A binary value + PrimitiveBoolean | + -- | 32-bit signed integer + PrimitiveInt | + -- | 64-bit signed integer + PrimitiveLong | + -- | single precision (32-bit) IEEE 754 floating-point number + PrimitiveFloat | + -- | double precision (64-bit) IEEE 754 floating-point number + PrimitiveDouble | + -- | sequence of 8-bit unsigned bytes + PrimitiveBytes | + -- | unicode character sequence + PrimitiveString + deriving (Eq, Ord, Read, Show) + +_Primitive = (Core.Name "hydra/ext/org/apache/avro/schema.Primitive") + +_Primitive_null = (Core.Name "null") + +_Primitive_boolean = (Core.Name "boolean") + +_Primitive_int = (Core.Name "int") + +_Primitive_long = (Core.Name "long") + +_Primitive_float = (Core.Name "float") + +_Primitive_double = (Core.Name "double") + +_Primitive_bytes = (Core.Name "bytes") + +_Primitive_string = (Core.Name "string") + +data Record = + Record { + -- | a JSON array, listing fields + recordFields :: [Field]} + deriving (Eq, Ord, Read, Show) + +_Record = (Core.Name "hydra/ext/org/apache/avro/schema.Record") + +_Record_fields = (Core.Name "fields") + +data Schema = + SchemaArray Array | + SchemaMap Map_ | + SchemaNamed Named | + SchemaPrimitive Primitive | + -- | A reference by name to a previously defined type + SchemaReference String | + SchemaUnion Union + deriving (Eq, Ord, Read, Show) + +_Schema = (Core.Name "hydra/ext/org/apache/avro/schema.Schema") + +_Schema_array = (Core.Name "array") + +_Schema_map = (Core.Name "map") + +_Schema_named = (Core.Name "named") + +_Schema_primitive = (Core.Name "primitive") + +_Schema_reference = (Core.Name "reference") + +_Schema_union = (Core.Name "union") + +newtype Union = + Union { + unUnion :: [Schema]} + deriving (Eq, Ord, Read, Show) + +_Union = (Core.Name "hydra/ext/org/apache/avro/schema.Union") diff --git a/src/gen-main/haskell/Hydra/Ext/Org/Graphql/Syntax.hs b/src/gen-main/haskell/Hydra/Ext/Org/Graphql/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Org/Graphql/Syntax.hs @@ -0,0 +1,1299 @@ +-- | A GraphQL model. Based on the (extended) BNF at: +-- | https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary + +module Hydra.Ext.Org.Graphql.Syntax where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +newtype Name = + Name { + unName :: String} + deriving (Eq, Ord, Read, Show) + +_Name = (Core.Name "hydra/ext/org/graphql/syntax.Name") + +newtype IntValue = + IntValue { + unIntValue :: String} + deriving (Eq, Ord, Read, Show) + +_IntValue = (Core.Name "hydra/ext/org/graphql/syntax.IntValue") + +newtype FloatValue = + FloatValue { + unFloatValue :: String} + deriving (Eq, Ord, Read, Show) + +_FloatValue = (Core.Name "hydra/ext/org/graphql/syntax.FloatValue") + +newtype StringValue = + StringValue { + unStringValue :: String} + deriving (Eq, Ord, Read, Show) + +_StringValue = (Core.Name "hydra/ext/org/graphql/syntax.StringValue") + +newtype Document = + Document { + unDocument :: [Definition]} + deriving (Eq, Ord, Read, Show) + +_Document = (Core.Name "hydra/ext/org/graphql/syntax.Document") + +data Definition = + DefinitionExecutable ExecutableDefinition | + DefinitionTypeSystem TypeSystemDefinitionOrExtension + deriving (Eq, Ord, Read, Show) + +_Definition = (Core.Name "hydra/ext/org/graphql/syntax.Definition") + +_Definition_executable = (Core.Name "executable") + +_Definition_typeSystem = (Core.Name "typeSystem") + +newtype ExecutableDocument = + ExecutableDocument { + unExecutableDocument :: [ExecutableDefinition]} + deriving (Eq, Ord, Read, Show) + +_ExecutableDocument = (Core.Name "hydra/ext/org/graphql/syntax.ExecutableDocument") + +data ExecutableDefinition = + ExecutableDefinitionOperation OperationDefinition | + ExecutableDefinitionFragment FragmentDefinition + deriving (Eq, Ord, Read, Show) + +_ExecutableDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ExecutableDefinition") + +_ExecutableDefinition_operation = (Core.Name "operation") + +_ExecutableDefinition_fragment = (Core.Name "fragment") + +data OperationDefinition = + OperationDefinitionSequence OperationDefinition_Sequence | + OperationDefinitionSelectionSet SelectionSet + deriving (Eq, Ord, Read, Show) + +_OperationDefinition = (Core.Name "hydra/ext/org/graphql/syntax.OperationDefinition") + +_OperationDefinition_sequence = (Core.Name "sequence") + +_OperationDefinition_selectionSet = (Core.Name "selectionSet") + +data OperationDefinition_Sequence = + OperationDefinition_Sequence { + operationDefinition_SequenceOperationType :: OperationType, + operationDefinition_SequenceName :: (Maybe Name), + operationDefinition_SequenceVariablesDefinition :: (Maybe VariablesDefinition), + operationDefinition_SequenceDirectives :: (Maybe Directives), + operationDefinition_SequenceSelectionSet :: SelectionSet} + deriving (Eq, Ord, Read, Show) + +_OperationDefinition_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.OperationDefinition.Sequence") + +_OperationDefinition_Sequence_operationType = (Core.Name "operationType") + +_OperationDefinition_Sequence_name = (Core.Name "name") + +_OperationDefinition_Sequence_variablesDefinition = (Core.Name "variablesDefinition") + +_OperationDefinition_Sequence_directives = (Core.Name "directives") + +_OperationDefinition_Sequence_selectionSet = (Core.Name "selectionSet") + +data OperationType = + OperationTypeQuery | + OperationTypeMutation | + OperationTypeSubscription + deriving (Eq, Ord, Read, Show) + +_OperationType = (Core.Name "hydra/ext/org/graphql/syntax.OperationType") + +_OperationType_query = (Core.Name "query") + +_OperationType_mutation = (Core.Name "mutation") + +_OperationType_subscription = (Core.Name "subscription") + +newtype SelectionSet = + SelectionSet { + unSelectionSet :: [Selection]} + deriving (Eq, Ord, Read, Show) + +_SelectionSet = (Core.Name "hydra/ext/org/graphql/syntax.SelectionSet") + +data Selection = + SelectionField Field | + SelectionFragmentSpread FragmentSpread | + SelectionInlineFragment InlineFragment + deriving (Eq, Ord, Read, Show) + +_Selection = (Core.Name "hydra/ext/org/graphql/syntax.Selection") + +_Selection_field = (Core.Name "field") + +_Selection_fragmentSpread = (Core.Name "fragmentSpread") + +_Selection_inlineFragment = (Core.Name "inlineFragment") + +data Field = + Field { + fieldAlias :: (Maybe Alias), + fieldName :: Name, + fieldArguments :: (Maybe Arguments), + fieldDirectives :: (Maybe Directives), + fieldSelectionSet :: (Maybe SelectionSet)} + deriving (Eq, Ord, Read, Show) + +_Field = (Core.Name "hydra/ext/org/graphql/syntax.Field") + +_Field_alias = (Core.Name "alias") + +_Field_name = (Core.Name "name") + +_Field_arguments = (Core.Name "arguments") + +_Field_directives = (Core.Name "directives") + +_Field_selectionSet = (Core.Name "selectionSet") + +data Alias = + AliasName Name | + AliasColon + deriving (Eq, Ord, Read, Show) + +_Alias = (Core.Name "hydra/ext/org/graphql/syntax.Alias") + +_Alias_name = (Core.Name "name") + +_Alias_colon = (Core.Name "colon") + +newtype Arguments = + Arguments { + unArguments :: [Argument]} + deriving (Eq, Ord, Read, Show) + +_Arguments = (Core.Name "hydra/ext/org/graphql/syntax.Arguments") + +data Argument = + Argument { + argumentName :: Name, + argumentValue :: Value} + deriving (Eq, Ord, Read, Show) + +_Argument = (Core.Name "hydra/ext/org/graphql/syntax.Argument") + +_Argument_name = (Core.Name "name") + +_Argument_value = (Core.Name "value") + +data FragmentSpread = + FragmentSpread { + fragmentSpreadFragmentName :: FragmentName, + fragmentSpreadDirectives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_FragmentSpread = (Core.Name "hydra/ext/org/graphql/syntax.FragmentSpread") + +_FragmentSpread_fragmentName = (Core.Name "fragmentName") + +_FragmentSpread_directives = (Core.Name "directives") + +data InlineFragment = + InlineFragment { + inlineFragmentTypeCondition :: (Maybe TypeCondition), + inlineFragmentDirectives :: (Maybe Directives), + inlineFragmentSelectionSet :: SelectionSet} + deriving (Eq, Ord, Read, Show) + +_InlineFragment = (Core.Name "hydra/ext/org/graphql/syntax.InlineFragment") + +_InlineFragment_typeCondition = (Core.Name "typeCondition") + +_InlineFragment_directives = (Core.Name "directives") + +_InlineFragment_selectionSet = (Core.Name "selectionSet") + +data FragmentDefinition = + FragmentDefinition { + fragmentDefinitionFragmentName :: FragmentName, + fragmentDefinitionTypeCondition :: TypeCondition, + fragmentDefinitionDirectives :: (Maybe Directives), + fragmentDefinitionSelectionSet :: SelectionSet} + deriving (Eq, Ord, Read, Show) + +_FragmentDefinition = (Core.Name "hydra/ext/org/graphql/syntax.FragmentDefinition") + +_FragmentDefinition_fragmentName = (Core.Name "fragmentName") + +_FragmentDefinition_typeCondition = (Core.Name "typeCondition") + +_FragmentDefinition_directives = (Core.Name "directives") + +_FragmentDefinition_selectionSet = (Core.Name "selectionSet") + +newtype FragmentName = + FragmentName { + unFragmentName :: Name} + deriving (Eq, Ord, Read, Show) + +_FragmentName = (Core.Name "hydra/ext/org/graphql/syntax.FragmentName") + +data TypeCondition = + TypeConditionOn | + TypeConditionNamedType NamedType + deriving (Eq, Ord, Read, Show) + +_TypeCondition = (Core.Name "hydra/ext/org/graphql/syntax.TypeCondition") + +_TypeCondition_on = (Core.Name "on") + +_TypeCondition_namedType = (Core.Name "namedType") + +data Value = + ValueVariable Variable | + ValueInt IntValue | + ValueFloat FloatValue | + ValueString StringValue | + ValueBoolean BooleanValue | + ValueNull NullValue | + ValueEnum EnumValue | + ValueList ListValue | + ValueObject ObjectValue + deriving (Eq, Ord, Read, Show) + +_Value = (Core.Name "hydra/ext/org/graphql/syntax.Value") + +_Value_variable = (Core.Name "variable") + +_Value_int = (Core.Name "int") + +_Value_float = (Core.Name "float") + +_Value_string = (Core.Name "string") + +_Value_boolean = (Core.Name "boolean") + +_Value_null = (Core.Name "null") + +_Value_enum = (Core.Name "enum") + +_Value_list = (Core.Name "list") + +_Value_object = (Core.Name "object") + +data BooleanValue = + BooleanValueTrue | + BooleanValueFalse + deriving (Eq, Ord, Read, Show) + +_BooleanValue = (Core.Name "hydra/ext/org/graphql/syntax.BooleanValue") + +_BooleanValue_true = (Core.Name "true") + +_BooleanValue_false = (Core.Name "false") + +data NullValue = + NullValue {} + deriving (Eq, Ord, Read, Show) + +_NullValue = (Core.Name "hydra/ext/org/graphql/syntax.NullValue") + +newtype EnumValue = + EnumValue { + unEnumValue :: Name} + deriving (Eq, Ord, Read, Show) + +_EnumValue = (Core.Name "hydra/ext/org/graphql/syntax.EnumValue") + +data ListValue = + ListValueSequence ListValue_Sequence | + ListValueSequence2 [Value] + deriving (Eq, Ord, Read, Show) + +_ListValue = (Core.Name "hydra/ext/org/graphql/syntax.ListValue") + +_ListValue_sequence = (Core.Name "sequence") + +_ListValue_sequence2 = (Core.Name "sequence2") + +data ListValue_Sequence = + ListValue_Sequence {} + deriving (Eq, Ord, Read, Show) + +_ListValue_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ListValue.Sequence") + +data ObjectValue = + ObjectValueSequence ObjectValue_Sequence | + ObjectValueSequence2 [ObjectField] + deriving (Eq, Ord, Read, Show) + +_ObjectValue = (Core.Name "hydra/ext/org/graphql/syntax.ObjectValue") + +_ObjectValue_sequence = (Core.Name "sequence") + +_ObjectValue_sequence2 = (Core.Name "sequence2") + +data ObjectValue_Sequence = + ObjectValue_Sequence {} + deriving (Eq, Ord, Read, Show) + +_ObjectValue_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ObjectValue.Sequence") + +data ObjectField = + ObjectField { + objectFieldName :: Name, + objectFieldValue :: Value} + deriving (Eq, Ord, Read, Show) + +_ObjectField = (Core.Name "hydra/ext/org/graphql/syntax.ObjectField") + +_ObjectField_name = (Core.Name "name") + +_ObjectField_value = (Core.Name "value") + +data VariablesDefinition = + VariablesDefinition { + variablesDefinitionVariable :: Variable, + variablesDefinitionType :: Type, + variablesDefinitionDefaultValue :: (Maybe DefaultValue), + variablesDefinitionDirectives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_VariablesDefinition = (Core.Name "hydra/ext/org/graphql/syntax.VariablesDefinition") + +_VariablesDefinition_variable = (Core.Name "variable") + +_VariablesDefinition_type = (Core.Name "type") + +_VariablesDefinition_defaultValue = (Core.Name "defaultValue") + +_VariablesDefinition_directives = (Core.Name "directives") + +newtype Variable = + Variable { + unVariable :: Name} + deriving (Eq, Ord, Read, Show) + +_Variable = (Core.Name "hydra/ext/org/graphql/syntax.Variable") + +newtype DefaultValue = + DefaultValue { + unDefaultValue :: Value} + deriving (Eq, Ord, Read, Show) + +_DefaultValue = (Core.Name "hydra/ext/org/graphql/syntax.DefaultValue") + +data Type = + TypeNamed NamedType | + TypeList ListType | + TypeNonNull NonNullType + deriving (Eq, Ord, Read, Show) + +_Type = (Core.Name "hydra/ext/org/graphql/syntax.Type") + +_Type_named = (Core.Name "named") + +_Type_list = (Core.Name "list") + +_Type_nonNull = (Core.Name "nonNull") + +newtype NamedType = + NamedType { + unNamedType :: Name} + deriving (Eq, Ord, Read, Show) + +_NamedType = (Core.Name "hydra/ext/org/graphql/syntax.NamedType") + +newtype ListType = + ListType { + unListType :: Type} + deriving (Eq, Ord, Read, Show) + +_ListType = (Core.Name "hydra/ext/org/graphql/syntax.ListType") + +data NonNullType = + NonNullTypeNamed NamedType | + NonNullTypeList ListType + deriving (Eq, Ord, Read, Show) + +_NonNullType = (Core.Name "hydra/ext/org/graphql/syntax.NonNullType") + +_NonNullType_named = (Core.Name "named") + +_NonNullType_list = (Core.Name "list") + +newtype Directives = + Directives { + unDirectives :: [Directive]} + deriving (Eq, Ord, Read, Show) + +_Directives = (Core.Name "hydra/ext/org/graphql/syntax.Directives") + +data Directive = + Directive { + directiveName :: Name, + directiveArguments :: (Maybe Arguments)} + deriving (Eq, Ord, Read, Show) + +_Directive = (Core.Name "hydra/ext/org/graphql/syntax.Directive") + +_Directive_name = (Core.Name "name") + +_Directive_arguments = (Core.Name "arguments") + +newtype TypeSystemDocment = + TypeSystemDocment { + unTypeSystemDocment :: [TypeSystemDefinition]} + deriving (Eq, Ord, Read, Show) + +_TypeSystemDocment = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDocment") + +data TypeSystemDefinition = + TypeSystemDefinitionSchema SchemaDefinition | + TypeSystemDefinitionType TypeDefinition | + TypeSystemDefinitionDirective DirectiveDefinition + deriving (Eq, Ord, Read, Show) + +_TypeSystemDefinition = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDefinition") + +_TypeSystemDefinition_schema = (Core.Name "schema") + +_TypeSystemDefinition_type = (Core.Name "type") + +_TypeSystemDefinition_directive = (Core.Name "directive") + +newtype TypeSystemExtensionDocument = + TypeSystemExtensionDocument { + unTypeSystemExtensionDocument :: [TypeSystemDefinitionOrExtension]} + deriving (Eq, Ord, Read, Show) + +_TypeSystemExtensionDocument = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemExtensionDocument") + +data TypeSystemDefinitionOrExtension = + TypeSystemDefinitionOrExtensionDefinition TypeSystemDefinition | + TypeSystemDefinitionOrExtensionExtension TypeSystemExtension + deriving (Eq, Ord, Read, Show) + +_TypeSystemDefinitionOrExtension = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDefinitionOrExtension") + +_TypeSystemDefinitionOrExtension_definition = (Core.Name "definition") + +_TypeSystemDefinitionOrExtension_extension = (Core.Name "extension") + +data TypeSystemExtension = + TypeSystemExtensionSchema SchemaExtension | + TypeSystemExtensionType TypeExtension + deriving (Eq, Ord, Read, Show) + +_TypeSystemExtension = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemExtension") + +_TypeSystemExtension_schema = (Core.Name "schema") + +_TypeSystemExtension_type = (Core.Name "type") + +data SchemaDefinition = + SchemaDefinition { + schemaDefinitionDescription :: (Maybe Description), + schemaDefinitionDirectives :: (Maybe Directives), + schemaDefinitionRootOperationTypeDefinition :: RootOperationTypeDefinition} + deriving (Eq, Ord, Read, Show) + +_SchemaDefinition = (Core.Name "hydra/ext/org/graphql/syntax.SchemaDefinition") + +_SchemaDefinition_description = (Core.Name "description") + +_SchemaDefinition_directives = (Core.Name "directives") + +_SchemaDefinition_rootOperationTypeDefinition = (Core.Name "rootOperationTypeDefinition") + +data SchemaExtension = + SchemaExtensionSequence SchemaExtension_Sequence | + SchemaExtensionSequence2 Directives + deriving (Eq, Ord, Read, Show) + +_SchemaExtension = (Core.Name "hydra/ext/org/graphql/syntax.SchemaExtension") + +_SchemaExtension_sequence = (Core.Name "sequence") + +_SchemaExtension_sequence2 = (Core.Name "sequence2") + +data SchemaExtension_Sequence = + SchemaExtension_Sequence { + schemaExtension_SequenceDirectives :: (Maybe Directives), + schemaExtension_SequenceRootOperationTypeDefinition :: RootOperationTypeDefinition} + deriving (Eq, Ord, Read, Show) + +_SchemaExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.SchemaExtension.Sequence") + +_SchemaExtension_Sequence_directives = (Core.Name "directives") + +_SchemaExtension_Sequence_rootOperationTypeDefinition = (Core.Name "rootOperationTypeDefinition") + +data RootOperationTypeDefinition = + RootOperationTypeDefinition { + rootOperationTypeDefinitionOperationType :: OperationType, + rootOperationTypeDefinitionNamedType :: NamedType} + deriving (Eq, Ord, Read, Show) + +_RootOperationTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.RootOperationTypeDefinition") + +_RootOperationTypeDefinition_operationType = (Core.Name "operationType") + +_RootOperationTypeDefinition_namedType = (Core.Name "namedType") + +newtype Description = + Description { + unDescription :: StringValue} + deriving (Eq, Ord, Read, Show) + +_Description = (Core.Name "hydra/ext/org/graphql/syntax.Description") + +data TypeDefinition = + TypeDefinitionScalar ScalarTypeDefinition | + TypeDefinitionObject ObjectTypeDefinition | + TypeDefinitionInterface InterfaceTypeDefinition | + TypeDefinitionUnion UnionTypeDefinition | + TypeDefinitionEnum EnumTypeDefinition | + TypeDefinitionInputObject InputObjectTypeDefinition + deriving (Eq, Ord, Read, Show) + +_TypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.TypeDefinition") + +_TypeDefinition_scalar = (Core.Name "scalar") + +_TypeDefinition_object = (Core.Name "object") + +_TypeDefinition_interface = (Core.Name "interface") + +_TypeDefinition_union = (Core.Name "union") + +_TypeDefinition_enum = (Core.Name "enum") + +_TypeDefinition_inputObject = (Core.Name "inputObject") + +data TypeExtension = + TypeExtensionScalar ScalarTypeExtension | + TypeExtensionObject ObjectTypeExtension | + TypeExtensionInterface InterfaceTypeExtension | + TypeExtensionUnion UnionTypeExtension | + TypeExtensionEnum EnumTypeExtension | + TypeExtensionInputObject InputObjectTypeExtension + deriving (Eq, Ord, Read, Show) + +_TypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.TypeExtension") + +_TypeExtension_scalar = (Core.Name "scalar") + +_TypeExtension_object = (Core.Name "object") + +_TypeExtension_interface = (Core.Name "interface") + +_TypeExtension_union = (Core.Name "union") + +_TypeExtension_enum = (Core.Name "enum") + +_TypeExtension_inputObject = (Core.Name "inputObject") + +data ScalarTypeDefinition = + ScalarTypeDefinition { + scalarTypeDefinitionDescription :: (Maybe Description), + scalarTypeDefinitionName :: Name, + scalarTypeDefinitionDirectives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_ScalarTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ScalarTypeDefinition") + +_ScalarTypeDefinition_description = (Core.Name "description") + +_ScalarTypeDefinition_name = (Core.Name "name") + +_ScalarTypeDefinition_directives = (Core.Name "directives") + +data ScalarTypeExtension = + ScalarTypeExtension { + scalarTypeExtensionName :: Name, + scalarTypeExtensionDirectives :: Directives} + deriving (Eq, Ord, Read, Show) + +_ScalarTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.ScalarTypeExtension") + +_ScalarTypeExtension_name = (Core.Name "name") + +_ScalarTypeExtension_directives = (Core.Name "directives") + +data ObjectTypeDefinition = + ObjectTypeDefinition { + objectTypeDefinitionDescription :: (Maybe Description), + objectTypeDefinitionName :: Name, + objectTypeDefinitionImplementsInterfaces :: (Maybe ImplementsInterfaces), + objectTypeDefinitionDirectives :: (Maybe Directives), + objectTypeDefinitionFieldsDefinition :: (Maybe FieldsDefinition)} + deriving (Eq, Ord, Read, Show) + +_ObjectTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeDefinition") + +_ObjectTypeDefinition_description = (Core.Name "description") + +_ObjectTypeDefinition_name = (Core.Name "name") + +_ObjectTypeDefinition_implementsInterfaces = (Core.Name "implementsInterfaces") + +_ObjectTypeDefinition_directives = (Core.Name "directives") + +_ObjectTypeDefinition_fieldsDefinition = (Core.Name "fieldsDefinition") + +data ObjectTypeExtension = + ObjectTypeExtensionSequence ObjectTypeExtension_Sequence | + ObjectTypeExtensionSequence2 ObjectTypeExtension_Sequence2 | + ObjectTypeExtensionSequence3 ObjectTypeExtension_Sequence3 + deriving (Eq, Ord, Read, Show) + +_ObjectTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension") + +_ObjectTypeExtension_sequence = (Core.Name "sequence") + +_ObjectTypeExtension_sequence2 = (Core.Name "sequence2") + +_ObjectTypeExtension_sequence3 = (Core.Name "sequence3") + +data ObjectTypeExtension_Sequence = + ObjectTypeExtension_Sequence { + objectTypeExtension_SequenceName :: Name, + objectTypeExtension_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces), + objectTypeExtension_SequenceDirectives :: (Maybe Directives), + objectTypeExtension_SequenceFieldsDefinition :: FieldsDefinition} + deriving (Eq, Ord, Read, Show) + +_ObjectTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension.Sequence") + +_ObjectTypeExtension_Sequence_name = (Core.Name "name") + +_ObjectTypeExtension_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") + +_ObjectTypeExtension_Sequence_directives = (Core.Name "directives") + +_ObjectTypeExtension_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition") + +data ObjectTypeExtension_Sequence2 = + ObjectTypeExtension_Sequence2 { + objectTypeExtension_Sequence2Name :: Name, + objectTypeExtension_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces), + objectTypeExtension_Sequence2Directives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_ObjectTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension.Sequence2") + +_ObjectTypeExtension_Sequence2_name = (Core.Name "name") + +_ObjectTypeExtension_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces") + +_ObjectTypeExtension_Sequence2_directives = (Core.Name "directives") + +data ObjectTypeExtension_Sequence3 = + ObjectTypeExtension_Sequence3 { + objectTypeExtension_Sequence3Name :: Name, + objectTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces} + deriving (Eq, Ord, Read, Show) + +_ObjectTypeExtension_Sequence3 = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension.Sequence3") + +_ObjectTypeExtension_Sequence3_name = (Core.Name "name") + +_ObjectTypeExtension_Sequence3_implementsInterfaces = (Core.Name "implementsInterfaces") + +data ImplementsInterfaces = + ImplementsInterfacesSequence ImplementsInterfaces_Sequence | + ImplementsInterfacesSequence2 ImplementsInterfaces_Sequence2 + deriving (Eq, Ord, Read, Show) + +_ImplementsInterfaces = (Core.Name "hydra/ext/org/graphql/syntax.ImplementsInterfaces") + +_ImplementsInterfaces_sequence = (Core.Name "sequence") + +_ImplementsInterfaces_sequence2 = (Core.Name "sequence2") + +data ImplementsInterfaces_Sequence = + ImplementsInterfaces_Sequence { + implementsInterfaces_SequenceImplementsInterfaces :: ImplementsInterfaces, + implementsInterfaces_SequenceNamedType :: NamedType} + deriving (Eq, Ord, Read, Show) + +_ImplementsInterfaces_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ImplementsInterfaces.Sequence") + +_ImplementsInterfaces_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") + +_ImplementsInterfaces_Sequence_namedType = (Core.Name "namedType") + +data ImplementsInterfaces_Sequence2 = + ImplementsInterfaces_Sequence2 { + implementsInterfaces_Sequence2Amp :: (Maybe ()), + implementsInterfaces_Sequence2NamedType :: NamedType} + deriving (Eq, Ord, Read, Show) + +_ImplementsInterfaces_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.ImplementsInterfaces.Sequence2") + +_ImplementsInterfaces_Sequence2_amp = (Core.Name "amp") + +_ImplementsInterfaces_Sequence2_namedType = (Core.Name "namedType") + +newtype FieldsDefinition = + FieldsDefinition { + unFieldsDefinition :: [FieldDefinition]} + deriving (Eq, Ord, Read, Show) + +_FieldsDefinition = (Core.Name "hydra/ext/org/graphql/syntax.FieldsDefinition") + +data FieldDefinition = + FieldDefinition { + fieldDefinitionDescription :: (Maybe Description), + fieldDefinitionName :: Name, + fieldDefinitionArgumentsDefinition :: (Maybe ArgumentsDefinition), + fieldDefinitionType :: Type, + fieldDefinitionDirectives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_FieldDefinition = (Core.Name "hydra/ext/org/graphql/syntax.FieldDefinition") + +_FieldDefinition_description = (Core.Name "description") + +_FieldDefinition_name = (Core.Name "name") + +_FieldDefinition_argumentsDefinition = (Core.Name "argumentsDefinition") + +_FieldDefinition_type = (Core.Name "type") + +_FieldDefinition_directives = (Core.Name "directives") + +newtype ArgumentsDefinition = + ArgumentsDefinition { + unArgumentsDefinition :: [InputValueDefinition]} + deriving (Eq, Ord, Read, Show) + +_ArgumentsDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ArgumentsDefinition") + +data InputValueDefinition = + InputValueDefinition { + inputValueDefinitionDescription :: (Maybe Description), + inputValueDefinitionName :: Name, + inputValueDefinitionType :: Type, + inputValueDefinitionDefaultValue :: (Maybe DefaultValue), + inputValueDefinitionDirectives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_InputValueDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InputValueDefinition") + +_InputValueDefinition_description = (Core.Name "description") + +_InputValueDefinition_name = (Core.Name "name") + +_InputValueDefinition_type = (Core.Name "type") + +_InputValueDefinition_defaultValue = (Core.Name "defaultValue") + +_InputValueDefinition_directives = (Core.Name "directives") + +data InterfaceTypeDefinition = + InterfaceTypeDefinitionSequence InterfaceTypeDefinition_Sequence | + InterfaceTypeDefinitionSequence2 InterfaceTypeDefinition_Sequence2 + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeDefinition") + +_InterfaceTypeDefinition_sequence = (Core.Name "sequence") + +_InterfaceTypeDefinition_sequence2 = (Core.Name "sequence2") + +data InterfaceTypeDefinition_Sequence = + InterfaceTypeDefinition_Sequence { + interfaceTypeDefinition_SequenceDescription :: (Maybe Description), + interfaceTypeDefinition_SequenceName :: Name, + interfaceTypeDefinition_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces), + interfaceTypeDefinition_SequenceDirectives :: (Maybe Directives), + interfaceTypeDefinition_SequenceFieldsDefinition :: FieldsDefinition} + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeDefinition_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeDefinition.Sequence") + +_InterfaceTypeDefinition_Sequence_description = (Core.Name "description") + +_InterfaceTypeDefinition_Sequence_name = (Core.Name "name") + +_InterfaceTypeDefinition_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") + +_InterfaceTypeDefinition_Sequence_directives = (Core.Name "directives") + +_InterfaceTypeDefinition_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition") + +data InterfaceTypeDefinition_Sequence2 = + InterfaceTypeDefinition_Sequence2 { + interfaceTypeDefinition_Sequence2Description :: (Maybe Description), + interfaceTypeDefinition_Sequence2Name :: Name, + interfaceTypeDefinition_Sequence2ImplementsInterfaces :: ImplementsInterfaces, + interfaceTypeDefinition_Sequence2Directives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeDefinition_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeDefinition.Sequence2") + +_InterfaceTypeDefinition_Sequence2_description = (Core.Name "description") + +_InterfaceTypeDefinition_Sequence2_name = (Core.Name "name") + +_InterfaceTypeDefinition_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces") + +_InterfaceTypeDefinition_Sequence2_directives = (Core.Name "directives") + +data InterfaceTypeExtension = + InterfaceTypeExtensionSequence InterfaceTypeExtension_Sequence | + InterfaceTypeExtensionSequence2 InterfaceTypeExtension_Sequence2 | + InterfaceTypeExtensionSequence3 InterfaceTypeExtension_Sequence3 + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension") + +_InterfaceTypeExtension_sequence = (Core.Name "sequence") + +_InterfaceTypeExtension_sequence2 = (Core.Name "sequence2") + +_InterfaceTypeExtension_sequence3 = (Core.Name "sequence3") + +data InterfaceTypeExtension_Sequence = + InterfaceTypeExtension_Sequence { + interfaceTypeExtension_SequenceName :: Name, + interfaceTypeExtension_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces), + interfaceTypeExtension_SequenceDirectives :: (Maybe Directives), + interfaceTypeExtension_SequenceFieldsDefinition :: FieldsDefinition} + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension.Sequence") + +_InterfaceTypeExtension_Sequence_name = (Core.Name "name") + +_InterfaceTypeExtension_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") + +_InterfaceTypeExtension_Sequence_directives = (Core.Name "directives") + +_InterfaceTypeExtension_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition") + +data InterfaceTypeExtension_Sequence2 = + InterfaceTypeExtension_Sequence2 { + interfaceTypeExtension_Sequence2Name :: Name, + interfaceTypeExtension_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces), + interfaceTypeExtension_Sequence2Directives :: Directives} + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension.Sequence2") + +_InterfaceTypeExtension_Sequence2_name = (Core.Name "name") + +_InterfaceTypeExtension_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces") + +_InterfaceTypeExtension_Sequence2_directives = (Core.Name "directives") + +data InterfaceTypeExtension_Sequence3 = + InterfaceTypeExtension_Sequence3 { + interfaceTypeExtension_Sequence3Name :: Name, + interfaceTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces} + deriving (Eq, Ord, Read, Show) + +_InterfaceTypeExtension_Sequence3 = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension.Sequence3") + +_InterfaceTypeExtension_Sequence3_name = (Core.Name "name") + +_InterfaceTypeExtension_Sequence3_implementsInterfaces = (Core.Name "implementsInterfaces") + +data UnionTypeDefinition = + UnionTypeDefinition { + unionTypeDefinitionDescription :: (Maybe Description), + unionTypeDefinitionName :: Name, + unionTypeDefinitionDirectives :: (Maybe Directives), + unionTypeDefinitionUnionMemberTypes :: (Maybe UnionMemberTypes)} + deriving (Eq, Ord, Read, Show) + +_UnionTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeDefinition") + +_UnionTypeDefinition_description = (Core.Name "description") + +_UnionTypeDefinition_name = (Core.Name "name") + +_UnionTypeDefinition_directives = (Core.Name "directives") + +_UnionTypeDefinition_unionMemberTypes = (Core.Name "unionMemberTypes") + +data UnionMemberTypes = + UnionMemberTypesSequence UnionMemberTypes_Sequence | + UnionMemberTypesSequence2 UnionMemberTypes_Sequence2 + deriving (Eq, Ord, Read, Show) + +_UnionMemberTypes = (Core.Name "hydra/ext/org/graphql/syntax.UnionMemberTypes") + +_UnionMemberTypes_sequence = (Core.Name "sequence") + +_UnionMemberTypes_sequence2 = (Core.Name "sequence2") + +data UnionMemberTypes_Sequence = + UnionMemberTypes_Sequence { + unionMemberTypes_SequenceUnionMemberTypes :: UnionMemberTypes, + unionMemberTypes_SequenceNamedType :: NamedType} + deriving (Eq, Ord, Read, Show) + +_UnionMemberTypes_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.UnionMemberTypes.Sequence") + +_UnionMemberTypes_Sequence_unionMemberTypes = (Core.Name "unionMemberTypes") + +_UnionMemberTypes_Sequence_namedType = (Core.Name "namedType") + +data UnionMemberTypes_Sequence2 = + UnionMemberTypes_Sequence2 { + unionMemberTypes_Sequence2Or :: (Maybe ()), + unionMemberTypes_Sequence2NamedType :: NamedType} + deriving (Eq, Ord, Read, Show) + +_UnionMemberTypes_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.UnionMemberTypes.Sequence2") + +_UnionMemberTypes_Sequence2_or = (Core.Name "or") + +_UnionMemberTypes_Sequence2_namedType = (Core.Name "namedType") + +data UnionTypeExtension = + UnionTypeExtensionSequence UnionTypeExtension_Sequence | + UnionTypeExtensionSequence2 UnionTypeExtension_Sequence2 + deriving (Eq, Ord, Read, Show) + +_UnionTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeExtension") + +_UnionTypeExtension_sequence = (Core.Name "sequence") + +_UnionTypeExtension_sequence2 = (Core.Name "sequence2") + +data UnionTypeExtension_Sequence = + UnionTypeExtension_Sequence { + unionTypeExtension_SequenceName :: Name, + unionTypeExtension_SequenceDirectives :: (Maybe Directives), + unionTypeExtension_SequenceUnionMemberTypes :: UnionMemberTypes} + deriving (Eq, Ord, Read, Show) + +_UnionTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeExtension.Sequence") + +_UnionTypeExtension_Sequence_name = (Core.Name "name") + +_UnionTypeExtension_Sequence_directives = (Core.Name "directives") + +_UnionTypeExtension_Sequence_unionMemberTypes = (Core.Name "unionMemberTypes") + +data UnionTypeExtension_Sequence2 = + UnionTypeExtension_Sequence2 { + unionTypeExtension_Sequence2Name :: Name, + unionTypeExtension_Sequence2Directives :: Directives} + deriving (Eq, Ord, Read, Show) + +_UnionTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeExtension.Sequence2") + +_UnionTypeExtension_Sequence2_name = (Core.Name "name") + +_UnionTypeExtension_Sequence2_directives = (Core.Name "directives") + +data EnumTypeDefinition = + EnumTypeDefinition { + enumTypeDefinitionDescription :: (Maybe Description), + enumTypeDefinitionName :: Name, + enumTypeDefinitionDirectives :: (Maybe Directives), + enumTypeDefinitionEnumValuesDefinition :: (Maybe EnumValuesDefinition)} + deriving (Eq, Ord, Read, Show) + +_EnumTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeDefinition") + +_EnumTypeDefinition_description = (Core.Name "description") + +_EnumTypeDefinition_name = (Core.Name "name") + +_EnumTypeDefinition_directives = (Core.Name "directives") + +_EnumTypeDefinition_enumValuesDefinition = (Core.Name "enumValuesDefinition") + +newtype EnumValuesDefinition = + EnumValuesDefinition { + unEnumValuesDefinition :: [EnumValueDefinition]} + deriving (Eq, Ord, Read, Show) + +_EnumValuesDefinition = (Core.Name "hydra/ext/org/graphql/syntax.EnumValuesDefinition") + +data EnumValueDefinition = + EnumValueDefinition { + enumValueDefinitionDescription :: (Maybe Description), + enumValueDefinitionEnumValue :: EnumValue, + enumValueDefinitionDirectives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_EnumValueDefinition = (Core.Name "hydra/ext/org/graphql/syntax.EnumValueDefinition") + +_EnumValueDefinition_description = (Core.Name "description") + +_EnumValueDefinition_enumValue = (Core.Name "enumValue") + +_EnumValueDefinition_directives = (Core.Name "directives") + +data EnumTypeExtension = + EnumTypeExtensionSequence EnumTypeExtension_Sequence | + EnumTypeExtensionSequence2 EnumTypeExtension_Sequence2 + deriving (Eq, Ord, Read, Show) + +_EnumTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeExtension") + +_EnumTypeExtension_sequence = (Core.Name "sequence") + +_EnumTypeExtension_sequence2 = (Core.Name "sequence2") + +data EnumTypeExtension_Sequence = + EnumTypeExtension_Sequence { + enumTypeExtension_SequenceName :: Name, + enumTypeExtension_SequenceDirectives :: (Maybe Directives), + enumTypeExtension_SequenceEnumValuesDefinition :: EnumValuesDefinition} + deriving (Eq, Ord, Read, Show) + +_EnumTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeExtension.Sequence") + +_EnumTypeExtension_Sequence_name = (Core.Name "name") + +_EnumTypeExtension_Sequence_directives = (Core.Name "directives") + +_EnumTypeExtension_Sequence_enumValuesDefinition = (Core.Name "enumValuesDefinition") + +data EnumTypeExtension_Sequence2 = + EnumTypeExtension_Sequence2 { + enumTypeExtension_Sequence2Name :: Name, + enumTypeExtension_Sequence2Directives :: Directives} + deriving (Eq, Ord, Read, Show) + +_EnumTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeExtension.Sequence2") + +_EnumTypeExtension_Sequence2_name = (Core.Name "name") + +_EnumTypeExtension_Sequence2_directives = (Core.Name "directives") + +data InputObjectTypeDefinition = + InputObjectTypeDefinitionSequence InputObjectTypeDefinition_Sequence | + InputObjectTypeDefinitionSequence2 InputObjectTypeDefinition_Sequence2 + deriving (Eq, Ord, Read, Show) + +_InputObjectTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeDefinition") + +_InputObjectTypeDefinition_sequence = (Core.Name "sequence") + +_InputObjectTypeDefinition_sequence2 = (Core.Name "sequence2") + +data InputObjectTypeDefinition_Sequence = + InputObjectTypeDefinition_Sequence { + inputObjectTypeDefinition_SequenceDescription :: (Maybe Description), + inputObjectTypeDefinition_SequenceName :: Name, + inputObjectTypeDefinition_SequenceDirectives :: (Maybe Directives), + inputObjectTypeDefinition_SequenceInputFieldsDefinition :: InputFieldsDefinition} + deriving (Eq, Ord, Read, Show) + +_InputObjectTypeDefinition_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeDefinition.Sequence") + +_InputObjectTypeDefinition_Sequence_description = (Core.Name "description") + +_InputObjectTypeDefinition_Sequence_name = (Core.Name "name") + +_InputObjectTypeDefinition_Sequence_directives = (Core.Name "directives") + +_InputObjectTypeDefinition_Sequence_inputFieldsDefinition = (Core.Name "inputFieldsDefinition") + +data InputObjectTypeDefinition_Sequence2 = + InputObjectTypeDefinition_Sequence2 { + inputObjectTypeDefinition_Sequence2Description :: (Maybe Description), + inputObjectTypeDefinition_Sequence2Name :: Name, + inputObjectTypeDefinition_Sequence2Directives :: (Maybe Directives)} + deriving (Eq, Ord, Read, Show) + +_InputObjectTypeDefinition_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeDefinition.Sequence2") + +_InputObjectTypeDefinition_Sequence2_description = (Core.Name "description") + +_InputObjectTypeDefinition_Sequence2_name = (Core.Name "name") + +_InputObjectTypeDefinition_Sequence2_directives = (Core.Name "directives") + +newtype InputFieldsDefinition = + InputFieldsDefinition { + unInputFieldsDefinition :: [InputValueDefinition]} + deriving (Eq, Ord, Read, Show) + +_InputFieldsDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InputFieldsDefinition") + +data InputObjectTypeExtension = + InputObjectTypeExtensionSequence InputObjectTypeExtension_Sequence | + InputObjectTypeExtensionSequence2 InputObjectTypeExtension_Sequence2 + deriving (Eq, Ord, Read, Show) + +_InputObjectTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeExtension") + +_InputObjectTypeExtension_sequence = (Core.Name "sequence") + +_InputObjectTypeExtension_sequence2 = (Core.Name "sequence2") + +data InputObjectTypeExtension_Sequence = + InputObjectTypeExtension_Sequence { + inputObjectTypeExtension_SequenceName :: Name, + inputObjectTypeExtension_SequenceDirectives :: (Maybe Directives), + inputObjectTypeExtension_SequenceInputFieldsDefinition :: InputFieldsDefinition} + deriving (Eq, Ord, Read, Show) + +_InputObjectTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeExtension.Sequence") + +_InputObjectTypeExtension_Sequence_name = (Core.Name "name") + +_InputObjectTypeExtension_Sequence_directives = (Core.Name "directives") + +_InputObjectTypeExtension_Sequence_inputFieldsDefinition = (Core.Name "inputFieldsDefinition") + +data InputObjectTypeExtension_Sequence2 = + InputObjectTypeExtension_Sequence2 { + inputObjectTypeExtension_Sequence2Name :: Name, + inputObjectTypeExtension_Sequence2Directives :: Directives} + deriving (Eq, Ord, Read, Show) + +_InputObjectTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeExtension.Sequence2") + +_InputObjectTypeExtension_Sequence2_name = (Core.Name "name") + +_InputObjectTypeExtension_Sequence2_directives = (Core.Name "directives") + +data DirectiveDefinition = + DirectiveDefinition { + directiveDefinitionDescription :: (Maybe Description), + directiveDefinitionName :: Name, + directiveDefinitionArgumentsDefinition :: (Maybe ArgumentsDefinition), + directiveDefinitionRepeatable :: (Maybe ()), + directiveDefinitionDirectiveLocations :: DirectiveLocations} + deriving (Eq, Ord, Read, Show) + +_DirectiveDefinition = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveDefinition") + +_DirectiveDefinition_description = (Core.Name "description") + +_DirectiveDefinition_name = (Core.Name "name") + +_DirectiveDefinition_argumentsDefinition = (Core.Name "argumentsDefinition") + +_DirectiveDefinition_repeatable = (Core.Name "repeatable") + +_DirectiveDefinition_directiveLocations = (Core.Name "directiveLocations") + +data DirectiveLocations = + DirectiveLocationsSequence DirectiveLocations_Sequence | + DirectiveLocationsSequence2 DirectiveLocations_Sequence2 + deriving (Eq, Ord, Read, Show) + +_DirectiveLocations = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocations") + +_DirectiveLocations_sequence = (Core.Name "sequence") + +_DirectiveLocations_sequence2 = (Core.Name "sequence2") + +data DirectiveLocations_Sequence = + DirectiveLocations_Sequence { + directiveLocations_SequenceDirectiveLocations :: DirectiveLocations, + directiveLocations_SequenceDirectiveLocation :: DirectiveLocation} + deriving (Eq, Ord, Read, Show) + +_DirectiveLocations_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocations.Sequence") + +_DirectiveLocations_Sequence_directiveLocations = (Core.Name "directiveLocations") + +_DirectiveLocations_Sequence_directiveLocation = (Core.Name "directiveLocation") + +data DirectiveLocations_Sequence2 = + DirectiveLocations_Sequence2 { + directiveLocations_Sequence2Or :: (Maybe ()), + directiveLocations_Sequence2DirectiveLocation :: DirectiveLocation} + deriving (Eq, Ord, Read, Show) + +_DirectiveLocations_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocations.Sequence2") + +_DirectiveLocations_Sequence2_or = (Core.Name "or") + +_DirectiveLocations_Sequence2_directiveLocation = (Core.Name "directiveLocation") + +data DirectiveLocation = + DirectiveLocationExecutable ExecutableDirectiveLocation | + DirectiveLocationTypeSystem TypeSystemDirectiveLocation + deriving (Eq, Ord, Read, Show) + +_DirectiveLocation = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocation") + +_DirectiveLocation_executable = (Core.Name "executable") + +_DirectiveLocation_typeSystem = (Core.Name "typeSystem") + +data ExecutableDirectiveLocation = + ExecutableDirectiveLocationQUERY | + ExecutableDirectiveLocationMUTATION | + ExecutableDirectiveLocationSUBSCRIPTION | + ExecutableDirectiveLocationFIELD | + ExecutableDirectiveLocationFRAGMENTLowbarDEFINITION | + ExecutableDirectiveLocationFRAGMENTLowbarSPREAD | + ExecutableDirectiveLocationINLINELowbarFRAGMENT | + ExecutableDirectiveLocationVARIABLELowbarDEFINITION + deriving (Eq, Ord, Read, Show) + +_ExecutableDirectiveLocation = (Core.Name "hydra/ext/org/graphql/syntax.ExecutableDirectiveLocation") + +_ExecutableDirectiveLocation_qUERY = (Core.Name "qUERY") + +_ExecutableDirectiveLocation_mUTATION = (Core.Name "mUTATION") + +_ExecutableDirectiveLocation_sUBSCRIPTION = (Core.Name "sUBSCRIPTION") + +_ExecutableDirectiveLocation_fIELD = (Core.Name "fIELD") + +_ExecutableDirectiveLocation_fRAGMENTLowbarDEFINITION = (Core.Name "fRAGMENTLowbarDEFINITION") + +_ExecutableDirectiveLocation_fRAGMENTLowbarSPREAD = (Core.Name "fRAGMENTLowbarSPREAD") + +_ExecutableDirectiveLocation_iNLINELowbarFRAGMENT = (Core.Name "iNLINELowbarFRAGMENT") + +_ExecutableDirectiveLocation_vARIABLELowbarDEFINITION = (Core.Name "vARIABLELowbarDEFINITION") + +data TypeSystemDirectiveLocation = + TypeSystemDirectiveLocationSCHEMA | + TypeSystemDirectiveLocationSCALAR | + TypeSystemDirectiveLocationOBJECT | + TypeSystemDirectiveLocationFIELDLowbarDEFINITION | + TypeSystemDirectiveLocationARGUMENTLowbarDEFINITION | + TypeSystemDirectiveLocationINTERFACE | + TypeSystemDirectiveLocationUNION | + TypeSystemDirectiveLocationENUM | + TypeSystemDirectiveLocationENUMLowbarVALUE | + TypeSystemDirectiveLocationINPUTLowbarOBJECT | + TypeSystemDirectiveLocationINPUTLowbarFIELDLowbarDEFINITION + deriving (Eq, Ord, Read, Show) + +_TypeSystemDirectiveLocation = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDirectiveLocation") + +_TypeSystemDirectiveLocation_sCHEMA = (Core.Name "sCHEMA") + +_TypeSystemDirectiveLocation_sCALAR = (Core.Name "sCALAR") + +_TypeSystemDirectiveLocation_oBJECT = (Core.Name "oBJECT") + +_TypeSystemDirectiveLocation_fIELDLowbarDEFINITION = (Core.Name "fIELDLowbarDEFINITION") + +_TypeSystemDirectiveLocation_aRGUMENTLowbarDEFINITION = (Core.Name "aRGUMENTLowbarDEFINITION") + +_TypeSystemDirectiveLocation_iNTERFACE = (Core.Name "iNTERFACE") + +_TypeSystemDirectiveLocation_uNION = (Core.Name "uNION") + +_TypeSystemDirectiveLocation_eNUM = (Core.Name "eNUM") + +_TypeSystemDirectiveLocation_eNUMLowbarVALUE = (Core.Name "eNUMLowbarVALUE") + +_TypeSystemDirectiveLocation_iNPUTLowbarOBJECT = (Core.Name "iNPUTLowbarOBJECT") + +_TypeSystemDirectiveLocation_iNPUTLowbarFIELDLowbarDEFINITION = (Core.Name "iNPUTLowbarFIELDLowbarDEFINITION") diff --git a/src/gen-main/haskell/Hydra/Ext/Org/Json/Decoding.hs b/src/gen-main/haskell/Hydra/Ext/Org/Json/Decoding.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Org/Json/Decoding.hs @@ -0,0 +1,50 @@ +-- | Decoding functions for JSON data + +module Hydra.Ext.Org.Json.Decoding where + +import qualified Hydra.Compute as Compute +import qualified Hydra.Json as Json +import qualified Hydra.Lib.Flows as Flows +import qualified Hydra.Lib.Maps as Maps +import qualified Hydra.Lib.Strings as Strings +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +decodeString :: (Json.Value -> Compute.Flow s String) +decodeString x = case x of + Json.ValueString v320 -> (Flows.pure v320) + _ -> (Flows.fail "expected a string") + +decodeNumber :: (Json.Value -> Compute.Flow s Double) +decodeNumber x = case x of + Json.ValueNumber v321 -> (Flows.pure v321) + _ -> (Flows.fail "expected a number") + +decodeBoolean :: (Json.Value -> Compute.Flow s Bool) +decodeBoolean x = case x of + Json.ValueBoolean v322 -> (Flows.pure v322) + _ -> (Flows.fail "expected a boolean") + +decodeArray :: ((Json.Value -> Compute.Flow s a) -> Json.Value -> Compute.Flow s [a]) +decodeArray decodeElem x = case x of + Json.ValueArray v323 -> (Flows.mapList decodeElem v323) + _ -> (Flows.fail "expected an array") + +decodeObject :: (Json.Value -> Compute.Flow s (Map String Json.Value)) +decodeObject x = case x of + Json.ValueObject v324 -> (Flows.pure v324) + _ -> (Flows.fail "expected an object") + +decodeField :: ((Json.Value -> Compute.Flow s a) -> String -> Map String Json.Value -> Compute.Flow s a) +decodeField decodeValue name m = (Flows.bind (decodeOptionalField decodeValue name m) (\x -> case x of + Nothing -> (Flows.fail (Strings.cat [ + "missing field: ", + name])) + Just v325 -> (Flows.pure v325))) + +decodeOptionalField :: ((Json.Value -> Compute.Flow s a) -> String -> Map String Json.Value -> Compute.Flow s (Maybe a)) +decodeOptionalField decodeValue name m = ((\x -> case x of + Nothing -> (Flows.pure Nothing) + Just v326 -> (Flows.map (\x -> Just x) (decodeValue v326))) (Maps.lookup name m)) diff --git a/src/gen-main/haskell/Hydra/Ext/Org/W3/Rdf/Syntax.hs b/src/gen-main/haskell/Hydra/Ext/Org/W3/Rdf/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Org/W3/Rdf/Syntax.hs @@ -0,0 +1,183 @@ +-- | An RDF 1.1 syntax model + +module Hydra.Ext.Org.W3.Rdf.Syntax where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +newtype BlankNode = + BlankNode { + unBlankNode :: String} + deriving (Eq, Ord, Read, Show) + +_BlankNode = (Core.Name "hydra/ext/org/w3/rdf/syntax.BlankNode") + +-- | Stand-in for rdfs:Class +data RdfsClass = + RdfsClass {} + deriving (Eq, Ord, Read, Show) + +_RdfsClass = (Core.Name "hydra/ext/org/w3/rdf/syntax.RdfsClass") + +newtype Dataset = + Dataset { + unDataset :: (Set Quad)} + deriving (Eq, Ord, Read, Show) + +_Dataset = (Core.Name "hydra/ext/org/w3/rdf/syntax.Dataset") + +-- | A graph of RDF statements together with a distinguished subject and/or object node +data Description = + Description { + descriptionSubject :: Node, + descriptionGraph :: Graph} + deriving (Eq, Ord, Read, Show) + +_Description = (Core.Name "hydra/ext/org/w3/rdf/syntax.Description") + +_Description_subject = (Core.Name "subject") + +_Description_graph = (Core.Name "graph") + +newtype Graph = + Graph { + unGraph :: (Set Triple)} + deriving (Eq, Ord, Read, Show) + +_Graph = (Core.Name "hydra/ext/org/w3/rdf/syntax.Graph") + +-- | An Internationalized Resource Identifier +newtype Iri = + Iri { + unIri :: String} + deriving (Eq, Ord, Read, Show) + +_Iri = (Core.Name "hydra/ext/org/w3/rdf/syntax.Iri") + +-- | An IRI or a literal; this type is a convenience for downstream models like SHACL which may exclude blank nodes +data IriOrLiteral = + IriOrLiteralIri Iri | + IriOrLiteralLiteral Literal + deriving (Eq, Ord, Read, Show) + +_IriOrLiteral = (Core.Name "hydra/ext/org/w3/rdf/syntax.IriOrLiteral") + +_IriOrLiteral_iri = (Core.Name "iri") + +_IriOrLiteral_literal = (Core.Name "literal") + +-- | A convenience type which provides at most one string value per language, and optionally a value without a language +newtype LangStrings = + LangStrings { + unLangStrings :: (Map (Maybe LanguageTag) String)} + deriving (Eq, Ord, Read, Show) + +_LangStrings = (Core.Name "hydra/ext/org/w3/rdf/syntax.LangStrings") + +-- | A BCP47 language tag +newtype LanguageTag = + LanguageTag { + unLanguageTag :: String} + deriving (Eq, Ord, Read, Show) + +_LanguageTag = (Core.Name "hydra/ext/org/w3/rdf/syntax.LanguageTag") + +-- | A value such as a string, number, or date +data Literal = + Literal { + -- | a Unicode string, which should be in Normal Form C + literalLexicalForm :: String, + -- | an IRI identifying a datatype that determines how the lexical form maps to a literal value + literalDatatypeIri :: Iri, + -- | An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString + literalLanguageTag :: (Maybe LanguageTag)} + deriving (Eq, Ord, Read, Show) + +_Literal = (Core.Name "hydra/ext/org/w3/rdf/syntax.Literal") + +_Literal_lexicalForm = (Core.Name "lexicalForm") + +_Literal_datatypeIri = (Core.Name "datatypeIri") + +_Literal_languageTag = (Core.Name "languageTag") + +data Node = + NodeIri Iri | + NodeBnode BlankNode | + NodeLiteral Literal + deriving (Eq, Ord, Read, Show) + +_Node = (Core.Name "hydra/ext/org/w3/rdf/syntax.Node") + +_Node_iri = (Core.Name "iri") + +_Node_bnode = (Core.Name "bnode") + +_Node_literal = (Core.Name "literal") + +-- | A type representing an RDF property, and encapsulating its domain, range, and subclass relationships +data Property = + Property { + -- | State that any resource that has a given property is an instance of one or more classes + propertyDomain :: (Set RdfsClass), + -- | States that the values of a property are instances of one or more classes + propertyRange :: (Set RdfsClass), + propertySubPropertyOf :: (Set Property)} + deriving (Eq, Ord, Read, Show) + +_Property = (Core.Name "hydra/ext/org/w3/rdf/syntax.Property") + +_Property_domain = (Core.Name "domain") + +_Property_range = (Core.Name "range") + +_Property_subPropertyOf = (Core.Name "subPropertyOf") + +-- | An RDF triple with an optional named graph component +data Quad = + Quad { + quadSubject :: Resource, + quadPredicate :: Iri, + quadObject :: Node, + quadGraph :: (Maybe Iri)} + deriving (Eq, Ord, Read, Show) + +_Quad = (Core.Name "hydra/ext/org/w3/rdf/syntax.Quad") + +_Quad_subject = (Core.Name "subject") + +_Quad_predicate = (Core.Name "predicate") + +_Quad_object = (Core.Name "object") + +_Quad_graph = (Core.Name "graph") + +data Resource = + ResourceIri Iri | + ResourceBnode BlankNode + deriving (Eq, Ord, Read, Show) + +_Resource = (Core.Name "hydra/ext/org/w3/rdf/syntax.Resource") + +_Resource_iri = (Core.Name "iri") + +_Resource_bnode = (Core.Name "bnode") + +-- | An RDF triple defined by a subject, predicate, and object +data Triple = + Triple { + tripleSubject :: Resource, + triplePredicate :: Iri, + tripleObject :: Node} + deriving (Eq, Ord, Read, Show) + +_Triple = (Core.Name "hydra/ext/org/w3/rdf/syntax.Triple") + +_Triple_subject = (Core.Name "subject") + +_Triple_predicate = (Core.Name "predicate") + +_Triple_object = (Core.Name "object") diff --git a/src/gen-main/haskell/Hydra/Ext/Org/W3/Shacl/Model.hs b/src/gen-main/haskell/Hydra/Ext/Org/W3/Shacl/Model.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Org/W3/Shacl/Model.hs @@ -0,0 +1,357 @@ +-- | A SHACL syntax model. See https://www.w3.org/TR/shacl + +module Hydra.Ext.Org.W3.Shacl.Model where + +import qualified Hydra.Core as Core +import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Syntax +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | See https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent +data Closed = + Closed { + closedIsClosed :: Bool, + closedIgnoredProperties :: (Maybe (Set Syntax.Property))} + deriving (Eq, Ord, Read, Show) + +_Closed = (Core.Name "hydra/ext/org/w3/shacl/model.Closed") + +_Closed_isClosed = (Core.Name "isClosed") + +_Closed_ignoredProperties = (Core.Name "ignoredProperties") + +-- | Any of a number of constraint parameters which can be applied either to node or property shapes +data CommonConstraint = + -- | See https://www.w3.org/TR/shacl/#AndConstraintComponent + CommonConstraintAnd (Set (Reference Shape)) | + -- | See https://www.w3.org/TR/shacl/#ClosedConstraintComponent + CommonConstraintClosed Closed | + -- | See https://www.w3.org/TR/shacl/#ClassConstraintComponent + CommonConstraintClass (Set Syntax.RdfsClass) | + -- | See https://www.w3.org/TR/shacl/#DatatypeConstraintComponent + CommonConstraintDatatype Syntax.Iri | + -- | See https://www.w3.org/TR/shacl/#DisjointConstraintComponent + CommonConstraintDisjoint (Set Syntax.Property) | + -- | See https://www.w3.org/TR/shacl/#EqualsConstraintComponent + CommonConstraintEquals (Set Syntax.Property) | + -- | Specifies the condition that at least one value node is equal to the given RDF term. See https://www.w3.org/TR/shacl/#HasValueConstraintComponent + CommonConstraintHasValue (Set Syntax.Node) | + -- | Specifies the condition that each value node is a member of a provided SHACL list. See https://www.w3.org/TR/shacl/#InConstraintComponent + CommonConstraintIn [Syntax.Node] | + -- | See https://www.w3.org/TR/shacl/#LanguageInConstraintComponent + CommonConstraintLanguageIn (Set Syntax.LanguageTag) | + -- | See https://www.w3.org/TR/shacl/#NodeKindConstraintComponent + CommonConstraintNodeKind NodeKind | + -- | See https://www.w3.org/TR/shacl/#NodeConstraintComponent + CommonConstraintNode (Set (Reference NodeShape)) | + -- | See https://www.w3.org/TR/shacl/#NotConstraintComponent + CommonConstraintNot (Set (Reference Shape)) | + -- | See https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent + CommonConstraintMaxExclusive Syntax.Literal | + -- | See https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent + CommonConstraintMaxInclusive Syntax.Literal | + -- | See https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent + CommonConstraintMaxLength Integer | + -- | See https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent + CommonConstraintMinExclusive Syntax.Literal | + -- | See https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent + CommonConstraintMinInclusive Syntax.Literal | + -- | See https://www.w3.org/TR/shacl/#MinLengthConstraintComponent + CommonConstraintMinLength Integer | + -- | See https://www.w3.org/TR/shacl/#PatternConstraintComponent + CommonConstraintPattern Pattern | + -- | See https://www.w3.org/TR/shacl/#PropertyConstraintComponent + CommonConstraintProperty (Set (Reference PropertyShape)) | + -- | See https://www.w3.org/TR/shacl/#OrConstraintComponent + CommonConstraintOr (Set (Reference Shape)) | + -- | See https://www.w3.org/TR/shacl/#XoneConstraintComponent + CommonConstraintXone (Set (Reference Shape)) + deriving (Eq, Ord, Read, Show) + +_CommonConstraint = (Core.Name "hydra/ext/org/w3/shacl/model.CommonConstraint") + +_CommonConstraint_and = (Core.Name "and") + +_CommonConstraint_closed = (Core.Name "closed") + +_CommonConstraint_class = (Core.Name "class") + +_CommonConstraint_datatype = (Core.Name "datatype") + +_CommonConstraint_disjoint = (Core.Name "disjoint") + +_CommonConstraint_equals = (Core.Name "equals") + +_CommonConstraint_hasValue = (Core.Name "hasValue") + +_CommonConstraint_in = (Core.Name "in") + +_CommonConstraint_languageIn = (Core.Name "languageIn") + +_CommonConstraint_nodeKind = (Core.Name "nodeKind") + +_CommonConstraint_node = (Core.Name "node") + +_CommonConstraint_not = (Core.Name "not") + +_CommonConstraint_maxExclusive = (Core.Name "maxExclusive") + +_CommonConstraint_maxInclusive = (Core.Name "maxInclusive") + +_CommonConstraint_maxLength = (Core.Name "maxLength") + +_CommonConstraint_minExclusive = (Core.Name "minExclusive") + +_CommonConstraint_minInclusive = (Core.Name "minInclusive") + +_CommonConstraint_minLength = (Core.Name "minLength") + +_CommonConstraint_pattern = (Core.Name "pattern") + +_CommonConstraint_property = (Core.Name "property") + +_CommonConstraint_or = (Core.Name "or") + +_CommonConstraint_xone = (Core.Name "xone") + +-- | Common constraint parameters and other properties for SHACL shapes +data CommonProperties = + CommonProperties { + -- | Common constraint parameters attached to this shape + commonPropertiesConstraints :: (Set CommonConstraint), + -- | See https://www.w3.org/TR/shacl/#deactivated + commonPropertiesDeactivated :: (Maybe Bool), + -- | See https://www.w3.org/TR/shacl/#message + commonPropertiesMessage :: Syntax.LangStrings, + -- | See https://www.w3.org/TR/shacl/#severity + commonPropertiesSeverity :: Severity, + -- | See https://www.w3.org/TR/shacl/#targetClass + commonPropertiesTargetClass :: (Set Syntax.RdfsClass), + -- | See https://www.w3.org/TR/shacl/#targetNode + commonPropertiesTargetNode :: (Set Syntax.IriOrLiteral), + -- | See https://www.w3.org/TR/shacl/#targetObjectsOf + commonPropertiesTargetObjectsOf :: (Set Syntax.Property), + -- | See https://www.w3.org/TR/shacl/#targetSubjectsOf + commonPropertiesTargetSubjectsOf :: (Set Syntax.Property)} + deriving (Eq, Ord, Read, Show) + +_CommonProperties = (Core.Name "hydra/ext/org/w3/shacl/model.CommonProperties") + +_CommonProperties_constraints = (Core.Name "constraints") + +_CommonProperties_deactivated = (Core.Name "deactivated") + +_CommonProperties_message = (Core.Name "message") + +_CommonProperties_severity = (Core.Name "severity") + +_CommonProperties_targetClass = (Core.Name "targetClass") + +_CommonProperties_targetNode = (Core.Name "targetNode") + +_CommonProperties_targetObjectsOf = (Core.Name "targetObjectsOf") + +_CommonProperties_targetSubjectsOf = (Core.Name "targetSubjectsOf") + +-- | An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance +data Definition a = + Definition { + definitionIri :: Syntax.Iri, + definitionTarget :: a} + deriving (Eq, Ord, Read, Show) + +_Definition = (Core.Name "hydra/ext/org/w3/shacl/model.Definition") + +_Definition_iri = (Core.Name "iri") + +_Definition_target = (Core.Name "target") + +data NodeKind = + -- | A blank node + NodeKindBlankNode | + -- | An IRI + NodeKindIri | + -- | A literal + NodeKindLiteral | + -- | A blank node or an IRI + NodeKindBlankNodeOrIri | + -- | A blank node or a literal + NodeKindBlankNodeOrLiteral | + -- | An IRI or a literal + NodeKindIriOrLiteral + deriving (Eq, Ord, Read, Show) + +_NodeKind = (Core.Name "hydra/ext/org/w3/shacl/model.NodeKind") + +_NodeKind_blankNode = (Core.Name "blankNode") + +_NodeKind_iri = (Core.Name "iri") + +_NodeKind_literal = (Core.Name "literal") + +_NodeKind_blankNodeOrIri = (Core.Name "blankNodeOrIri") + +_NodeKind_blankNodeOrLiteral = (Core.Name "blankNodeOrLiteral") + +_NodeKind_iriOrLiteral = (Core.Name "iriOrLiteral") + +-- | A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes +data NodeShape = + NodeShape { + nodeShapeCommon :: CommonProperties} + deriving (Eq, Ord, Read, Show) + +_NodeShape = (Core.Name "hydra/ext/org/w3/shacl/model.NodeShape") + +_NodeShape_common = (Core.Name "common") + +-- | A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent +data Pattern = + Pattern { + patternRegex :: String, + patternFlags :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_Pattern = (Core.Name "hydra/ext/org/w3/shacl/model.Pattern") + +_Pattern_regex = (Core.Name "regex") + +_Pattern_flags = (Core.Name "flags") + +-- | A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes +data PropertyShape = + PropertyShape { + propertyShapeCommon :: CommonProperties, + -- | Any property shape -specific constraint parameters + propertyShapeConstraints :: (Set PropertyShapeConstraint), + -- | See https://www.w3.org/TR/shacl/#defaultValue + propertyShapeDefaultValue :: (Maybe Syntax.Node), + -- | See https://www.w3.org/TR/shacl/#name + propertyShapeDescription :: Syntax.LangStrings, + -- | See https://www.w3.org/TR/shacl/#name + propertyShapeName :: Syntax.LangStrings, + -- | See https://www.w3.org/TR/shacl/#order + propertyShapeOrder :: (Maybe Integer), + propertyShapePath :: Syntax.Iri} + deriving (Eq, Ord, Read, Show) + +_PropertyShape = (Core.Name "hydra/ext/org/w3/shacl/model.PropertyShape") + +_PropertyShape_common = (Core.Name "common") + +_PropertyShape_constraints = (Core.Name "constraints") + +_PropertyShape_defaultValue = (Core.Name "defaultValue") + +_PropertyShape_description = (Core.Name "description") + +_PropertyShape_name = (Core.Name "name") + +_PropertyShape_order = (Core.Name "order") + +_PropertyShape_path = (Core.Name "path") + +-- | A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes +data PropertyShapeConstraint = + -- | See https://www.w3.org/TR/shacl/#LessThanConstraintComponent + PropertyShapeConstraintLessThan (Set Syntax.Property) | + -- | See https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent + PropertyShapeConstraintLessThanOrEquals (Set Syntax.Property) | + -- | The maximum cardinality. Node shapes cannot have any value for sh:maxCount. See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent + PropertyShapeConstraintMaxCount Integer | + -- | The minimum cardinality. Node shapes cannot have any value for sh:minCount. See https://www.w3.org/TR/shacl/#MinCountConstraintComponent + PropertyShapeConstraintMinCount Integer | + -- | See https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent + PropertyShapeConstraintUniqueLang Bool | + -- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent + PropertyShapeConstraintQualifiedValueShape QualifiedValueShape + deriving (Eq, Ord, Read, Show) + +_PropertyShapeConstraint = (Core.Name "hydra/ext/org/w3/shacl/model.PropertyShapeConstraint") + +_PropertyShapeConstraint_lessThan = (Core.Name "lessThan") + +_PropertyShapeConstraint_lessThanOrEquals = (Core.Name "lessThanOrEquals") + +_PropertyShapeConstraint_maxCount = (Core.Name "maxCount") + +_PropertyShapeConstraint_minCount = (Core.Name "minCount") + +_PropertyShapeConstraint_uniqueLang = (Core.Name "uniqueLang") + +_PropertyShapeConstraint_qualifiedValueShape = (Core.Name "qualifiedValueShape") + +-- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent +data QualifiedValueShape = + QualifiedValueShape { + qualifiedValueShapeQualifiedValueShape :: (Reference Shape), + qualifiedValueShapeQualifiedMaxCount :: Integer, + qualifiedValueShapeQualifiedMinCount :: Integer, + qualifiedValueShapeQualifiedValueShapesDisjoint :: (Maybe Bool)} + deriving (Eq, Ord, Read, Show) + +_QualifiedValueShape = (Core.Name "hydra/ext/org/w3/shacl/model.QualifiedValueShape") + +_QualifiedValueShape_qualifiedValueShape = (Core.Name "qualifiedValueShape") + +_QualifiedValueShape_qualifiedMaxCount = (Core.Name "qualifiedMaxCount") + +_QualifiedValueShape_qualifiedMinCount = (Core.Name "qualifiedMinCount") + +_QualifiedValueShape_qualifiedValueShapesDisjoint = (Core.Name "qualifiedValueShapesDisjoint") + +-- | Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type +data Reference a = + ReferenceNamed Syntax.Iri | + -- | An anonymous instance + ReferenceAnonymous a | + -- | An inline definition + ReferenceDefinition (Definition a) + deriving (Eq, Ord, Read, Show) + +_Reference = (Core.Name "hydra/ext/org/w3/shacl/model.Reference") + +_Reference_named = (Core.Name "named") + +_Reference_anonymous = (Core.Name "anonymous") + +_Reference_definition = (Core.Name "definition") + +data Severity = + -- | A non-critical constraint violation indicating an informative message + SeverityInfo | + -- | A non-critical constraint violation indicating a warning + SeverityWarning | + -- | A constraint violation + SeverityViolation + deriving (Eq, Ord, Read, Show) + +_Severity = (Core.Name "hydra/ext/org/w3/shacl/model.Severity") + +_Severity_info = (Core.Name "info") + +_Severity_warning = (Core.Name "warning") + +_Severity_violation = (Core.Name "violation") + +-- | A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes +data Shape = + ShapeNode NodeShape | + ShapeProperty PropertyShape + deriving (Eq, Ord, Read, Show) + +_Shape = (Core.Name "hydra/ext/org/w3/shacl/model.Shape") + +_Shape_node = (Core.Name "node") + +_Shape_property = (Core.Name "property") + +-- | An RDF graph containing zero or more shapes that is passed into a SHACL validation process so that a data graph can be validated against the shapes +newtype ShapesGraph = + ShapesGraph { + unShapesGraph :: (Set (Definition Shape))} + deriving (Eq, Ord, Read, Show) + +_ShapesGraph = (Core.Name "hydra/ext/org/w3/shacl/model.ShapesGraph") diff --git a/src/gen-main/haskell/Hydra/Ext/Org/Yaml/Model.hs b/src/gen-main/haskell/Hydra/Ext/Org/Yaml/Model.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Org/Yaml/Model.hs @@ -0,0 +1,54 @@ +-- | A basic YAML representation model. Based on: +-- | https://yaml.org/spec/1.2/spec.html +-- | The Serialization and Presentation properties of YAML, +-- | including directives, comments, anchors, style, formatting, and aliases, are not supported by this model. +-- | In addition, tags are omitted from this model, and non-standard scalars are unsupported. + +module Hydra.Ext.Org.Yaml.Model where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | A YAML node (value) +data Node = + NodeMapping (Map Node Node) | + NodeScalar Scalar | + NodeSequence [Node] + deriving (Eq, Ord, Read, Show) + +_Node = (Core.Name "hydra/ext/org/yaml/model.Node") + +_Node_mapping = (Core.Name "mapping") + +_Node_scalar = (Core.Name "scalar") + +_Node_sequence = (Core.Name "sequence") + +-- | A union of scalars supported in the YAML failsafe and JSON schemas. Other scalars are not supported here +data Scalar = + -- | Represents a true/false value + ScalarBool Bool | + -- | Represents an approximation to real numbers + ScalarFloat Double | + -- | Represents arbitrary sized finite mathematical integers + ScalarInt Integer | + -- | Represents the lack of a value + ScalarNull | + -- | A string value + ScalarStr String + deriving (Eq, Ord, Read, Show) + +_Scalar = (Core.Name "hydra/ext/org/yaml/model.Scalar") + +_Scalar_bool = (Core.Name "bool") + +_Scalar_float = (Core.Name "float") + +_Scalar_int = (Core.Name "int") + +_Scalar_null = (Core.Name "null") + +_Scalar_str = (Core.Name "str") diff --git a/src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs b/src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs @@ -0,0 +1,268 @@ +-- | A model for PDL (Pegasus Data Language) schemas. Based on the specification at: +-- | https://linkedin.github.io/rest.li/pdl_schema + +module Hydra.Ext.Pegasus.Pdl where + +import qualified Hydra.Core as Core +import qualified Hydra.Json as Json +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas +data Annotations = + Annotations { + annotationsDoc :: (Maybe String), + annotationsDeprecated :: Bool} + deriving (Eq, Ord, Read, Show) + +_Annotations = (Core.Name "hydra/ext/pegasus/pdl.Annotations") + +_Annotations_doc = (Core.Name "doc") + +_Annotations_deprecated = (Core.Name "deprecated") + +data EnumField = + EnumField { + enumFieldName :: EnumFieldName, + enumFieldAnnotations :: Annotations} + deriving (Eq, Ord, Read, Show) + +_EnumField = (Core.Name "hydra/ext/pegasus/pdl.EnumField") + +_EnumField_name = (Core.Name "name") + +_EnumField_annotations = (Core.Name "annotations") + +newtype EnumFieldName = + EnumFieldName { + unEnumFieldName :: String} + deriving (Eq, Ord, Read, Show) + +_EnumFieldName = (Core.Name "hydra/ext/pegasus/pdl.EnumFieldName") + +data EnumSchema = + EnumSchema { + enumSchemaFields :: [EnumField]} + deriving (Eq, Ord, Read, Show) + +_EnumSchema = (Core.Name "hydra/ext/pegasus/pdl.EnumSchema") + +_EnumSchema_fields = (Core.Name "fields") + +newtype FieldName = + FieldName { + unFieldName :: String} + deriving (Eq, Ord, Read, Show) + +_FieldName = (Core.Name "hydra/ext/pegasus/pdl.FieldName") + +data NamedSchema = + NamedSchema { + namedSchemaQualifiedName :: QualifiedName, + namedSchemaType :: NamedSchema_Type, + namedSchemaAnnotations :: Annotations} + deriving (Eq, Ord, Read, Show) + +_NamedSchema = (Core.Name "hydra/ext/pegasus/pdl.NamedSchema") + +_NamedSchema_qualifiedName = (Core.Name "qualifiedName") + +_NamedSchema_type = (Core.Name "type") + +_NamedSchema_annotations = (Core.Name "annotations") + +data NamedSchema_Type = + NamedSchema_TypeRecord RecordSchema | + NamedSchema_TypeEnum EnumSchema | + NamedSchema_TypeTyperef Schema + deriving (Eq, Ord, Read, Show) + +_NamedSchema_Type = (Core.Name "hydra/ext/pegasus/pdl.NamedSchema.Type") + +_NamedSchema_Type_record = (Core.Name "record") + +_NamedSchema_Type_enum = (Core.Name "enum") + +_NamedSchema_Type_typeref = (Core.Name "typeref") + +newtype Name = + Name { + unName :: String} + deriving (Eq, Ord, Read, Show) + +_Name = (Core.Name "hydra/ext/pegasus/pdl.Name") + +newtype Namespace = + Namespace { + unNamespace :: String} + deriving (Eq, Ord, Read, Show) + +_Namespace = (Core.Name "hydra/ext/pegasus/pdl.Namespace") + +newtype Package = + Package { + unPackage :: String} + deriving (Eq, Ord, Read, Show) + +_Package = (Core.Name "hydra/ext/pegasus/pdl.Package") + +data PrimitiveType = + PrimitiveTypeBoolean | + PrimitiveTypeBytes | + PrimitiveTypeDouble | + PrimitiveTypeFloat | + PrimitiveTypeInt | + PrimitiveTypeLong | + PrimitiveTypeString + deriving (Eq, Ord, Read, Show) + +_PrimitiveType = (Core.Name "hydra/ext/pegasus/pdl.PrimitiveType") + +_PrimitiveType_boolean = (Core.Name "boolean") + +_PrimitiveType_bytes = (Core.Name "bytes") + +_PrimitiveType_double = (Core.Name "double") + +_PrimitiveType_float = (Core.Name "float") + +_PrimitiveType_int = (Core.Name "int") + +_PrimitiveType_long = (Core.Name "long") + +_PrimitiveType_string = (Core.Name "string") + +newtype PropertyKey = + PropertyKey { + unPropertyKey :: String} + deriving (Eq, Ord, Read, Show) + +_PropertyKey = (Core.Name "hydra/ext/pegasus/pdl.PropertyKey") + +data Property = + Property { + propertyKey :: PropertyKey, + propertyValue :: (Maybe Json.Value)} + deriving (Eq, Ord, Read, Show) + +_Property = (Core.Name "hydra/ext/pegasus/pdl.Property") + +_Property_key = (Core.Name "key") + +_Property_value = (Core.Name "value") + +data QualifiedName = + QualifiedName { + qualifiedNameName :: Name, + qualifiedNameNamespace :: (Maybe Namespace)} + deriving (Eq, Ord, Read, Show) + +_QualifiedName = (Core.Name "hydra/ext/pegasus/pdl.QualifiedName") + +_QualifiedName_name = (Core.Name "name") + +_QualifiedName_namespace = (Core.Name "namespace") + +data RecordField = + RecordField { + recordFieldName :: FieldName, + recordFieldValue :: Schema, + recordFieldOptional :: Bool, + recordFieldDefault :: (Maybe Json.Value), + recordFieldAnnotations :: Annotations} + deriving (Eq, Ord, Read, Show) + +_RecordField = (Core.Name "hydra/ext/pegasus/pdl.RecordField") + +_RecordField_name = (Core.Name "name") + +_RecordField_value = (Core.Name "value") + +_RecordField_optional = (Core.Name "optional") + +_RecordField_default = (Core.Name "default") + +_RecordField_annotations = (Core.Name "annotations") + +data RecordSchema = + RecordSchema { + recordSchemaFields :: [RecordField], + recordSchemaIncludes :: [NamedSchema]} + deriving (Eq, Ord, Read, Show) + +_RecordSchema = (Core.Name "hydra/ext/pegasus/pdl.RecordSchema") + +_RecordSchema_fields = (Core.Name "fields") + +_RecordSchema_includes = (Core.Name "includes") + +data Schema = + SchemaArray Schema | + SchemaFixed Int | + SchemaInline NamedSchema | + SchemaMap Schema | + SchemaNamed QualifiedName | + SchemaNull | + SchemaPrimitive PrimitiveType | + SchemaUnion UnionSchema + deriving (Eq, Ord, Read, Show) + +_Schema = (Core.Name "hydra/ext/pegasus/pdl.Schema") + +_Schema_array = (Core.Name "array") + +_Schema_fixed = (Core.Name "fixed") + +_Schema_inline = (Core.Name "inline") + +_Schema_map = (Core.Name "map") + +_Schema_named = (Core.Name "named") + +_Schema_null = (Core.Name "null") + +_Schema_primitive = (Core.Name "primitive") + +_Schema_union = (Core.Name "union") + +data SchemaFile = + SchemaFile { + schemaFileNamespace :: Namespace, + schemaFilePackage :: (Maybe Package), + schemaFileImports :: [QualifiedName], + schemaFileSchemas :: [NamedSchema]} + deriving (Eq, Ord, Read, Show) + +_SchemaFile = (Core.Name "hydra/ext/pegasus/pdl.SchemaFile") + +_SchemaFile_namespace = (Core.Name "namespace") + +_SchemaFile_package = (Core.Name "package") + +_SchemaFile_imports = (Core.Name "imports") + +_SchemaFile_schemas = (Core.Name "schemas") + +data UnionMember = + UnionMember { + unionMemberAlias :: (Maybe FieldName), + unionMemberValue :: Schema, + unionMemberAnnotations :: Annotations} + deriving (Eq, Ord, Read, Show) + +_UnionMember = (Core.Name "hydra/ext/pegasus/pdl.UnionMember") + +_UnionMember_alias = (Core.Name "alias") + +_UnionMember_value = (Core.Name "value") + +_UnionMember_annotations = (Core.Name "annotations") + +newtype UnionSchema = + UnionSchema { + unUnionSchema :: [UnionMember]} + deriving (Eq, Ord, Read, Show) + +_UnionSchema = (Core.Name "hydra/ext/pegasus/pdl.UnionSchema") diff --git a/src/gen-main/haskell/Hydra/Ext/Protobuf/Any.hs b/src/gen-main/haskell/Hydra/Ext/Protobuf/Any.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Protobuf/Any.hs @@ -0,0 +1,24 @@ +-- | Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/any.proto + +module Hydra.Ext.Protobuf.Any where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | `Any` contains an arbitrary serialized protocol buffer message along with a URL that describes the type of the serialized message. +data Any = + Any { + -- | A URL/resource name that uniquely identifies the type of the serialized protocol buffer message. + anyTypeUrl :: String, + -- | Must be a valid serialized protocol buffer of the above specified type. + anyValue :: String} + deriving (Eq, Ord, Read, Show) + +_Any = (Core.Name "hydra/ext/protobuf/any.Any") + +_Any_typeUrl = (Core.Name "typeUrl") + +_Any_value = (Core.Name "value") diff --git a/src/gen-main/haskell/Hydra/Ext/Protobuf/Language.hs b/src/gen-main/haskell/Hydra/Ext/Protobuf/Language.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Protobuf/Language.hs @@ -0,0 +1,90 @@ +-- | Language constraints for Protobuf v3 + +module Hydra.Ext.Protobuf.Language where + +import qualified Hydra.Coders as Coders +import qualified Hydra.Core as Core +import qualified Hydra.Lib.Lists as Lists +import qualified Hydra.Lib.Sets as Sets +import qualified Hydra.Mantle as Mantle +import qualified Hydra.Strip as Strip +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | Language constraints for Protocol Buffers v3 +protobufLanguage :: Coders.Language +protobufLanguage = Coders.Language { + Coders.languageName = (Coders.LanguageName "hydra/ext/protobuf"), + Coders.languageConstraints = Coders.LanguageConstraints { + Coders.languageConstraintsEliminationVariants = Sets.empty, + Coders.languageConstraintsLiteralVariants = (Sets.fromList [ + Mantle.LiteralVariantBinary, + Mantle.LiteralVariantBoolean, + Mantle.LiteralVariantFloat, + Mantle.LiteralVariantInteger, + Mantle.LiteralVariantString]), + Coders.languageConstraintsFloatTypes = (Sets.fromList [ + Core.FloatTypeFloat32, + Core.FloatTypeFloat64]), + Coders.languageConstraintsFunctionVariants = Sets.empty, + Coders.languageConstraintsIntegerTypes = (Sets.fromList [ + Core.IntegerTypeInt32, + Core.IntegerTypeInt64, + Core.IntegerTypeUint32, + Core.IntegerTypeUint64]), + Coders.languageConstraintsTermVariants = (Sets.fromList [ + Mantle.TermVariantList, + Mantle.TermVariantLiteral, + Mantle.TermVariantMap, + Mantle.TermVariantOptional, + Mantle.TermVariantRecord, + Mantle.TermVariantUnion]), + Coders.languageConstraintsTypeVariants = (Sets.fromList [ + Mantle.TypeVariantAnnotated, + Mantle.TypeVariantList, + Mantle.TypeVariantLiteral, + Mantle.TypeVariantMap, + Mantle.TypeVariantOptional, + Mantle.TypeVariantRecord, + Mantle.TypeVariantUnion, + Mantle.TypeVariantVariable]), + Coders.languageConstraintsTypes = (\x -> case x of + Core.TypeMap v327 -> ((\x -> case x of + Core.TypeOptional _ -> False + _ -> True) (Strip.stripType (Core.mapTypeValues v327))) + _ -> True)}} + +-- | A set of reserved words in Protobuf +protobufReservedWords :: (Set String) +protobufReservedWords = (Sets.fromList (Lists.concat [ + fieldNames])) + where + fieldNames = [ + "case", + "class", + "data", + "default", + "deriving", + "do", + "else", + "foreign", + "if", + "import", + "in", + "infix", + "infixl", + "infixr", + "instance", + "let", + "mdo", + "module", + "newtype", + "of", + "pattern", + "proc", + "rec", + "then", + "type", + "where"] diff --git a/src/gen-main/haskell/Hydra/Ext/Protobuf/Proto3.hs b/src/gen-main/haskell/Hydra/Ext/Protobuf/Proto3.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Protobuf/Proto3.hs @@ -0,0 +1,275 @@ +-- | A model for Protocol Buffers v3 enum and message types, designed as a target for transformations.This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto, as well as the proto3 reference documentation + +module Hydra.Ext.Protobuf.Proto3 where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +data Definition = + DefinitionEnum EnumDefinition | + DefinitionMessage MessageDefinition + deriving (Eq, Ord, Read, Show) + +_Definition = (Core.Name "hydra/ext/protobuf/proto3.Definition") + +_Definition_enum = (Core.Name "enum") + +_Definition_message = (Core.Name "message") + +-- | Enum type definition +data EnumDefinition = + EnumDefinition { + -- | Enum type name + enumDefinitionName :: TypeName, + -- | Enum value definitions + enumDefinitionValues :: [EnumValue], + -- | Protocol buffer options + enumDefinitionOptions :: [Option]} + deriving (Eq, Ord, Read, Show) + +_EnumDefinition = (Core.Name "hydra/ext/protobuf/proto3.EnumDefinition") + +_EnumDefinition_name = (Core.Name "name") + +_EnumDefinition_values = (Core.Name "values") + +_EnumDefinition_options = (Core.Name "options") + +-- | Enum value definition +data EnumValue = + EnumValue { + -- | Enum value name + enumValueName :: EnumValueName, + -- | Enum value number + enumValueNumber :: Int, + -- | Protocol buffer options + enumValueOptions :: [Option]} + deriving (Eq, Ord, Read, Show) + +_EnumValue = (Core.Name "hydra/ext/protobuf/proto3.EnumValue") + +_EnumValue_name = (Core.Name "name") + +_EnumValue_number = (Core.Name "number") + +_EnumValue_options = (Core.Name "options") + +newtype EnumValueName = + EnumValueName { + unEnumValueName :: String} + deriving (Eq, Ord, Read, Show) + +_EnumValueName = (Core.Name "hydra/ext/protobuf/proto3.EnumValueName") + +-- | A single field of a message type +data Field = + Field { + -- | The field name + fieldName :: FieldName, + -- | The field JSON name + fieldJsonName :: (Maybe String), + -- | The datatype of the field + fieldType :: FieldType, + -- | The field number + fieldNumber :: Int, + -- | The protocol buffer options + fieldOptions :: [Option]} + deriving (Eq, Ord, Read, Show) + +_Field = (Core.Name "hydra/ext/protobuf/proto3.Field") + +_Field_name = (Core.Name "name") + +_Field_jsonName = (Core.Name "jsonName") + +_Field_type = (Core.Name "type") + +_Field_number = (Core.Name "number") + +_Field_options = (Core.Name "options") + +-- | The name of a field +newtype FieldName = + FieldName { + unFieldName :: String} + deriving (Eq, Ord, Read, Show) + +_FieldName = (Core.Name "hydra/ext/protobuf/proto3.FieldName") + +data FieldType = + FieldTypeMap SimpleType | + FieldTypeOneof [Field] | + FieldTypeRepeated SimpleType | + FieldTypeSimple SimpleType + deriving (Eq, Ord, Read, Show) + +_FieldType = (Core.Name "hydra/ext/protobuf/proto3.FieldType") + +_FieldType_map = (Core.Name "map") + +_FieldType_oneof = (Core.Name "oneof") + +_FieldType_repeated = (Core.Name "repeated") + +_FieldType_simple = (Core.Name "simple") + +newtype FileReference = + FileReference { + unFileReference :: String} + deriving (Eq, Ord, Read, Show) + +_FileReference = (Core.Name "hydra/ext/protobuf/proto3.FileReference") + +-- | A protocol buffer message type +data MessageDefinition = + MessageDefinition { + -- | The fully qualified message name + messageDefinitionName :: TypeName, + -- | The list of fields + messageDefinitionFields :: [Field], + -- | The protocol buffer options + messageDefinitionOptions :: [Option]} + deriving (Eq, Ord, Read, Show) + +_MessageDefinition = (Core.Name "hydra/ext/protobuf/proto3.MessageDefinition") + +_MessageDefinition_name = (Core.Name "name") + +_MessageDefinition_fields = (Core.Name "fields") + +_MessageDefinition_options = (Core.Name "options") + +-- | A protocol buffer option, which can be attached to a message, field, enumeration, etc +data Option = + Option { + -- | The option's name. For protobuf built-in options (options defined in descriptor.proto), this is the short name. For example, `"map_entry"`. For custom options, it should be the fully-qualified name. For example, `"google.api.http"`. + optionName :: String, + -- | The option's value + optionValue :: Value} + deriving (Eq, Ord, Read, Show) + +_Option = (Core.Name "hydra/ext/protobuf/proto3.Option") + +_Option_name = (Core.Name "name") + +_Option_value = (Core.Name "value") + +newtype PackageName = + PackageName { + unPackageName :: String} + deriving (Eq, Ord, Read, Show) + +_PackageName = (Core.Name "hydra/ext/protobuf/proto3.PackageName") + +-- | A .proto file, usually containing one or more enum or message type definitions +data ProtoFile = + ProtoFile { + protoFilePackage :: PackageName, + protoFileImports :: [FileReference], + protoFileTypes :: [Definition], + protoFileOptions :: [Option]} + deriving (Eq, Ord, Read, Show) + +_ProtoFile = (Core.Name "hydra/ext/protobuf/proto3.ProtoFile") + +_ProtoFile_package = (Core.Name "package") + +_ProtoFile_imports = (Core.Name "imports") + +_ProtoFile_types = (Core.Name "types") + +_ProtoFile_options = (Core.Name "options") + +-- | One of several Proto3 scalar types +data ScalarType = + ScalarTypeBool | + ScalarTypeBytes | + ScalarTypeDouble | + ScalarTypeFixed32 | + ScalarTypeFixed64 | + ScalarTypeFloat | + ScalarTypeInt32 | + ScalarTypeInt64 | + ScalarTypeSfixed32 | + ScalarTypeSfixed64 | + ScalarTypeSint32 | + ScalarTypeSint64 | + ScalarTypeString | + ScalarTypeUint32 | + ScalarTypeUint64 + deriving (Eq, Ord, Read, Show) + +_ScalarType = (Core.Name "hydra/ext/protobuf/proto3.ScalarType") + +_ScalarType_bool = (Core.Name "bool") + +_ScalarType_bytes = (Core.Name "bytes") + +_ScalarType_double = (Core.Name "double") + +_ScalarType_fixed32 = (Core.Name "fixed32") + +_ScalarType_fixed64 = (Core.Name "fixed64") + +_ScalarType_float = (Core.Name "float") + +_ScalarType_int32 = (Core.Name "int32") + +_ScalarType_int64 = (Core.Name "int64") + +_ScalarType_sfixed32 = (Core.Name "sfixed32") + +_ScalarType_sfixed64 = (Core.Name "sfixed64") + +_ScalarType_sint32 = (Core.Name "sint32") + +_ScalarType_sint64 = (Core.Name "sint64") + +_ScalarType_string = (Core.Name "string") + +_ScalarType_uint32 = (Core.Name "uint32") + +_ScalarType_uint64 = (Core.Name "uint64") + +-- | A scalar type or a reference to an enum type or message type +data SimpleType = + SimpleTypeReference TypeName | + SimpleTypeScalar ScalarType + deriving (Eq, Ord, Read, Show) + +_SimpleType = (Core.Name "hydra/ext/protobuf/proto3.SimpleType") + +_SimpleType_reference = (Core.Name "reference") + +_SimpleType_scalar = (Core.Name "scalar") + +-- | The local name of an enum type or message type +newtype TypeName = + TypeName { + unTypeName :: String} + deriving (Eq, Ord, Read, Show) + +_TypeName = (Core.Name "hydra/ext/protobuf/proto3.TypeName") + +-- | A reference to an enum type or message type +newtype TypeReference = + TypeReference { + unTypeReference :: String} + deriving (Eq, Ord, Read, Show) + +_TypeReference = (Core.Name "hydra/ext/protobuf/proto3.TypeReference") + +-- | A scalar value +data Value = + ValueBoolean Bool | + ValueString String + deriving (Eq, Ord, Read, Show) + +_Value = (Core.Name "hydra/ext/protobuf/proto3.Value") + +_Value_boolean = (Core.Name "boolean") + +_Value_string = (Core.Name "string") diff --git a/src/gen-main/haskell/Hydra/Ext/Protobuf/SourceContext.hs b/src/gen-main/haskell/Hydra/Ext/Protobuf/SourceContext.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Protobuf/SourceContext.hs @@ -0,0 +1,20 @@ +-- | Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/source_context.proto + +module Hydra.Ext.Protobuf.SourceContext where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | `SourceContext` represents information about the source of a protobuf element, like the file in which it is defined. +data SourceContext = + SourceContext { + -- | The path-qualified name of the .proto file that contained the associated protobuf element. For example: `"google/protobuf/source_context.proto"`. + sourceContextFileName :: String} + deriving (Eq, Ord, Read, Show) + +_SourceContext = (Core.Name "hydra/ext/protobuf/sourceContext.SourceContext") + +_SourceContext_fileName = (Core.Name "fileName") diff --git a/src/gen-main/haskell/Hydra/Ext/RelationalModel.hs b/src/gen-main/haskell/Hydra/Ext/RelationalModel.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/RelationalModel.hs @@ -0,0 +1,113 @@ +-- | An interpretation of Codd's Relational Model, as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). Types ('domains') and values are parameterized so as to allow for application-specific implementations. No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized. + +module Hydra.Ext.RelationalModel where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd +newtype ColumnName = + ColumnName { + unColumnName :: String} + deriving (Eq, Ord, Read, Show) + +_ColumnName = (Core.Name "hydra/ext/relationalModel.ColumnName") + +-- | An abstract specification of the domain represented by a column in a relation; a role +data ColumnSchema t = + ColumnSchema { + -- | A unique name for the column + columnSchemaName :: ColumnName, + -- | The domain (type) of the column + columnSchemaDomain :: t, + -- | Whether this column represents the primary key of its relation + columnSchemaIsPrimaryKey :: Bool} + deriving (Eq, Ord, Read, Show) + +_ColumnSchema = (Core.Name "hydra/ext/relationalModel.ColumnSchema") + +_ColumnSchema_name = (Core.Name "name") + +_ColumnSchema_domain = (Core.Name "domain") + +_ColumnSchema_isPrimaryKey = (Core.Name "isPrimaryKey") + +-- | A mapping from certain columns of a source relation to primary key columns of a target relation +data ForeignKey = + ForeignKey { + -- | The name of the target relation + foreignKeyForeignRelation :: RelationName, + foreignKeyKeys :: (Map ColumnName ColumnName)} + deriving (Eq, Ord, Read, Show) + +_ForeignKey = (Core.Name "hydra/ext/relationalModel.ForeignKey") + +_ForeignKey_foreignRelation = (Core.Name "foreignRelation") + +_ForeignKey_keys = (Core.Name "keys") + +-- | A primary key of a relation, specified either as a single column, or as a list of columns +newtype PrimaryKey = + PrimaryKey { + unPrimaryKey :: [ColumnName]} + deriving (Eq, Ord, Read, Show) + +_PrimaryKey = (Core.Name "hydra/ext/relationalModel.PrimaryKey") + +-- | A set of distinct n-tuples; a table +newtype Relation v = + Relation { + unRelation :: (Set [v])} + deriving (Eq, Ord, Read, Show) + +_Relation = (Core.Name "hydra/ext/relationalModel.Relation") + +-- | A unique relation (table) name +newtype RelationName = + RelationName { + unRelationName :: String} + deriving (Eq, Ord, Read, Show) + +_RelationName = (Core.Name "hydra/ext/relationalModel.RelationName") + +-- | An abstract relation; the name and columns of a relation without its actual data +data RelationSchema t = + RelationSchema { + -- | A unique name for the relation + relationSchemaName :: RelationName, + -- | A list of column specifications + relationSchemaColumns :: [ColumnSchema t], + -- | Any number of primary keys for the relation, each of which must be valid for this relation + relationSchemaPrimaryKeys :: [PrimaryKey], + -- | Any number of foreign keys, each of which must be valid for both this relation and the target relation + relationSchemaForeignKeys :: [ForeignKey]} + deriving (Eq, Ord, Read, Show) + +_RelationSchema = (Core.Name "hydra/ext/relationalModel.RelationSchema") + +_RelationSchema_name = (Core.Name "name") + +_RelationSchema_columns = (Core.Name "columns") + +_RelationSchema_primaryKeys = (Core.Name "primaryKeys") + +_RelationSchema_foreignKeys = (Core.Name "foreignKeys") + +-- | A domain-unordered (string-indexed, rather than position-indexed) relation +newtype Relationship v = + Relationship { + unRelationship :: (Set (Map ColumnName v))} + deriving (Eq, Ord, Read, Show) + +_Relationship = (Core.Name "hydra/ext/relationalModel.Relationship") + +-- | An n-tuple which is an element of a given relation +newtype Row v = + Row { + unRow :: [v]} + deriving (Eq, Ord, Read, Show) + +_Row = (Core.Name "hydra/ext/relationalModel.Row") diff --git a/src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs b/src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs @@ -0,0 +1,2265 @@ +-- | A Scala syntax model based on Scalameta (https://scalameta.org) + +module Hydra.Ext.Scala.Meta where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +newtype PredefString = + PredefString { + unPredefString :: String} + deriving (Eq, Ord, Read, Show) + +_PredefString = (Core.Name "hydra/ext/scala/meta.PredefString") + +data ScalaSymbol = + ScalaSymbol { + scalaSymbolName :: String} + deriving (Eq, Ord, Read, Show) + +_ScalaSymbol = (Core.Name "hydra/ext/scala/meta.ScalaSymbol") + +_ScalaSymbol_name = (Core.Name "name") + +data Tree = + TreeRef Ref | + TreeStat Stat | + TreeType Type | + TreeBounds Type_Bounds | + TreePat Pat | + TreeMember Member | + TreeCtor Ctor | + TreeTemplate Template | + TreeMod Mod | + TreeEnumerator Enumerator | + TreeImporter Importer | + TreeImportee Importee | + TreeCaseTree CaseTree | + TreeSource Source | + TreeQuasi Quasi + deriving (Eq, Ord, Read, Show) + +_Tree = (Core.Name "hydra/ext/scala/meta.Tree") + +_Tree_ref = (Core.Name "ref") + +_Tree_stat = (Core.Name "stat") + +_Tree_type = (Core.Name "type") + +_Tree_bounds = (Core.Name "bounds") + +_Tree_pat = (Core.Name "pat") + +_Tree_member = (Core.Name "member") + +_Tree_ctor = (Core.Name "ctor") + +_Tree_template = (Core.Name "template") + +_Tree_mod = (Core.Name "mod") + +_Tree_enumerator = (Core.Name "enumerator") + +_Tree_importer = (Core.Name "importer") + +_Tree_importee = (Core.Name "importee") + +_Tree_caseTree = (Core.Name "caseTree") + +_Tree_source = (Core.Name "source") + +_Tree_quasi = (Core.Name "quasi") + +data Ref = + RefName Name | + RefInit Init + deriving (Eq, Ord, Read, Show) + +_Ref = (Core.Name "hydra/ext/scala/meta.Ref") + +_Ref_name = (Core.Name "name") + +_Ref_init = (Core.Name "init") + +data Stat = + StatTerm Data | + StatDecl Decl | + StatDefn Defn | + StatImportExport ImportExportStat + deriving (Eq, Ord, Read, Show) + +_Stat = (Core.Name "hydra/ext/scala/meta.Stat") + +_Stat_term = (Core.Name "term") + +_Stat_decl = (Core.Name "decl") + +_Stat_defn = (Core.Name "defn") + +_Stat_importExport = (Core.Name "importExport") + +data Name = + NameValue String | + NameAnonymous | + NameIndeterminate PredefString + deriving (Eq, Ord, Read, Show) + +_Name = (Core.Name "hydra/ext/scala/meta.Name") + +_Name_value = (Core.Name "value") + +_Name_anonymous = (Core.Name "anonymous") + +_Name_indeterminate = (Core.Name "indeterminate") + +data Lit = + LitNull | + LitInt Int | + LitDouble Double | + LitFloat Float | + LitByte Int8 | + LitShort Int16 | + LitChar Int | + LitLong Int64 | + LitBoolean Bool | + LitUnit | + LitString String | + LitSymbol ScalaSymbol + deriving (Eq, Ord, Read, Show) + +_Lit = (Core.Name "hydra/ext/scala/meta.Lit") + +_Lit_null = (Core.Name "null") + +_Lit_int = (Core.Name "int") + +_Lit_double = (Core.Name "double") + +_Lit_float = (Core.Name "float") + +_Lit_byte = (Core.Name "byte") + +_Lit_short = (Core.Name "short") + +_Lit_char = (Core.Name "char") + +_Lit_long = (Core.Name "long") + +_Lit_boolean = (Core.Name "boolean") + +_Lit_unit = (Core.Name "unit") + +_Lit_string = (Core.Name "string") + +_Lit_symbol = (Core.Name "symbol") + +data Data = + DataLit Lit | + DataRef Data_Ref | + DataInterpolate Data_Interpolate | + DataXml Data_Xml | + DataApply Data_Apply | + DataApplyUsing Data_ApplyUsing | + DataApplyType Data_ApplyType | + DataAssign Data_Assign | + DataReturn Data_Return | + DataThrow Data_Throw | + DataAscribe Data_Ascribe | + DataAnnotate Data_Annotate | + DataTuple Data_Tuple | + DataBlock Data_Block | + DataEndMarker Data_EndMarker | + DataIf Data_If | + DataQuotedMacroExpr Data_QuotedMacroExpr | + DataQuotedMacroType Data_QuotedMacroType | + DataSplicedMacroExpr Data_SplicedMacroExpr | + DataMatch Data_Match | + DataTry Data_Try | + DataTryWithHandler Data_TryWithHandler | + DataFunctionData Data_FunctionData | + DataPolyFunction Data_PolyFunction | + DataPartialFunction Data_PartialFunction | + DataWhile Data_While | + DataDo Data_Do | + DataFor Data_For | + DataForYield Data_ForYield | + DataNew Data_New | + DataNewAnonymous Data_NewAnonymous | + DataPlaceholder Data_Placeholder | + DataEta Data_Eta | + DataRepeated Data_Repeated | + DataParam Data_Param + deriving (Eq, Ord, Read, Show) + +_Data = (Core.Name "hydra/ext/scala/meta.Data") + +_Data_lit = (Core.Name "lit") + +_Data_ref = (Core.Name "ref") + +_Data_interpolate = (Core.Name "interpolate") + +_Data_xml = (Core.Name "xml") + +_Data_apply = (Core.Name "apply") + +_Data_applyUsing = (Core.Name "applyUsing") + +_Data_applyType = (Core.Name "applyType") + +_Data_assign = (Core.Name "assign") + +_Data_return = (Core.Name "return") + +_Data_throw = (Core.Name "throw") + +_Data_ascribe = (Core.Name "ascribe") + +_Data_annotate = (Core.Name "annotate") + +_Data_tuple = (Core.Name "tuple") + +_Data_block = (Core.Name "block") + +_Data_endMarker = (Core.Name "endMarker") + +_Data_if = (Core.Name "if") + +_Data_quotedMacroExpr = (Core.Name "quotedMacroExpr") + +_Data_quotedMacroType = (Core.Name "quotedMacroType") + +_Data_splicedMacroExpr = (Core.Name "splicedMacroExpr") + +_Data_match = (Core.Name "match") + +_Data_try = (Core.Name "try") + +_Data_tryWithHandler = (Core.Name "tryWithHandler") + +_Data_functionData = (Core.Name "functionData") + +_Data_polyFunction = (Core.Name "polyFunction") + +_Data_partialFunction = (Core.Name "partialFunction") + +_Data_while = (Core.Name "while") + +_Data_do = (Core.Name "do") + +_Data_for = (Core.Name "for") + +_Data_forYield = (Core.Name "forYield") + +_Data_new = (Core.Name "new") + +_Data_newAnonymous = (Core.Name "newAnonymous") + +_Data_placeholder = (Core.Name "placeholder") + +_Data_eta = (Core.Name "eta") + +_Data_repeated = (Core.Name "repeated") + +_Data_param = (Core.Name "param") + +data Data_Ref = + Data_RefThis Data_This | + Data_RefSuper Data_Super | + Data_RefName Data_Name | + Data_RefAnonymous Data_Anonymous | + Data_RefSelect Data_Select | + Data_RefApplyUnary Data_ApplyUnary + deriving (Eq, Ord, Read, Show) + +_Data_Ref = (Core.Name "hydra/ext/scala/meta.Data.Ref") + +_Data_Ref_this = (Core.Name "this") + +_Data_Ref_super = (Core.Name "super") + +_Data_Ref_name = (Core.Name "name") + +_Data_Ref_anonymous = (Core.Name "anonymous") + +_Data_Ref_select = (Core.Name "select") + +_Data_Ref_applyUnary = (Core.Name "applyUnary") + +data Data_This = + Data_This {} + deriving (Eq, Ord, Read, Show) + +_Data_This = (Core.Name "hydra/ext/scala/meta.Data.This") + +data Data_Super = + Data_Super { + data_SuperThisp :: Name, + data_SuperSuperp :: Name} + deriving (Eq, Ord, Read, Show) + +_Data_Super = (Core.Name "hydra/ext/scala/meta.Data.Super") + +_Data_Super_thisp = (Core.Name "thisp") + +_Data_Super_superp = (Core.Name "superp") + +data Data_Name = + Data_Name { + data_NameValue :: PredefString} + deriving (Eq, Ord, Read, Show) + +_Data_Name = (Core.Name "hydra/ext/scala/meta.Data.Name") + +_Data_Name_value = (Core.Name "value") + +data Data_Anonymous = + Data_Anonymous {} + deriving (Eq, Ord, Read, Show) + +_Data_Anonymous = (Core.Name "hydra/ext/scala/meta.Data.Anonymous") + +data Data_Select = + Data_Select { + data_SelectQual :: Data, + data_SelectName :: Data_Name} + deriving (Eq, Ord, Read, Show) + +_Data_Select = (Core.Name "hydra/ext/scala/meta.Data.Select") + +_Data_Select_qual = (Core.Name "qual") + +_Data_Select_name = (Core.Name "name") + +data Data_Interpolate = + Data_Interpolate { + data_InterpolatePrefix :: Data_Name, + data_InterpolateParts :: [Lit], + data_InterpolateArgs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_Interpolate = (Core.Name "hydra/ext/scala/meta.Data.Interpolate") + +_Data_Interpolate_prefix = (Core.Name "prefix") + +_Data_Interpolate_parts = (Core.Name "parts") + +_Data_Interpolate_args = (Core.Name "args") + +data Data_Xml = + Data_Xml { + data_XmlParts :: [Lit], + data_XmlArgs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_Xml = (Core.Name "hydra/ext/scala/meta.Data.Xml") + +_Data_Xml_parts = (Core.Name "parts") + +_Data_Xml_args = (Core.Name "args") + +data Data_Apply = + Data_Apply { + data_ApplyFun :: Data, + data_ApplyArgs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_Apply = (Core.Name "hydra/ext/scala/meta.Data.Apply") + +_Data_Apply_fun = (Core.Name "fun") + +_Data_Apply_args = (Core.Name "args") + +data Data_ApplyUsing = + Data_ApplyUsing { + data_ApplyUsingFun :: Data, + data_ApplyUsingTargs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_ApplyUsing = (Core.Name "hydra/ext/scala/meta.Data.ApplyUsing") + +_Data_ApplyUsing_fun = (Core.Name "fun") + +_Data_ApplyUsing_targs = (Core.Name "targs") + +data Data_ApplyType = + Data_ApplyType { + data_ApplyTypeLhs :: Data, + data_ApplyTypeOp :: Data_Name, + data_ApplyTypeTargs :: [Type], + data_ApplyTypeArgs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_ApplyType = (Core.Name "hydra/ext/scala/meta.Data.ApplyType") + +_Data_ApplyType_lhs = (Core.Name "lhs") + +_Data_ApplyType_op = (Core.Name "op") + +_Data_ApplyType_targs = (Core.Name "targs") + +_Data_ApplyType_args = (Core.Name "args") + +data Data_ApplyInfix = + Data_ApplyInfix { + data_ApplyInfixLhs :: Data, + data_ApplyInfixOp :: Data_Name, + data_ApplyInfixTargs :: [Type], + data_ApplyInfixArgs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_ApplyInfix = (Core.Name "hydra/ext/scala/meta.Data.ApplyInfix") + +_Data_ApplyInfix_lhs = (Core.Name "lhs") + +_Data_ApplyInfix_op = (Core.Name "op") + +_Data_ApplyInfix_targs = (Core.Name "targs") + +_Data_ApplyInfix_args = (Core.Name "args") + +data Data_ApplyUnary = + Data_ApplyUnary { + data_ApplyUnaryOp :: Data_Name, + data_ApplyUnaryArg :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_ApplyUnary = (Core.Name "hydra/ext/scala/meta.Data.ApplyUnary") + +_Data_ApplyUnary_op = (Core.Name "op") + +_Data_ApplyUnary_arg = (Core.Name "arg") + +data Data_Assign = + Data_Assign { + data_AssignLhs :: Data, + data_AssignRhs :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Assign = (Core.Name "hydra/ext/scala/meta.Data.Assign") + +_Data_Assign_lhs = (Core.Name "lhs") + +_Data_Assign_rhs = (Core.Name "rhs") + +data Data_Return = + Data_Return { + data_ReturnExpr :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Return = (Core.Name "hydra/ext/scala/meta.Data.Return") + +_Data_Return_expr = (Core.Name "expr") + +data Data_Throw = + Data_Throw { + data_ThrowExpr :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Throw = (Core.Name "hydra/ext/scala/meta.Data.Throw") + +_Data_Throw_expr = (Core.Name "expr") + +data Data_Ascribe = + Data_Ascribe { + data_AscribeExpr :: Data, + data_AscribeTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Data_Ascribe = (Core.Name "hydra/ext/scala/meta.Data.Ascribe") + +_Data_Ascribe_expr = (Core.Name "expr") + +_Data_Ascribe_tpe = (Core.Name "tpe") + +data Data_Annotate = + Data_Annotate { + data_AnnotateExpr :: Data, + data_AnnotateAnnots :: [Mod_Annot]} + deriving (Eq, Ord, Read, Show) + +_Data_Annotate = (Core.Name "hydra/ext/scala/meta.Data.Annotate") + +_Data_Annotate_expr = (Core.Name "expr") + +_Data_Annotate_annots = (Core.Name "annots") + +data Data_Tuple = + Data_Tuple { + data_TupleArgs :: [Data]} + deriving (Eq, Ord, Read, Show) + +_Data_Tuple = (Core.Name "hydra/ext/scala/meta.Data.Tuple") + +_Data_Tuple_args = (Core.Name "args") + +data Data_Block = + Data_Block { + data_BlockStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Data_Block = (Core.Name "hydra/ext/scala/meta.Data.Block") + +_Data_Block_stats = (Core.Name "stats") + +data Data_EndMarker = + Data_EndMarker { + data_EndMarkerName :: Data_Name} + deriving (Eq, Ord, Read, Show) + +_Data_EndMarker = (Core.Name "hydra/ext/scala/meta.Data.EndMarker") + +_Data_EndMarker_name = (Core.Name "name") + +data Data_If = + Data_If { + data_IfCond :: Data, + data_IfThenp :: Data, + data_IfElsep :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_If = (Core.Name "hydra/ext/scala/meta.Data.If") + +_Data_If_cond = (Core.Name "cond") + +_Data_If_thenp = (Core.Name "thenp") + +_Data_If_elsep = (Core.Name "elsep") + +data Data_QuotedMacroExpr = + Data_QuotedMacroExpr { + data_QuotedMacroExprBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_QuotedMacroExpr = (Core.Name "hydra/ext/scala/meta.Data.QuotedMacroExpr") + +_Data_QuotedMacroExpr_body = (Core.Name "body") + +data Data_QuotedMacroType = + Data_QuotedMacroType { + data_QuotedMacroTypeTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Data_QuotedMacroType = (Core.Name "hydra/ext/scala/meta.Data.QuotedMacroType") + +_Data_QuotedMacroType_tpe = (Core.Name "tpe") + +data Data_SplicedMacroExpr = + Data_SplicedMacroExpr { + data_SplicedMacroExprBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_SplicedMacroExpr = (Core.Name "hydra/ext/scala/meta.Data.SplicedMacroExpr") + +_Data_SplicedMacroExpr_body = (Core.Name "body") + +data Data_Match = + Data_Match { + data_MatchExpr :: Data, + data_MatchCases :: [Case]} + deriving (Eq, Ord, Read, Show) + +_Data_Match = (Core.Name "hydra/ext/scala/meta.Data.Match") + +_Data_Match_expr = (Core.Name "expr") + +_Data_Match_cases = (Core.Name "cases") + +data Data_Try = + Data_Try { + data_TryExpr :: Data, + data_TryCatchp :: [Case], + data_TryFinallyp :: (Maybe Data)} + deriving (Eq, Ord, Read, Show) + +_Data_Try = (Core.Name "hydra/ext/scala/meta.Data.Try") + +_Data_Try_expr = (Core.Name "expr") + +_Data_Try_catchp = (Core.Name "catchp") + +_Data_Try_finallyp = (Core.Name "finallyp") + +data Data_TryWithHandler = + Data_TryWithHandler { + data_TryWithHandlerExpr :: Data, + data_TryWithHandlerCatchp :: Data, + data_TryWithHandlerFinallyp :: (Maybe Data)} + deriving (Eq, Ord, Read, Show) + +_Data_TryWithHandler = (Core.Name "hydra/ext/scala/meta.Data.TryWithHandler") + +_Data_TryWithHandler_expr = (Core.Name "expr") + +_Data_TryWithHandler_catchp = (Core.Name "catchp") + +_Data_TryWithHandler_finallyp = (Core.Name "finallyp") + +data Data_FunctionData = + Data_FunctionDataContextFunction Data_ContextFunction | + Data_FunctionDataFunction Data_Function + deriving (Eq, Ord, Read, Show) + +_Data_FunctionData = (Core.Name "hydra/ext/scala/meta.Data.FunctionData") + +_Data_FunctionData_contextFunction = (Core.Name "contextFunction") + +_Data_FunctionData_function = (Core.Name "function") + +data Data_ContextFunction = + Data_ContextFunction { + data_ContextFunctionParams :: [Data_Param], + data_ContextFunctionBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_ContextFunction = (Core.Name "hydra/ext/scala/meta.Data.ContextFunction") + +_Data_ContextFunction_params = (Core.Name "params") + +_Data_ContextFunction_body = (Core.Name "body") + +data Data_Function = + Data_Function { + data_FunctionParams :: [Data_Param], + data_FunctionBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Function = (Core.Name "hydra/ext/scala/meta.Data.Function") + +_Data_Function_params = (Core.Name "params") + +_Data_Function_body = (Core.Name "body") + +data Data_PolyFunction = + Data_PolyFunction { + data_PolyFunctionTparams :: [Type_Param], + data_PolyFunctionBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_PolyFunction = (Core.Name "hydra/ext/scala/meta.Data.PolyFunction") + +_Data_PolyFunction_tparams = (Core.Name "tparams") + +_Data_PolyFunction_body = (Core.Name "body") + +data Data_PartialFunction = + Data_PartialFunction { + data_PartialFunctionCases :: [Case]} + deriving (Eq, Ord, Read, Show) + +_Data_PartialFunction = (Core.Name "hydra/ext/scala/meta.Data.PartialFunction") + +_Data_PartialFunction_cases = (Core.Name "cases") + +data Data_While = + Data_While { + data_WhileExpr :: Data, + data_WhileBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_While = (Core.Name "hydra/ext/scala/meta.Data.While") + +_Data_While_expr = (Core.Name "expr") + +_Data_While_body = (Core.Name "body") + +data Data_Do = + Data_Do { + data_DoBody :: Data, + data_DoExpr :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Do = (Core.Name "hydra/ext/scala/meta.Data.Do") + +_Data_Do_body = (Core.Name "body") + +_Data_Do_expr = (Core.Name "expr") + +data Data_For = + Data_For { + data_ForEnums :: [Enumerator]} + deriving (Eq, Ord, Read, Show) + +_Data_For = (Core.Name "hydra/ext/scala/meta.Data.For") + +_Data_For_enums = (Core.Name "enums") + +data Data_ForYield = + Data_ForYield { + data_ForYieldEnums :: [Enumerator]} + deriving (Eq, Ord, Read, Show) + +_Data_ForYield = (Core.Name "hydra/ext/scala/meta.Data.ForYield") + +_Data_ForYield_enums = (Core.Name "enums") + +data Data_New = + Data_New { + data_NewInit :: Init} + deriving (Eq, Ord, Read, Show) + +_Data_New = (Core.Name "hydra/ext/scala/meta.Data.New") + +_Data_New_init = (Core.Name "init") + +data Data_NewAnonymous = + Data_NewAnonymous { + data_NewAnonymousTempl :: Template} + deriving (Eq, Ord, Read, Show) + +_Data_NewAnonymous = (Core.Name "hydra/ext/scala/meta.Data.NewAnonymous") + +_Data_NewAnonymous_templ = (Core.Name "templ") + +data Data_Placeholder = + Data_Placeholder {} + deriving (Eq, Ord, Read, Show) + +_Data_Placeholder = (Core.Name "hydra/ext/scala/meta.Data.Placeholder") + +data Data_Eta = + Data_Eta { + data_EtaExpr :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Eta = (Core.Name "hydra/ext/scala/meta.Data.Eta") + +_Data_Eta_expr = (Core.Name "expr") + +data Data_Repeated = + Data_Repeated { + data_RepeatedExpr :: Data} + deriving (Eq, Ord, Read, Show) + +_Data_Repeated = (Core.Name "hydra/ext/scala/meta.Data.Repeated") + +_Data_Repeated_expr = (Core.Name "expr") + +data Data_Param = + Data_Param { + data_ParamMods :: [Mod], + data_ParamName :: Name, + data_ParamDecltpe :: (Maybe Type), + data_ParamDefault :: (Maybe Data)} + deriving (Eq, Ord, Read, Show) + +_Data_Param = (Core.Name "hydra/ext/scala/meta.Data.Param") + +_Data_Param_mods = (Core.Name "mods") + +_Data_Param_name = (Core.Name "name") + +_Data_Param_decltpe = (Core.Name "decltpe") + +_Data_Param_default = (Core.Name "default") + +data Type = + TypeRef Type_Ref | + TypeAnonymousName Type_AnonymousName | + TypeApply Type_Apply | + TypeApplyInfix Type_ApplyInfix | + TypeFunctionType Type_FunctionType | + TypePolyFunction Type_PolyFunction | + TypeImplicitFunction Type_ImplicitFunction | + TypeTuple Type_Tuple | + TypeWith Type_With | + TypeAnd Type_And | + TypeOr Type_Or | + TypeRefine Type_Refine | + TypeExistential Type_Existential | + TypeAnnotate Type_Annotate | + TypeLambda Type_Lambda | + TypeMacro Type_Macro | + TypeMethod Type_Method | + TypePlaceholder Type_Placeholder | + TypeByName Type_ByName | + TypeRepeated Type_Repeated | + TypeVar Type_Var | + TypeTypedParam Type_TypedParam | + TypeMatch Type_Match + deriving (Eq, Ord, Read, Show) + +_Type = (Core.Name "hydra/ext/scala/meta.Type") + +_Type_ref = (Core.Name "ref") + +_Type_anonymousName = (Core.Name "anonymousName") + +_Type_apply = (Core.Name "apply") + +_Type_applyInfix = (Core.Name "applyInfix") + +_Type_functionType = (Core.Name "functionType") + +_Type_polyFunction = (Core.Name "polyFunction") + +_Type_implicitFunction = (Core.Name "implicitFunction") + +_Type_tuple = (Core.Name "tuple") + +_Type_with = (Core.Name "with") + +_Type_and = (Core.Name "and") + +_Type_or = (Core.Name "or") + +_Type_refine = (Core.Name "refine") + +_Type_existential = (Core.Name "existential") + +_Type_annotate = (Core.Name "annotate") + +_Type_lambda = (Core.Name "lambda") + +_Type_macro = (Core.Name "macro") + +_Type_method = (Core.Name "method") + +_Type_placeholder = (Core.Name "placeholder") + +_Type_byName = (Core.Name "byName") + +_Type_repeated = (Core.Name "repeated") + +_Type_var = (Core.Name "var") + +_Type_typedParam = (Core.Name "typedParam") + +_Type_match = (Core.Name "match") + +data Type_Ref = + Type_RefName Type_Name | + Type_RefSelect Type_Select | + Type_RefProject Type_Project | + Type_RefSingleton Type_Singleton + deriving (Eq, Ord, Read, Show) + +_Type_Ref = (Core.Name "hydra/ext/scala/meta.Type.Ref") + +_Type_Ref_name = (Core.Name "name") + +_Type_Ref_select = (Core.Name "select") + +_Type_Ref_project = (Core.Name "project") + +_Type_Ref_singleton = (Core.Name "singleton") + +data Type_Name = + Type_Name { + type_NameValue :: String} + deriving (Eq, Ord, Read, Show) + +_Type_Name = (Core.Name "hydra/ext/scala/meta.Type.Name") + +_Type_Name_value = (Core.Name "value") + +data Type_AnonymousName = + Type_AnonymousName {} + deriving (Eq, Ord, Read, Show) + +_Type_AnonymousName = (Core.Name "hydra/ext/scala/meta.Type.AnonymousName") + +data Type_Select = + Type_Select { + type_SelectQual :: Data_Ref, + type_SelectName :: Type_Name} + deriving (Eq, Ord, Read, Show) + +_Type_Select = (Core.Name "hydra/ext/scala/meta.Type.Select") + +_Type_Select_qual = (Core.Name "qual") + +_Type_Select_name = (Core.Name "name") + +data Type_Project = + Type_Project { + type_ProjectQual :: Type, + type_ProjectName :: Type_Name} + deriving (Eq, Ord, Read, Show) + +_Type_Project = (Core.Name "hydra/ext/scala/meta.Type.Project") + +_Type_Project_qual = (Core.Name "qual") + +_Type_Project_name = (Core.Name "name") + +data Type_Singleton = + Type_Singleton { + type_SingletonRef :: Data_Ref} + deriving (Eq, Ord, Read, Show) + +_Type_Singleton = (Core.Name "hydra/ext/scala/meta.Type.Singleton") + +_Type_Singleton_ref = (Core.Name "ref") + +data Type_Apply = + Type_Apply { + type_ApplyTpe :: Type, + type_ApplyArgs :: [Type]} + deriving (Eq, Ord, Read, Show) + +_Type_Apply = (Core.Name "hydra/ext/scala/meta.Type.Apply") + +_Type_Apply_tpe = (Core.Name "tpe") + +_Type_Apply_args = (Core.Name "args") + +data Type_ApplyInfix = + Type_ApplyInfix { + type_ApplyInfixLhs :: Type, + type_ApplyInfixOp :: Type_Name, + type_ApplyInfixRhs :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_ApplyInfix = (Core.Name "hydra/ext/scala/meta.Type.ApplyInfix") + +_Type_ApplyInfix_lhs = (Core.Name "lhs") + +_Type_ApplyInfix_op = (Core.Name "op") + +_Type_ApplyInfix_rhs = (Core.Name "rhs") + +data Type_FunctionType = + Type_FunctionTypeFunction Type_Function | + Type_FunctionTypeContextFunction Type_ContextFunction + deriving (Eq, Ord, Read, Show) + +_Type_FunctionType = (Core.Name "hydra/ext/scala/meta.Type.FunctionType") + +_Type_FunctionType_function = (Core.Name "function") + +_Type_FunctionType_contextFunction = (Core.Name "contextFunction") + +data Type_Function = + Type_Function { + type_FunctionParams :: [Type], + type_FunctionRes :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Function = (Core.Name "hydra/ext/scala/meta.Type.Function") + +_Type_Function_params = (Core.Name "params") + +_Type_Function_res = (Core.Name "res") + +data Type_PolyFunction = + Type_PolyFunction { + type_PolyFunctionTparams :: [Type_Param], + type_PolyFunctionTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_PolyFunction = (Core.Name "hydra/ext/scala/meta.Type.PolyFunction") + +_Type_PolyFunction_tparams = (Core.Name "tparams") + +_Type_PolyFunction_tpe = (Core.Name "tpe") + +data Type_ContextFunction = + Type_ContextFunction { + type_ContextFunctionParams :: [Type], + type_ContextFunctionRes :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_ContextFunction = (Core.Name "hydra/ext/scala/meta.Type.ContextFunction") + +_Type_ContextFunction_params = (Core.Name "params") + +_Type_ContextFunction_res = (Core.Name "res") + +data Type_ImplicitFunction = + Type_ImplicitFunction { + type_ImplicitFunctionParams :: [Type], + type_ImplicitFunctionRes :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_ImplicitFunction = (Core.Name "hydra/ext/scala/meta.Type.ImplicitFunction") + +_Type_ImplicitFunction_params = (Core.Name "params") + +_Type_ImplicitFunction_res = (Core.Name "res") + +data Type_Tuple = + Type_Tuple { + type_TupleArgs :: [Type]} + deriving (Eq, Ord, Read, Show) + +_Type_Tuple = (Core.Name "hydra/ext/scala/meta.Type.Tuple") + +_Type_Tuple_args = (Core.Name "args") + +data Type_With = + Type_With { + type_WithLhs :: Type, + type_WithRhs :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_With = (Core.Name "hydra/ext/scala/meta.Type.With") + +_Type_With_lhs = (Core.Name "lhs") + +_Type_With_rhs = (Core.Name "rhs") + +data Type_And = + Type_And { + type_AndLhs :: Type, + type_AndRhs :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_And = (Core.Name "hydra/ext/scala/meta.Type.And") + +_Type_And_lhs = (Core.Name "lhs") + +_Type_And_rhs = (Core.Name "rhs") + +data Type_Or = + Type_Or { + type_OrLhs :: Type, + type_OrRhs :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Or = (Core.Name "hydra/ext/scala/meta.Type.Or") + +_Type_Or_lhs = (Core.Name "lhs") + +_Type_Or_rhs = (Core.Name "rhs") + +data Type_Refine = + Type_Refine { + type_RefineTpe :: (Maybe Type), + type_RefineStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Type_Refine = (Core.Name "hydra/ext/scala/meta.Type.Refine") + +_Type_Refine_tpe = (Core.Name "tpe") + +_Type_Refine_stats = (Core.Name "stats") + +data Type_Existential = + Type_Existential { + type_ExistentialTpe :: Type, + type_ExistentialStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Type_Existential = (Core.Name "hydra/ext/scala/meta.Type.Existential") + +_Type_Existential_tpe = (Core.Name "tpe") + +_Type_Existential_stats = (Core.Name "stats") + +data Type_Annotate = + Type_Annotate { + type_AnnotateTpe :: Type, + type_AnnotateAnnots :: [Mod_Annot]} + deriving (Eq, Ord, Read, Show) + +_Type_Annotate = (Core.Name "hydra/ext/scala/meta.Type.Annotate") + +_Type_Annotate_tpe = (Core.Name "tpe") + +_Type_Annotate_annots = (Core.Name "annots") + +data Type_Lambda = + Type_Lambda { + type_LambdaTparams :: [Type_Param], + type_LambdaTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Lambda = (Core.Name "hydra/ext/scala/meta.Type.Lambda") + +_Type_Lambda_tparams = (Core.Name "tparams") + +_Type_Lambda_tpe = (Core.Name "tpe") + +data Type_Macro = + Type_Macro { + type_MacroBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Type_Macro = (Core.Name "hydra/ext/scala/meta.Type.Macro") + +_Type_Macro_body = (Core.Name "body") + +data Type_Method = + Type_Method { + type_MethodParamss :: [[Data_Param]], + type_MethodTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Method = (Core.Name "hydra/ext/scala/meta.Type.Method") + +_Type_Method_paramss = (Core.Name "paramss") + +_Type_Method_tpe = (Core.Name "tpe") + +data Type_Placeholder = + Type_Placeholder { + type_PlaceholderBounds :: Type_Bounds} + deriving (Eq, Ord, Read, Show) + +_Type_Placeholder = (Core.Name "hydra/ext/scala/meta.Type.Placeholder") + +_Type_Placeholder_bounds = (Core.Name "bounds") + +data Type_Bounds = + Type_Bounds { + type_BoundsLo :: (Maybe Type), + type_BoundsHi :: (Maybe Type)} + deriving (Eq, Ord, Read, Show) + +_Type_Bounds = (Core.Name "hydra/ext/scala/meta.Type.Bounds") + +_Type_Bounds_lo = (Core.Name "lo") + +_Type_Bounds_hi = (Core.Name "hi") + +data Type_ByName = + Type_ByName { + type_ByNameTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_ByName = (Core.Name "hydra/ext/scala/meta.Type.ByName") + +_Type_ByName_tpe = (Core.Name "tpe") + +data Type_Repeated = + Type_Repeated { + type_RepeatedTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_Repeated = (Core.Name "hydra/ext/scala/meta.Type.Repeated") + +_Type_Repeated_tpe = (Core.Name "tpe") + +data Type_Var = + Type_Var { + type_VarName :: Type_Name} + deriving (Eq, Ord, Read, Show) + +_Type_Var = (Core.Name "hydra/ext/scala/meta.Type.Var") + +_Type_Var_name = (Core.Name "name") + +data Type_TypedParam = + Type_TypedParam { + type_TypedParamName :: Name, + type_TypedParamTyp :: Type} + deriving (Eq, Ord, Read, Show) + +_Type_TypedParam = (Core.Name "hydra/ext/scala/meta.Type.TypedParam") + +_Type_TypedParam_name = (Core.Name "name") + +_Type_TypedParam_typ = (Core.Name "typ") + +data Type_Param = + Type_Param { + type_ParamMods :: [Mod], + type_ParamName :: Name, + type_ParamTparams :: [Type_Param], + type_ParamTbounds :: [Type_Bounds], + type_ParamVbounds :: [Type], + type_ParamCbounds :: [Type]} + deriving (Eq, Ord, Read, Show) + +_Type_Param = (Core.Name "hydra/ext/scala/meta.Type.Param") + +_Type_Param_mods = (Core.Name "mods") + +_Type_Param_name = (Core.Name "name") + +_Type_Param_tparams = (Core.Name "tparams") + +_Type_Param_tbounds = (Core.Name "tbounds") + +_Type_Param_vbounds = (Core.Name "vbounds") + +_Type_Param_cbounds = (Core.Name "cbounds") + +data Type_Match = + Type_Match { + type_MatchTpe :: Type, + type_MatchCases :: [TypeCase]} + deriving (Eq, Ord, Read, Show) + +_Type_Match = (Core.Name "hydra/ext/scala/meta.Type.Match") + +_Type_Match_tpe = (Core.Name "tpe") + +_Type_Match_cases = (Core.Name "cases") + +data Pat = + PatVar Pat_Var | + PatWildcard | + PatSeqWildcard | + PatBind Pat_Bind | + PatAlternative Pat_Alternative | + PatTuple Pat_Tuple | + PatRepeated Pat_Repeated | + PatExtract Pat_Extract | + PatExtractInfix Pat_ExtractInfix | + PatInterpolate Pat_Interpolate | + PatXml Pat_Xml | + PatTyped Pat_Typed | + PatMacro Pat_Macro | + PatGiven Pat_Given + deriving (Eq, Ord, Read, Show) + +_Pat = (Core.Name "hydra/ext/scala/meta.Pat") + +_Pat_var = (Core.Name "var") + +_Pat_wildcard = (Core.Name "wildcard") + +_Pat_seqWildcard = (Core.Name "seqWildcard") + +_Pat_bind = (Core.Name "bind") + +_Pat_alternative = (Core.Name "alternative") + +_Pat_tuple = (Core.Name "tuple") + +_Pat_repeated = (Core.Name "repeated") + +_Pat_extract = (Core.Name "extract") + +_Pat_extractInfix = (Core.Name "extractInfix") + +_Pat_interpolate = (Core.Name "interpolate") + +_Pat_xml = (Core.Name "xml") + +_Pat_typed = (Core.Name "typed") + +_Pat_macro = (Core.Name "macro") + +_Pat_given = (Core.Name "given") + +data Pat_Var = + Pat_Var { + pat_VarName :: Data_Name} + deriving (Eq, Ord, Read, Show) + +_Pat_Var = (Core.Name "hydra/ext/scala/meta.Pat.Var") + +_Pat_Var_name = (Core.Name "name") + +data Pat_Bind = + Pat_Bind { + pat_BindLhs :: Pat, + pat_BindRhs :: Pat} + deriving (Eq, Ord, Read, Show) + +_Pat_Bind = (Core.Name "hydra/ext/scala/meta.Pat.Bind") + +_Pat_Bind_lhs = (Core.Name "lhs") + +_Pat_Bind_rhs = (Core.Name "rhs") + +data Pat_Alternative = + Pat_Alternative { + pat_AlternativeLhs :: Pat, + pat_AlternativeRhs :: Pat} + deriving (Eq, Ord, Read, Show) + +_Pat_Alternative = (Core.Name "hydra/ext/scala/meta.Pat.Alternative") + +_Pat_Alternative_lhs = (Core.Name "lhs") + +_Pat_Alternative_rhs = (Core.Name "rhs") + +data Pat_Tuple = + Pat_Tuple { + pat_TupleArgs :: [Pat]} + deriving (Eq, Ord, Read, Show) + +_Pat_Tuple = (Core.Name "hydra/ext/scala/meta.Pat.Tuple") + +_Pat_Tuple_args = (Core.Name "args") + +data Pat_Repeated = + Pat_Repeated { + pat_RepeatedName :: Data_Name} + deriving (Eq, Ord, Read, Show) + +_Pat_Repeated = (Core.Name "hydra/ext/scala/meta.Pat.Repeated") + +_Pat_Repeated_name = (Core.Name "name") + +data Pat_Extract = + Pat_Extract { + pat_ExtractFun :: Data, + pat_ExtractArgs :: [Pat]} + deriving (Eq, Ord, Read, Show) + +_Pat_Extract = (Core.Name "hydra/ext/scala/meta.Pat.Extract") + +_Pat_Extract_fun = (Core.Name "fun") + +_Pat_Extract_args = (Core.Name "args") + +data Pat_ExtractInfix = + Pat_ExtractInfix { + pat_ExtractInfixLhs :: Pat, + pat_ExtractInfixOp :: Data_Name, + pat_ExtractInfixRhs :: [Pat]} + deriving (Eq, Ord, Read, Show) + +_Pat_ExtractInfix = (Core.Name "hydra/ext/scala/meta.Pat.ExtractInfix") + +_Pat_ExtractInfix_lhs = (Core.Name "lhs") + +_Pat_ExtractInfix_op = (Core.Name "op") + +_Pat_ExtractInfix_rhs = (Core.Name "rhs") + +data Pat_Interpolate = + Pat_Interpolate { + pat_InterpolatePrefix :: Data_Name, + pat_InterpolateParts :: [Lit]} + deriving (Eq, Ord, Read, Show) + +_Pat_Interpolate = (Core.Name "hydra/ext/scala/meta.Pat.Interpolate") + +_Pat_Interpolate_prefix = (Core.Name "prefix") + +_Pat_Interpolate_parts = (Core.Name "parts") + +data Pat_Xml = + Pat_Xml { + pat_XmlParts :: [Lit], + pat_XmlArgs :: [Pat]} + deriving (Eq, Ord, Read, Show) + +_Pat_Xml = (Core.Name "hydra/ext/scala/meta.Pat.Xml") + +_Pat_Xml_parts = (Core.Name "parts") + +_Pat_Xml_args = (Core.Name "args") + +data Pat_Typed = + Pat_Typed { + pat_TypedLhs :: Pat, + pat_TypedRhs :: Type} + deriving (Eq, Ord, Read, Show) + +_Pat_Typed = (Core.Name "hydra/ext/scala/meta.Pat.Typed") + +_Pat_Typed_lhs = (Core.Name "lhs") + +_Pat_Typed_rhs = (Core.Name "rhs") + +data Pat_Macro = + Pat_Macro { + pat_MacroBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Pat_Macro = (Core.Name "hydra/ext/scala/meta.Pat.Macro") + +_Pat_Macro_body = (Core.Name "body") + +data Pat_Given = + Pat_Given { + pat_GivenTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Pat_Given = (Core.Name "hydra/ext/scala/meta.Pat.Given") + +_Pat_Given_tpe = (Core.Name "tpe") + +data Member = + MemberTerm Member_Data | + MemberType Member_Type | + MemberTermParam Data_Param | + MemberTypeParam Type_Param | + MemberSelf Self + deriving (Eq, Ord, Read, Show) + +_Member = (Core.Name "hydra/ext/scala/meta.Member") + +_Member_term = (Core.Name "term") + +_Member_type = (Core.Name "type") + +_Member_termParam = (Core.Name "termParam") + +_Member_typeParam = (Core.Name "typeParam") + +_Member_self = (Core.Name "self") + +data Member_Data = + Member_DataPkg Pkg | + Member_DataObject Pkg_Object + deriving (Eq, Ord, Read, Show) + +_Member_Data = (Core.Name "hydra/ext/scala/meta.Member.Data") + +_Member_Data_pkg = (Core.Name "pkg") + +_Member_Data_object = (Core.Name "object") + +data Member_Type = + Member_Type { + member_TypeName :: Type_Name} + deriving (Eq, Ord, Read, Show) + +_Member_Type = (Core.Name "hydra/ext/scala/meta.Member.Type") + +_Member_Type_name = (Core.Name "name") + +data Decl = + DeclVal Decl_Val | + DeclVar Decl_Var | + DeclDef Decl_Def | + DeclType Decl_Type | + DeclGiven Decl_Given + deriving (Eq, Ord, Read, Show) + +_Decl = (Core.Name "hydra/ext/scala/meta.Decl") + +_Decl_val = (Core.Name "val") + +_Decl_var = (Core.Name "var") + +_Decl_def = (Core.Name "def") + +_Decl_type = (Core.Name "type") + +_Decl_given = (Core.Name "given") + +data Decl_Val = + Decl_Val { + decl_ValMods :: [Mod], + decl_ValPats :: [Pat], + decl_ValDecltpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Decl_Val = (Core.Name "hydra/ext/scala/meta.Decl.Val") + +_Decl_Val_mods = (Core.Name "mods") + +_Decl_Val_pats = (Core.Name "pats") + +_Decl_Val_decltpe = (Core.Name "decltpe") + +data Decl_Var = + Decl_Var { + decl_VarMods :: [Mod], + decl_VarPats :: [Pat], + decl_VarDecltpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Decl_Var = (Core.Name "hydra/ext/scala/meta.Decl.Var") + +_Decl_Var_mods = (Core.Name "mods") + +_Decl_Var_pats = (Core.Name "pats") + +_Decl_Var_decltpe = (Core.Name "decltpe") + +data Decl_Def = + Decl_Def { + decl_DefMods :: [Mod], + decl_DefName :: Data_Name, + decl_DefTparams :: [Type_Param], + decl_DefParamss :: [[Data_Param]], + decl_DefDecltpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Decl_Def = (Core.Name "hydra/ext/scala/meta.Decl.Def") + +_Decl_Def_mods = (Core.Name "mods") + +_Decl_Def_name = (Core.Name "name") + +_Decl_Def_tparams = (Core.Name "tparams") + +_Decl_Def_paramss = (Core.Name "paramss") + +_Decl_Def_decltpe = (Core.Name "decltpe") + +data Decl_Type = + Decl_Type { + decl_TypeMods :: [Mod], + decl_TypeName :: Type_Name, + decl_TypeTparams :: [Type_Param], + decl_TypeBounds :: Type_Bounds} + deriving (Eq, Ord, Read, Show) + +_Decl_Type = (Core.Name "hydra/ext/scala/meta.Decl.Type") + +_Decl_Type_mods = (Core.Name "mods") + +_Decl_Type_name = (Core.Name "name") + +_Decl_Type_tparams = (Core.Name "tparams") + +_Decl_Type_bounds = (Core.Name "bounds") + +data Decl_Given = + Decl_Given { + decl_GivenMods :: [Mod], + decl_GivenName :: Data_Name, + decl_GivenTparams :: [Type_Param], + decl_GivenSparams :: [[Data_Param]], + decl_GivenDecltpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Decl_Given = (Core.Name "hydra/ext/scala/meta.Decl.Given") + +_Decl_Given_mods = (Core.Name "mods") + +_Decl_Given_name = (Core.Name "name") + +_Decl_Given_tparams = (Core.Name "tparams") + +_Decl_Given_sparams = (Core.Name "sparams") + +_Decl_Given_decltpe = (Core.Name "decltpe") + +data Defn = + DefnVal Defn_Val | + DefnVar Defn_Var | + DefnGiven Defn_Given | + DefnEnum Defn_Enum | + DefnEnumCase Defn_EnumCase | + DefnRepeatedEnumCase Defn_RepeatedEnumCase | + DefnGivenAlias Defn_GivenAlias | + DefnExtensionGroup Defn_ExtensionGroup | + DefnDef Defn_Def | + DefnMacro Defn_Macro | + DefnType Defn_Type | + DefnClass Defn_Class | + DefnTrait Defn_Trait | + DefnObject Defn_Object + deriving (Eq, Ord, Read, Show) + +_Defn = (Core.Name "hydra/ext/scala/meta.Defn") + +_Defn_val = (Core.Name "val") + +_Defn_var = (Core.Name "var") + +_Defn_given = (Core.Name "given") + +_Defn_enum = (Core.Name "enum") + +_Defn_enumCase = (Core.Name "enumCase") + +_Defn_repeatedEnumCase = (Core.Name "repeatedEnumCase") + +_Defn_givenAlias = (Core.Name "givenAlias") + +_Defn_extensionGroup = (Core.Name "extensionGroup") + +_Defn_def = (Core.Name "def") + +_Defn_macro = (Core.Name "macro") + +_Defn_type = (Core.Name "type") + +_Defn_class = (Core.Name "class") + +_Defn_trait = (Core.Name "trait") + +_Defn_object = (Core.Name "object") + +data Defn_Val = + Defn_Val { + defn_ValMods :: [Mod], + defn_ValPats :: [Pat], + defn_ValDecltpe :: (Maybe Type), + defn_ValRhs :: Data} + deriving (Eq, Ord, Read, Show) + +_Defn_Val = (Core.Name "hydra/ext/scala/meta.Defn.Val") + +_Defn_Val_mods = (Core.Name "mods") + +_Defn_Val_pats = (Core.Name "pats") + +_Defn_Val_decltpe = (Core.Name "decltpe") + +_Defn_Val_rhs = (Core.Name "rhs") + +data Defn_Var = + Defn_Var { + defn_VarMods :: [Mod], + defn_VarPats :: [Pat], + defn_VarDecltpe :: Type, + defn_VarRhs :: (Maybe Data)} + deriving (Eq, Ord, Read, Show) + +_Defn_Var = (Core.Name "hydra/ext/scala/meta.Defn.Var") + +_Defn_Var_mods = (Core.Name "mods") + +_Defn_Var_pats = (Core.Name "pats") + +_Defn_Var_decltpe = (Core.Name "decltpe") + +_Defn_Var_rhs = (Core.Name "rhs") + +data Defn_Given = + Defn_Given { + defn_GivenMods :: [Mod], + defn_GivenName :: Name, + defn_GivenTparams :: [[Type_Param]], + defn_GivenSparams :: [[Data_Param]], + defn_GivenTempl :: Template} + deriving (Eq, Ord, Read, Show) + +_Defn_Given = (Core.Name "hydra/ext/scala/meta.Defn.Given") + +_Defn_Given_mods = (Core.Name "mods") + +_Defn_Given_name = (Core.Name "name") + +_Defn_Given_tparams = (Core.Name "tparams") + +_Defn_Given_sparams = (Core.Name "sparams") + +_Defn_Given_templ = (Core.Name "templ") + +data Defn_Enum = + Defn_Enum { + defn_EnumMods :: [Mod], + defn_EnumName :: Type_Name, + defn_EnumTparams :: [Type_Param], + defn_EnumCtor :: Ctor_Primary, + defn_EnumTemplate :: Template} + deriving (Eq, Ord, Read, Show) + +_Defn_Enum = (Core.Name "hydra/ext/scala/meta.Defn.Enum") + +_Defn_Enum_mods = (Core.Name "mods") + +_Defn_Enum_name = (Core.Name "name") + +_Defn_Enum_tparams = (Core.Name "tparams") + +_Defn_Enum_ctor = (Core.Name "ctor") + +_Defn_Enum_template = (Core.Name "template") + +data Defn_EnumCase = + Defn_EnumCase { + defn_EnumCaseMods :: [Mod], + defn_EnumCaseName :: Data_Name, + defn_EnumCaseTparams :: [Type_Param], + defn_EnumCaseCtor :: Ctor_Primary, + defn_EnumCaseInits :: [Init]} + deriving (Eq, Ord, Read, Show) + +_Defn_EnumCase = (Core.Name "hydra/ext/scala/meta.Defn.EnumCase") + +_Defn_EnumCase_mods = (Core.Name "mods") + +_Defn_EnumCase_name = (Core.Name "name") + +_Defn_EnumCase_tparams = (Core.Name "tparams") + +_Defn_EnumCase_ctor = (Core.Name "ctor") + +_Defn_EnumCase_inits = (Core.Name "inits") + +data Defn_RepeatedEnumCase = + Defn_RepeatedEnumCase { + defn_RepeatedEnumCaseMods :: [Mod], + defn_RepeatedEnumCaseCases :: [Data_Name]} + deriving (Eq, Ord, Read, Show) + +_Defn_RepeatedEnumCase = (Core.Name "hydra/ext/scala/meta.Defn.RepeatedEnumCase") + +_Defn_RepeatedEnumCase_mods = (Core.Name "mods") + +_Defn_RepeatedEnumCase_cases = (Core.Name "cases") + +data Defn_GivenAlias = + Defn_GivenAlias { + defn_GivenAliasMods :: [Mod], + defn_GivenAliasName :: Name, + defn_GivenAliasTparams :: [[Type_Param]], + defn_GivenAliasSparams :: [[Data_Param]], + defn_GivenAliasDecltpe :: Type, + defn_GivenAliasBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Defn_GivenAlias = (Core.Name "hydra/ext/scala/meta.Defn.GivenAlias") + +_Defn_GivenAlias_mods = (Core.Name "mods") + +_Defn_GivenAlias_name = (Core.Name "name") + +_Defn_GivenAlias_tparams = (Core.Name "tparams") + +_Defn_GivenAlias_sparams = (Core.Name "sparams") + +_Defn_GivenAlias_decltpe = (Core.Name "decltpe") + +_Defn_GivenAlias_body = (Core.Name "body") + +data Defn_ExtensionGroup = + Defn_ExtensionGroup { + defn_ExtensionGroupTparams :: [Type_Param], + defn_ExtensionGroupParmss :: [[Data_Param]], + defn_ExtensionGroupBody :: Stat} + deriving (Eq, Ord, Read, Show) + +_Defn_ExtensionGroup = (Core.Name "hydra/ext/scala/meta.Defn.ExtensionGroup") + +_Defn_ExtensionGroup_tparams = (Core.Name "tparams") + +_Defn_ExtensionGroup_parmss = (Core.Name "parmss") + +_Defn_ExtensionGroup_body = (Core.Name "body") + +data Defn_Def = + Defn_Def { + defn_DefMods :: [Mod], + defn_DefName :: Data_Name, + defn_DefTparams :: [Type_Param], + defn_DefParamss :: [[Data_Param]], + defn_DefDecltpe :: (Maybe Type), + defn_DefBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Defn_Def = (Core.Name "hydra/ext/scala/meta.Defn.Def") + +_Defn_Def_mods = (Core.Name "mods") + +_Defn_Def_name = (Core.Name "name") + +_Defn_Def_tparams = (Core.Name "tparams") + +_Defn_Def_paramss = (Core.Name "paramss") + +_Defn_Def_decltpe = (Core.Name "decltpe") + +_Defn_Def_body = (Core.Name "body") + +data Defn_Macro = + Defn_Macro { + defn_MacroMods :: [Mod], + defn_MacroName :: Data_Name, + defn_MacroTparams :: [Type_Param], + defn_MacroParamss :: [[Data_Param]], + defn_MacroDecltpe :: (Maybe Type), + defn_MacroBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Defn_Macro = (Core.Name "hydra/ext/scala/meta.Defn.Macro") + +_Defn_Macro_mods = (Core.Name "mods") + +_Defn_Macro_name = (Core.Name "name") + +_Defn_Macro_tparams = (Core.Name "tparams") + +_Defn_Macro_paramss = (Core.Name "paramss") + +_Defn_Macro_decltpe = (Core.Name "decltpe") + +_Defn_Macro_body = (Core.Name "body") + +data Defn_Type = + Defn_Type { + defn_TypeMods :: [Mod], + defn_TypeName :: Type_Name, + defn_TypeTparams :: [Type_Param], + defn_TypeBody :: Type} + deriving (Eq, Ord, Read, Show) + +_Defn_Type = (Core.Name "hydra/ext/scala/meta.Defn.Type") + +_Defn_Type_mods = (Core.Name "mods") + +_Defn_Type_name = (Core.Name "name") + +_Defn_Type_tparams = (Core.Name "tparams") + +_Defn_Type_body = (Core.Name "body") + +data Defn_Class = + Defn_Class { + defn_ClassMods :: [Mod], + defn_ClassName :: Type_Name, + defn_ClassTparams :: [Type_Param], + defn_ClassCtor :: Ctor_Primary, + defn_ClassTemplate :: Template} + deriving (Eq, Ord, Read, Show) + +_Defn_Class = (Core.Name "hydra/ext/scala/meta.Defn.Class") + +_Defn_Class_mods = (Core.Name "mods") + +_Defn_Class_name = (Core.Name "name") + +_Defn_Class_tparams = (Core.Name "tparams") + +_Defn_Class_ctor = (Core.Name "ctor") + +_Defn_Class_template = (Core.Name "template") + +data Defn_Trait = + Defn_Trait { + defn_TraitMods :: [Mod], + defn_TraitName :: Type_Name, + defn_TraitTparams :: [Type_Param], + defn_TraitCtor :: Ctor_Primary, + defn_TraitTemplate :: Template} + deriving (Eq, Ord, Read, Show) + +_Defn_Trait = (Core.Name "hydra/ext/scala/meta.Defn.Trait") + +_Defn_Trait_mods = (Core.Name "mods") + +_Defn_Trait_name = (Core.Name "name") + +_Defn_Trait_tparams = (Core.Name "tparams") + +_Defn_Trait_ctor = (Core.Name "ctor") + +_Defn_Trait_template = (Core.Name "template") + +data Defn_Object = + Defn_Object { + defn_ObjectName :: Data_Name} + deriving (Eq, Ord, Read, Show) + +_Defn_Object = (Core.Name "hydra/ext/scala/meta.Defn.Object") + +_Defn_Object_name = (Core.Name "name") + +data Pkg = + Pkg { + pkgName :: Data_Name, + pkgRef :: Data_Ref, + pkgStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Pkg = (Core.Name "hydra/ext/scala/meta.Pkg") + +_Pkg_name = (Core.Name "name") + +_Pkg_ref = (Core.Name "ref") + +_Pkg_stats = (Core.Name "stats") + +data Pkg_Object = + Pkg_Object { + pkg_ObjectMods :: [Mod], + pkg_ObjectName :: Data_Name, + pkg_ObjectTemplate :: Template} + deriving (Eq, Ord, Read, Show) + +_Pkg_Object = (Core.Name "hydra/ext/scala/meta.Pkg.Object") + +_Pkg_Object_mods = (Core.Name "mods") + +_Pkg_Object_name = (Core.Name "name") + +_Pkg_Object_template = (Core.Name "template") + +data Ctor = + CtorPrimary Ctor_Primary | + CtorSecondary Ctor_Secondary + deriving (Eq, Ord, Read, Show) + +_Ctor = (Core.Name "hydra/ext/scala/meta.Ctor") + +_Ctor_primary = (Core.Name "primary") + +_Ctor_secondary = (Core.Name "secondary") + +data Ctor_Primary = + Ctor_Primary { + ctor_PrimaryMods :: [Mod], + ctor_PrimaryName :: Name, + ctor_PrimaryParamss :: [[Data_Param]]} + deriving (Eq, Ord, Read, Show) + +_Ctor_Primary = (Core.Name "hydra/ext/scala/meta.Ctor.Primary") + +_Ctor_Primary_mods = (Core.Name "mods") + +_Ctor_Primary_name = (Core.Name "name") + +_Ctor_Primary_paramss = (Core.Name "paramss") + +data Ctor_Secondary = + Ctor_Secondary { + ctor_SecondaryMods :: [Mod], + ctor_SecondaryName :: Name, + ctor_SecondaryParamss :: [[Data_Param]], + ctor_SecondaryInit :: Init, + ctor_SecondaryStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Ctor_Secondary = (Core.Name "hydra/ext/scala/meta.Ctor.Secondary") + +_Ctor_Secondary_mods = (Core.Name "mods") + +_Ctor_Secondary_name = (Core.Name "name") + +_Ctor_Secondary_paramss = (Core.Name "paramss") + +_Ctor_Secondary_init = (Core.Name "init") + +_Ctor_Secondary_stats = (Core.Name "stats") + +data Init = + Init { + initTpe :: Type, + initName :: Name, + initArgss :: [[Data]]} + deriving (Eq, Ord, Read, Show) + +_Init = (Core.Name "hydra/ext/scala/meta.Init") + +_Init_tpe = (Core.Name "tpe") + +_Init_name = (Core.Name "name") + +_Init_argss = (Core.Name "argss") + +data Self = + Self {} + deriving (Eq, Ord, Read, Show) + +_Self = (Core.Name "hydra/ext/scala/meta.Self") + +data Template = + Template { + templateEarly :: [Stat], + templateInits :: [Init], + templateSelf :: Self, + templateStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Template = (Core.Name "hydra/ext/scala/meta.Template") + +_Template_early = (Core.Name "early") + +_Template_inits = (Core.Name "inits") + +_Template_self = (Core.Name "self") + +_Template_stats = (Core.Name "stats") + +data Mod = + ModAnnot Mod_Annot | + ModPrivate Mod_Private | + ModProtected Mod_Protected | + ModImplicit | + ModFinal | + ModSealed | + ModOpen | + ModSuper | + ModOverride | + ModCase | + ModAbstract | + ModCovariant | + ModContravariant | + ModLazy | + ModValParam | + ModVarParam | + ModInfix | + ModInline | + ModUsing | + ModOpaque | + ModTransparent + deriving (Eq, Ord, Read, Show) + +_Mod = (Core.Name "hydra/ext/scala/meta.Mod") + +_Mod_annot = (Core.Name "annot") + +_Mod_private = (Core.Name "private") + +_Mod_protected = (Core.Name "protected") + +_Mod_implicit = (Core.Name "implicit") + +_Mod_final = (Core.Name "final") + +_Mod_sealed = (Core.Name "sealed") + +_Mod_open = (Core.Name "open") + +_Mod_super = (Core.Name "super") + +_Mod_override = (Core.Name "override") + +_Mod_case = (Core.Name "case") + +_Mod_abstract = (Core.Name "abstract") + +_Mod_covariant = (Core.Name "covariant") + +_Mod_contravariant = (Core.Name "contravariant") + +_Mod_lazy = (Core.Name "lazy") + +_Mod_valParam = (Core.Name "valParam") + +_Mod_varParam = (Core.Name "varParam") + +_Mod_infix = (Core.Name "infix") + +_Mod_inline = (Core.Name "inline") + +_Mod_using = (Core.Name "using") + +_Mod_opaque = (Core.Name "opaque") + +_Mod_transparent = (Core.Name "transparent") + +data Mod_Annot = + Mod_Annot { + mod_AnnotInit :: Init} + deriving (Eq, Ord, Read, Show) + +_Mod_Annot = (Core.Name "hydra/ext/scala/meta.Mod.Annot") + +_Mod_Annot_init = (Core.Name "init") + +data Mod_Private = + Mod_Private { + mod_PrivateWithin :: Ref} + deriving (Eq, Ord, Read, Show) + +_Mod_Private = (Core.Name "hydra/ext/scala/meta.Mod.Private") + +_Mod_Private_within = (Core.Name "within") + +data Mod_Protected = + Mod_Protected { + mod_ProtectedWithin :: Ref} + deriving (Eq, Ord, Read, Show) + +_Mod_Protected = (Core.Name "hydra/ext/scala/meta.Mod.Protected") + +_Mod_Protected_within = (Core.Name "within") + +data Enumerator = + EnumeratorGenerator Enumerator_Generator | + EnumeratorCaseGenerator Enumerator_CaseGenerator | + EnumeratorVal Enumerator_Val | + EnumeratorGuard Enumerator_Guard + deriving (Eq, Ord, Read, Show) + +_Enumerator = (Core.Name "hydra/ext/scala/meta.Enumerator") + +_Enumerator_generator = (Core.Name "generator") + +_Enumerator_caseGenerator = (Core.Name "caseGenerator") + +_Enumerator_val = (Core.Name "val") + +_Enumerator_guard = (Core.Name "guard") + +data Enumerator_Generator = + Enumerator_Generator { + enumerator_GeneratorPat :: Pat, + enumerator_GeneratorRhs :: Data} + deriving (Eq, Ord, Read, Show) + +_Enumerator_Generator = (Core.Name "hydra/ext/scala/meta.Enumerator.Generator") + +_Enumerator_Generator_pat = (Core.Name "pat") + +_Enumerator_Generator_rhs = (Core.Name "rhs") + +data Enumerator_CaseGenerator = + Enumerator_CaseGenerator { + enumerator_CaseGeneratorPat :: Pat, + enumerator_CaseGeneratorRhs :: Data} + deriving (Eq, Ord, Read, Show) + +_Enumerator_CaseGenerator = (Core.Name "hydra/ext/scala/meta.Enumerator.CaseGenerator") + +_Enumerator_CaseGenerator_pat = (Core.Name "pat") + +_Enumerator_CaseGenerator_rhs = (Core.Name "rhs") + +data Enumerator_Val = + Enumerator_Val { + enumerator_ValPat :: Pat, + enumerator_ValRhs :: Data} + deriving (Eq, Ord, Read, Show) + +_Enumerator_Val = (Core.Name "hydra/ext/scala/meta.Enumerator.Val") + +_Enumerator_Val_pat = (Core.Name "pat") + +_Enumerator_Val_rhs = (Core.Name "rhs") + +data Enumerator_Guard = + Enumerator_Guard { + enumerator_GuardCond :: Data} + deriving (Eq, Ord, Read, Show) + +_Enumerator_Guard = (Core.Name "hydra/ext/scala/meta.Enumerator.Guard") + +_Enumerator_Guard_cond = (Core.Name "cond") + +data ImportExportStat = + ImportExportStatImport Import | + ImportExportStatExport Export + deriving (Eq, Ord, Read, Show) + +_ImportExportStat = (Core.Name "hydra/ext/scala/meta.ImportExportStat") + +_ImportExportStat_import = (Core.Name "import") + +_ImportExportStat_export = (Core.Name "export") + +data Import = + Import { + importImporters :: [Importer]} + deriving (Eq, Ord, Read, Show) + +_Import = (Core.Name "hydra/ext/scala/meta.Import") + +_Import_importers = (Core.Name "importers") + +data Export = + Export { + exportImporters :: [Importer]} + deriving (Eq, Ord, Read, Show) + +_Export = (Core.Name "hydra/ext/scala/meta.Export") + +_Export_importers = (Core.Name "importers") + +data Importer = + Importer { + importerRef :: Data_Ref, + importerImportees :: [Importee]} + deriving (Eq, Ord, Read, Show) + +_Importer = (Core.Name "hydra/ext/scala/meta.Importer") + +_Importer_ref = (Core.Name "ref") + +_Importer_importees = (Core.Name "importees") + +data Importee = + ImporteeWildcard | + ImporteeGiven Importee_Given | + ImporteeGivenAll | + ImporteeName Importee_Name | + ImporteeRename Importee_Rename | + ImporteeUnimport Importee_Unimport + deriving (Eq, Ord, Read, Show) + +_Importee = (Core.Name "hydra/ext/scala/meta.Importee") + +_Importee_wildcard = (Core.Name "wildcard") + +_Importee_given = (Core.Name "given") + +_Importee_givenAll = (Core.Name "givenAll") + +_Importee_name = (Core.Name "name") + +_Importee_rename = (Core.Name "rename") + +_Importee_unimport = (Core.Name "unimport") + +data Importee_Given = + Importee_Given { + importee_GivenTpe :: Type} + deriving (Eq, Ord, Read, Show) + +_Importee_Given = (Core.Name "hydra/ext/scala/meta.Importee.Given") + +_Importee_Given_tpe = (Core.Name "tpe") + +data Importee_Name = + Importee_Name { + importee_NameName :: Name} + deriving (Eq, Ord, Read, Show) + +_Importee_Name = (Core.Name "hydra/ext/scala/meta.Importee.Name") + +_Importee_Name_name = (Core.Name "name") + +data Importee_Rename = + Importee_Rename { + importee_RenameName :: Name, + importee_RenameRename :: Name} + deriving (Eq, Ord, Read, Show) + +_Importee_Rename = (Core.Name "hydra/ext/scala/meta.Importee.Rename") + +_Importee_Rename_name = (Core.Name "name") + +_Importee_Rename_rename = (Core.Name "rename") + +data Importee_Unimport = + Importee_Unimport { + importee_UnimportName :: Name} + deriving (Eq, Ord, Read, Show) + +_Importee_Unimport = (Core.Name "hydra/ext/scala/meta.Importee.Unimport") + +_Importee_Unimport_name = (Core.Name "name") + +data CaseTree = + CaseTreeCase Case | + CaseTreeTypeCase TypeCase + deriving (Eq, Ord, Read, Show) + +_CaseTree = (Core.Name "hydra/ext/scala/meta.CaseTree") + +_CaseTree_case = (Core.Name "case") + +_CaseTree_typeCase = (Core.Name "typeCase") + +data Case = + Case { + casePat :: Pat, + caseCond :: (Maybe Data), + caseBody :: Data} + deriving (Eq, Ord, Read, Show) + +_Case = (Core.Name "hydra/ext/scala/meta.Case") + +_Case_pat = (Core.Name "pat") + +_Case_cond = (Core.Name "cond") + +_Case_body = (Core.Name "body") + +data TypeCase = + TypeCase { + typeCasePat :: Type, + typeCaseBody :: Type} + deriving (Eq, Ord, Read, Show) + +_TypeCase = (Core.Name "hydra/ext/scala/meta.TypeCase") + +_TypeCase_pat = (Core.Name "pat") + +_TypeCase_body = (Core.Name "body") + +data Source = + Source { + sourceStats :: [Stat]} + deriving (Eq, Ord, Read, Show) + +_Source = (Core.Name "hydra/ext/scala/meta.Source") + +_Source_stats = (Core.Name "stats") + +data Quasi = + Quasi {} + deriving (Eq, Ord, Read, Show) + +_Quasi = (Core.Name "hydra/ext/scala/meta.Quasi") diff --git a/src/gen-main/haskell/Hydra/Ext/Tabular.hs b/src/gen-main/haskell/Hydra/Ext/Tabular.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Ext/Tabular.hs @@ -0,0 +1,40 @@ +-- | A simple, untyped tabular data model, suitable for CSVs and TSVs + +module Hydra.Ext.Tabular where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | A data row, containing optional-valued cells; one per column +newtype DataRow v = + DataRow { + unDataRow :: [Maybe v]} + deriving (Eq, Ord, Read, Show) + +_DataRow = (Core.Name "hydra/ext/tabular.DataRow") + +-- | A header row, containing column names (but no types or data) +newtype HeaderRow = + HeaderRow { + unHeaderRow :: [String]} + deriving (Eq, Ord, Read, Show) + +_HeaderRow = (Core.Name "hydra/ext/tabular.HeaderRow") + +-- | A simple table as in a CSV file, having an optional header row and any number of data rows +data Table v = + Table { + -- | The optional header row of the table. If present, the header must have the same number of cells as each data row. + tableHeader :: (Maybe HeaderRow), + -- | The data rows of the table. Each row must have the same number of cells. + tableData :: [DataRow v]} + deriving (Eq, Ord, Read, Show) + +_Table = (Core.Name "hydra/ext/tabular.Table") + +_Table_header = (Core.Name "header") + +_Table_data = (Core.Name "data") diff --git a/src/gen-main/haskell/Hydra/Extras.hs b/src/gen-main/haskell/Hydra/Extras.hs --- a/src/gen-main/haskell/Hydra/Extras.hs +++ b/src/gen-main/haskell/Hydra/Extras.hs @@ -17,7 +17,7 @@ functionArity :: (Core.Function -> Int) functionArity x = case x of Core.FunctionElimination _ -> 1 - Core.FunctionLambda v232 -> (Math.add 1 (termArity (Core.lambdaBody v232))) + Core.FunctionLambda v275 -> (Math.add 1 (termArity (Core.lambdaBody v275))) Core.FunctionPrimitive _ -> 42 lookupPrimitive :: (Graph.Graph -> Core.Name -> Maybe Graph.Primitive) @@ -25,7 +25,7 @@ -- | Find the arity (expected number of arguments) of a primitive constant or function primitiveArity :: (Graph.Primitive -> Int) -primitiveArity x = (typeArity (Graph.primitiveType x)) +primitiveArity x = ((\x -> typeArity (Core.typeSchemeType x)) (Graph.primitiveType x)) -- | Construct a qualified (dot-separated) name qname :: (Module.Namespace -> String -> Core.Name) @@ -36,27 +36,27 @@ termArity :: (Core.Term -> Int) termArity x = case x of - Core.TermApplication v234 -> ((\x -> Math.sub x 1) (termArity (Core.applicationFunction v234))) - Core.TermFunction v235 -> (functionArity v235) + Core.TermApplication v277 -> ((\x -> (\x -> Math.sub x 1) (termArity x)) (Core.applicationFunction v277)) + Core.TermFunction v278 -> (functionArity v278) _ -> 0 typeArity :: (Core.Type -> Int) typeArity x = case x of - Core.TypeAnnotated v236 -> (typeArity (Core.annotatedTypeSubject v236)) - Core.TypeApplication v237 -> (typeArity (Core.applicationTypeFunction v237)) - Core.TypeLambda v238 -> (typeArity (Core.lambdaTypeBody v238)) - Core.TypeFunction v239 -> (Math.add 1 (typeArity (Core.functionTypeCodomain v239))) + Core.TypeAnnotated v279 -> (typeArity (Core.annotatedTypeSubject v279)) + Core.TypeApplication v280 -> (typeArity (Core.applicationTypeFunction v280)) + Core.TypeLambda v281 -> (typeArity (Core.lambdaTypeBody v281)) + Core.TypeFunction v282 -> (Math.add 1 (typeArity (Core.functionTypeCodomain v282))) _ -> 0 -- | Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b) uncurryType :: (Core.Type -> [Core.Type]) uncurryType t = ((\x -> case x of - Core.TypeAnnotated v240 -> (uncurryType (Core.annotatedTypeSubject v240)) - Core.TypeApplication v241 -> (uncurryType (Core.applicationTypeFunction v241)) - Core.TypeLambda v242 -> (uncurryType (Core.lambdaTypeBody v242)) - Core.TypeFunction v243 -> (Lists.cons (Core.functionTypeDomain v243) (uncurryType (Core.functionTypeCodomain v243))) + Core.TypeAnnotated v283 -> (uncurryType (Core.annotatedTypeSubject v283)) + Core.TypeApplication v284 -> (uncurryType (Core.applicationTypeFunction v284)) + Core.TypeLambda v285 -> (uncurryType (Core.lambdaTypeBody v285)) + Core.TypeFunction v286 -> (Lists.cons (Core.functionTypeDomain v286) (uncurryType (Core.functionTypeCodomain v286))) _ -> [ t]) t) -getAnnotation :: (String -> Map String Core.Term -> Maybe Core.Term) +getAnnotation :: (Core.Name -> Map Core.Name Core.Term -> Maybe Core.Term) getAnnotation key ann = (Maps.lookup key ann) diff --git a/src/gen-main/haskell/Hydra/Graph.hs b/src/gen-main/haskell/Hydra/Graph.hs --- a/src/gen-main/haskell/Hydra/Graph.hs +++ b/src/gen-main/haskell/Hydra/Graph.hs @@ -32,7 +32,7 @@ -- | The lambda environment of this graph context; it indicates whether a variable is bound by a lambda (Nothing) or a let (Just term) graphEnvironment :: (Map Core.Name (Maybe Core.Term)), -- | The typing environment of the graph - graphTypes :: (Map Core.Name Core.Type), + graphTypes :: (Map Core.Name Core.TypeScheme), -- | The body of the term which generated this context graphBody :: Core.Term, -- | All supported primitive constants and functions, by name @@ -73,7 +73,7 @@ -- | The unique name of the primitive function primitiveName :: Core.Name, -- | The type signature of the primitive function - primitiveType :: Core.Type, + primitiveType :: Core.TypeScheme, -- | A concrete implementation of the primitive function primitiveImplementation :: ([Core.Term] -> Compute.Flow Graph Core.Term)} diff --git a/src/gen-main/haskell/Hydra/Json.hs b/src/gen-main/haskell/Hydra/Json.hs --- a/src/gen-main/haskell/Hydra/Json.hs +++ b/src/gen-main/haskell/Hydra/Json.hs @@ -10,11 +10,17 @@ -- | A JSON value data Value = + -- | A JSON array ValueArray [Value] | + -- | A boolean value ValueBoolean Bool | + -- | JSON's null value ValueNull | + -- | A numeric value ValueNumber Double | + -- | A JSON object as a set of key/value pairs ValueObject (Map String Value) | + -- | A string value ValueString String deriving (Eq, Ord, Read, Show) diff --git a/src/gen-main/haskell/Hydra/Langs/Avro/Schema.hs b/src/gen-main/haskell/Hydra/Langs/Avro/Schema.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Avro/Schema.hs +++ /dev/null @@ -1,222 +0,0 @@ --- | A model for Avro schemas. Based on the Avro 1.11.1 specification: --- | https://avro.apache.org/docs/1.11.1/specification - -module Hydra.Langs.Avro.Schema where - -import qualified Hydra.Core as Core -import qualified Hydra.Json as Json -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data Array = - Array { - arrayItems :: Schema} - deriving (Eq, Ord, Read, Show) - -_Array = (Core.Name "hydra/langs/avro/schema.Array") - -_Array_items = (Core.Name "items") - -data Enum_ = - Enum_ { - -- | a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* (the same requirement as for names) - enumSymbols :: [String], - -- | A default value for this enumeration, used during resolution when the reader encounters a symbol from the writer that isn’t defined in the reader’s schema. The value provided here must be a JSON string that’s a member of the symbols array - enumDefault :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_Enum = (Core.Name "hydra/langs/avro/schema.Enum") - -_Enum_symbols = (Core.Name "symbols") - -_Enum_default = (Core.Name "default") - -data Field = - Field { - -- | a JSON string providing the name of the field - fieldName :: String, - -- | a JSON string describing this field for users - fieldDoc :: (Maybe String), - -- | a schema - fieldType :: Schema, - -- | default value for this field, only used when reading instances that lack the field for schema evolution purposes - fieldDefault :: (Maybe Json.Value), - -- | specifies how this field impacts sort ordering of this record - fieldOrder :: (Maybe Order), - -- | a JSON array of strings, providing alternate names for this field - fieldAliases :: (Maybe [String]), - -- | Any additional key/value pairs attached to the field - fieldAnnotations :: (Map String Json.Value)} - deriving (Eq, Ord, Read, Show) - -_Field = (Core.Name "hydra/langs/avro/schema.Field") - -_Field_name = (Core.Name "name") - -_Field_doc = (Core.Name "doc") - -_Field_type = (Core.Name "type") - -_Field_default = (Core.Name "default") - -_Field_order = (Core.Name "order") - -_Field_aliases = (Core.Name "aliases") - -_Field_annotations = (Core.Name "annotations") - -data Fixed = - Fixed { - -- | an integer, specifying the number of bytes per value - fixedSize :: Int} - deriving (Eq, Ord, Read, Show) - -_Fixed = (Core.Name "hydra/langs/avro/schema.Fixed") - -_Fixed_size = (Core.Name "size") - -data Map_ = - Map_ { - mapValues :: Schema} - deriving (Eq, Ord, Read, Show) - -_Map = (Core.Name "hydra/langs/avro/schema.Map") - -_Map_values = (Core.Name "values") - -data Named = - Named { - -- | a string naming this schema - namedName :: String, - -- | a string that qualifies the name - namedNamespace :: (Maybe String), - -- | a JSON array of strings, providing alternate names for this schema - namedAliases :: (Maybe [String]), - -- | a JSON string providing documentation to the user of this schema - namedDoc :: (Maybe String), - namedType :: NamedType, - -- | Any additional key/value pairs attached to the type - namedAnnotations :: (Map String Json.Value)} - deriving (Eq, Ord, Read, Show) - -_Named = (Core.Name "hydra/langs/avro/schema.Named") - -_Named_name = (Core.Name "name") - -_Named_namespace = (Core.Name "namespace") - -_Named_aliases = (Core.Name "aliases") - -_Named_doc = (Core.Name "doc") - -_Named_type = (Core.Name "type") - -_Named_annotations = (Core.Name "annotations") - -data NamedType = - NamedTypeEnum Enum_ | - NamedTypeFixed Fixed | - NamedTypeRecord Record - deriving (Eq, Ord, Read, Show) - -_NamedType = (Core.Name "hydra/langs/avro/schema.NamedType") - -_NamedType_enum = (Core.Name "enum") - -_NamedType_fixed = (Core.Name "fixed") - -_NamedType_record = (Core.Name "record") - -data Order = - OrderAscending | - OrderDescending | - OrderIgnore - deriving (Eq, Ord, Read, Show) - -_Order = (Core.Name "hydra/langs/avro/schema.Order") - -_Order_ascending = (Core.Name "ascending") - -_Order_descending = (Core.Name "descending") - -_Order_ignore = (Core.Name "ignore") - -data Primitive = - -- | no value - PrimitiveNull | - -- | A binary value - PrimitiveBoolean | - -- | 32-bit signed integer - PrimitiveInt | - -- | 64-bit signed integer - PrimitiveLong | - -- | single precision (32-bit) IEEE 754 floating-point number - PrimitiveFloat | - -- | double precision (64-bit) IEEE 754 floating-point number - PrimitiveDouble | - -- | sequence of 8-bit unsigned bytes - PrimitiveBytes | - -- | unicode character sequence - PrimitiveString - deriving (Eq, Ord, Read, Show) - -_Primitive = (Core.Name "hydra/langs/avro/schema.Primitive") - -_Primitive_null = (Core.Name "null") - -_Primitive_boolean = (Core.Name "boolean") - -_Primitive_int = (Core.Name "int") - -_Primitive_long = (Core.Name "long") - -_Primitive_float = (Core.Name "float") - -_Primitive_double = (Core.Name "double") - -_Primitive_bytes = (Core.Name "bytes") - -_Primitive_string = (Core.Name "string") - -data Record = - Record { - -- | a JSON array, listing fields - recordFields :: [Field]} - deriving (Eq, Ord, Read, Show) - -_Record = (Core.Name "hydra/langs/avro/schema.Record") - -_Record_fields = (Core.Name "fields") - -data Schema = - SchemaArray Array | - SchemaMap Map_ | - SchemaNamed Named | - SchemaPrimitive Primitive | - -- | A reference by name to a previously defined type - SchemaReference String | - SchemaUnion Union - deriving (Eq, Ord, Read, Show) - -_Schema = (Core.Name "hydra/langs/avro/schema.Schema") - -_Schema_array = (Core.Name "array") - -_Schema_map = (Core.Name "map") - -_Schema_named = (Core.Name "named") - -_Schema_primitive = (Core.Name "primitive") - -_Schema_reference = (Core.Name "reference") - -_Schema_union = (Core.Name "union") - -newtype Union = - Union { - unUnion :: [Schema]} - deriving (Eq, Ord, Read, Show) - -_Union = (Core.Name "hydra/langs/avro/schema.Union") diff --git a/src/gen-main/haskell/Hydra/Langs/Cypher/Features.hs b/src/gen-main/haskell/Hydra/Langs/Cypher/Features.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Cypher/Features.hs +++ /dev/null @@ -1,935 +0,0 @@ --- | A model for characterizing OpenCypher queries and implementations in terms of included features. - -module Hydra.Langs.Cypher.Features where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | A set of features for aggregation functions. -data AggregateFeatures = - AggregateFeatures { - -- | Whether to expect the avg() / AVG aggregate function. - aggregateFeaturesAvg :: Bool, - -- | Whether to expect the collect() / COLLECT aggregate function. - aggregateFeaturesCollect :: Bool, - -- | Whether to expect the count() / COUNT aggregate function. - aggregateFeaturesCount :: Bool, - -- | Whether to expect the max() / MAX aggregate function. - aggregateFeaturesMax :: Bool, - -- | Whether to expect the min() / MIN aggregate function. - aggregateFeaturesMin :: Bool, - -- | Whether to expect the percentileCont() function. - aggregateFeaturesPercentileCont :: Bool, - -- | Whether to expect the percentileDisc() function. - aggregateFeaturesPercentileDisc :: Bool, - -- | Whether to expect the stdev() function. - aggregateFeaturesStdev :: Bool, - -- | Whether to expect the sum() / SUM aggregate function. - aggregateFeaturesSum :: Bool} - deriving (Eq, Ord, Read, Show) - -_AggregateFeatures = (Core.Name "hydra/langs/cypher/features.AggregateFeatures") - -_AggregateFeatures_avg = (Core.Name "avg") - -_AggregateFeatures_collect = (Core.Name "collect") - -_AggregateFeatures_count = (Core.Name "count") - -_AggregateFeatures_max = (Core.Name "max") - -_AggregateFeatures_min = (Core.Name "min") - -_AggregateFeatures_percentileCont = (Core.Name "percentileCont") - -_AggregateFeatures_percentileDisc = (Core.Name "percentileDisc") - -_AggregateFeatures_stdev = (Core.Name "stdev") - -_AggregateFeatures_sum = (Core.Name "sum") - --- | A set of features for arithmetic operations. -data ArithmeticFeatures = - ArithmeticFeatures { - -- | Whether to expect the + operator. - arithmeticFeaturesPlus :: Bool, - -- | Whether to expect the - operator. - arithmeticFeaturesMinus :: Bool, - -- | Whether to expect the * operator. - arithmeticFeaturesMultiply :: Bool, - -- | Whether to expect the / operator. - arithmeticFeaturesDivide :: Bool, - -- | Whether to expect the % operator. - arithmeticFeaturesModulus :: Bool, - -- | Whether to expect the ^ operator. - arithmeticFeaturesPowerOf :: Bool} - deriving (Eq, Ord, Read, Show) - -_ArithmeticFeatures = (Core.Name "hydra/langs/cypher/features.ArithmeticFeatures") - -_ArithmeticFeatures_plus = (Core.Name "plus") - -_ArithmeticFeatures_minus = (Core.Name "minus") - -_ArithmeticFeatures_multiply = (Core.Name "multiply") - -_ArithmeticFeatures_divide = (Core.Name "divide") - -_ArithmeticFeatures_modulus = (Core.Name "modulus") - -_ArithmeticFeatures_powerOf = (Core.Name "powerOf") - --- | A set of features for various kinds of atomic expressions. -data AtomFeatures = - AtomFeatures { - -- | Whether to expect CASE expressions. - atomFeaturesCaseExpression :: Bool, - -- | Whether to expect the COUNT (*) expression. - atomFeaturesCount :: Bool, - -- | Whether to expect existential subqueries. - atomFeaturesExistentialSubquery :: Bool, - -- | Whether to expect function invocation. - atomFeaturesFunctionInvocation :: Bool, - -- | Whether to expect lists, and if so, which specific features - atomFeaturesList :: (Maybe ListFeatures), - -- | Whether to expect literal values, and if so, which specific features - atomFeaturesLiteral :: (Maybe LiteralFeatures), - -- | Whether to expect parameter expressions. - atomFeaturesParameter :: Bool, - -- | Whether to expect pattern comprehensions. - atomFeaturesPatternComprehension :: Bool, - -- | Whether to expect relationship patterns as subexpressions. - atomFeaturesPatternPredicate :: Bool, - -- | Whether to expect quantifier expressions, and if so, which specific features - atomFeaturesQuantifier :: (Maybe QuantifierFeatures), - -- | Whether to expect variable expressions (note: included by most if not all implementations). - atomFeaturesVariable :: Bool} - deriving (Eq, Ord, Read, Show) - -_AtomFeatures = (Core.Name "hydra/langs/cypher/features.AtomFeatures") - -_AtomFeatures_caseExpression = (Core.Name "caseExpression") - -_AtomFeatures_count = (Core.Name "count") - -_AtomFeatures_existentialSubquery = (Core.Name "existentialSubquery") - -_AtomFeatures_functionInvocation = (Core.Name "functionInvocation") - -_AtomFeatures_list = (Core.Name "list") - -_AtomFeatures_literal = (Core.Name "literal") - -_AtomFeatures_parameter = (Core.Name "parameter") - -_AtomFeatures_patternComprehension = (Core.Name "patternComprehension") - -_AtomFeatures_patternPredicate = (Core.Name "patternPredicate") - -_AtomFeatures_quantifier = (Core.Name "quantifier") - -_AtomFeatures_variable = (Core.Name "variable") - --- | A set of features for comparison operators and functions. -data ComparisonFeatures = - ComparisonFeatures { - -- | Whether to expect the = comparison operator. - comparisonFeaturesEqual :: Bool, - -- | Whether to expect the > comparison operator. - comparisonFeaturesGreaterThan :: Bool, - -- | Whether to expect the >= comparison operator. - comparisonFeaturesGreaterThanOrEqual :: Bool, - -- | Whether to expect the < comparison operator. - comparisonFeaturesLessThan :: Bool, - -- | Whether to expect the <= comparison operator. - comparisonFeaturesLessThanOrEqual :: Bool, - -- | Whether to expect the <> comparison operator. - comparisonFeaturesNotEqual :: Bool, - -- | Whether to expect the nullIf() function. - comparisonFeaturesNullIf :: Bool} - deriving (Eq, Ord, Read, Show) - -_ComparisonFeatures = (Core.Name "hydra/langs/cypher/features.ComparisonFeatures") - -_ComparisonFeatures_equal = (Core.Name "equal") - -_ComparisonFeatures_greaterThan = (Core.Name "greaterThan") - -_ComparisonFeatures_greaterThanOrEqual = (Core.Name "greaterThanOrEqual") - -_ComparisonFeatures_lessThan = (Core.Name "lessThan") - -_ComparisonFeatures_lessThanOrEqual = (Core.Name "lessThanOrEqual") - -_ComparisonFeatures_notEqual = (Core.Name "notEqual") - -_ComparisonFeatures_nullIf = (Core.Name "nullIf") - --- | A set of features which characterize an OpenCypher query or implementation. Any features which are omitted from the set are assumed to be unsupported or nonrequired. -data CypherFeatures = - CypherFeatures { - -- | Whether to expect aggregate functions, and if so, which specific features - cypherFeaturesAggregate :: (Maybe AggregateFeatures), - -- | Whether to expect arithmetic operations, and if so, which specific features - cypherFeaturesArithmetic :: (Maybe ArithmeticFeatures), - -- | Whether to expect atomic expressions, and if so, which specific features - cypherFeaturesAtom :: (Maybe AtomFeatures), - -- | Whether to expect comparison operations, and if so, which specific features - cypherFeaturesComparison :: (Maybe ComparisonFeatures), - -- | Whether to expect delete operations, and if so, which specific features - cypherFeaturesDelete :: (Maybe DeleteFeatures), - -- | Whether to expect element functions, and if so, which specific features - cypherFeaturesElement :: (Maybe ElementFeatures), - -- | Whether to expect logical operations, and if so, which specific features - cypherFeaturesLogical :: (Maybe LogicalFeatures), - -- | Whether to expect property map functions, and if so, which specific features - cypherFeaturesMap :: (Maybe MapFeatures), - -- | Whether to expect match queries, and if so, which specific features - cypherFeaturesMatch :: (Maybe MatchFeatures), - -- | Whether to expect merge operations, and if so, which specific features - cypherFeaturesMerge :: (Maybe MergeFeatures), - -- | Whether to expect node patterns, and if so, which specific features - cypherFeaturesNodePattern :: (Maybe NodePatternFeatures), - -- | Whether to expect IS NULL / IS NOT NULL checks, and if so, which specific features - cypherFeaturesNull :: (Maybe NullFeatures), - -- | Whether to expect numeric functions, and if so, which specific features - cypherFeaturesNumeric :: (Maybe NumericFeatures), - -- | Whether to expect path functions, and if so, which specific features - cypherFeaturesPath :: (Maybe PathFeatures), - -- | Whether to expect procedure calls, and if so, which specific features - cypherFeaturesProcedureCall :: (Maybe ProcedureCallFeatures), - -- | Whether to expect projection operations, and if so, which specific features - cypherFeaturesProjection :: (Maybe ProjectionFeatures), - -- | Whether to expect random value generation, and if so, which specific features - cypherFeaturesRandomness :: (Maybe RandomnessFeatures), - -- | Whether to expect range literals, and if so, which specific features - cypherFeaturesRangeLiteral :: (Maybe RangeLiteralFeatures), - -- | Whether to expect reading operations, and if so, which specific features - cypherFeaturesReading :: (Maybe ReadingFeatures), - -- | Whether to expect relationship directions, and if so, which specific features - cypherFeaturesRelationshipDirection :: (Maybe RelationshipDirectionFeatures), - -- | Whether to expect relationship patterns, and if so, which specific features - cypherFeaturesRelationshipPattern :: (Maybe RelationshipPatternFeatures), - -- | Whether to expect remove operations, and if so, which specific features - cypherFeaturesRemove :: (Maybe RemoveFeatures), - -- | Whether to expect schema functions, and if so, which specific features - cypherFeaturesSchema :: (Maybe SchemaFeatures), - -- | Whether to expect set operations, and if so, which specific features - cypherFeaturesSet :: (Maybe SetFeatures), - -- | Whether to expect string operations, and if so, which specific features - cypherFeaturesString :: (Maybe StringFeatures), - -- | Whether to expect updating operations, and if so, which specific features - cypherFeaturesUpdating :: (Maybe UpdatingFeatures)} - deriving (Eq, Ord, Read, Show) - -_CypherFeatures = (Core.Name "hydra/langs/cypher/features.CypherFeatures") - -_CypherFeatures_aggregate = (Core.Name "aggregate") - -_CypherFeatures_arithmetic = (Core.Name "arithmetic") - -_CypherFeatures_atom = (Core.Name "atom") - -_CypherFeatures_comparison = (Core.Name "comparison") - -_CypherFeatures_delete = (Core.Name "delete") - -_CypherFeatures_element = (Core.Name "element") - -_CypherFeatures_logical = (Core.Name "logical") - -_CypherFeatures_map = (Core.Name "map") - -_CypherFeatures_match = (Core.Name "match") - -_CypherFeatures_merge = (Core.Name "merge") - -_CypherFeatures_nodePattern = (Core.Name "nodePattern") - -_CypherFeatures_null = (Core.Name "null") - -_CypherFeatures_numeric = (Core.Name "numeric") - -_CypherFeatures_path = (Core.Name "path") - -_CypherFeatures_procedureCall = (Core.Name "procedureCall") - -_CypherFeatures_projection = (Core.Name "projection") - -_CypherFeatures_randomness = (Core.Name "randomness") - -_CypherFeatures_rangeLiteral = (Core.Name "rangeLiteral") - -_CypherFeatures_reading = (Core.Name "reading") - -_CypherFeatures_relationshipDirection = (Core.Name "relationshipDirection") - -_CypherFeatures_relationshipPattern = (Core.Name "relationshipPattern") - -_CypherFeatures_remove = (Core.Name "remove") - -_CypherFeatures_schema = (Core.Name "schema") - -_CypherFeatures_set = (Core.Name "set") - -_CypherFeatures_string = (Core.Name "string") - -_CypherFeatures_updating = (Core.Name "updating") - --- | A set of features for delete operations. -data DeleteFeatures = - DeleteFeatures { - -- | Whether to expect the basic DELETE clause. - deleteFeaturesDelete :: Bool, - -- | Whether to expect the DETACH DELETE clause. - deleteFeaturesDetachDelete :: Bool} - deriving (Eq, Ord, Read, Show) - -_DeleteFeatures = (Core.Name "hydra/langs/cypher/features.DeleteFeatures") - -_DeleteFeatures_delete = (Core.Name "delete") - -_DeleteFeatures_detachDelete = (Core.Name "detachDelete") - --- | A set of features for element functions. -data ElementFeatures = - ElementFeatures { - -- | Whether to expect the elementId() function. - elementFeaturesElementId :: Bool, - -- | Whether to expect the endNode() function. - elementFeaturesEndNode :: Bool, - -- | Whether to expect the labels() function. - elementFeaturesLabels :: Bool, - -- | Whether to expect the properties() function. - elementFeaturesProperties :: Bool, - -- | Whether to expect the startNode() function. - elementFeaturesStartNode :: Bool} - deriving (Eq, Ord, Read, Show) - -_ElementFeatures = (Core.Name "hydra/langs/cypher/features.ElementFeatures") - -_ElementFeatures_elementId = (Core.Name "elementId") - -_ElementFeatures_endNode = (Core.Name "endNode") - -_ElementFeatures_labels = (Core.Name "labels") - -_ElementFeatures_properties = (Core.Name "properties") - -_ElementFeatures_startNode = (Core.Name "startNode") - --- | A set of features for list functionality. -data ListFeatures = - ListFeatures { - -- | Whether to expect the all() function. - listFeaturesAll :: Bool, - -- | Whether to expect the any() function. - listFeaturesAny :: Bool, - -- | Whether to expect the coalesce() function. - listFeaturesCoalesce :: Bool, - -- | Whether to expect the isEmpty() function. - listFeaturesIsEmpty :: Bool, - -- | Whether to expect the head() function. - listFeaturesHead :: Bool, - -- | Whether to expect the last() function. - listFeaturesLast :: Bool, - -- | Whether to expect basic list comprehensions. - listFeaturesListComprehension :: Bool, - -- | Whether to expect list range comprehensions (e.g. [1..10]). - listFeaturesListRange :: Bool, - -- | Whether to expect the none() function. - listFeaturesNone :: Bool, - -- | Whether to expect the reduce() function. - listFeaturesReduce :: Bool, - -- | Whether to expect the reverse() function. - listFeaturesReverse :: Bool, - -- | Whether to expect the single() function. - listFeaturesSingle :: Bool, - -- | Whether to expect the size() function. - listFeaturesSize :: Bool, - -- | Whether to expect the tail() function. - listFeaturesTail :: Bool, - -- | Whether to expect the toBooleanList() function. - listFeaturesToBooleanList :: Bool, - -- | Whether to expect the toFloatList() function. - listFeaturesToFloatList :: Bool, - -- | Whether to expect the toIntegerList() function. - listFeaturesToIntegerList :: Bool, - -- | Whether to expect the toStringList() function. - listFeaturesToStringList :: Bool} - deriving (Eq, Ord, Read, Show) - -_ListFeatures = (Core.Name "hydra/langs/cypher/features.ListFeatures") - -_ListFeatures_all = (Core.Name "all") - -_ListFeatures_any = (Core.Name "any") - -_ListFeatures_coalesce = (Core.Name "coalesce") - -_ListFeatures_isEmpty = (Core.Name "isEmpty") - -_ListFeatures_head = (Core.Name "head") - -_ListFeatures_last = (Core.Name "last") - -_ListFeatures_listComprehension = (Core.Name "listComprehension") - -_ListFeatures_listRange = (Core.Name "listRange") - -_ListFeatures_none = (Core.Name "none") - -_ListFeatures_reduce = (Core.Name "reduce") - -_ListFeatures_reverse = (Core.Name "reverse") - -_ListFeatures_single = (Core.Name "single") - -_ListFeatures_size = (Core.Name "size") - -_ListFeatures_tail = (Core.Name "tail") - -_ListFeatures_toBooleanList = (Core.Name "toBooleanList") - -_ListFeatures_toFloatList = (Core.Name "toFloatList") - -_ListFeatures_toIntegerList = (Core.Name "toIntegerList") - -_ListFeatures_toStringList = (Core.Name "toStringList") - --- | A set of features for various types of literal values. -data LiteralFeatures = - LiteralFeatures { - -- | Whether to expect boolean literals (note: included by most if not all implementations). - literalFeaturesBoolean :: Bool, - -- | Whether to expect double-precision floating-point literals. - literalFeaturesDouble :: Bool, - -- | Whether to expect integer literals. - literalFeaturesInteger :: Bool, - -- | Whether to expect list literals. - literalFeaturesList :: Bool, - -- | Whether to expect map literals. - literalFeaturesMap :: Bool, - -- | Whether to expect the NULL literal. - literalFeaturesNull :: Bool, - -- | Whether to expect string literals (note: included by most if not all implementations). - literalFeaturesString :: Bool} - deriving (Eq, Ord, Read, Show) - -_LiteralFeatures = (Core.Name "hydra/langs/cypher/features.LiteralFeatures") - -_LiteralFeatures_boolean = (Core.Name "boolean") - -_LiteralFeatures_double = (Core.Name "double") - -_LiteralFeatures_integer = (Core.Name "integer") - -_LiteralFeatures_list = (Core.Name "list") - -_LiteralFeatures_map = (Core.Name "map") - -_LiteralFeatures_null = (Core.Name "null") - -_LiteralFeatures_string = (Core.Name "string") - --- | A set of features for logical operations. -data LogicalFeatures = - LogicalFeatures { - -- | Whether to expect the AND operator. - logicalFeaturesAnd :: Bool, - -- | Whether to expect the NOT operator. - logicalFeaturesNot :: Bool, - -- | Whether to expect the OR operator. - logicalFeaturesOr :: Bool, - -- | Whether to expect the XOR operator. - logicalFeaturesXor :: Bool} - deriving (Eq, Ord, Read, Show) - -_LogicalFeatures = (Core.Name "hydra/langs/cypher/features.LogicalFeatures") - -_LogicalFeatures_and = (Core.Name "and") - -_LogicalFeatures_not = (Core.Name "not") - -_LogicalFeatures_or = (Core.Name "or") - -_LogicalFeatures_xor = (Core.Name "xor") - --- | A set of features for property map functions. -data MapFeatures = - MapFeatures { - -- | Whether to expect the keys() function. - mapFeaturesKeys :: Bool} - deriving (Eq, Ord, Read, Show) - -_MapFeatures = (Core.Name "hydra/langs/cypher/features.MapFeatures") - -_MapFeatures_keys = (Core.Name "keys") - --- | A set of features for match queries. -data MatchFeatures = - MatchFeatures { - -- | Whether to expect the basic (non-optional) MATCH clause. - matchFeaturesMatch :: Bool, - -- | Whether to expect OPTIONAL MATCH. - matchFeaturesOptionalMatch :: Bool} - deriving (Eq, Ord, Read, Show) - -_MatchFeatures = (Core.Name "hydra/langs/cypher/features.MatchFeatures") - -_MatchFeatures_match = (Core.Name "match") - -_MatchFeatures_optionalMatch = (Core.Name "optionalMatch") - --- | A set of features for merge operations. -data MergeFeatures = - MergeFeatures { - -- | Whether to expect the basic MERGE clause. - mergeFeaturesMerge :: Bool, - -- | Whether to expect MERGE with the ON CREATE action. - mergeFeaturesMergeOnCreate :: Bool, - -- | Whether to expect MERGE with the ON MATCH action. - mergeFeaturesMergeOnMatch :: Bool} - deriving (Eq, Ord, Read, Show) - -_MergeFeatures = (Core.Name "hydra/langs/cypher/features.MergeFeatures") - -_MergeFeatures_merge = (Core.Name "merge") - -_MergeFeatures_mergeOnCreate = (Core.Name "mergeOnCreate") - -_MergeFeatures_mergeOnMatch = (Core.Name "mergeOnMatch") - --- | A set of features for node patterns. -data NodePatternFeatures = - NodePatternFeatures { - -- | Whether to expect specifying multiple labels in a node pattern. - nodePatternFeaturesMultipleLabels :: Bool, - -- | Whether to expect specifying a parameter as part of a node pattern. - nodePatternFeaturesParameter :: Bool, - -- | Whether to expect specifying a key/value map of properties in a node pattern. - nodePatternFeaturesPropertyMap :: Bool, - -- | Whether to expect binding a variable to a node in a node pattern (note: included by most if not all implementations). - nodePatternFeaturesVariableNode :: Bool, - -- | Whether to expect omitting labels from a node pattern. - nodePatternFeaturesWildcardLabel :: Bool} - deriving (Eq, Ord, Read, Show) - -_NodePatternFeatures = (Core.Name "hydra/langs/cypher/features.NodePatternFeatures") - -_NodePatternFeatures_multipleLabels = (Core.Name "multipleLabels") - -_NodePatternFeatures_parameter = (Core.Name "parameter") - -_NodePatternFeatures_propertyMap = (Core.Name "propertyMap") - -_NodePatternFeatures_variableNode = (Core.Name "variableNode") - -_NodePatternFeatures_wildcardLabel = (Core.Name "wildcardLabel") - --- | A set of features for IS NULL / IS NOT NULL checks. -data NullFeatures = - NullFeatures { - -- | Whether to expect the IS NULL operator. - nullFeaturesIsNull :: Bool, - -- | Whether to expect the IS NOT NULL operator. - nullFeaturesIsNotNull :: Bool} - deriving (Eq, Ord, Read, Show) - -_NullFeatures = (Core.Name "hydra/langs/cypher/features.NullFeatures") - -_NullFeatures_isNull = (Core.Name "isNull") - -_NullFeatures_isNotNull = (Core.Name "isNotNull") - --- | A set of features for numeric functions. -data NumericFeatures = - NumericFeatures { - -- | Whether to expect the abs() function. - numericFeaturesAbs :: Bool, - -- | Whether to expect the ceil() function. - numericFeaturesCeil :: Bool, - -- | Whether to expect the e() function. - numericFeaturesE :: Bool, - -- | Whether to expect the exp() function. - numericFeaturesExp :: Bool, - -- | Whether to expect the floor() function. - numericFeaturesFloor :: Bool, - -- | Whether to expect the isNaN() function. - numericFeaturesIsNaN :: Bool, - -- | Whether to expect the log() function. - numericFeaturesLog :: Bool, - -- | Whether to expect the log10() function. - numericFeaturesLog10 :: Bool, - -- | Whether to expect the range() function. - numericFeaturesRange :: Bool, - -- | Whether to expect the round() function. - numericFeaturesRound :: Bool, - -- | Whether to expect the sign() function. - numericFeaturesSign :: Bool, - -- | Whether to expect the sqrt() function. - numericFeaturesSqrt :: Bool} - deriving (Eq, Ord, Read, Show) - -_NumericFeatures = (Core.Name "hydra/langs/cypher/features.NumericFeatures") - -_NumericFeatures_abs = (Core.Name "abs") - -_NumericFeatures_ceil = (Core.Name "ceil") - -_NumericFeatures_e = (Core.Name "e") - -_NumericFeatures_exp = (Core.Name "exp") - -_NumericFeatures_floor = (Core.Name "floor") - -_NumericFeatures_isNaN = (Core.Name "isNaN") - -_NumericFeatures_log = (Core.Name "log") - -_NumericFeatures_log10 = (Core.Name "log10") - -_NumericFeatures_range = (Core.Name "range") - -_NumericFeatures_round = (Core.Name "round") - -_NumericFeatures_sign = (Core.Name "sign") - -_NumericFeatures_sqrt = (Core.Name "sqrt") - --- | A set of features for path functions. -data PathFeatures = - PathFeatures { - -- | Whether to expect the length() function. - pathFeaturesLength :: Bool, - -- | Whether to expect the nodes() function. - pathFeaturesNodes :: Bool, - -- | Whether to expect the relationships() function. - pathFeaturesRelationships :: Bool, - -- | Whether to expect the shortestPath() function. - pathFeaturesShortestPath :: Bool} - deriving (Eq, Ord, Read, Show) - -_PathFeatures = (Core.Name "hydra/langs/cypher/features.PathFeatures") - -_PathFeatures_length = (Core.Name "length") - -_PathFeatures_nodes = (Core.Name "nodes") - -_PathFeatures_relationships = (Core.Name "relationships") - -_PathFeatures_shortestPath = (Core.Name "shortestPath") - --- | A set of features for procedure calls. -data ProcedureCallFeatures = - ProcedureCallFeatures { - -- | Whether to expect CALL within a query. - procedureCallFeaturesInQueryCall :: Bool, - -- | Whether to expect standalone / top-level CALL. - procedureCallFeaturesStandaloneCall :: Bool, - -- | Whether to expect the YIELD clause in CALL. - procedureCallFeaturesYield :: Bool} - deriving (Eq, Ord, Read, Show) - -_ProcedureCallFeatures = (Core.Name "hydra/langs/cypher/features.ProcedureCallFeatures") - -_ProcedureCallFeatures_inQueryCall = (Core.Name "inQueryCall") - -_ProcedureCallFeatures_standaloneCall = (Core.Name "standaloneCall") - -_ProcedureCallFeatures_yield = (Core.Name "yield") - --- | A set of features for projections. -data ProjectionFeatures = - ProjectionFeatures { - -- | Whether to expect the LIMIT clause. - projectionFeaturesLimit :: Bool, - -- | Whether to expect the ORDER BY clause. - projectionFeaturesOrderBy :: Bool, - -- | Whether to expect the DISTINCT keyword. - projectionFeaturesProjectDistinct :: Bool, - -- | Whether to expect the * projection. - projectionFeaturesProjectAll :: Bool, - -- | Whether to expect the AS keyword. - projectionFeaturesProjectAs :: Bool, - -- | Whether to expect the SKIP clause. - projectionFeaturesSkip :: Bool, - -- | Whether to expect the ASC/ASCENDING and DESC/DESCENDING keywords. - projectionFeaturesSortOrder :: Bool} - deriving (Eq, Ord, Read, Show) - -_ProjectionFeatures = (Core.Name "hydra/langs/cypher/features.ProjectionFeatures") - -_ProjectionFeatures_limit = (Core.Name "limit") - -_ProjectionFeatures_orderBy = (Core.Name "orderBy") - -_ProjectionFeatures_projectDistinct = (Core.Name "projectDistinct") - -_ProjectionFeatures_projectAll = (Core.Name "projectAll") - -_ProjectionFeatures_projectAs = (Core.Name "projectAs") - -_ProjectionFeatures_skip = (Core.Name "skip") - -_ProjectionFeatures_sortOrder = (Core.Name "sortOrder") - --- | A set of features for quantifier expressions. -data QuantifierFeatures = - QuantifierFeatures { - -- | Whether to expect the ALL quantifier. - quantifierFeaturesAll :: Bool, - -- | Whether to expect the ANY quantifier. - quantifierFeaturesAny :: Bool, - -- | Whether to expect the exists() function. - quantifierFeaturesExists :: Bool, - -- | Whether to expect the NONE quantifier. - quantifierFeaturesNone :: Bool, - -- | Whether to expect the SINGLE quantifier. - quantifierFeaturesSingle :: Bool} - deriving (Eq, Ord, Read, Show) - -_QuantifierFeatures = (Core.Name "hydra/langs/cypher/features.QuantifierFeatures") - -_QuantifierFeatures_all = (Core.Name "all") - -_QuantifierFeatures_any = (Core.Name "any") - -_QuantifierFeatures_exists = (Core.Name "exists") - -_QuantifierFeatures_none = (Core.Name "none") - -_QuantifierFeatures_single = (Core.Name "single") - --- | A set of features for random value generation. -data RandomnessFeatures = - RandomnessFeatures { - -- | Whether to expect the rand() function. - randomnessFeaturesRand :: Bool, - -- | Whether to expect the randomUUID() function. - randomnessFeaturesRandomUUID :: Bool} - deriving (Eq, Ord, Read, Show) - -_RandomnessFeatures = (Core.Name "hydra/langs/cypher/features.RandomnessFeatures") - -_RandomnessFeatures_rand = (Core.Name "rand") - -_RandomnessFeatures_randomUUID = (Core.Name "randomUUID") - --- | A set of features for range literals within relationship patterns. -data RangeLiteralFeatures = - RangeLiteralFeatures { - -- | Whether to expect range literals with both lower and upper bounds. - rangeLiteralFeaturesBounds :: Bool, - -- | Whether to expect range literals providing an exact number of repetitions. - rangeLiteralFeaturesExactRange :: Bool, - -- | Whether to expect range literals with a lower bound (only). - rangeLiteralFeaturesLowerBound :: Bool, - -- | Whether to expect the * range literal. - rangeLiteralFeaturesStarRange :: Bool, - -- | Whether to expect range literals with an upper bound (only). - rangeLiteralFeaturesUpperBound :: Bool} - deriving (Eq, Ord, Read, Show) - -_RangeLiteralFeatures = (Core.Name "hydra/langs/cypher/features.RangeLiteralFeatures") - -_RangeLiteralFeatures_bounds = (Core.Name "bounds") - -_RangeLiteralFeatures_exactRange = (Core.Name "exactRange") - -_RangeLiteralFeatures_lowerBound = (Core.Name "lowerBound") - -_RangeLiteralFeatures_starRange = (Core.Name "starRange") - -_RangeLiteralFeatures_upperBound = (Core.Name "upperBound") - --- | A set of features for specific syntax related to reading data from the graph.. -data ReadingFeatures = - ReadingFeatures { - -- | Whether to expect the UNION operator. - readingFeaturesUnion :: Bool, - -- | Whether to expect the UNION ALL operator. - readingFeaturesUnionAll :: Bool, - -- | Whether to expect the UNWIND clause. - readingFeaturesUnwind :: Bool} - deriving (Eq, Ord, Read, Show) - -_ReadingFeatures = (Core.Name "hydra/langs/cypher/features.ReadingFeatures") - -_ReadingFeatures_union = (Core.Name "union") - -_ReadingFeatures_unionAll = (Core.Name "unionAll") - -_ReadingFeatures_unwind = (Core.Name "unwind") - --- | A set of features for relationship directions / arrow patterns. -data RelationshipDirectionFeatures = - RelationshipDirectionFeatures { - -- | Whether to expect the two-headed arrow (<-[]->) relationship direction. - relationshipDirectionFeaturesBoth :: Bool, - -- | Whether to expect the left arrow (<-[]-) relationship direction. - relationshipDirectionFeaturesLeft :: Bool, - -- | Whether to expect the headless arrow (-[]-) relationship direction. - relationshipDirectionFeaturesNeither :: Bool, - -- | Whether to expect the right arrow (-[]->) relationship direction. - relationshipDirectionFeaturesRight :: Bool} - deriving (Eq, Ord, Read, Show) - -_RelationshipDirectionFeatures = (Core.Name "hydra/langs/cypher/features.RelationshipDirectionFeatures") - -_RelationshipDirectionFeatures_both = (Core.Name "both") - -_RelationshipDirectionFeatures_left = (Core.Name "left") - -_RelationshipDirectionFeatures_neither = (Core.Name "neither") - -_RelationshipDirectionFeatures_right = (Core.Name "right") - --- | A set of features for relationship patterns. -data RelationshipPatternFeatures = - RelationshipPatternFeatures { - -- | Whether to expect specifying a disjunction of multiple types in a relationship pattern. - relationshipPatternFeaturesMultipleTypes :: Bool, - -- | Whether to expect binding a variable to a relationship in a relationship pattern (note: included by most if not all implementations). - relationshipPatternFeaturesVariableRelationship :: Bool, - -- | Whether to expect omitting types from a relationship pattern. - relationshipPatternFeaturesWildcardType :: Bool} - deriving (Eq, Ord, Read, Show) - -_RelationshipPatternFeatures = (Core.Name "hydra/langs/cypher/features.RelationshipPatternFeatures") - -_RelationshipPatternFeatures_multipleTypes = (Core.Name "multipleTypes") - -_RelationshipPatternFeatures_variableRelationship = (Core.Name "variableRelationship") - -_RelationshipPatternFeatures_wildcardType = (Core.Name "wildcardType") - --- | A set of features for REMOVE operations. -data RemoveFeatures = - RemoveFeatures { - -- | Whether to expect REMOVE Variable:NodeLabels. - removeFeaturesByLabel :: Bool, - -- | Whether to expect REMOVE PropertyExpression. - removeFeaturesByProperty :: Bool} - deriving (Eq, Ord, Read, Show) - -_RemoveFeatures = (Core.Name "hydra/langs/cypher/features.RemoveFeatures") - -_RemoveFeatures_byLabel = (Core.Name "byLabel") - -_RemoveFeatures_byProperty = (Core.Name "byProperty") - --- | A set of features for schema functions. -data SchemaFeatures = - SchemaFeatures { - -- | Whether to expect the type() function. - schemaFeaturesType :: Bool, - -- | Whether to expect the valueType() function. - schemaFeaturesValueType :: Bool} - deriving (Eq, Ord, Read, Show) - -_SchemaFeatures = (Core.Name "hydra/langs/cypher/features.SchemaFeatures") - -_SchemaFeatures_type = (Core.Name "type") - -_SchemaFeatures_valueType = (Core.Name "valueType") - --- | A set of features for set definitions. -data SetFeatures = - SetFeatures { - -- | Whether to expect defining a set using PropertyExpression = Expression. - setFeaturesPropertyEquals :: Bool, - -- | Whether to expect defining a set using Variable = Expression. - setFeaturesVariableEquals :: Bool, - -- | Whether to expect defining a set using Variable += Expression. - setFeaturesVariablePlusEquals :: Bool, - -- | Whether to expect defining a set using Variable:NodeLabels. - setFeaturesVariableWithNodeLabels :: Bool} - deriving (Eq, Ord, Read, Show) - -_SetFeatures = (Core.Name "hydra/langs/cypher/features.SetFeatures") - -_SetFeatures_propertyEquals = (Core.Name "propertyEquals") - -_SetFeatures_variableEquals = (Core.Name "variableEquals") - -_SetFeatures_variablePlusEquals = (Core.Name "variablePlusEquals") - -_SetFeatures_variableWithNodeLabels = (Core.Name "variableWithNodeLabels") - --- | A set of features for string functions. -data StringFeatures = - StringFeatures { - -- | Whether to expect the char_length() function. - stringFeaturesChar_length :: Bool, - -- | Whether to expect the character_length() function. - stringFeaturesCharacter_length :: Bool, - -- | Whether to expect the contains() / CONTAINS aggregate function. - stringFeaturesContains :: Bool, - -- | Whether to expect the endsWith() / ENDS WITH aggregate function. - stringFeaturesEndsWith :: Bool, - -- | Whether to expect the in() / IN aggregate function. - stringFeaturesIn :: Bool, - -- | Whether to expect the startsWith() / STARTS WITH aggregate function. - stringFeaturesStartsWith :: Bool, - -- | Whether to expect the toBoolean() function. - stringFeaturesToBoolean :: Bool, - -- | Whether to expect the toBooleanOrNull() function. - stringFeaturesToBooleanOrNull :: Bool, - -- | Whether to expect the toFloat() function. - stringFeaturesToFloat :: Bool, - -- | Whether to expect the toFloatOrNull() function. - stringFeaturesToFloatOrNull :: Bool, - -- | Whether to expect the toInteger() function. - stringFeaturesToInteger :: Bool, - -- | Whether to expect the toIntegerOrNull() function. - stringFeaturesToIntegerOrNull :: Bool} - deriving (Eq, Ord, Read, Show) - -_StringFeatures = (Core.Name "hydra/langs/cypher/features.StringFeatures") - -_StringFeatures_char_length = (Core.Name "char_length") - -_StringFeatures_character_length = (Core.Name "character_length") - -_StringFeatures_contains = (Core.Name "contains") - -_StringFeatures_endsWith = (Core.Name "endsWith") - -_StringFeatures_in = (Core.Name "in") - -_StringFeatures_startsWith = (Core.Name "startsWith") - -_StringFeatures_toBoolean = (Core.Name "toBoolean") - -_StringFeatures_toBooleanOrNull = (Core.Name "toBooleanOrNull") - -_StringFeatures_toFloat = (Core.Name "toFloat") - -_StringFeatures_toFloatOrNull = (Core.Name "toFloatOrNull") - -_StringFeatures_toInteger = (Core.Name "toInteger") - -_StringFeatures_toIntegerOrNull = (Core.Name "toIntegerOrNull") - --- | A set of features for specific syntax related to updating data in the graph. -data UpdatingFeatures = - UpdatingFeatures { - -- | Whether to expect the CREATE clause. - updatingFeaturesCreate :: Bool, - -- | Whether to expect the SET clause. - updatingFeaturesSet :: Bool, - -- | Whether to expect multi-part queries using WITH. - updatingFeaturesWith :: Bool} - deriving (Eq, Ord, Read, Show) - -_UpdatingFeatures = (Core.Name "hydra/langs/cypher/features.UpdatingFeatures") - -_UpdatingFeatures_create = (Core.Name "create") - -_UpdatingFeatures_set = (Core.Name "set") - -_UpdatingFeatures_with = (Core.Name "with") diff --git a/src/gen-main/haskell/Hydra/Langs/Cypher/OpenCypher.hs b/src/gen-main/haskell/Hydra/Langs/Cypher/OpenCypher.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Cypher/OpenCypher.hs +++ /dev/null @@ -1,1306 +0,0 @@ --- | A Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at: --- | https://opencypher.org/resources/ - -module Hydra.Langs.Cypher.OpenCypher where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data Query = - QueryRegular RegularQuery | - QueryStandalone StandaloneCall - deriving (Eq, Ord, Read, Show) - -_Query = (Core.Name "hydra/langs/cypher/openCypher.Query") - -_Query_regular = (Core.Name "regular") - -_Query_standalone = (Core.Name "standalone") - -data RegularQuery = - RegularQuery { - regularQueryHead :: SingleQuery, - regularQueryRest :: [Union]} - deriving (Eq, Ord, Read, Show) - -_RegularQuery = (Core.Name "hydra/langs/cypher/openCypher.RegularQuery") - -_RegularQuery_head = (Core.Name "head") - -_RegularQuery_rest = (Core.Name "rest") - -data Union = - Union { - unionAll :: Bool, - unionQuery :: SingleQuery} - deriving (Eq, Ord, Read, Show) - -_Union = (Core.Name "hydra/langs/cypher/openCypher.Union") - -_Union_all = (Core.Name "all") - -_Union_query = (Core.Name "query") - -data SingleQuery = - SingleQuerySinglePart SinglePartQuery | - SingleQueryMultiPart MultiPartQuery - deriving (Eq, Ord, Read, Show) - -_SingleQuery = (Core.Name "hydra/langs/cypher/openCypher.SingleQuery") - -_SingleQuery_singlePart = (Core.Name "singlePart") - -_SingleQuery_multiPart = (Core.Name "multiPart") - -data SinglePartQuery = - SinglePartQuery { - singlePartQueryReading :: [ReadingClause], - singlePartQueryUpdating :: [UpdatingClause], - singlePartQueryReturn :: (Maybe Return)} - deriving (Eq, Ord, Read, Show) - -_SinglePartQuery = (Core.Name "hydra/langs/cypher/openCypher.SinglePartQuery") - -_SinglePartQuery_reading = (Core.Name "reading") - -_SinglePartQuery_updating = (Core.Name "updating") - -_SinglePartQuery_return = (Core.Name "return") - -data WithClause = - WithClause { - withClauseReading :: [ReadingClause], - withClauseUpdating :: [UpdatingClause], - withClauseWith :: With} - deriving (Eq, Ord, Read, Show) - -_WithClause = (Core.Name "hydra/langs/cypher/openCypher.WithClause") - -_WithClause_reading = (Core.Name "reading") - -_WithClause_updating = (Core.Name "updating") - -_WithClause_with = (Core.Name "with") - -data MultiPartQuery = - MultiPartQuery { - multiPartQueryWith :: [WithClause], - multiPartQueryBody :: SinglePartQuery} - deriving (Eq, Ord, Read, Show) - -_MultiPartQuery = (Core.Name "hydra/langs/cypher/openCypher.MultiPartQuery") - -_MultiPartQuery_with = (Core.Name "with") - -_MultiPartQuery_body = (Core.Name "body") - -data UpdatingClause = - UpdatingClauseCreate Create | - UpdatingClauseMerge Merge | - UpdatingClauseDelete Delete | - UpdatingClauseSet Set_ | - UpdatingClauseRemove Remove - deriving (Eq, Ord, Read, Show) - -_UpdatingClause = (Core.Name "hydra/langs/cypher/openCypher.UpdatingClause") - -_UpdatingClause_create = (Core.Name "create") - -_UpdatingClause_merge = (Core.Name "merge") - -_UpdatingClause_delete = (Core.Name "delete") - -_UpdatingClause_set = (Core.Name "set") - -_UpdatingClause_remove = (Core.Name "remove") - -data ReadingClause = - ReadingClauseMatch Match | - ReadingClauseUnwind Unwind | - ReadingClauseInQueryCall InQueryCall - deriving (Eq, Ord, Read, Show) - -_ReadingClause = (Core.Name "hydra/langs/cypher/openCypher.ReadingClause") - -_ReadingClause_match = (Core.Name "match") - -_ReadingClause_unwind = (Core.Name "unwind") - -_ReadingClause_inQueryCall = (Core.Name "inQueryCall") - -data Match = - Match { - matchOptional :: Bool, - matchPattern :: Pattern, - matchWhere :: (Maybe Where)} - deriving (Eq, Ord, Read, Show) - -_Match = (Core.Name "hydra/langs/cypher/openCypher.Match") - -_Match_optional = (Core.Name "optional") - -_Match_pattern = (Core.Name "pattern") - -_Match_where = (Core.Name "where") - -data Unwind = - Unwind { - unwindExpression :: Expression, - unwindVariable :: Variable} - deriving (Eq, Ord, Read, Show) - -_Unwind = (Core.Name "hydra/langs/cypher/openCypher.Unwind") - -_Unwind_expression = (Core.Name "expression") - -_Unwind_variable = (Core.Name "variable") - -data Merge = - Merge { - mergePatternPart :: PatternPart, - mergeActions :: [MergeAction]} - deriving (Eq, Ord, Read, Show) - -_Merge = (Core.Name "hydra/langs/cypher/openCypher.Merge") - -_Merge_patternPart = (Core.Name "patternPart") - -_Merge_actions = (Core.Name "actions") - -data MatchOrCreate = - MatchOrCreateMatch | - MatchOrCreateCreate - deriving (Eq, Ord, Read, Show) - -_MatchOrCreate = (Core.Name "hydra/langs/cypher/openCypher.MatchOrCreate") - -_MatchOrCreate_match = (Core.Name "match") - -_MatchOrCreate_create = (Core.Name "create") - -data MergeAction = - MergeAction { - mergeActionAction :: MatchOrCreate, - mergeActionSet :: Set_} - deriving (Eq, Ord, Read, Show) - -_MergeAction = (Core.Name "hydra/langs/cypher/openCypher.MergeAction") - -_MergeAction_action = (Core.Name "action") - -_MergeAction_set = (Core.Name "set") - -newtype Create = - Create { - unCreate :: Pattern} - deriving (Eq, Ord, Read, Show) - -_Create = (Core.Name "hydra/langs/cypher/openCypher.Create") - -newtype Set_ = - Set_ { - unSet :: [SetItem]} - deriving (Eq, Ord, Read, Show) - -_Set = (Core.Name "hydra/langs/cypher/openCypher.Set") - -data SetItem = - SetItemProperty PropertyEquals | - SetItemVariableEqual VariableEquals | - SetItemVariablePlusEqual VariablePlusEquals | - SetItemVariableLabels VariableAndNodeLabels - deriving (Eq, Ord, Read, Show) - -_SetItem = (Core.Name "hydra/langs/cypher/openCypher.SetItem") - -_SetItem_property = (Core.Name "property") - -_SetItem_variableEqual = (Core.Name "variableEqual") - -_SetItem_variablePlusEqual = (Core.Name "variablePlusEqual") - -_SetItem_variableLabels = (Core.Name "variableLabels") - -data PropertyEquals = - PropertyEquals { - propertyEqualsLhs :: PropertyExpression, - propertyEqualsRhs :: Expression} - deriving (Eq, Ord, Read, Show) - -_PropertyEquals = (Core.Name "hydra/langs/cypher/openCypher.PropertyEquals") - -_PropertyEquals_lhs = (Core.Name "lhs") - -_PropertyEquals_rhs = (Core.Name "rhs") - -data VariableEquals = - VariableEquals { - variableEqualsLhs :: Variable, - variableEqualsRhs :: Expression} - deriving (Eq, Ord, Read, Show) - -_VariableEquals = (Core.Name "hydra/langs/cypher/openCypher.VariableEquals") - -_VariableEquals_lhs = (Core.Name "lhs") - -_VariableEquals_rhs = (Core.Name "rhs") - -data VariablePlusEquals = - VariablePlusEquals { - variablePlusEqualsLhs :: Variable, - variablePlusEqualsRhs :: Expression} - deriving (Eq, Ord, Read, Show) - -_VariablePlusEquals = (Core.Name "hydra/langs/cypher/openCypher.VariablePlusEquals") - -_VariablePlusEquals_lhs = (Core.Name "lhs") - -_VariablePlusEquals_rhs = (Core.Name "rhs") - -data VariableAndNodeLabels = - VariableAndNodeLabels { - variableAndNodeLabelsVariable :: Variable, - variableAndNodeLabelsLabels :: NodeLabels} - deriving (Eq, Ord, Read, Show) - -_VariableAndNodeLabels = (Core.Name "hydra/langs/cypher/openCypher.VariableAndNodeLabels") - -_VariableAndNodeLabels_variable = (Core.Name "variable") - -_VariableAndNodeLabels_labels = (Core.Name "labels") - -data Delete = - Delete { - deleteDetach :: Bool, - deleteExpressions :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_Delete = (Core.Name "hydra/langs/cypher/openCypher.Delete") - -_Delete_detach = (Core.Name "detach") - -_Delete_expressions = (Core.Name "expressions") - -newtype Remove = - Remove { - unRemove :: [RemoveItem]} - deriving (Eq, Ord, Read, Show) - -_Remove = (Core.Name "hydra/langs/cypher/openCypher.Remove") - -data RemoveItem = - RemoveItemVariableLabels VariableAndNodeLabels | - RemoveItemProperty PropertyExpression - deriving (Eq, Ord, Read, Show) - -_RemoveItem = (Core.Name "hydra/langs/cypher/openCypher.RemoveItem") - -_RemoveItem_variableLabels = (Core.Name "variableLabels") - -_RemoveItem_property = (Core.Name "property") - -data InQueryCall = - InQueryCall { - inQueryCallCall :: ExplicitProcedureInvocation, - inQueryCallYieldItems :: (Maybe YieldItems)} - deriving (Eq, Ord, Read, Show) - -_InQueryCall = (Core.Name "hydra/langs/cypher/openCypher.InQueryCall") - -_InQueryCall_call = (Core.Name "call") - -_InQueryCall_yieldItems = (Core.Name "yieldItems") - -data ProcedureInvocation = - ProcedureInvocationExplicit ExplicitProcedureInvocation | - ProcedureInvocationImplicit ImplicitProcedureInvocation - deriving (Eq, Ord, Read, Show) - -_ProcedureInvocation = (Core.Name "hydra/langs/cypher/openCypher.ProcedureInvocation") - -_ProcedureInvocation_explicit = (Core.Name "explicit") - -_ProcedureInvocation_implicit = (Core.Name "implicit") - -data StarOrYieldItems = - StarOrYieldItemsStar | - StarOrYieldItemsItems YieldItems - deriving (Eq, Ord, Read, Show) - -_StarOrYieldItems = (Core.Name "hydra/langs/cypher/openCypher.StarOrYieldItems") - -_StarOrYieldItems_star = (Core.Name "star") - -_StarOrYieldItems_items = (Core.Name "items") - -data StandaloneCall = - StandaloneCall { - standaloneCallCall :: ProcedureInvocation, - standaloneCallYieldItems :: (Maybe StarOrYieldItems)} - deriving (Eq, Ord, Read, Show) - -_StandaloneCall = (Core.Name "hydra/langs/cypher/openCypher.StandaloneCall") - -_StandaloneCall_call = (Core.Name "call") - -_StandaloneCall_yieldItems = (Core.Name "yieldItems") - -data YieldItems = - YieldItems { - yieldItemsItems :: [YieldItem], - yieldItemsWhere :: (Maybe Where)} - deriving (Eq, Ord, Read, Show) - -_YieldItems = (Core.Name "hydra/langs/cypher/openCypher.YieldItems") - -_YieldItems_items = (Core.Name "items") - -_YieldItems_where = (Core.Name "where") - -data YieldItem = - YieldItem { - yieldItemField :: (Maybe ProcedureResultField), - yieldItemVariable :: Variable} - deriving (Eq, Ord, Read, Show) - -_YieldItem = (Core.Name "hydra/langs/cypher/openCypher.YieldItem") - -_YieldItem_field = (Core.Name "field") - -_YieldItem_variable = (Core.Name "variable") - -data With = - With { - withProjection :: ProjectionBody, - withWhere :: (Maybe Where)} - deriving (Eq, Ord, Read, Show) - -_With = (Core.Name "hydra/langs/cypher/openCypher.With") - -_With_projection = (Core.Name "projection") - -_With_where = (Core.Name "where") - -newtype Return = - Return { - unReturn :: ProjectionBody} - deriving (Eq, Ord, Read, Show) - -_Return = (Core.Name "hydra/langs/cypher/openCypher.Return") - -data ProjectionBody = - ProjectionBody { - projectionBodyDistinct :: Bool, - projectionBodyProjectionItems :: ProjectionItems, - projectionBodyOrder :: (Maybe Order), - projectionBodySkip :: (Maybe Skip), - projectionBodyLimit :: (Maybe Limit)} - deriving (Eq, Ord, Read, Show) - -_ProjectionBody = (Core.Name "hydra/langs/cypher/openCypher.ProjectionBody") - -_ProjectionBody_distinct = (Core.Name "distinct") - -_ProjectionBody_projectionItems = (Core.Name "projectionItems") - -_ProjectionBody_order = (Core.Name "order") - -_ProjectionBody_skip = (Core.Name "skip") - -_ProjectionBody_limit = (Core.Name "limit") - -data ProjectionItems = - ProjectionItems { - projectionItemsStar :: Bool, - projectionItemsExplicit :: [ProjectionItem]} - deriving (Eq, Ord, Read, Show) - -_ProjectionItems = (Core.Name "hydra/langs/cypher/openCypher.ProjectionItems") - -_ProjectionItems_star = (Core.Name "star") - -_ProjectionItems_explicit = (Core.Name "explicit") - -data ProjectionItem = - ProjectionItem { - projectionItemExpression :: Expression, - projectionItemVariable :: (Maybe Variable)} - deriving (Eq, Ord, Read, Show) - -_ProjectionItem = (Core.Name "hydra/langs/cypher/openCypher.ProjectionItem") - -_ProjectionItem_expression = (Core.Name "expression") - -_ProjectionItem_variable = (Core.Name "variable") - -newtype Order = - Order { - unOrder :: [SortItem]} - deriving (Eq, Ord, Read, Show) - -_Order = (Core.Name "hydra/langs/cypher/openCypher.Order") - -newtype Skip = - Skip { - unSkip :: Expression} - deriving (Eq, Ord, Read, Show) - -_Skip = (Core.Name "hydra/langs/cypher/openCypher.Skip") - -newtype Limit = - Limit { - unLimit :: Expression} - deriving (Eq, Ord, Read, Show) - -_Limit = (Core.Name "hydra/langs/cypher/openCypher.Limit") - -data SortOrder = - SortOrderAscending | - SortOrderDescending - deriving (Eq, Ord, Read, Show) - -_SortOrder = (Core.Name "hydra/langs/cypher/openCypher.SortOrder") - -_SortOrder_ascending = (Core.Name "ascending") - -_SortOrder_descending = (Core.Name "descending") - -data SortItem = - SortItem { - sortItemExpression :: Expression, - sortItemOrder :: (Maybe SortOrder)} - deriving (Eq, Ord, Read, Show) - -_SortItem = (Core.Name "hydra/langs/cypher/openCypher.SortItem") - -_SortItem_expression = (Core.Name "expression") - -_SortItem_order = (Core.Name "order") - -newtype Where = - Where { - unWhere :: Expression} - deriving (Eq, Ord, Read, Show) - -_Where = (Core.Name "hydra/langs/cypher/openCypher.Where") - -newtype Pattern = - Pattern { - unPattern :: [PatternPart]} - deriving (Eq, Ord, Read, Show) - -_Pattern = (Core.Name "hydra/langs/cypher/openCypher.Pattern") - -data PatternPart = - PatternPart { - patternPartVariable :: (Maybe Variable), - patternPartPattern :: AnonymousPatternPart} - deriving (Eq, Ord, Read, Show) - -_PatternPart = (Core.Name "hydra/langs/cypher/openCypher.PatternPart") - -_PatternPart_variable = (Core.Name "variable") - -_PatternPart_pattern = (Core.Name "pattern") - -newtype AnonymousPatternPart = - AnonymousPatternPart { - unAnonymousPatternPart :: PatternElement} - deriving (Eq, Ord, Read, Show) - -_AnonymousPatternPart = (Core.Name "hydra/langs/cypher/openCypher.AnonymousPatternPart") - -data NodePatternChain = - NodePatternChain { - nodePatternChainNodePattern :: NodePattern, - nodePatternChainChain :: [PatternElementChain]} - deriving (Eq, Ord, Read, Show) - -_NodePatternChain = (Core.Name "hydra/langs/cypher/openCypher.NodePatternChain") - -_NodePatternChain_nodePattern = (Core.Name "nodePattern") - -_NodePatternChain_chain = (Core.Name "chain") - -data PatternElement = - PatternElementChained NodePatternChain | - PatternElementParenthesized PatternElement - deriving (Eq, Ord, Read, Show) - -_PatternElement = (Core.Name "hydra/langs/cypher/openCypher.PatternElement") - -_PatternElement_chained = (Core.Name "chained") - -_PatternElement_parenthesized = (Core.Name "parenthesized") - -data RelationshipsPattern = - RelationshipsPattern { - relationshipsPatternNodePattern :: NodePattern, - relationshipsPatternChain :: [PatternElementChain]} - deriving (Eq, Ord, Read, Show) - -_RelationshipsPattern = (Core.Name "hydra/langs/cypher/openCypher.RelationshipsPattern") - -_RelationshipsPattern_nodePattern = (Core.Name "nodePattern") - -_RelationshipsPattern_chain = (Core.Name "chain") - -data NodePattern = - NodePattern { - nodePatternVariable :: (Maybe Variable), - nodePatternLabels :: (Maybe NodeLabels), - nodePatternProperties :: (Maybe Properties)} - deriving (Eq, Ord, Read, Show) - -_NodePattern = (Core.Name "hydra/langs/cypher/openCypher.NodePattern") - -_NodePattern_variable = (Core.Name "variable") - -_NodePattern_labels = (Core.Name "labels") - -_NodePattern_properties = (Core.Name "properties") - -data PatternElementChain = - PatternElementChain { - patternElementChainRelationship :: RelationshipPattern, - patternElementChainNode :: NodePattern} - deriving (Eq, Ord, Read, Show) - -_PatternElementChain = (Core.Name "hydra/langs/cypher/openCypher.PatternElementChain") - -_PatternElementChain_relationship = (Core.Name "relationship") - -_PatternElementChain_node = (Core.Name "node") - -data RelationshipPattern = - RelationshipPattern { - relationshipPatternLeftArrow :: Bool, - relationshipPatternDetail :: (Maybe RelationshipDetail), - relationshipPatternRightArrow :: Bool} - deriving (Eq, Ord, Read, Show) - -_RelationshipPattern = (Core.Name "hydra/langs/cypher/openCypher.RelationshipPattern") - -_RelationshipPattern_leftArrow = (Core.Name "leftArrow") - -_RelationshipPattern_detail = (Core.Name "detail") - -_RelationshipPattern_rightArrow = (Core.Name "rightArrow") - -data RelationshipDetail = - RelationshipDetail { - relationshipDetailVariable :: (Maybe Variable), - relationshipDetailTypes :: (Maybe RelationshipTypes), - relationshipDetailRange :: (Maybe RangeLiteral), - relationshipDetailProperties :: (Maybe Properties)} - deriving (Eq, Ord, Read, Show) - -_RelationshipDetail = (Core.Name "hydra/langs/cypher/openCypher.RelationshipDetail") - -_RelationshipDetail_variable = (Core.Name "variable") - -_RelationshipDetail_types = (Core.Name "types") - -_RelationshipDetail_range = (Core.Name "range") - -_RelationshipDetail_properties = (Core.Name "properties") - -data Properties = - PropertiesMap MapLiteral | - PropertiesParameter Parameter - deriving (Eq, Ord, Read, Show) - -_Properties = (Core.Name "hydra/langs/cypher/openCypher.Properties") - -_Properties_map = (Core.Name "map") - -_Properties_parameter = (Core.Name "parameter") - -newtype RelationshipTypes = - RelationshipTypes { - unRelationshipTypes :: [RelTypeName]} - deriving (Eq, Ord, Read, Show) - -_RelationshipTypes = (Core.Name "hydra/langs/cypher/openCypher.RelationshipTypes") - -newtype NodeLabels = - NodeLabels { - unNodeLabels :: [NodeLabel]} - deriving (Eq, Ord, Read, Show) - -_NodeLabels = (Core.Name "hydra/langs/cypher/openCypher.NodeLabels") - -newtype NodeLabel = - NodeLabel { - unNodeLabel :: String} - deriving (Eq, Ord, Read, Show) - -_NodeLabel = (Core.Name "hydra/langs/cypher/openCypher.NodeLabel") - -data RangeLiteral = - RangeLiteral { - rangeLiteralStart :: (Maybe Integer), - rangeLiteralEnd :: (Maybe Integer)} - deriving (Eq, Ord, Read, Show) - -_RangeLiteral = (Core.Name "hydra/langs/cypher/openCypher.RangeLiteral") - -_RangeLiteral_start = (Core.Name "start") - -_RangeLiteral_end = (Core.Name "end") - -newtype RelTypeName = - RelTypeName { - unRelTypeName :: String} - deriving (Eq, Ord, Read, Show) - -_RelTypeName = (Core.Name "hydra/langs/cypher/openCypher.RelTypeName") - -data PropertyExpression = - PropertyExpression { - propertyExpressionAtom :: Atom, - propertyExpressionLookups :: [PropertyLookup]} - deriving (Eq, Ord, Read, Show) - -_PropertyExpression = (Core.Name "hydra/langs/cypher/openCypher.PropertyExpression") - -_PropertyExpression_atom = (Core.Name "atom") - -_PropertyExpression_lookups = (Core.Name "lookups") - -newtype Expression = - Expression { - unExpression :: OrExpression} - deriving (Eq, Ord, Read, Show) - -_Expression = (Core.Name "hydra/langs/cypher/openCypher.Expression") - -newtype OrExpression = - OrExpression { - unOrExpression :: [XorExpression]} - deriving (Eq, Ord, Read, Show) - -_OrExpression = (Core.Name "hydra/langs/cypher/openCypher.OrExpression") - -newtype XorExpression = - XorExpression { - unXorExpression :: [AndExpression]} - deriving (Eq, Ord, Read, Show) - -_XorExpression = (Core.Name "hydra/langs/cypher/openCypher.XorExpression") - -newtype AndExpression = - AndExpression { - unAndExpression :: [NotExpression]} - deriving (Eq, Ord, Read, Show) - -_AndExpression = (Core.Name "hydra/langs/cypher/openCypher.AndExpression") - -data NotExpression = - NotExpression { - notExpressionNot :: Bool, - notExpressionExpression :: ComparisonExpression} - deriving (Eq, Ord, Read, Show) - -_NotExpression = (Core.Name "hydra/langs/cypher/openCypher.NotExpression") - -_NotExpression_not = (Core.Name "not") - -_NotExpression_expression = (Core.Name "expression") - -data ComparisonExpression = - ComparisonExpression { - comparisonExpressionLeft :: StringListNullPredicateExpression, - comparisonExpressionRight :: [PartialComparisonExpression]} - deriving (Eq, Ord, Read, Show) - -_ComparisonExpression = (Core.Name "hydra/langs/cypher/openCypher.ComparisonExpression") - -_ComparisonExpression_left = (Core.Name "left") - -_ComparisonExpression_right = (Core.Name "right") - -data ComparisonOperator = - ComparisonOperatorEq | - ComparisonOperatorNeq | - ComparisonOperatorLt | - ComparisonOperatorGt | - ComparisonOperatorLte | - ComparisonOperatorGte - deriving (Eq, Ord, Read, Show) - -_ComparisonOperator = (Core.Name "hydra/langs/cypher/openCypher.ComparisonOperator") - -_ComparisonOperator_eq = (Core.Name "eq") - -_ComparisonOperator_neq = (Core.Name "neq") - -_ComparisonOperator_lt = (Core.Name "lt") - -_ComparisonOperator_gt = (Core.Name "gt") - -_ComparisonOperator_lte = (Core.Name "lte") - -_ComparisonOperator_gte = (Core.Name "gte") - -data PartialComparisonExpression = - PartialComparisonExpression { - partialComparisonExpressionOperator :: ComparisonOperator, - partialComparisonExpressionRight :: StringListNullPredicateExpression} - deriving (Eq, Ord, Read, Show) - -_PartialComparisonExpression = (Core.Name "hydra/langs/cypher/openCypher.PartialComparisonExpression") - -_PartialComparisonExpression_operator = (Core.Name "operator") - -_PartialComparisonExpression_right = (Core.Name "right") - -data StringListNullPredicateExpression = - StringListNullPredicateExpression { - stringListNullPredicateExpressionLeft :: AddOrSubtractExpression, - stringListNullPredicateExpressionRight :: [StringListNullPredicateRightHandSide]} - deriving (Eq, Ord, Read, Show) - -_StringListNullPredicateExpression = (Core.Name "hydra/langs/cypher/openCypher.StringListNullPredicateExpression") - -_StringListNullPredicateExpression_left = (Core.Name "left") - -_StringListNullPredicateExpression_right = (Core.Name "right") - -data StringListNullPredicateRightHandSide = - StringListNullPredicateRightHandSideString StringPredicateExpression | - StringListNullPredicateRightHandSideList ListPredicateExpression | - StringListNullPredicateRightHandSideNull NullPredicateExpression - deriving (Eq, Ord, Read, Show) - -_StringListNullPredicateRightHandSide = (Core.Name "hydra/langs/cypher/openCypher.StringListNullPredicateRightHandSide") - -_StringListNullPredicateRightHandSide_string = (Core.Name "string") - -_StringListNullPredicateRightHandSide_list = (Core.Name "list") - -_StringListNullPredicateRightHandSide_null = (Core.Name "null") - -data StringPredicateExpression = - StringPredicateExpression { - stringPredicateExpressionOperator :: StringPredicateOperator, - stringPredicateExpressionExpression :: AddOrSubtractExpression} - deriving (Eq, Ord, Read, Show) - -_StringPredicateExpression = (Core.Name "hydra/langs/cypher/openCypher.StringPredicateExpression") - -_StringPredicateExpression_operator = (Core.Name "operator") - -_StringPredicateExpression_expression = (Core.Name "expression") - -data StringPredicateOperator = - StringPredicateOperatorStartsWith | - StringPredicateOperatorEndsWith | - StringPredicateOperatorContains - deriving (Eq, Ord, Read, Show) - -_StringPredicateOperator = (Core.Name "hydra/langs/cypher/openCypher.StringPredicateOperator") - -_StringPredicateOperator_startsWith = (Core.Name "startsWith") - -_StringPredicateOperator_endsWith = (Core.Name "endsWith") - -_StringPredicateOperator_contains = (Core.Name "contains") - -newtype ListPredicateExpression = - ListPredicateExpression { - unListPredicateExpression :: AddOrSubtractExpression} - deriving (Eq, Ord, Read, Show) - -_ListPredicateExpression = (Core.Name "hydra/langs/cypher/openCypher.ListPredicateExpression") - -newtype NullPredicateExpression = - NullPredicateExpression { - unNullPredicateExpression :: Bool} - deriving (Eq, Ord, Read, Show) - -_NullPredicateExpression = (Core.Name "hydra/langs/cypher/openCypher.NullPredicateExpression") - -data AddOrSubtractExpression = - AddOrSubtractExpression { - addOrSubtractExpressionLeft :: MultiplyDivideModuloExpression, - addOrSubtractExpressionRight :: [AddOrSubtractRightHandSide]} - deriving (Eq, Ord, Read, Show) - -_AddOrSubtractExpression = (Core.Name "hydra/langs/cypher/openCypher.AddOrSubtractExpression") - -_AddOrSubtractExpression_left = (Core.Name "left") - -_AddOrSubtractExpression_right = (Core.Name "right") - -data AddOrSubtractRightHandSide = - AddOrSubtractRightHandSide { - addOrSubtractRightHandSideOperator :: AddOrSubtractOperator, - addOrSubtractRightHandSideExpression :: MultiplyDivideModuloExpression} - deriving (Eq, Ord, Read, Show) - -_AddOrSubtractRightHandSide = (Core.Name "hydra/langs/cypher/openCypher.AddOrSubtractRightHandSide") - -_AddOrSubtractRightHandSide_operator = (Core.Name "operator") - -_AddOrSubtractRightHandSide_expression = (Core.Name "expression") - -data AddOrSubtractOperator = - AddOrSubtractOperatorAdd | - AddOrSubtractOperatorSubtract - deriving (Eq, Ord, Read, Show) - -_AddOrSubtractOperator = (Core.Name "hydra/langs/cypher/openCypher.AddOrSubtractOperator") - -_AddOrSubtractOperator_add = (Core.Name "add") - -_AddOrSubtractOperator_subtract = (Core.Name "subtract") - -data MultiplyDivideModuloExpression = - MultiplyDivideModuloExpression { - multiplyDivideModuloExpressionLeft :: PowerOfExpression, - multiplyDivideModuloExpressionRight :: [MultiplyDivideModuloRightHandSide]} - deriving (Eq, Ord, Read, Show) - -_MultiplyDivideModuloExpression = (Core.Name "hydra/langs/cypher/openCypher.MultiplyDivideModuloExpression") - -_MultiplyDivideModuloExpression_left = (Core.Name "left") - -_MultiplyDivideModuloExpression_right = (Core.Name "right") - -data MultiplyDivideModuloRightHandSide = - MultiplyDivideModuloRightHandSide { - multiplyDivideModuloRightHandSideOperator :: MultiplyDivideModuloOperator, - multiplyDivideModuloRightHandSideExpression :: PowerOfExpression} - deriving (Eq, Ord, Read, Show) - -_MultiplyDivideModuloRightHandSide = (Core.Name "hydra/langs/cypher/openCypher.MultiplyDivideModuloRightHandSide") - -_MultiplyDivideModuloRightHandSide_operator = (Core.Name "operator") - -_MultiplyDivideModuloRightHandSide_expression = (Core.Name "expression") - -data MultiplyDivideModuloOperator = - MultiplyDivideModuloOperatorMultiply | - MultiplyDivideModuloOperatorDivide | - MultiplyDivideModuloOperatorModulo - deriving (Eq, Ord, Read, Show) - -_MultiplyDivideModuloOperator = (Core.Name "hydra/langs/cypher/openCypher.MultiplyDivideModuloOperator") - -_MultiplyDivideModuloOperator_multiply = (Core.Name "multiply") - -_MultiplyDivideModuloOperator_divide = (Core.Name "divide") - -_MultiplyDivideModuloOperator_modulo = (Core.Name "modulo") - -newtype PowerOfExpression = - PowerOfExpression { - unPowerOfExpression :: [UnaryAddOrSubtractExpression]} - deriving (Eq, Ord, Read, Show) - -_PowerOfExpression = (Core.Name "hydra/langs/cypher/openCypher.PowerOfExpression") - -data UnaryAddOrSubtractExpression = - UnaryAddOrSubtractExpression { - unaryAddOrSubtractExpressionOperator :: (Maybe AddOrSubtractOperator), - unaryAddOrSubtractExpressionExpression :: NonArithmeticOperatorExpression} - deriving (Eq, Ord, Read, Show) - -_UnaryAddOrSubtractExpression = (Core.Name "hydra/langs/cypher/openCypher.UnaryAddOrSubtractExpression") - -_UnaryAddOrSubtractExpression_operator = (Core.Name "operator") - -_UnaryAddOrSubtractExpression_expression = (Core.Name "expression") - -data ListOperatorExpressionOrPropertyLookup = - ListOperatorExpressionOrPropertyLookupList ListOperatorExpression | - ListOperatorExpressionOrPropertyLookupProperty PropertyLookup - deriving (Eq, Ord, Read, Show) - -_ListOperatorExpressionOrPropertyLookup = (Core.Name "hydra/langs/cypher/openCypher.ListOperatorExpressionOrPropertyLookup") - -_ListOperatorExpressionOrPropertyLookup_list = (Core.Name "list") - -_ListOperatorExpressionOrPropertyLookup_property = (Core.Name "property") - -data NonArithmeticOperatorExpression = - NonArithmeticOperatorExpression { - nonArithmeticOperatorExpressionAtom :: Atom, - nonArithmeticOperatorExpressionListsAndLookups :: [ListOperatorExpressionOrPropertyLookup], - nonArithmeticOperatorExpressionLabels :: (Maybe NodeLabels)} - deriving (Eq, Ord, Read, Show) - -_NonArithmeticOperatorExpression = (Core.Name "hydra/langs/cypher/openCypher.NonArithmeticOperatorExpression") - -_NonArithmeticOperatorExpression_atom = (Core.Name "atom") - -_NonArithmeticOperatorExpression_listsAndLookups = (Core.Name "listsAndLookups") - -_NonArithmeticOperatorExpression_labels = (Core.Name "labels") - -data RangeExpression = - RangeExpression { - rangeExpressionStart :: (Maybe Expression), - rangeExpressionEnd :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_RangeExpression = (Core.Name "hydra/langs/cypher/openCypher.RangeExpression") - -_RangeExpression_start = (Core.Name "start") - -_RangeExpression_end = (Core.Name "end") - -data ListOperatorExpression = - ListOperatorExpressionSingle Expression | - ListOperatorExpressionRange RangeExpression - deriving (Eq, Ord, Read, Show) - -_ListOperatorExpression = (Core.Name "hydra/langs/cypher/openCypher.ListOperatorExpression") - -_ListOperatorExpression_single = (Core.Name "single") - -_ListOperatorExpression_range = (Core.Name "range") - -newtype PropertyLookup = - PropertyLookup { - unPropertyLookup :: PropertyKeyName} - deriving (Eq, Ord, Read, Show) - -_PropertyLookup = (Core.Name "hydra/langs/cypher/openCypher.PropertyLookup") - -data Atom = - AtomLiteral Literal | - AtomParameter Parameter | - AtomCase CaseExpression | - AtomCountStar | - AtomListComprehension ListComprehension | - AtomPatternComprehension PatternComprehension | - AtomQuantifier Quantifier | - AtomPatternPredicate PatternPredicate | - AtomParenthesized ParenthesizedExpression | - AtomFunctionInvocation FunctionInvocation | - AtomExistentialSubquery ExistentialSubquery | - AtomVariable Variable - deriving (Eq, Ord, Read, Show) - -_Atom = (Core.Name "hydra/langs/cypher/openCypher.Atom") - -_Atom_literal = (Core.Name "literal") - -_Atom_parameter = (Core.Name "parameter") - -_Atom_case = (Core.Name "case") - -_Atom_countStar = (Core.Name "countStar") - -_Atom_listComprehension = (Core.Name "listComprehension") - -_Atom_patternComprehension = (Core.Name "patternComprehension") - -_Atom_quantifier = (Core.Name "quantifier") - -_Atom_patternPredicate = (Core.Name "patternPredicate") - -_Atom_parenthesized = (Core.Name "parenthesized") - -_Atom_functionInvocation = (Core.Name "functionInvocation") - -_Atom_existentialSubquery = (Core.Name "existentialSubquery") - -_Atom_variable = (Core.Name "variable") - -data CaseExpression = - CaseExpression { - caseExpressionExpression :: (Maybe Expression), - caseExpressionAlternatives :: [CaseAlternative], - caseExpressionElse :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_CaseExpression = (Core.Name "hydra/langs/cypher/openCypher.CaseExpression") - -_CaseExpression_expression = (Core.Name "expression") - -_CaseExpression_alternatives = (Core.Name "alternatives") - -_CaseExpression_else = (Core.Name "else") - -data CaseAlternative = - CaseAlternative { - caseAlternativeCondition :: Expression, - caseAlternativeResult :: Expression} - deriving (Eq, Ord, Read, Show) - -_CaseAlternative = (Core.Name "hydra/langs/cypher/openCypher.CaseAlternative") - -_CaseAlternative_condition = (Core.Name "condition") - -_CaseAlternative_result = (Core.Name "result") - -data ListComprehension = - ListComprehension { - listComprehensionLeft :: FilterExpression, - listComprehensionRight :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_ListComprehension = (Core.Name "hydra/langs/cypher/openCypher.ListComprehension") - -_ListComprehension_left = (Core.Name "left") - -_ListComprehension_right = (Core.Name "right") - -data PatternComprehension = - PatternComprehension { - patternComprehensionVariable :: (Maybe Variable), - patternComprehensionPattern :: RelationshipsPattern, - patternComprehensionWhere :: (Maybe Where), - patternComprehensionRight :: Expression} - deriving (Eq, Ord, Read, Show) - -_PatternComprehension = (Core.Name "hydra/langs/cypher/openCypher.PatternComprehension") - -_PatternComprehension_variable = (Core.Name "variable") - -_PatternComprehension_pattern = (Core.Name "pattern") - -_PatternComprehension_where = (Core.Name "where") - -_PatternComprehension_right = (Core.Name "right") - -data Quantifier = - Quantifier { - quantifierOperator :: QuantifierOperator, - quantifierExpression :: FilterExpression} - deriving (Eq, Ord, Read, Show) - -_Quantifier = (Core.Name "hydra/langs/cypher/openCypher.Quantifier") - -_Quantifier_operator = (Core.Name "operator") - -_Quantifier_expression = (Core.Name "expression") - -data QuantifierOperator = - QuantifierOperatorAll | - QuantifierOperatorAny | - QuantifierOperatorNone | - QuantifierOperatorSingle - deriving (Eq, Ord, Read, Show) - -_QuantifierOperator = (Core.Name "hydra/langs/cypher/openCypher.QuantifierOperator") - -_QuantifierOperator_all = (Core.Name "all") - -_QuantifierOperator_any = (Core.Name "any") - -_QuantifierOperator_none = (Core.Name "none") - -_QuantifierOperator_single = (Core.Name "single") - -data FilterExpression = - FilterExpression { - filterExpressionIdInColl :: IdInColl, - filterExpressionWhere :: (Maybe Where)} - deriving (Eq, Ord, Read, Show) - -_FilterExpression = (Core.Name "hydra/langs/cypher/openCypher.FilterExpression") - -_FilterExpression_idInColl = (Core.Name "idInColl") - -_FilterExpression_where = (Core.Name "where") - -newtype PatternPredicate = - PatternPredicate { - unPatternPredicate :: RelationshipsPattern} - deriving (Eq, Ord, Read, Show) - -_PatternPredicate = (Core.Name "hydra/langs/cypher/openCypher.PatternPredicate") - -newtype ParenthesizedExpression = - ParenthesizedExpression { - unParenthesizedExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_ParenthesizedExpression = (Core.Name "hydra/langs/cypher/openCypher.ParenthesizedExpression") - -data IdInColl = - IdInColl { - idInCollVariable :: Variable, - idInCollExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_IdInColl = (Core.Name "hydra/langs/cypher/openCypher.IdInColl") - -_IdInColl_variable = (Core.Name "variable") - -_IdInColl_expression = (Core.Name "expression") - -data FunctionInvocation = - FunctionInvocation { - functionInvocationName :: QualifiedName, - functionInvocationDistinct :: Bool, - functionInvocationArguments :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_FunctionInvocation = (Core.Name "hydra/langs/cypher/openCypher.FunctionInvocation") - -_FunctionInvocation_name = (Core.Name "name") - -_FunctionInvocation_distinct = (Core.Name "distinct") - -_FunctionInvocation_arguments = (Core.Name "arguments") - -data QualifiedName = - QualifiedName { - qualifiedNameNamespace :: String, - qualifiedNameLocal :: String} - deriving (Eq, Ord, Read, Show) - -_QualifiedName = (Core.Name "hydra/langs/cypher/openCypher.QualifiedName") - -_QualifiedName_namespace = (Core.Name "namespace") - -_QualifiedName_local = (Core.Name "local") - -data PatternWhere = - PatternWhere { - patternWherePattern :: Pattern, - patternWhereWhere :: (Maybe Where)} - deriving (Eq, Ord, Read, Show) - -_PatternWhere = (Core.Name "hydra/langs/cypher/openCypher.PatternWhere") - -_PatternWhere_pattern = (Core.Name "pattern") - -_PatternWhere_where = (Core.Name "where") - -data ExistentialSubquery = - ExistentialSubqueryRegular RegularQuery | - ExistentialSubqueryPattern PatternWhere - deriving (Eq, Ord, Read, Show) - -_ExistentialSubquery = (Core.Name "hydra/langs/cypher/openCypher.ExistentialSubquery") - -_ExistentialSubquery_regular = (Core.Name "regular") - -_ExistentialSubquery_pattern = (Core.Name "pattern") - -data ExplicitProcedureInvocation = - ExplicitProcedureInvocation { - explicitProcedureInvocationName :: QualifiedName, - explicitProcedureInvocationArguments :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_ExplicitProcedureInvocation = (Core.Name "hydra/langs/cypher/openCypher.ExplicitProcedureInvocation") - -_ExplicitProcedureInvocation_name = (Core.Name "name") - -_ExplicitProcedureInvocation_arguments = (Core.Name "arguments") - -newtype ImplicitProcedureInvocation = - ImplicitProcedureInvocation { - unImplicitProcedureInvocation :: QualifiedName} - deriving (Eq, Ord, Read, Show) - -_ImplicitProcedureInvocation = (Core.Name "hydra/langs/cypher/openCypher.ImplicitProcedureInvocation") - -newtype ProcedureResultField = - ProcedureResultField { - unProcedureResultField :: String} - deriving (Eq, Ord, Read, Show) - -_ProcedureResultField = (Core.Name "hydra/langs/cypher/openCypher.ProcedureResultField") - -newtype Variable = - Variable { - unVariable :: String} - deriving (Eq, Ord, Read, Show) - -_Variable = (Core.Name "hydra/langs/cypher/openCypher.Variable") - -data Literal = - LiteralBoolean Bool | - LiteralNull | - LiteralNumber NumberLiteral | - LiteralString StringLiteral | - LiteralList ListLiteral | - LiteralMap MapLiteral - deriving (Eq, Ord, Read, Show) - -_Literal = (Core.Name "hydra/langs/cypher/openCypher.Literal") - -_Literal_boolean = (Core.Name "boolean") - -_Literal_null = (Core.Name "null") - -_Literal_number = (Core.Name "number") - -_Literal_string = (Core.Name "string") - -_Literal_list = (Core.Name "list") - -_Literal_map = (Core.Name "map") - -data NumberLiteral = - NumberLiteralDouble Double | - NumberLiteralInteger Integer - deriving (Eq, Ord, Read, Show) - -_NumberLiteral = (Core.Name "hydra/langs/cypher/openCypher.NumberLiteral") - -_NumberLiteral_double = (Core.Name "double") - -_NumberLiteral_integer = (Core.Name "integer") - -newtype StringLiteral = - StringLiteral { - unStringLiteral :: String} - deriving (Eq, Ord, Read, Show) - -_StringLiteral = (Core.Name "hydra/langs/cypher/openCypher.StringLiteral") - -newtype ListLiteral = - ListLiteral { - unListLiteral :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_ListLiteral = (Core.Name "hydra/langs/cypher/openCypher.ListLiteral") - -newtype MapLiteral = - MapLiteral { - unMapLiteral :: [KeyValuePair]} - deriving (Eq, Ord, Read, Show) - -_MapLiteral = (Core.Name "hydra/langs/cypher/openCypher.MapLiteral") - -data KeyValuePair = - KeyValuePair { - keyValuePairKey :: PropertyKeyName, - keyValuePairValue :: Expression} - deriving (Eq, Ord, Read, Show) - -_KeyValuePair = (Core.Name "hydra/langs/cypher/openCypher.KeyValuePair") - -_KeyValuePair_key = (Core.Name "key") - -_KeyValuePair_value = (Core.Name "value") - -newtype PropertyKeyName = - PropertyKeyName { - unPropertyKeyName :: String} - deriving (Eq, Ord, Read, Show) - -_PropertyKeyName = (Core.Name "hydra/langs/cypher/openCypher.PropertyKeyName") - -data Parameter = - ParameterSymbolic String | - ParameterInteger Integer - deriving (Eq, Ord, Read, Show) - -_Parameter = (Core.Name "hydra/langs/cypher/openCypher.Parameter") - -_Parameter_symbolic = (Core.Name "symbolic") - -_Parameter_integer = (Core.Name "integer") diff --git a/src/gen-main/haskell/Hydra/Langs/Graphql/Syntax.hs b/src/gen-main/haskell/Hydra/Langs/Graphql/Syntax.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Graphql/Syntax.hs +++ /dev/null @@ -1,1299 +0,0 @@ --- | A GraphQL model. Based on the (extended) BNF at: --- | https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary - -module Hydra.Langs.Graphql.Syntax where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype Name = - Name { - unName :: String} - deriving (Eq, Ord, Read, Show) - -_Name = (Core.Name "hydra/langs/graphql/syntax.Name") - -newtype IntValue = - IntValue { - unIntValue :: String} - deriving (Eq, Ord, Read, Show) - -_IntValue = (Core.Name "hydra/langs/graphql/syntax.IntValue") - -newtype FloatValue = - FloatValue { - unFloatValue :: String} - deriving (Eq, Ord, Read, Show) - -_FloatValue = (Core.Name "hydra/langs/graphql/syntax.FloatValue") - -newtype StringValue = - StringValue { - unStringValue :: String} - deriving (Eq, Ord, Read, Show) - -_StringValue = (Core.Name "hydra/langs/graphql/syntax.StringValue") - -newtype Document = - Document { - unDocument :: [Definition]} - deriving (Eq, Ord, Read, Show) - -_Document = (Core.Name "hydra/langs/graphql/syntax.Document") - -data Definition = - DefinitionExecutable ExecutableDefinition | - DefinitionTypeSystem TypeSystemDefinitionOrExtension - deriving (Eq, Ord, Read, Show) - -_Definition = (Core.Name "hydra/langs/graphql/syntax.Definition") - -_Definition_executable = (Core.Name "executable") - -_Definition_typeSystem = (Core.Name "typeSystem") - -newtype ExecutableDocument = - ExecutableDocument { - unExecutableDocument :: [ExecutableDefinition]} - deriving (Eq, Ord, Read, Show) - -_ExecutableDocument = (Core.Name "hydra/langs/graphql/syntax.ExecutableDocument") - -data ExecutableDefinition = - ExecutableDefinitionOperation OperationDefinition | - ExecutableDefinitionFragment FragmentDefinition - deriving (Eq, Ord, Read, Show) - -_ExecutableDefinition = (Core.Name "hydra/langs/graphql/syntax.ExecutableDefinition") - -_ExecutableDefinition_operation = (Core.Name "operation") - -_ExecutableDefinition_fragment = (Core.Name "fragment") - -data OperationDefinition = - OperationDefinitionSequence OperationDefinition_Sequence | - OperationDefinitionSelectionSet SelectionSet - deriving (Eq, Ord, Read, Show) - -_OperationDefinition = (Core.Name "hydra/langs/graphql/syntax.OperationDefinition") - -_OperationDefinition_sequence = (Core.Name "sequence") - -_OperationDefinition_selectionSet = (Core.Name "selectionSet") - -data OperationDefinition_Sequence = - OperationDefinition_Sequence { - operationDefinition_SequenceOperationType :: OperationType, - operationDefinition_SequenceName :: (Maybe Name), - operationDefinition_SequenceVariablesDefinition :: (Maybe VariablesDefinition), - operationDefinition_SequenceDirectives :: (Maybe Directives), - operationDefinition_SequenceSelectionSet :: SelectionSet} - deriving (Eq, Ord, Read, Show) - -_OperationDefinition_Sequence = (Core.Name "hydra/langs/graphql/syntax.OperationDefinition.Sequence") - -_OperationDefinition_Sequence_operationType = (Core.Name "operationType") - -_OperationDefinition_Sequence_name = (Core.Name "name") - -_OperationDefinition_Sequence_variablesDefinition = (Core.Name "variablesDefinition") - -_OperationDefinition_Sequence_directives = (Core.Name "directives") - -_OperationDefinition_Sequence_selectionSet = (Core.Name "selectionSet") - -data OperationType = - OperationTypeQuery | - OperationTypeMutation | - OperationTypeSubscription - deriving (Eq, Ord, Read, Show) - -_OperationType = (Core.Name "hydra/langs/graphql/syntax.OperationType") - -_OperationType_query = (Core.Name "query") - -_OperationType_mutation = (Core.Name "mutation") - -_OperationType_subscription = (Core.Name "subscription") - -newtype SelectionSet = - SelectionSet { - unSelectionSet :: [Selection]} - deriving (Eq, Ord, Read, Show) - -_SelectionSet = (Core.Name "hydra/langs/graphql/syntax.SelectionSet") - -data Selection = - SelectionField Field | - SelectionFragmentSpread FragmentSpread | - SelectionInlineFragment InlineFragment - deriving (Eq, Ord, Read, Show) - -_Selection = (Core.Name "hydra/langs/graphql/syntax.Selection") - -_Selection_field = (Core.Name "field") - -_Selection_fragmentSpread = (Core.Name "fragmentSpread") - -_Selection_inlineFragment = (Core.Name "inlineFragment") - -data Field = - Field { - fieldAlias :: (Maybe Alias), - fieldName :: Name, - fieldArguments :: (Maybe Arguments), - fieldDirectives :: (Maybe Directives), - fieldSelectionSet :: (Maybe SelectionSet)} - deriving (Eq, Ord, Read, Show) - -_Field = (Core.Name "hydra/langs/graphql/syntax.Field") - -_Field_alias = (Core.Name "alias") - -_Field_name = (Core.Name "name") - -_Field_arguments = (Core.Name "arguments") - -_Field_directives = (Core.Name "directives") - -_Field_selectionSet = (Core.Name "selectionSet") - -data Alias = - AliasName Name | - AliasColon - deriving (Eq, Ord, Read, Show) - -_Alias = (Core.Name "hydra/langs/graphql/syntax.Alias") - -_Alias_name = (Core.Name "name") - -_Alias_colon = (Core.Name "colon") - -newtype Arguments = - Arguments { - unArguments :: [Argument]} - deriving (Eq, Ord, Read, Show) - -_Arguments = (Core.Name "hydra/langs/graphql/syntax.Arguments") - -data Argument = - Argument { - argumentName :: Name, - argumentValue :: Value} - deriving (Eq, Ord, Read, Show) - -_Argument = (Core.Name "hydra/langs/graphql/syntax.Argument") - -_Argument_name = (Core.Name "name") - -_Argument_value = (Core.Name "value") - -data FragmentSpread = - FragmentSpread { - fragmentSpreadFragmentName :: FragmentName, - fragmentSpreadDirectives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_FragmentSpread = (Core.Name "hydra/langs/graphql/syntax.FragmentSpread") - -_FragmentSpread_fragmentName = (Core.Name "fragmentName") - -_FragmentSpread_directives = (Core.Name "directives") - -data InlineFragment = - InlineFragment { - inlineFragmentTypeCondition :: (Maybe TypeCondition), - inlineFragmentDirectives :: (Maybe Directives), - inlineFragmentSelectionSet :: SelectionSet} - deriving (Eq, Ord, Read, Show) - -_InlineFragment = (Core.Name "hydra/langs/graphql/syntax.InlineFragment") - -_InlineFragment_typeCondition = (Core.Name "typeCondition") - -_InlineFragment_directives = (Core.Name "directives") - -_InlineFragment_selectionSet = (Core.Name "selectionSet") - -data FragmentDefinition = - FragmentDefinition { - fragmentDefinitionFragmentName :: FragmentName, - fragmentDefinitionTypeCondition :: TypeCondition, - fragmentDefinitionDirectives :: (Maybe Directives), - fragmentDefinitionSelectionSet :: SelectionSet} - deriving (Eq, Ord, Read, Show) - -_FragmentDefinition = (Core.Name "hydra/langs/graphql/syntax.FragmentDefinition") - -_FragmentDefinition_fragmentName = (Core.Name "fragmentName") - -_FragmentDefinition_typeCondition = (Core.Name "typeCondition") - -_FragmentDefinition_directives = (Core.Name "directives") - -_FragmentDefinition_selectionSet = (Core.Name "selectionSet") - -newtype FragmentName = - FragmentName { - unFragmentName :: Name} - deriving (Eq, Ord, Read, Show) - -_FragmentName = (Core.Name "hydra/langs/graphql/syntax.FragmentName") - -data TypeCondition = - TypeConditionOn | - TypeConditionNamedType NamedType - deriving (Eq, Ord, Read, Show) - -_TypeCondition = (Core.Name "hydra/langs/graphql/syntax.TypeCondition") - -_TypeCondition_on = (Core.Name "on") - -_TypeCondition_namedType = (Core.Name "namedType") - -data Value = - ValueVariable Variable | - ValueInt IntValue | - ValueFloat FloatValue | - ValueString StringValue | - ValueBoolean BooleanValue | - ValueNull NullValue | - ValueEnum EnumValue | - ValueList ListValue | - ValueObject ObjectValue - deriving (Eq, Ord, Read, Show) - -_Value = (Core.Name "hydra/langs/graphql/syntax.Value") - -_Value_variable = (Core.Name "variable") - -_Value_int = (Core.Name "int") - -_Value_float = (Core.Name "float") - -_Value_string = (Core.Name "string") - -_Value_boolean = (Core.Name "boolean") - -_Value_null = (Core.Name "null") - -_Value_enum = (Core.Name "enum") - -_Value_list = (Core.Name "list") - -_Value_object = (Core.Name "object") - -data BooleanValue = - BooleanValueTrue | - BooleanValueFalse - deriving (Eq, Ord, Read, Show) - -_BooleanValue = (Core.Name "hydra/langs/graphql/syntax.BooleanValue") - -_BooleanValue_true = (Core.Name "true") - -_BooleanValue_false = (Core.Name "false") - -data NullValue = - NullValue {} - deriving (Eq, Ord, Read, Show) - -_NullValue = (Core.Name "hydra/langs/graphql/syntax.NullValue") - -newtype EnumValue = - EnumValue { - unEnumValue :: Name} - deriving (Eq, Ord, Read, Show) - -_EnumValue = (Core.Name "hydra/langs/graphql/syntax.EnumValue") - -data ListValue = - ListValueSequence ListValue_Sequence | - ListValueSequence2 [Value] - deriving (Eq, Ord, Read, Show) - -_ListValue = (Core.Name "hydra/langs/graphql/syntax.ListValue") - -_ListValue_sequence = (Core.Name "sequence") - -_ListValue_sequence2 = (Core.Name "sequence2") - -data ListValue_Sequence = - ListValue_Sequence {} - deriving (Eq, Ord, Read, Show) - -_ListValue_Sequence = (Core.Name "hydra/langs/graphql/syntax.ListValue.Sequence") - -data ObjectValue = - ObjectValueSequence ObjectValue_Sequence | - ObjectValueSequence2 [ObjectField] - deriving (Eq, Ord, Read, Show) - -_ObjectValue = (Core.Name "hydra/langs/graphql/syntax.ObjectValue") - -_ObjectValue_sequence = (Core.Name "sequence") - -_ObjectValue_sequence2 = (Core.Name "sequence2") - -data ObjectValue_Sequence = - ObjectValue_Sequence {} - deriving (Eq, Ord, Read, Show) - -_ObjectValue_Sequence = (Core.Name "hydra/langs/graphql/syntax.ObjectValue.Sequence") - -data ObjectField = - ObjectField { - objectFieldName :: Name, - objectFieldValue :: Value} - deriving (Eq, Ord, Read, Show) - -_ObjectField = (Core.Name "hydra/langs/graphql/syntax.ObjectField") - -_ObjectField_name = (Core.Name "name") - -_ObjectField_value = (Core.Name "value") - -data VariablesDefinition = - VariablesDefinition { - variablesDefinitionVariable :: Variable, - variablesDefinitionType :: Type, - variablesDefinitionDefaultValue :: (Maybe DefaultValue), - variablesDefinitionDirectives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_VariablesDefinition = (Core.Name "hydra/langs/graphql/syntax.VariablesDefinition") - -_VariablesDefinition_variable = (Core.Name "variable") - -_VariablesDefinition_type = (Core.Name "type") - -_VariablesDefinition_defaultValue = (Core.Name "defaultValue") - -_VariablesDefinition_directives = (Core.Name "directives") - -newtype Variable = - Variable { - unVariable :: Name} - deriving (Eq, Ord, Read, Show) - -_Variable = (Core.Name "hydra/langs/graphql/syntax.Variable") - -newtype DefaultValue = - DefaultValue { - unDefaultValue :: Value} - deriving (Eq, Ord, Read, Show) - -_DefaultValue = (Core.Name "hydra/langs/graphql/syntax.DefaultValue") - -data Type = - TypeNamed NamedType | - TypeList ListType | - TypeNonNull NonNullType - deriving (Eq, Ord, Read, Show) - -_Type = (Core.Name "hydra/langs/graphql/syntax.Type") - -_Type_named = (Core.Name "named") - -_Type_list = (Core.Name "list") - -_Type_nonNull = (Core.Name "nonNull") - -newtype NamedType = - NamedType { - unNamedType :: Name} - deriving (Eq, Ord, Read, Show) - -_NamedType = (Core.Name "hydra/langs/graphql/syntax.NamedType") - -newtype ListType = - ListType { - unListType :: Type} - deriving (Eq, Ord, Read, Show) - -_ListType = (Core.Name "hydra/langs/graphql/syntax.ListType") - -data NonNullType = - NonNullTypeNamed NamedType | - NonNullTypeList ListType - deriving (Eq, Ord, Read, Show) - -_NonNullType = (Core.Name "hydra/langs/graphql/syntax.NonNullType") - -_NonNullType_named = (Core.Name "named") - -_NonNullType_list = (Core.Name "list") - -newtype Directives = - Directives { - unDirectives :: [Directive]} - deriving (Eq, Ord, Read, Show) - -_Directives = (Core.Name "hydra/langs/graphql/syntax.Directives") - -data Directive = - Directive { - directiveName :: Name, - directiveArguments :: (Maybe Arguments)} - deriving (Eq, Ord, Read, Show) - -_Directive = (Core.Name "hydra/langs/graphql/syntax.Directive") - -_Directive_name = (Core.Name "name") - -_Directive_arguments = (Core.Name "arguments") - -newtype TypeSystemDocment = - TypeSystemDocment { - unTypeSystemDocment :: [TypeSystemDefinition]} - deriving (Eq, Ord, Read, Show) - -_TypeSystemDocment = (Core.Name "hydra/langs/graphql/syntax.TypeSystemDocment") - -data TypeSystemDefinition = - TypeSystemDefinitionSchema SchemaDefinition | - TypeSystemDefinitionType TypeDefinition | - TypeSystemDefinitionDirective DirectiveDefinition - deriving (Eq, Ord, Read, Show) - -_TypeSystemDefinition = (Core.Name "hydra/langs/graphql/syntax.TypeSystemDefinition") - -_TypeSystemDefinition_schema = (Core.Name "schema") - -_TypeSystemDefinition_type = (Core.Name "type") - -_TypeSystemDefinition_directive = (Core.Name "directive") - -newtype TypeSystemExtensionDocument = - TypeSystemExtensionDocument { - unTypeSystemExtensionDocument :: [TypeSystemDefinitionOrExtension]} - deriving (Eq, Ord, Read, Show) - -_TypeSystemExtensionDocument = (Core.Name "hydra/langs/graphql/syntax.TypeSystemExtensionDocument") - -data TypeSystemDefinitionOrExtension = - TypeSystemDefinitionOrExtensionDefinition TypeSystemDefinition | - TypeSystemDefinitionOrExtensionExtension TypeSystemExtension - deriving (Eq, Ord, Read, Show) - -_TypeSystemDefinitionOrExtension = (Core.Name "hydra/langs/graphql/syntax.TypeSystemDefinitionOrExtension") - -_TypeSystemDefinitionOrExtension_definition = (Core.Name "definition") - -_TypeSystemDefinitionOrExtension_extension = (Core.Name "extension") - -data TypeSystemExtension = - TypeSystemExtensionSchema SchemaExtension | - TypeSystemExtensionType TypeExtension - deriving (Eq, Ord, Read, Show) - -_TypeSystemExtension = (Core.Name "hydra/langs/graphql/syntax.TypeSystemExtension") - -_TypeSystemExtension_schema = (Core.Name "schema") - -_TypeSystemExtension_type = (Core.Name "type") - -data SchemaDefinition = - SchemaDefinition { - schemaDefinitionDescription :: (Maybe Description), - schemaDefinitionDirectives :: (Maybe Directives), - schemaDefinitionRootOperationTypeDefinition :: RootOperationTypeDefinition} - deriving (Eq, Ord, Read, Show) - -_SchemaDefinition = (Core.Name "hydra/langs/graphql/syntax.SchemaDefinition") - -_SchemaDefinition_description = (Core.Name "description") - -_SchemaDefinition_directives = (Core.Name "directives") - -_SchemaDefinition_rootOperationTypeDefinition = (Core.Name "rootOperationTypeDefinition") - -data SchemaExtension = - SchemaExtensionSequence SchemaExtension_Sequence | - SchemaExtensionSequence2 Directives - deriving (Eq, Ord, Read, Show) - -_SchemaExtension = (Core.Name "hydra/langs/graphql/syntax.SchemaExtension") - -_SchemaExtension_sequence = (Core.Name "sequence") - -_SchemaExtension_sequence2 = (Core.Name "sequence2") - -data SchemaExtension_Sequence = - SchemaExtension_Sequence { - schemaExtension_SequenceDirectives :: (Maybe Directives), - schemaExtension_SequenceRootOperationTypeDefinition :: RootOperationTypeDefinition} - deriving (Eq, Ord, Read, Show) - -_SchemaExtension_Sequence = (Core.Name "hydra/langs/graphql/syntax.SchemaExtension.Sequence") - -_SchemaExtension_Sequence_directives = (Core.Name "directives") - -_SchemaExtension_Sequence_rootOperationTypeDefinition = (Core.Name "rootOperationTypeDefinition") - -data RootOperationTypeDefinition = - RootOperationTypeDefinition { - rootOperationTypeDefinitionOperationType :: OperationType, - rootOperationTypeDefinitionNamedType :: NamedType} - deriving (Eq, Ord, Read, Show) - -_RootOperationTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.RootOperationTypeDefinition") - -_RootOperationTypeDefinition_operationType = (Core.Name "operationType") - -_RootOperationTypeDefinition_namedType = (Core.Name "namedType") - -newtype Description = - Description { - unDescription :: StringValue} - deriving (Eq, Ord, Read, Show) - -_Description = (Core.Name "hydra/langs/graphql/syntax.Description") - -data TypeDefinition = - TypeDefinitionScalar ScalarTypeDefinition | - TypeDefinitionObject ObjectTypeDefinition | - TypeDefinitionInterface InterfaceTypeDefinition | - TypeDefinitionUnion UnionTypeDefinition | - TypeDefinitionEnum EnumTypeDefinition | - TypeDefinitionInputObject InputObjectTypeDefinition - deriving (Eq, Ord, Read, Show) - -_TypeDefinition = (Core.Name "hydra/langs/graphql/syntax.TypeDefinition") - -_TypeDefinition_scalar = (Core.Name "scalar") - -_TypeDefinition_object = (Core.Name "object") - -_TypeDefinition_interface = (Core.Name "interface") - -_TypeDefinition_union = (Core.Name "union") - -_TypeDefinition_enum = (Core.Name "enum") - -_TypeDefinition_inputObject = (Core.Name "inputObject") - -data TypeExtension = - TypeExtensionScalar ScalarTypeExtension | - TypeExtensionObject ObjectTypeExtension | - TypeExtensionInterface InterfaceTypeExtension | - TypeExtensionUnion UnionTypeExtension | - TypeExtensionEnum EnumTypeExtension | - TypeExtensionInputObject InputObjectTypeExtension - deriving (Eq, Ord, Read, Show) - -_TypeExtension = (Core.Name "hydra/langs/graphql/syntax.TypeExtension") - -_TypeExtension_scalar = (Core.Name "scalar") - -_TypeExtension_object = (Core.Name "object") - -_TypeExtension_interface = (Core.Name "interface") - -_TypeExtension_union = (Core.Name "union") - -_TypeExtension_enum = (Core.Name "enum") - -_TypeExtension_inputObject = (Core.Name "inputObject") - -data ScalarTypeDefinition = - ScalarTypeDefinition { - scalarTypeDefinitionDescription :: (Maybe Description), - scalarTypeDefinitionName :: Name, - scalarTypeDefinitionDirectives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_ScalarTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.ScalarTypeDefinition") - -_ScalarTypeDefinition_description = (Core.Name "description") - -_ScalarTypeDefinition_name = (Core.Name "name") - -_ScalarTypeDefinition_directives = (Core.Name "directives") - -data ScalarTypeExtension = - ScalarTypeExtension { - scalarTypeExtensionName :: Name, - scalarTypeExtensionDirectives :: Directives} - deriving (Eq, Ord, Read, Show) - -_ScalarTypeExtension = (Core.Name "hydra/langs/graphql/syntax.ScalarTypeExtension") - -_ScalarTypeExtension_name = (Core.Name "name") - -_ScalarTypeExtension_directives = (Core.Name "directives") - -data ObjectTypeDefinition = - ObjectTypeDefinition { - objectTypeDefinitionDescription :: (Maybe Description), - objectTypeDefinitionName :: Name, - objectTypeDefinitionImplementsInterfaces :: (Maybe ImplementsInterfaces), - objectTypeDefinitionDirectives :: (Maybe Directives), - objectTypeDefinitionFieldsDefinition :: (Maybe FieldsDefinition)} - deriving (Eq, Ord, Read, Show) - -_ObjectTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.ObjectTypeDefinition") - -_ObjectTypeDefinition_description = (Core.Name "description") - -_ObjectTypeDefinition_name = (Core.Name "name") - -_ObjectTypeDefinition_implementsInterfaces = (Core.Name "implementsInterfaces") - -_ObjectTypeDefinition_directives = (Core.Name "directives") - -_ObjectTypeDefinition_fieldsDefinition = (Core.Name "fieldsDefinition") - -data ObjectTypeExtension = - ObjectTypeExtensionSequence ObjectTypeExtension_Sequence | - ObjectTypeExtensionSequence2 ObjectTypeExtension_Sequence2 | - ObjectTypeExtensionSequence3 ObjectTypeExtension_Sequence3 - deriving (Eq, Ord, Read, Show) - -_ObjectTypeExtension = (Core.Name "hydra/langs/graphql/syntax.ObjectTypeExtension") - -_ObjectTypeExtension_sequence = (Core.Name "sequence") - -_ObjectTypeExtension_sequence2 = (Core.Name "sequence2") - -_ObjectTypeExtension_sequence3 = (Core.Name "sequence3") - -data ObjectTypeExtension_Sequence = - ObjectTypeExtension_Sequence { - objectTypeExtension_SequenceName :: Name, - objectTypeExtension_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces), - objectTypeExtension_SequenceDirectives :: (Maybe Directives), - objectTypeExtension_SequenceFieldsDefinition :: FieldsDefinition} - deriving (Eq, Ord, Read, Show) - -_ObjectTypeExtension_Sequence = (Core.Name "hydra/langs/graphql/syntax.ObjectTypeExtension.Sequence") - -_ObjectTypeExtension_Sequence_name = (Core.Name "name") - -_ObjectTypeExtension_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") - -_ObjectTypeExtension_Sequence_directives = (Core.Name "directives") - -_ObjectTypeExtension_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition") - -data ObjectTypeExtension_Sequence2 = - ObjectTypeExtension_Sequence2 { - objectTypeExtension_Sequence2Name :: Name, - objectTypeExtension_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces), - objectTypeExtension_Sequence2Directives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_ObjectTypeExtension_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.ObjectTypeExtension.Sequence2") - -_ObjectTypeExtension_Sequence2_name = (Core.Name "name") - -_ObjectTypeExtension_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces") - -_ObjectTypeExtension_Sequence2_directives = (Core.Name "directives") - -data ObjectTypeExtension_Sequence3 = - ObjectTypeExtension_Sequence3 { - objectTypeExtension_Sequence3Name :: Name, - objectTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces} - deriving (Eq, Ord, Read, Show) - -_ObjectTypeExtension_Sequence3 = (Core.Name "hydra/langs/graphql/syntax.ObjectTypeExtension.Sequence3") - -_ObjectTypeExtension_Sequence3_name = (Core.Name "name") - -_ObjectTypeExtension_Sequence3_implementsInterfaces = (Core.Name "implementsInterfaces") - -data ImplementsInterfaces = - ImplementsInterfacesSequence ImplementsInterfaces_Sequence | - ImplementsInterfacesSequence2 ImplementsInterfaces_Sequence2 - deriving (Eq, Ord, Read, Show) - -_ImplementsInterfaces = (Core.Name "hydra/langs/graphql/syntax.ImplementsInterfaces") - -_ImplementsInterfaces_sequence = (Core.Name "sequence") - -_ImplementsInterfaces_sequence2 = (Core.Name "sequence2") - -data ImplementsInterfaces_Sequence = - ImplementsInterfaces_Sequence { - implementsInterfaces_SequenceImplementsInterfaces :: ImplementsInterfaces, - implementsInterfaces_SequenceNamedType :: NamedType} - deriving (Eq, Ord, Read, Show) - -_ImplementsInterfaces_Sequence = (Core.Name "hydra/langs/graphql/syntax.ImplementsInterfaces.Sequence") - -_ImplementsInterfaces_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") - -_ImplementsInterfaces_Sequence_namedType = (Core.Name "namedType") - -data ImplementsInterfaces_Sequence2 = - ImplementsInterfaces_Sequence2 { - implementsInterfaces_Sequence2Amp :: (Maybe ()), - implementsInterfaces_Sequence2NamedType :: NamedType} - deriving (Eq, Ord, Read, Show) - -_ImplementsInterfaces_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.ImplementsInterfaces.Sequence2") - -_ImplementsInterfaces_Sequence2_amp = (Core.Name "amp") - -_ImplementsInterfaces_Sequence2_namedType = (Core.Name "namedType") - -newtype FieldsDefinition = - FieldsDefinition { - unFieldsDefinition :: [FieldDefinition]} - deriving (Eq, Ord, Read, Show) - -_FieldsDefinition = (Core.Name "hydra/langs/graphql/syntax.FieldsDefinition") - -data FieldDefinition = - FieldDefinition { - fieldDefinitionDescription :: (Maybe Description), - fieldDefinitionName :: Name, - fieldDefinitionArgumentsDefinition :: (Maybe ArgumentsDefinition), - fieldDefinitionType :: Type, - fieldDefinitionDirectives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_FieldDefinition = (Core.Name "hydra/langs/graphql/syntax.FieldDefinition") - -_FieldDefinition_description = (Core.Name "description") - -_FieldDefinition_name = (Core.Name "name") - -_FieldDefinition_argumentsDefinition = (Core.Name "argumentsDefinition") - -_FieldDefinition_type = (Core.Name "type") - -_FieldDefinition_directives = (Core.Name "directives") - -newtype ArgumentsDefinition = - ArgumentsDefinition { - unArgumentsDefinition :: [InputValueDefinition]} - deriving (Eq, Ord, Read, Show) - -_ArgumentsDefinition = (Core.Name "hydra/langs/graphql/syntax.ArgumentsDefinition") - -data InputValueDefinition = - InputValueDefinition { - inputValueDefinitionDescription :: (Maybe Description), - inputValueDefinitionName :: Name, - inputValueDefinitionType :: Type, - inputValueDefinitionDefaultValue :: (Maybe DefaultValue), - inputValueDefinitionDirectives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_InputValueDefinition = (Core.Name "hydra/langs/graphql/syntax.InputValueDefinition") - -_InputValueDefinition_description = (Core.Name "description") - -_InputValueDefinition_name = (Core.Name "name") - -_InputValueDefinition_type = (Core.Name "type") - -_InputValueDefinition_defaultValue = (Core.Name "defaultValue") - -_InputValueDefinition_directives = (Core.Name "directives") - -data InterfaceTypeDefinition = - InterfaceTypeDefinitionSequence InterfaceTypeDefinition_Sequence | - InterfaceTypeDefinitionSequence2 InterfaceTypeDefinition_Sequence2 - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeDefinition") - -_InterfaceTypeDefinition_sequence = (Core.Name "sequence") - -_InterfaceTypeDefinition_sequence2 = (Core.Name "sequence2") - -data InterfaceTypeDefinition_Sequence = - InterfaceTypeDefinition_Sequence { - interfaceTypeDefinition_SequenceDescription :: (Maybe Description), - interfaceTypeDefinition_SequenceName :: Name, - interfaceTypeDefinition_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces), - interfaceTypeDefinition_SequenceDirectives :: (Maybe Directives), - interfaceTypeDefinition_SequenceFieldsDefinition :: FieldsDefinition} - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeDefinition_Sequence = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeDefinition.Sequence") - -_InterfaceTypeDefinition_Sequence_description = (Core.Name "description") - -_InterfaceTypeDefinition_Sequence_name = (Core.Name "name") - -_InterfaceTypeDefinition_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") - -_InterfaceTypeDefinition_Sequence_directives = (Core.Name "directives") - -_InterfaceTypeDefinition_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition") - -data InterfaceTypeDefinition_Sequence2 = - InterfaceTypeDefinition_Sequence2 { - interfaceTypeDefinition_Sequence2Description :: (Maybe Description), - interfaceTypeDefinition_Sequence2Name :: Name, - interfaceTypeDefinition_Sequence2ImplementsInterfaces :: ImplementsInterfaces, - interfaceTypeDefinition_Sequence2Directives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeDefinition_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeDefinition.Sequence2") - -_InterfaceTypeDefinition_Sequence2_description = (Core.Name "description") - -_InterfaceTypeDefinition_Sequence2_name = (Core.Name "name") - -_InterfaceTypeDefinition_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces") - -_InterfaceTypeDefinition_Sequence2_directives = (Core.Name "directives") - -data InterfaceTypeExtension = - InterfaceTypeExtensionSequence InterfaceTypeExtension_Sequence | - InterfaceTypeExtensionSequence2 InterfaceTypeExtension_Sequence2 | - InterfaceTypeExtensionSequence3 InterfaceTypeExtension_Sequence3 - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeExtension = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeExtension") - -_InterfaceTypeExtension_sequence = (Core.Name "sequence") - -_InterfaceTypeExtension_sequence2 = (Core.Name "sequence2") - -_InterfaceTypeExtension_sequence3 = (Core.Name "sequence3") - -data InterfaceTypeExtension_Sequence = - InterfaceTypeExtension_Sequence { - interfaceTypeExtension_SequenceName :: Name, - interfaceTypeExtension_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces), - interfaceTypeExtension_SequenceDirectives :: (Maybe Directives), - interfaceTypeExtension_SequenceFieldsDefinition :: FieldsDefinition} - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeExtension_Sequence = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeExtension.Sequence") - -_InterfaceTypeExtension_Sequence_name = (Core.Name "name") - -_InterfaceTypeExtension_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces") - -_InterfaceTypeExtension_Sequence_directives = (Core.Name "directives") - -_InterfaceTypeExtension_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition") - -data InterfaceTypeExtension_Sequence2 = - InterfaceTypeExtension_Sequence2 { - interfaceTypeExtension_Sequence2Name :: Name, - interfaceTypeExtension_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces), - interfaceTypeExtension_Sequence2Directives :: Directives} - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeExtension_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeExtension.Sequence2") - -_InterfaceTypeExtension_Sequence2_name = (Core.Name "name") - -_InterfaceTypeExtension_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces") - -_InterfaceTypeExtension_Sequence2_directives = (Core.Name "directives") - -data InterfaceTypeExtension_Sequence3 = - InterfaceTypeExtension_Sequence3 { - interfaceTypeExtension_Sequence3Name :: Name, - interfaceTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces} - deriving (Eq, Ord, Read, Show) - -_InterfaceTypeExtension_Sequence3 = (Core.Name "hydra/langs/graphql/syntax.InterfaceTypeExtension.Sequence3") - -_InterfaceTypeExtension_Sequence3_name = (Core.Name "name") - -_InterfaceTypeExtension_Sequence3_implementsInterfaces = (Core.Name "implementsInterfaces") - -data UnionTypeDefinition = - UnionTypeDefinition { - unionTypeDefinitionDescription :: (Maybe Description), - unionTypeDefinitionName :: Name, - unionTypeDefinitionDirectives :: (Maybe Directives), - unionTypeDefinitionUnionMemberTypes :: (Maybe UnionMemberTypes)} - deriving (Eq, Ord, Read, Show) - -_UnionTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.UnionTypeDefinition") - -_UnionTypeDefinition_description = (Core.Name "description") - -_UnionTypeDefinition_name = (Core.Name "name") - -_UnionTypeDefinition_directives = (Core.Name "directives") - -_UnionTypeDefinition_unionMemberTypes = (Core.Name "unionMemberTypes") - -data UnionMemberTypes = - UnionMemberTypesSequence UnionMemberTypes_Sequence | - UnionMemberTypesSequence2 UnionMemberTypes_Sequence2 - deriving (Eq, Ord, Read, Show) - -_UnionMemberTypes = (Core.Name "hydra/langs/graphql/syntax.UnionMemberTypes") - -_UnionMemberTypes_sequence = (Core.Name "sequence") - -_UnionMemberTypes_sequence2 = (Core.Name "sequence2") - -data UnionMemberTypes_Sequence = - UnionMemberTypes_Sequence { - unionMemberTypes_SequenceUnionMemberTypes :: UnionMemberTypes, - unionMemberTypes_SequenceNamedType :: NamedType} - deriving (Eq, Ord, Read, Show) - -_UnionMemberTypes_Sequence = (Core.Name "hydra/langs/graphql/syntax.UnionMemberTypes.Sequence") - -_UnionMemberTypes_Sequence_unionMemberTypes = (Core.Name "unionMemberTypes") - -_UnionMemberTypes_Sequence_namedType = (Core.Name "namedType") - -data UnionMemberTypes_Sequence2 = - UnionMemberTypes_Sequence2 { - unionMemberTypes_Sequence2Or :: (Maybe ()), - unionMemberTypes_Sequence2NamedType :: NamedType} - deriving (Eq, Ord, Read, Show) - -_UnionMemberTypes_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.UnionMemberTypes.Sequence2") - -_UnionMemberTypes_Sequence2_or = (Core.Name "or") - -_UnionMemberTypes_Sequence2_namedType = (Core.Name "namedType") - -data UnionTypeExtension = - UnionTypeExtensionSequence UnionTypeExtension_Sequence | - UnionTypeExtensionSequence2 UnionTypeExtension_Sequence2 - deriving (Eq, Ord, Read, Show) - -_UnionTypeExtension = (Core.Name "hydra/langs/graphql/syntax.UnionTypeExtension") - -_UnionTypeExtension_sequence = (Core.Name "sequence") - -_UnionTypeExtension_sequence2 = (Core.Name "sequence2") - -data UnionTypeExtension_Sequence = - UnionTypeExtension_Sequence { - unionTypeExtension_SequenceName :: Name, - unionTypeExtension_SequenceDirectives :: (Maybe Directives), - unionTypeExtension_SequenceUnionMemberTypes :: UnionMemberTypes} - deriving (Eq, Ord, Read, Show) - -_UnionTypeExtension_Sequence = (Core.Name "hydra/langs/graphql/syntax.UnionTypeExtension.Sequence") - -_UnionTypeExtension_Sequence_name = (Core.Name "name") - -_UnionTypeExtension_Sequence_directives = (Core.Name "directives") - -_UnionTypeExtension_Sequence_unionMemberTypes = (Core.Name "unionMemberTypes") - -data UnionTypeExtension_Sequence2 = - UnionTypeExtension_Sequence2 { - unionTypeExtension_Sequence2Name :: Name, - unionTypeExtension_Sequence2Directives :: Directives} - deriving (Eq, Ord, Read, Show) - -_UnionTypeExtension_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.UnionTypeExtension.Sequence2") - -_UnionTypeExtension_Sequence2_name = (Core.Name "name") - -_UnionTypeExtension_Sequence2_directives = (Core.Name "directives") - -data EnumTypeDefinition = - EnumTypeDefinition { - enumTypeDefinitionDescription :: (Maybe Description), - enumTypeDefinitionName :: Name, - enumTypeDefinitionDirectives :: (Maybe Directives), - enumTypeDefinitionEnumValuesDefinition :: (Maybe EnumValuesDefinition)} - deriving (Eq, Ord, Read, Show) - -_EnumTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.EnumTypeDefinition") - -_EnumTypeDefinition_description = (Core.Name "description") - -_EnumTypeDefinition_name = (Core.Name "name") - -_EnumTypeDefinition_directives = (Core.Name "directives") - -_EnumTypeDefinition_enumValuesDefinition = (Core.Name "enumValuesDefinition") - -newtype EnumValuesDefinition = - EnumValuesDefinition { - unEnumValuesDefinition :: [EnumValueDefinition]} - deriving (Eq, Ord, Read, Show) - -_EnumValuesDefinition = (Core.Name "hydra/langs/graphql/syntax.EnumValuesDefinition") - -data EnumValueDefinition = - EnumValueDefinition { - enumValueDefinitionDescription :: (Maybe Description), - enumValueDefinitionEnumValue :: EnumValue, - enumValueDefinitionDirectives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_EnumValueDefinition = (Core.Name "hydra/langs/graphql/syntax.EnumValueDefinition") - -_EnumValueDefinition_description = (Core.Name "description") - -_EnumValueDefinition_enumValue = (Core.Name "enumValue") - -_EnumValueDefinition_directives = (Core.Name "directives") - -data EnumTypeExtension = - EnumTypeExtensionSequence EnumTypeExtension_Sequence | - EnumTypeExtensionSequence2 EnumTypeExtension_Sequence2 - deriving (Eq, Ord, Read, Show) - -_EnumTypeExtension = (Core.Name "hydra/langs/graphql/syntax.EnumTypeExtension") - -_EnumTypeExtension_sequence = (Core.Name "sequence") - -_EnumTypeExtension_sequence2 = (Core.Name "sequence2") - -data EnumTypeExtension_Sequence = - EnumTypeExtension_Sequence { - enumTypeExtension_SequenceName :: Name, - enumTypeExtension_SequenceDirectives :: (Maybe Directives), - enumTypeExtension_SequenceEnumValuesDefinition :: EnumValuesDefinition} - deriving (Eq, Ord, Read, Show) - -_EnumTypeExtension_Sequence = (Core.Name "hydra/langs/graphql/syntax.EnumTypeExtension.Sequence") - -_EnumTypeExtension_Sequence_name = (Core.Name "name") - -_EnumTypeExtension_Sequence_directives = (Core.Name "directives") - -_EnumTypeExtension_Sequence_enumValuesDefinition = (Core.Name "enumValuesDefinition") - -data EnumTypeExtension_Sequence2 = - EnumTypeExtension_Sequence2 { - enumTypeExtension_Sequence2Name :: Name, - enumTypeExtension_Sequence2Directives :: Directives} - deriving (Eq, Ord, Read, Show) - -_EnumTypeExtension_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.EnumTypeExtension.Sequence2") - -_EnumTypeExtension_Sequence2_name = (Core.Name "name") - -_EnumTypeExtension_Sequence2_directives = (Core.Name "directives") - -data InputObjectTypeDefinition = - InputObjectTypeDefinitionSequence InputObjectTypeDefinition_Sequence | - InputObjectTypeDefinitionSequence2 InputObjectTypeDefinition_Sequence2 - deriving (Eq, Ord, Read, Show) - -_InputObjectTypeDefinition = (Core.Name "hydra/langs/graphql/syntax.InputObjectTypeDefinition") - -_InputObjectTypeDefinition_sequence = (Core.Name "sequence") - -_InputObjectTypeDefinition_sequence2 = (Core.Name "sequence2") - -data InputObjectTypeDefinition_Sequence = - InputObjectTypeDefinition_Sequence { - inputObjectTypeDefinition_SequenceDescription :: (Maybe Description), - inputObjectTypeDefinition_SequenceName :: Name, - inputObjectTypeDefinition_SequenceDirectives :: (Maybe Directives), - inputObjectTypeDefinition_SequenceInputFieldsDefinition :: InputFieldsDefinition} - deriving (Eq, Ord, Read, Show) - -_InputObjectTypeDefinition_Sequence = (Core.Name "hydra/langs/graphql/syntax.InputObjectTypeDefinition.Sequence") - -_InputObjectTypeDefinition_Sequence_description = (Core.Name "description") - -_InputObjectTypeDefinition_Sequence_name = (Core.Name "name") - -_InputObjectTypeDefinition_Sequence_directives = (Core.Name "directives") - -_InputObjectTypeDefinition_Sequence_inputFieldsDefinition = (Core.Name "inputFieldsDefinition") - -data InputObjectTypeDefinition_Sequence2 = - InputObjectTypeDefinition_Sequence2 { - inputObjectTypeDefinition_Sequence2Description :: (Maybe Description), - inputObjectTypeDefinition_Sequence2Name :: Name, - inputObjectTypeDefinition_Sequence2Directives :: (Maybe Directives)} - deriving (Eq, Ord, Read, Show) - -_InputObjectTypeDefinition_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.InputObjectTypeDefinition.Sequence2") - -_InputObjectTypeDefinition_Sequence2_description = (Core.Name "description") - -_InputObjectTypeDefinition_Sequence2_name = (Core.Name "name") - -_InputObjectTypeDefinition_Sequence2_directives = (Core.Name "directives") - -newtype InputFieldsDefinition = - InputFieldsDefinition { - unInputFieldsDefinition :: [InputValueDefinition]} - deriving (Eq, Ord, Read, Show) - -_InputFieldsDefinition = (Core.Name "hydra/langs/graphql/syntax.InputFieldsDefinition") - -data InputObjectTypeExtension = - InputObjectTypeExtensionSequence InputObjectTypeExtension_Sequence | - InputObjectTypeExtensionSequence2 InputObjectTypeExtension_Sequence2 - deriving (Eq, Ord, Read, Show) - -_InputObjectTypeExtension = (Core.Name "hydra/langs/graphql/syntax.InputObjectTypeExtension") - -_InputObjectTypeExtension_sequence = (Core.Name "sequence") - -_InputObjectTypeExtension_sequence2 = (Core.Name "sequence2") - -data InputObjectTypeExtension_Sequence = - InputObjectTypeExtension_Sequence { - inputObjectTypeExtension_SequenceName :: Name, - inputObjectTypeExtension_SequenceDirectives :: (Maybe Directives), - inputObjectTypeExtension_SequenceInputFieldsDefinition :: InputFieldsDefinition} - deriving (Eq, Ord, Read, Show) - -_InputObjectTypeExtension_Sequence = (Core.Name "hydra/langs/graphql/syntax.InputObjectTypeExtension.Sequence") - -_InputObjectTypeExtension_Sequence_name = (Core.Name "name") - -_InputObjectTypeExtension_Sequence_directives = (Core.Name "directives") - -_InputObjectTypeExtension_Sequence_inputFieldsDefinition = (Core.Name "inputFieldsDefinition") - -data InputObjectTypeExtension_Sequence2 = - InputObjectTypeExtension_Sequence2 { - inputObjectTypeExtension_Sequence2Name :: Name, - inputObjectTypeExtension_Sequence2Directives :: Directives} - deriving (Eq, Ord, Read, Show) - -_InputObjectTypeExtension_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.InputObjectTypeExtension.Sequence2") - -_InputObjectTypeExtension_Sequence2_name = (Core.Name "name") - -_InputObjectTypeExtension_Sequence2_directives = (Core.Name "directives") - -data DirectiveDefinition = - DirectiveDefinition { - directiveDefinitionDescription :: (Maybe Description), - directiveDefinitionName :: Name, - directiveDefinitionArgumentsDefinition :: (Maybe ArgumentsDefinition), - directiveDefinitionRepeatable :: (Maybe ()), - directiveDefinitionDirectiveLocations :: DirectiveLocations} - deriving (Eq, Ord, Read, Show) - -_DirectiveDefinition = (Core.Name "hydra/langs/graphql/syntax.DirectiveDefinition") - -_DirectiveDefinition_description = (Core.Name "description") - -_DirectiveDefinition_name = (Core.Name "name") - -_DirectiveDefinition_argumentsDefinition = (Core.Name "argumentsDefinition") - -_DirectiveDefinition_repeatable = (Core.Name "repeatable") - -_DirectiveDefinition_directiveLocations = (Core.Name "directiveLocations") - -data DirectiveLocations = - DirectiveLocationsSequence DirectiveLocations_Sequence | - DirectiveLocationsSequence2 DirectiveLocations_Sequence2 - deriving (Eq, Ord, Read, Show) - -_DirectiveLocations = (Core.Name "hydra/langs/graphql/syntax.DirectiveLocations") - -_DirectiveLocations_sequence = (Core.Name "sequence") - -_DirectiveLocations_sequence2 = (Core.Name "sequence2") - -data DirectiveLocations_Sequence = - DirectiveLocations_Sequence { - directiveLocations_SequenceDirectiveLocations :: DirectiveLocations, - directiveLocations_SequenceDirectiveLocation :: DirectiveLocation} - deriving (Eq, Ord, Read, Show) - -_DirectiveLocations_Sequence = (Core.Name "hydra/langs/graphql/syntax.DirectiveLocations.Sequence") - -_DirectiveLocations_Sequence_directiveLocations = (Core.Name "directiveLocations") - -_DirectiveLocations_Sequence_directiveLocation = (Core.Name "directiveLocation") - -data DirectiveLocations_Sequence2 = - DirectiveLocations_Sequence2 { - directiveLocations_Sequence2Or :: (Maybe ()), - directiveLocations_Sequence2DirectiveLocation :: DirectiveLocation} - deriving (Eq, Ord, Read, Show) - -_DirectiveLocations_Sequence2 = (Core.Name "hydra/langs/graphql/syntax.DirectiveLocations.Sequence2") - -_DirectiveLocations_Sequence2_or = (Core.Name "or") - -_DirectiveLocations_Sequence2_directiveLocation = (Core.Name "directiveLocation") - -data DirectiveLocation = - DirectiveLocationExecutable ExecutableDirectiveLocation | - DirectiveLocationTypeSystem TypeSystemDirectiveLocation - deriving (Eq, Ord, Read, Show) - -_DirectiveLocation = (Core.Name "hydra/langs/graphql/syntax.DirectiveLocation") - -_DirectiveLocation_executable = (Core.Name "executable") - -_DirectiveLocation_typeSystem = (Core.Name "typeSystem") - -data ExecutableDirectiveLocation = - ExecutableDirectiveLocationQUERY | - ExecutableDirectiveLocationMUTATION | - ExecutableDirectiveLocationSUBSCRIPTION | - ExecutableDirectiveLocationFIELD | - ExecutableDirectiveLocationFRAGMENTLowbarDEFINITION | - ExecutableDirectiveLocationFRAGMENTLowbarSPREAD | - ExecutableDirectiveLocationINLINELowbarFRAGMENT | - ExecutableDirectiveLocationVARIABLELowbarDEFINITION - deriving (Eq, Ord, Read, Show) - -_ExecutableDirectiveLocation = (Core.Name "hydra/langs/graphql/syntax.ExecutableDirectiveLocation") - -_ExecutableDirectiveLocation_qUERY = (Core.Name "qUERY") - -_ExecutableDirectiveLocation_mUTATION = (Core.Name "mUTATION") - -_ExecutableDirectiveLocation_sUBSCRIPTION = (Core.Name "sUBSCRIPTION") - -_ExecutableDirectiveLocation_fIELD = (Core.Name "fIELD") - -_ExecutableDirectiveLocation_fRAGMENTLowbarDEFINITION = (Core.Name "fRAGMENTLowbarDEFINITION") - -_ExecutableDirectiveLocation_fRAGMENTLowbarSPREAD = (Core.Name "fRAGMENTLowbarSPREAD") - -_ExecutableDirectiveLocation_iNLINELowbarFRAGMENT = (Core.Name "iNLINELowbarFRAGMENT") - -_ExecutableDirectiveLocation_vARIABLELowbarDEFINITION = (Core.Name "vARIABLELowbarDEFINITION") - -data TypeSystemDirectiveLocation = - TypeSystemDirectiveLocationSCHEMA | - TypeSystemDirectiveLocationSCALAR | - TypeSystemDirectiveLocationOBJECT | - TypeSystemDirectiveLocationFIELDLowbarDEFINITION | - TypeSystemDirectiveLocationARGUMENTLowbarDEFINITION | - TypeSystemDirectiveLocationINTERFACE | - TypeSystemDirectiveLocationUNION | - TypeSystemDirectiveLocationENUM | - TypeSystemDirectiveLocationENUMLowbarVALUE | - TypeSystemDirectiveLocationINPUTLowbarOBJECT | - TypeSystemDirectiveLocationINPUTLowbarFIELDLowbarDEFINITION - deriving (Eq, Ord, Read, Show) - -_TypeSystemDirectiveLocation = (Core.Name "hydra/langs/graphql/syntax.TypeSystemDirectiveLocation") - -_TypeSystemDirectiveLocation_sCHEMA = (Core.Name "sCHEMA") - -_TypeSystemDirectiveLocation_sCALAR = (Core.Name "sCALAR") - -_TypeSystemDirectiveLocation_oBJECT = (Core.Name "oBJECT") - -_TypeSystemDirectiveLocation_fIELDLowbarDEFINITION = (Core.Name "fIELDLowbarDEFINITION") - -_TypeSystemDirectiveLocation_aRGUMENTLowbarDEFINITION = (Core.Name "aRGUMENTLowbarDEFINITION") - -_TypeSystemDirectiveLocation_iNTERFACE = (Core.Name "iNTERFACE") - -_TypeSystemDirectiveLocation_uNION = (Core.Name "uNION") - -_TypeSystemDirectiveLocation_eNUM = (Core.Name "eNUM") - -_TypeSystemDirectiveLocation_eNUMLowbarVALUE = (Core.Name "eNUMLowbarVALUE") - -_TypeSystemDirectiveLocation_iNPUTLowbarOBJECT = (Core.Name "iNPUTLowbarOBJECT") - -_TypeSystemDirectiveLocation_iNPUTLowbarFIELDLowbarDEFINITION = (Core.Name "iNPUTLowbarFIELDLowbarDEFINITION") diff --git a/src/gen-main/haskell/Hydra/Langs/Haskell/Ast.hs b/src/gen-main/haskell/Hydra/Langs/Haskell/Ast.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Haskell/Ast.hs +++ /dev/null @@ -1,917 +0,0 @@ --- | A Haskell syntax model, loosely based on Language.Haskell.Tools.AST - -module Hydra.Langs.Haskell.Ast where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | A pattern-matching alternative -data Alternative = - Alternative { - alternativePattern :: Pattern, - alternativeRhs :: CaseRhs, - alternativeBinds :: (Maybe LocalBindings)} - deriving (Eq, Ord, Read, Show) - -_Alternative = (Core.Name "hydra/langs/haskell/ast.Alternative") - -_Alternative_pattern = (Core.Name "pattern") - -_Alternative_rhs = (Core.Name "rhs") - -_Alternative_binds = (Core.Name "binds") - --- | A type assertion -data Assertion = - AssertionClass Assertion_Class | - AssertionTuple [Assertion] - deriving (Eq, Ord, Read, Show) - -_Assertion = (Core.Name "hydra/langs/haskell/ast.Assertion") - -_Assertion_class = (Core.Name "class") - -_Assertion_tuple = (Core.Name "tuple") - -data Assertion_Class = - Assertion_Class { - assertion_ClassName :: Name, - assertion_ClassTypes :: [Type]} - deriving (Eq, Ord, Read, Show) - -_Assertion_Class = (Core.Name "hydra/langs/haskell/ast.Assertion.Class") - -_Assertion_Class_name = (Core.Name "name") - -_Assertion_Class_types = (Core.Name "types") - --- | The right-hand side of a pattern-matching alternative -newtype CaseRhs = - CaseRhs { - unCaseRhs :: Expression} - deriving (Eq, Ord, Read, Show) - -_CaseRhs = (Core.Name "hydra/langs/haskell/ast.CaseRhs") - --- | A data constructor -data Constructor = - ConstructorOrdinary Constructor_Ordinary | - ConstructorRecord Constructor_Record - deriving (Eq, Ord, Read, Show) - -_Constructor = (Core.Name "hydra/langs/haskell/ast.Constructor") - -_Constructor_ordinary = (Core.Name "ordinary") - -_Constructor_record = (Core.Name "record") - --- | An ordinary (positional) data constructor -data Constructor_Ordinary = - Constructor_Ordinary { - constructor_OrdinaryName :: Name, - constructor_OrdinaryFields :: [Type]} - deriving (Eq, Ord, Read, Show) - -_Constructor_Ordinary = (Core.Name "hydra/langs/haskell/ast.Constructor.Ordinary") - -_Constructor_Ordinary_name = (Core.Name "name") - -_Constructor_Ordinary_fields = (Core.Name "fields") - --- | A record-style data constructor -data Constructor_Record = - Constructor_Record { - constructor_RecordName :: Name, - constructor_RecordFields :: [FieldWithComments]} - deriving (Eq, Ord, Read, Show) - -_Constructor_Record = (Core.Name "hydra/langs/haskell/ast.Constructor.Record") - -_Constructor_Record_name = (Core.Name "name") - -_Constructor_Record_fields = (Core.Name "fields") - --- | A data constructor together with any comments -data ConstructorWithComments = - ConstructorWithComments { - constructorWithCommentsBody :: Constructor, - constructorWithCommentsComments :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_ConstructorWithComments = (Core.Name "hydra/langs/haskell/ast.ConstructorWithComments") - -_ConstructorWithComments_body = (Core.Name "body") - -_ConstructorWithComments_comments = (Core.Name "comments") - --- | A data type declaration -data DataDeclaration = - DataDeclaration { - dataDeclarationKeyword :: DataDeclaration_Keyword, - dataDeclarationContext :: [Assertion], - dataDeclarationHead :: DeclarationHead, - dataDeclarationConstructors :: [ConstructorWithComments], - dataDeclarationDeriving :: [Deriving]} - deriving (Eq, Ord, Read, Show) - -_DataDeclaration = (Core.Name "hydra/langs/haskell/ast.DataDeclaration") - -_DataDeclaration_keyword = (Core.Name "keyword") - -_DataDeclaration_context = (Core.Name "context") - -_DataDeclaration_head = (Core.Name "head") - -_DataDeclaration_constructors = (Core.Name "constructors") - -_DataDeclaration_deriving = (Core.Name "deriving") - --- | The 'data' versus 'newtype keyword -data DataDeclaration_Keyword = - DataDeclaration_KeywordData | - DataDeclaration_KeywordNewtype - deriving (Eq, Ord, Read, Show) - -_DataDeclaration_Keyword = (Core.Name "hydra/langs/haskell/ast.DataDeclaration.Keyword") - -_DataDeclaration_Keyword_data = (Core.Name "data") - -_DataDeclaration_Keyword_newtype = (Core.Name "newtype") - --- | A data declaration together with any comments -data DeclarationWithComments = - DeclarationWithComments { - declarationWithCommentsBody :: Declaration, - declarationWithCommentsComments :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_DeclarationWithComments = (Core.Name "hydra/langs/haskell/ast.DeclarationWithComments") - -_DeclarationWithComments_body = (Core.Name "body") - -_DeclarationWithComments_comments = (Core.Name "comments") - --- | A data or value declaration -data Declaration = - DeclarationData DataDeclaration | - DeclarationType TypeDeclaration | - DeclarationValueBinding ValueBinding | - DeclarationTypedBinding TypedBinding - deriving (Eq, Ord, Read, Show) - -_Declaration = (Core.Name "hydra/langs/haskell/ast.Declaration") - -_Declaration_data = (Core.Name "data") - -_Declaration_type = (Core.Name "type") - -_Declaration_valueBinding = (Core.Name "valueBinding") - -_Declaration_typedBinding = (Core.Name "typedBinding") - --- | The left-hand side of a declaration -data DeclarationHead = - DeclarationHeadApplication DeclarationHead_Application | - DeclarationHeadParens DeclarationHead | - DeclarationHeadSimple Name - deriving (Eq, Ord, Read, Show) - -_DeclarationHead = (Core.Name "hydra/langs/haskell/ast.DeclarationHead") - -_DeclarationHead_application = (Core.Name "application") - -_DeclarationHead_parens = (Core.Name "parens") - -_DeclarationHead_simple = (Core.Name "simple") - --- | An application-style declaration head -data DeclarationHead_Application = - DeclarationHead_Application { - declarationHead_ApplicationFunction :: DeclarationHead, - declarationHead_ApplicationOperand :: Variable} - deriving (Eq, Ord, Read, Show) - -_DeclarationHead_Application = (Core.Name "hydra/langs/haskell/ast.DeclarationHead.Application") - -_DeclarationHead_Application_function = (Core.Name "function") - -_DeclarationHead_Application_operand = (Core.Name "operand") - --- | A 'deriving' statement -newtype Deriving = - Deriving { - unDeriving :: [Name]} - deriving (Eq, Ord, Read, Show) - -_Deriving = (Core.Name "hydra/langs/haskell/ast.Deriving") - --- | An export statement -data Export = - ExportDeclaration ImportExportSpec | - ExportModule ModuleName - deriving (Eq, Ord, Read, Show) - -_Export = (Core.Name "hydra/langs/haskell/ast.Export") - -_Export_declaration = (Core.Name "declaration") - -_Export_module = (Core.Name "module") - --- | A data expression -data Expression = - ExpressionApplication Expression_Application | - ExpressionCase Expression_Case | - ExpressionConstructRecord Expression_ConstructRecord | - ExpressionDo [Statement] | - ExpressionIf Expression_If | - ExpressionInfixApplication Expression_InfixApplication | - ExpressionLiteral Literal | - ExpressionLambda Expression_Lambda | - ExpressionLeftSection Expression_Section | - ExpressionLet Expression_Let | - ExpressionList [Expression] | - ExpressionParens Expression | - ExpressionPrefixApplication Expression_PrefixApplication | - ExpressionRightSection Expression_Section | - ExpressionTuple [Expression] | - ExpressionTypeSignature Expression_TypeSignature | - ExpressionUpdateRecord Expression_UpdateRecord | - ExpressionVariable Name - deriving (Eq, Ord, Read, Show) - -_Expression = (Core.Name "hydra/langs/haskell/ast.Expression") - -_Expression_application = (Core.Name "application") - -_Expression_case = (Core.Name "case") - -_Expression_constructRecord = (Core.Name "constructRecord") - -_Expression_do = (Core.Name "do") - -_Expression_if = (Core.Name "if") - -_Expression_infixApplication = (Core.Name "infixApplication") - -_Expression_literal = (Core.Name "literal") - -_Expression_lambda = (Core.Name "lambda") - -_Expression_leftSection = (Core.Name "leftSection") - -_Expression_let = (Core.Name "let") - -_Expression_list = (Core.Name "list") - -_Expression_parens = (Core.Name "parens") - -_Expression_prefixApplication = (Core.Name "prefixApplication") - -_Expression_rightSection = (Core.Name "rightSection") - -_Expression_tuple = (Core.Name "tuple") - -_Expression_typeSignature = (Core.Name "typeSignature") - -_Expression_updateRecord = (Core.Name "updateRecord") - -_Expression_variable = (Core.Name "variable") - --- | An application expression -data Expression_Application = - Expression_Application { - expression_ApplicationFunction :: Expression, - expression_ApplicationArgument :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_Application = (Core.Name "hydra/langs/haskell/ast.Expression.Application") - -_Expression_Application_function = (Core.Name "function") - -_Expression_Application_argument = (Core.Name "argument") - --- | A case expression -data Expression_Case = - Expression_Case { - expression_CaseCase :: Expression, - expression_CaseAlternatives :: [Alternative]} - deriving (Eq, Ord, Read, Show) - -_Expression_Case = (Core.Name "hydra/langs/haskell/ast.Expression.Case") - -_Expression_Case_case = (Core.Name "case") - -_Expression_Case_alternatives = (Core.Name "alternatives") - --- | A record constructor expression -data Expression_ConstructRecord = - Expression_ConstructRecord { - expression_ConstructRecordName :: Name, - expression_ConstructRecordFields :: [FieldUpdate]} - deriving (Eq, Ord, Read, Show) - -_Expression_ConstructRecord = (Core.Name "hydra/langs/haskell/ast.Expression.ConstructRecord") - -_Expression_ConstructRecord_name = (Core.Name "name") - -_Expression_ConstructRecord_fields = (Core.Name "fields") - --- | An 'if' expression -data Expression_If = - Expression_If { - expression_IfCondition :: Expression, - expression_IfThen :: Expression, - expression_IfElse :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_If = (Core.Name "hydra/langs/haskell/ast.Expression.If") - -_Expression_If_condition = (Core.Name "condition") - -_Expression_If_then = (Core.Name "then") - -_Expression_If_else = (Core.Name "else") - --- | An infix application expression -data Expression_InfixApplication = - Expression_InfixApplication { - expression_InfixApplicationLhs :: Expression, - expression_InfixApplicationOperator :: Operator, - expression_InfixApplicationRhs :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_InfixApplication = (Core.Name "hydra/langs/haskell/ast.Expression.InfixApplication") - -_Expression_InfixApplication_lhs = (Core.Name "lhs") - -_Expression_InfixApplication_operator = (Core.Name "operator") - -_Expression_InfixApplication_rhs = (Core.Name "rhs") - --- | A lambda expression -data Expression_Lambda = - Expression_Lambda { - expression_LambdaBindings :: [Pattern], - expression_LambdaInner :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_Lambda = (Core.Name "hydra/langs/haskell/ast.Expression.Lambda") - -_Expression_Lambda_bindings = (Core.Name "bindings") - -_Expression_Lambda_inner = (Core.Name "inner") - --- | A 'let' expression -data Expression_Let = - Expression_Let { - expression_LetBindings :: [LocalBinding], - expression_LetInner :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_Let = (Core.Name "hydra/langs/haskell/ast.Expression.Let") - -_Expression_Let_bindings = (Core.Name "bindings") - -_Expression_Let_inner = (Core.Name "inner") - --- | A prefix expression -data Expression_PrefixApplication = - Expression_PrefixApplication { - expression_PrefixApplicationOperator :: Operator, - expression_PrefixApplicationRhs :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_PrefixApplication = (Core.Name "hydra/langs/haskell/ast.Expression.PrefixApplication") - -_Expression_PrefixApplication_operator = (Core.Name "operator") - -_Expression_PrefixApplication_rhs = (Core.Name "rhs") - --- | A section expression -data Expression_Section = - Expression_Section { - expression_SectionOperator :: Operator, - expression_SectionExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_Expression_Section = (Core.Name "hydra/langs/haskell/ast.Expression.Section") - -_Expression_Section_operator = (Core.Name "operator") - -_Expression_Section_expression = (Core.Name "expression") - --- | A type signature expression -data Expression_TypeSignature = - Expression_TypeSignature { - expression_TypeSignatureInner :: Expression, - expression_TypeSignatureType :: Type} - deriving (Eq, Ord, Read, Show) - -_Expression_TypeSignature = (Core.Name "hydra/langs/haskell/ast.Expression.TypeSignature") - -_Expression_TypeSignature_inner = (Core.Name "inner") - -_Expression_TypeSignature_type = (Core.Name "type") - --- | An update record expression -data Expression_UpdateRecord = - Expression_UpdateRecord { - expression_UpdateRecordInner :: Expression, - expression_UpdateRecordFields :: [FieldUpdate]} - deriving (Eq, Ord, Read, Show) - -_Expression_UpdateRecord = (Core.Name "hydra/langs/haskell/ast.Expression.UpdateRecord") - -_Expression_UpdateRecord_inner = (Core.Name "inner") - -_Expression_UpdateRecord_fields = (Core.Name "fields") - --- | A field (name/type pair) -data Field = - Field { - fieldName :: Name, - fieldType :: Type} - deriving (Eq, Ord, Read, Show) - -_Field = (Core.Name "hydra/langs/haskell/ast.Field") - -_Field_name = (Core.Name "name") - -_Field_type = (Core.Name "type") - --- | A field together with any comments -data FieldWithComments = - FieldWithComments { - fieldWithCommentsField :: Field, - fieldWithCommentsComments :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_FieldWithComments = (Core.Name "hydra/langs/haskell/ast.FieldWithComments") - -_FieldWithComments_field = (Core.Name "field") - -_FieldWithComments_comments = (Core.Name "comments") - --- | A field name and value -data FieldUpdate = - FieldUpdate { - fieldUpdateName :: Name, - fieldUpdateValue :: Expression} - deriving (Eq, Ord, Read, Show) - -_FieldUpdate = (Core.Name "hydra/langs/haskell/ast.FieldUpdate") - -_FieldUpdate_name = (Core.Name "name") - -_FieldUpdate_value = (Core.Name "value") - --- | An import statement -data Import = - Import { - importQualified :: Bool, - importModule :: ModuleName, - importAs :: (Maybe ModuleName), - importSpec :: (Maybe Import_Spec)} - deriving (Eq, Ord, Read, Show) - -_Import = (Core.Name "hydra/langs/haskell/ast.Import") - -_Import_qualified = (Core.Name "qualified") - -_Import_module = (Core.Name "module") - -_Import_as = (Core.Name "as") - -_Import_spec = (Core.Name "spec") - --- | An import specification -data Import_Spec = - Import_SpecList [ImportExportSpec] | - Import_SpecHiding [ImportExportSpec] - deriving (Eq, Ord, Read, Show) - -_Import_Spec = (Core.Name "hydra/langs/haskell/ast.Import.Spec") - -_Import_Spec_list = (Core.Name "list") - -_Import_Spec_hiding = (Core.Name "hiding") - --- | An import modifier ('pattern' or 'type') -data ImportModifier = - ImportModifierPattern | - ImportModifierType - deriving (Eq, Ord, Read, Show) - -_ImportModifier = (Core.Name "hydra/langs/haskell/ast.ImportModifier") - -_ImportModifier_pattern = (Core.Name "pattern") - -_ImportModifier_type = (Core.Name "type") - --- | An import or export specification -data ImportExportSpec = - ImportExportSpec { - importExportSpecModifier :: (Maybe ImportModifier), - importExportSpecName :: Name, - importExportSpecSubspec :: (Maybe ImportExportSpec_Subspec)} - deriving (Eq, Ord, Read, Show) - -_ImportExportSpec = (Core.Name "hydra/langs/haskell/ast.ImportExportSpec") - -_ImportExportSpec_modifier = (Core.Name "modifier") - -_ImportExportSpec_name = (Core.Name "name") - -_ImportExportSpec_subspec = (Core.Name "subspec") - -data ImportExportSpec_Subspec = - ImportExportSpec_SubspecAll | - ImportExportSpec_SubspecList [Name] - deriving (Eq, Ord, Read, Show) - -_ImportExportSpec_Subspec = (Core.Name "hydra/langs/haskell/ast.ImportExportSpec.Subspec") - -_ImportExportSpec_Subspec_all = (Core.Name "all") - -_ImportExportSpec_Subspec_list = (Core.Name "list") - --- | A literal value -data Literal = - LiteralChar Int | - LiteralDouble Double | - LiteralFloat Float | - LiteralInt Int | - LiteralInteger Integer | - LiteralString String - deriving (Eq, Ord, Read, Show) - -_Literal = (Core.Name "hydra/langs/haskell/ast.Literal") - -_Literal_char = (Core.Name "char") - -_Literal_double = (Core.Name "double") - -_Literal_float = (Core.Name "float") - -_Literal_int = (Core.Name "int") - -_Literal_integer = (Core.Name "integer") - -_Literal_string = (Core.Name "string") - -data LocalBinding = - LocalBindingSignature TypeSignature | - LocalBindingValue ValueBinding - deriving (Eq, Ord, Read, Show) - -_LocalBinding = (Core.Name "hydra/langs/haskell/ast.LocalBinding") - -_LocalBinding_signature = (Core.Name "signature") - -_LocalBinding_value = (Core.Name "value") - -newtype LocalBindings = - LocalBindings { - unLocalBindings :: [LocalBinding]} - deriving (Eq, Ord, Read, Show) - -_LocalBindings = (Core.Name "hydra/langs/haskell/ast.LocalBindings") - -data Module = - Module { - moduleHead :: (Maybe ModuleHead), - moduleImports :: [Import], - moduleDeclarations :: [DeclarationWithComments]} - deriving (Eq, Ord, Read, Show) - -_Module = (Core.Name "hydra/langs/haskell/ast.Module") - -_Module_head = (Core.Name "head") - -_Module_imports = (Core.Name "imports") - -_Module_declarations = (Core.Name "declarations") - -data ModuleHead = - ModuleHead { - moduleHeadComments :: (Maybe String), - moduleHeadName :: ModuleName, - moduleHeadExports :: [Export]} - deriving (Eq, Ord, Read, Show) - -_ModuleHead = (Core.Name "hydra/langs/haskell/ast.ModuleHead") - -_ModuleHead_comments = (Core.Name "comments") - -_ModuleHead_name = (Core.Name "name") - -_ModuleHead_exports = (Core.Name "exports") - -newtype ModuleName = - ModuleName { - unModuleName :: String} - deriving (Eq, Ord, Read, Show) - -_ModuleName = (Core.Name "hydra/langs/haskell/ast.ModuleName") - -data Name = - NameImplicit QualifiedName | - NameNormal QualifiedName | - NameParens QualifiedName - deriving (Eq, Ord, Read, Show) - -_Name = (Core.Name "hydra/langs/haskell/ast.Name") - -_Name_implicit = (Core.Name "implicit") - -_Name_normal = (Core.Name "normal") - -_Name_parens = (Core.Name "parens") - -newtype NamePart = - NamePart { - unNamePart :: String} - deriving (Eq, Ord, Read, Show) - -_NamePart = (Core.Name "hydra/langs/haskell/ast.NamePart") - -data Operator = - OperatorBacktick QualifiedName | - OperatorNormal QualifiedName - deriving (Eq, Ord, Read, Show) - -_Operator = (Core.Name "hydra/langs/haskell/ast.Operator") - -_Operator_backtick = (Core.Name "backtick") - -_Operator_normal = (Core.Name "normal") - -data Pattern = - PatternApplication Pattern_Application | - PatternAs Pattern_As | - PatternList [Pattern] | - PatternLiteral Literal | - PatternName Name | - PatternParens Pattern | - PatternRecord Pattern_Record | - PatternTuple [Pattern] | - PatternTyped Pattern_Typed | - PatternWildcard - deriving (Eq, Ord, Read, Show) - -_Pattern = (Core.Name "hydra/langs/haskell/ast.Pattern") - -_Pattern_application = (Core.Name "application") - -_Pattern_as = (Core.Name "as") - -_Pattern_list = (Core.Name "list") - -_Pattern_literal = (Core.Name "literal") - -_Pattern_name = (Core.Name "name") - -_Pattern_parens = (Core.Name "parens") - -_Pattern_record = (Core.Name "record") - -_Pattern_tuple = (Core.Name "tuple") - -_Pattern_typed = (Core.Name "typed") - -_Pattern_wildcard = (Core.Name "wildcard") - -data Pattern_Application = - Pattern_Application { - pattern_ApplicationName :: Name, - pattern_ApplicationArgs :: [Pattern]} - deriving (Eq, Ord, Read, Show) - -_Pattern_Application = (Core.Name "hydra/langs/haskell/ast.Pattern.Application") - -_Pattern_Application_name = (Core.Name "name") - -_Pattern_Application_args = (Core.Name "args") - -data Pattern_As = - Pattern_As { - pattern_AsName :: Name, - pattern_AsInner :: Pattern} - deriving (Eq, Ord, Read, Show) - -_Pattern_As = (Core.Name "hydra/langs/haskell/ast.Pattern.As") - -_Pattern_As_name = (Core.Name "name") - -_Pattern_As_inner = (Core.Name "inner") - -data Pattern_Record = - Pattern_Record { - pattern_RecordName :: Name, - pattern_RecordFields :: [PatternField]} - deriving (Eq, Ord, Read, Show) - -_Pattern_Record = (Core.Name "hydra/langs/haskell/ast.Pattern.Record") - -_Pattern_Record_name = (Core.Name "name") - -_Pattern_Record_fields = (Core.Name "fields") - -data Pattern_Typed = - Pattern_Typed { - pattern_TypedInner :: Pattern, - pattern_TypedType :: Type} - deriving (Eq, Ord, Read, Show) - -_Pattern_Typed = (Core.Name "hydra/langs/haskell/ast.Pattern.Typed") - -_Pattern_Typed_inner = (Core.Name "inner") - -_Pattern_Typed_type = (Core.Name "type") - -data PatternField = - PatternField { - patternFieldName :: Name, - patternFieldPattern :: Pattern} - deriving (Eq, Ord, Read, Show) - -_PatternField = (Core.Name "hydra/langs/haskell/ast.PatternField") - -_PatternField_name = (Core.Name "name") - -_PatternField_pattern = (Core.Name "pattern") - -data QualifiedName = - QualifiedName { - qualifiedNameQualifiers :: [NamePart], - qualifiedNameUnqualified :: NamePart} - deriving (Eq, Ord, Read, Show) - -_QualifiedName = (Core.Name "hydra/langs/haskell/ast.QualifiedName") - -_QualifiedName_qualifiers = (Core.Name "qualifiers") - -_QualifiedName_unqualified = (Core.Name "unqualified") - -newtype RightHandSide = - RightHandSide { - unRightHandSide :: Expression} - deriving (Eq, Ord, Read, Show) - -_RightHandSide = (Core.Name "hydra/langs/haskell/ast.RightHandSide") - -newtype Statement = - Statement { - unStatement :: Expression} - deriving (Eq, Ord, Read, Show) - -_Statement = (Core.Name "hydra/langs/haskell/ast.Statement") - -data Type = - TypeApplication Type_Application | - TypeCtx Type_Context | - TypeFunction Type_Function | - TypeInfix Type_Infix | - TypeList Type | - TypeParens Type | - TypeTuple [Type] | - TypeVariable Name - deriving (Eq, Ord, Read, Show) - -_Type = (Core.Name "hydra/langs/haskell/ast.Type") - -_Type_application = (Core.Name "application") - -_Type_ctx = (Core.Name "ctx") - -_Type_function = (Core.Name "function") - -_Type_infix = (Core.Name "infix") - -_Type_list = (Core.Name "list") - -_Type_parens = (Core.Name "parens") - -_Type_tuple = (Core.Name "tuple") - -_Type_variable = (Core.Name "variable") - -data Type_Application = - Type_Application { - type_ApplicationContext :: Type, - type_ApplicationArgument :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Application = (Core.Name "hydra/langs/haskell/ast.Type.Application") - -_Type_Application_context = (Core.Name "context") - -_Type_Application_argument = (Core.Name "argument") - -data Type_Context = - Type_Context { - type_ContextCtx :: Assertion, - type_ContextType :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Context = (Core.Name "hydra/langs/haskell/ast.Type.Context") - -_Type_Context_ctx = (Core.Name "ctx") - -_Type_Context_type = (Core.Name "type") - -data Type_Function = - Type_Function { - type_FunctionDomain :: Type, - type_FunctionCodomain :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Function = (Core.Name "hydra/langs/haskell/ast.Type.Function") - -_Type_Function_domain = (Core.Name "domain") - -_Type_Function_codomain = (Core.Name "codomain") - -data Type_Infix = - Type_Infix { - type_InfixLhs :: Type, - type_InfixOperator :: Operator, - type_InfixRhs :: Operator} - deriving (Eq, Ord, Read, Show) - -_Type_Infix = (Core.Name "hydra/langs/haskell/ast.Type.Infix") - -_Type_Infix_lhs = (Core.Name "lhs") - -_Type_Infix_operator = (Core.Name "operator") - -_Type_Infix_rhs = (Core.Name "rhs") - -data TypeDeclaration = - TypeDeclaration { - typeDeclarationName :: DeclarationHead, - typeDeclarationType :: Type} - deriving (Eq, Ord, Read, Show) - -_TypeDeclaration = (Core.Name "hydra/langs/haskell/ast.TypeDeclaration") - -_TypeDeclaration_name = (Core.Name "name") - -_TypeDeclaration_type = (Core.Name "type") - -data TypeSignature = - TypeSignature { - typeSignatureName :: Name, - typeSignatureType :: Type} - deriving (Eq, Ord, Read, Show) - -_TypeSignature = (Core.Name "hydra/langs/haskell/ast.TypeSignature") - -_TypeSignature_name = (Core.Name "name") - -_TypeSignature_type = (Core.Name "type") - -data TypedBinding = - TypedBinding { - typedBindingTypeSignature :: TypeSignature, - typedBindingValueBinding :: ValueBinding} - deriving (Eq, Ord, Read, Show) - -_TypedBinding = (Core.Name "hydra/langs/haskell/ast.TypedBinding") - -_TypedBinding_typeSignature = (Core.Name "typeSignature") - -_TypedBinding_valueBinding = (Core.Name "valueBinding") - -data ValueBinding = - ValueBindingSimple ValueBinding_Simple - deriving (Eq, Ord, Read, Show) - -_ValueBinding = (Core.Name "hydra/langs/haskell/ast.ValueBinding") - -_ValueBinding_simple = (Core.Name "simple") - -data ValueBinding_Simple = - ValueBinding_Simple { - valueBinding_SimplePattern :: Pattern, - valueBinding_SimpleRhs :: RightHandSide, - valueBinding_SimpleLocalBindings :: (Maybe LocalBindings)} - deriving (Eq, Ord, Read, Show) - -_ValueBinding_Simple = (Core.Name "hydra/langs/haskell/ast.ValueBinding.Simple") - -_ValueBinding_Simple_pattern = (Core.Name "pattern") - -_ValueBinding_Simple_rhs = (Core.Name "rhs") - -_ValueBinding_Simple_localBindings = (Core.Name "localBindings") - -newtype Variable = - Variable { - unVariable :: Name} - deriving (Eq, Ord, Read, Show) - -_Variable = (Core.Name "hydra/langs/haskell/ast.Variable") diff --git a/src/gen-main/haskell/Hydra/Langs/Java/Language.hs b/src/gen-main/haskell/Hydra/Langs/Java/Language.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Java/Language.hs +++ /dev/null @@ -1,237 +0,0 @@ --- | Language constraints for Java - -module Hydra.Langs.Java.Language where - -import qualified Hydra.Basics as Basics -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Lib.Equality as Equality -import qualified Hydra.Lib.Lists as Lists -import qualified Hydra.Lib.Sets as Sets -import qualified Hydra.Mantle as Mantle -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | The maximum supported length of a tuple in Hydra-Java. Note: if this constant is changed, also change Tuples.java correspondingly -javaMaxTupleLength :: Int -javaMaxTupleLength = 9 - --- | Language constraints for Java -javaLanguage :: Coders.Language -javaLanguage = Coders.Language { - Coders.languageName = (Coders.LanguageName "hydra/langs/java"), - Coders.languageConstraints = Coders.LanguageConstraints { - Coders.languageConstraintsEliminationVariants = (Sets.fromList Basics.eliminationVariants), - Coders.languageConstraintsLiteralVariants = (Sets.fromList [ - Mantle.LiteralVariantBoolean, - Mantle.LiteralVariantFloat, - Mantle.LiteralVariantInteger, - Mantle.LiteralVariantString]), - Coders.languageConstraintsFloatTypes = (Sets.fromList [ - Core.FloatTypeFloat32, - Core.FloatTypeFloat64]), - Coders.languageConstraintsFunctionVariants = (Sets.fromList Basics.functionVariants), - Coders.languageConstraintsIntegerTypes = (Sets.fromList [ - Core.IntegerTypeBigint, - Core.IntegerTypeInt16, - Core.IntegerTypeInt32, - Core.IntegerTypeInt64, - Core.IntegerTypeUint8, - Core.IntegerTypeUint16]), - Coders.languageConstraintsTermVariants = (Sets.fromList [ - Mantle.TermVariantApplication, - Mantle.TermVariantFunction, - Mantle.TermVariantLet, - Mantle.TermVariantList, - Mantle.TermVariantLiteral, - Mantle.TermVariantMap, - Mantle.TermVariantOptional, - Mantle.TermVariantProduct, - Mantle.TermVariantRecord, - Mantle.TermVariantSet, - Mantle.TermVariantUnion, - Mantle.TermVariantVariable, - Mantle.TermVariantWrap]), - Coders.languageConstraintsTypeVariants = (Sets.fromList [ - Mantle.TypeVariantAnnotated, - Mantle.TypeVariantApplication, - Mantle.TypeVariantFunction, - Mantle.TypeVariantLambda, - Mantle.TypeVariantList, - Mantle.TypeVariantLiteral, - Mantle.TypeVariantMap, - Mantle.TypeVariantOptional, - Mantle.TypeVariantProduct, - Mantle.TypeVariantRecord, - Mantle.TypeVariantSet, - Mantle.TypeVariantUnion, - Mantle.TypeVariantVariable, - Mantle.TypeVariantWrap]), - Coders.languageConstraintsTypes = (\x -> case x of - Core.TypeProduct v276 -> (Equality.ltInt32 (Lists.length v276) javaMaxTupleLength) - _ -> True)}} - --- | A set of reserved words in Java -reservedWords :: (Set String) -reservedWords = (Sets.fromList (Lists.concat [ - specialNames, - classNames, - keywords, - literals])) - where - specialNames = [ - "Elements"] - classNames = [ - "AbstractMethodError", - "Appendable", - "ArithmeticException", - "ArrayIndexOutOfBoundsException", - "ArrayStoreException", - "AssertionError", - "AutoCloseable", - "Boolean", - "BootstrapMethodError", - "Byte", - "CharSequence", - "Character", - "Class", - "ClassCastException", - "ClassCircularityError", - "ClassFormatError", - "ClassLoader", - "ClassNotFoundException", - "ClassValue", - "CloneNotSupportedException", - "Cloneable", - "Comparable", - "Compiler", - "Deprecated", - "Double", - "Enum", - "EnumConstantNotPresentException", - "Error", - "Exception", - "ExceptionInInitializerError", - "Float", - "IllegalAccessError", - "IllegalAccessException", - "IllegalArgumentException", - "IllegalMonitorStateException", - "IllegalStateException", - "IllegalThreadStateException", - "IncompatibleClassChangeError", - "IndexOutOfBoundsException", - "InheritableThreadLocal", - "InstantiationError", - "InstantiationException", - "Integer", - "InternalError", - "InterruptedException", - "Iterable", - "LinkageError", - "Long", - "Math", - "NegativeArraySizeException", - "NoClassDefFoundError", - "NoSuchFieldError", - "NoSuchFieldException", - "NoSuchMethodError", - "NoSuchMethodException", - "NullPointerException", - "Number", - "NumberFormatException", - "Object", - "OutOfMemoryError", - "Override", - "Package", - "Process", - "ProcessBuilder", - "Readable", - "ReflectiveOperationException", - "Runnable", - "Runtime", - "RuntimeException", - "RuntimePermission", - "SafeVarargs", - "SecurityException", - "SecurityManager", - "Short", - "StackOverflowError", - "StackTraceElement", - "StrictMath", - "String", - "StringBuffer", - "StringBuilder", - "StringIndexOutOfBoundsException", - "SuppressWarnings", - "System", - "Thread", - "ThreadDeath", - "ThreadGroup", - "ThreadLocal", - "Throwable", - "TypeNotPresentException", - "UnknownError", - "UnsatisfiedLinkError", - "UnsupportedClassVersionError", - "UnsupportedOperationException", - "VerifyError", - "VirtualMachineError", - "Void"] - keywords = [ - "abstract", - "assert", - "boolean", - "break", - "byte", - "case", - "catch", - "char", - "class", - "const", - "continue", - "default", - "do", - "double", - "else", - "enum", - "extends", - "final", - "finally", - "float", - "for", - "goto", - "if", - "implements", - "import", - "instanceof", - "int", - "interface", - "long", - "native", - "new", - "package", - "private", - "protected", - "public", - "return", - "short", - "static", - "strictfp", - "super", - "switch", - "synchronized", - "this", - "throw", - "throws", - "transient", - "try", - "void", - "volatile", - "while"] - literals = [ - "false", - "null", - "true"] diff --git a/src/gen-main/haskell/Hydra/Langs/Java/Syntax.hs b/src/gen-main/haskell/Hydra/Langs/Java/Syntax.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Java/Syntax.hs +++ /dev/null @@ -1,3276 +0,0 @@ --- | A Java syntax module. Based on the Oracle Java SE 12 BNF: --- | https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html --- | Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments. - -module Hydra.Langs.Java.Syntax where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype Identifier = - Identifier { - unIdentifier :: String} - deriving (Eq, Ord, Read, Show) - -_Identifier = (Core.Name "hydra/langs/java/syntax.Identifier") - -newtype TypeIdentifier = - TypeIdentifier { - unTypeIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_TypeIdentifier = (Core.Name "hydra/langs/java/syntax.TypeIdentifier") - -data Literal = - LiteralNull | - LiteralInteger IntegerLiteral | - LiteralFloatingPoint FloatingPointLiteral | - LiteralBoolean Bool | - LiteralCharacter Int | - LiteralString StringLiteral - deriving (Eq, Ord, Read, Show) - -_Literal = (Core.Name "hydra/langs/java/syntax.Literal") - -_Literal_null = (Core.Name "null") - -_Literal_integer = (Core.Name "integer") - -_Literal_floatingPoint = (Core.Name "floatingPoint") - -_Literal_boolean = (Core.Name "boolean") - -_Literal_character = (Core.Name "character") - -_Literal_string = (Core.Name "string") - --- | Note: this is an approximation which ignores encoding -newtype IntegerLiteral = - IntegerLiteral { - unIntegerLiteral :: Integer} - deriving (Eq, Ord, Read, Show) - -_IntegerLiteral = (Core.Name "hydra/langs/java/syntax.IntegerLiteral") - --- | Note: this is an approximation which ignores encoding -newtype FloatingPointLiteral = - FloatingPointLiteral { - unFloatingPointLiteral :: Double} - deriving (Eq, Ord, Read, Show) - -_FloatingPointLiteral = (Core.Name "hydra/langs/java/syntax.FloatingPointLiteral") - --- | Note: this is an approximation which ignores encoding -newtype StringLiteral = - StringLiteral { - unStringLiteral :: String} - deriving (Eq, Ord, Read, Show) - -_StringLiteral = (Core.Name "hydra/langs/java/syntax.StringLiteral") - -data Type = - TypePrimitive PrimitiveTypeWithAnnotations | - TypeReference ReferenceType - deriving (Eq, Ord, Read, Show) - -_Type = (Core.Name "hydra/langs/java/syntax.Type") - -_Type_primitive = (Core.Name "primitive") - -_Type_reference = (Core.Name "reference") - -data PrimitiveTypeWithAnnotations = - PrimitiveTypeWithAnnotations { - primitiveTypeWithAnnotationsType :: PrimitiveType, - primitiveTypeWithAnnotationsAnnotations :: [Annotation]} - deriving (Eq, Ord, Read, Show) - -_PrimitiveTypeWithAnnotations = (Core.Name "hydra/langs/java/syntax.PrimitiveTypeWithAnnotations") - -_PrimitiveTypeWithAnnotations_type = (Core.Name "type") - -_PrimitiveTypeWithAnnotations_annotations = (Core.Name "annotations") - -data PrimitiveType = - PrimitiveTypeNumeric NumericType | - PrimitiveTypeBoolean - deriving (Eq, Ord, Read, Show) - -_PrimitiveType = (Core.Name "hydra/langs/java/syntax.PrimitiveType") - -_PrimitiveType_numeric = (Core.Name "numeric") - -_PrimitiveType_boolean = (Core.Name "boolean") - -data NumericType = - NumericTypeIntegral IntegralType | - NumericTypeFloatingPoint FloatingPointType - deriving (Eq, Ord, Read, Show) - -_NumericType = (Core.Name "hydra/langs/java/syntax.NumericType") - -_NumericType_integral = (Core.Name "integral") - -_NumericType_floatingPoint = (Core.Name "floatingPoint") - -data IntegralType = - IntegralTypeByte | - IntegralTypeShort | - IntegralTypeInt | - IntegralTypeLong | - IntegralTypeChar - deriving (Eq, Ord, Read, Show) - -_IntegralType = (Core.Name "hydra/langs/java/syntax.IntegralType") - -_IntegralType_byte = (Core.Name "byte") - -_IntegralType_short = (Core.Name "short") - -_IntegralType_int = (Core.Name "int") - -_IntegralType_long = (Core.Name "long") - -_IntegralType_char = (Core.Name "char") - -data FloatingPointType = - FloatingPointTypeFloat | - FloatingPointTypeDouble - deriving (Eq, Ord, Read, Show) - -_FloatingPointType = (Core.Name "hydra/langs/java/syntax.FloatingPointType") - -_FloatingPointType_float = (Core.Name "float") - -_FloatingPointType_double = (Core.Name "double") - -data ReferenceType = - ReferenceTypeClassOrInterface ClassOrInterfaceType | - ReferenceTypeVariable TypeVariable | - ReferenceTypeArray ArrayType - deriving (Eq, Ord, Read, Show) - -_ReferenceType = (Core.Name "hydra/langs/java/syntax.ReferenceType") - -_ReferenceType_classOrInterface = (Core.Name "classOrInterface") - -_ReferenceType_variable = (Core.Name "variable") - -_ReferenceType_array = (Core.Name "array") - -data ClassOrInterfaceType = - ClassOrInterfaceTypeClass ClassType | - ClassOrInterfaceTypeInterface InterfaceType - deriving (Eq, Ord, Read, Show) - -_ClassOrInterfaceType = (Core.Name "hydra/langs/java/syntax.ClassOrInterfaceType") - -_ClassOrInterfaceType_class = (Core.Name "class") - -_ClassOrInterfaceType_interface = (Core.Name "interface") - -data ClassType = - ClassType { - classTypeAnnotations :: [Annotation], - classTypeQualifier :: ClassTypeQualifier, - classTypeIdentifier :: TypeIdentifier, - classTypeArguments :: [TypeArgument]} - deriving (Eq, Ord, Read, Show) - -_ClassType = (Core.Name "hydra/langs/java/syntax.ClassType") - -_ClassType_annotations = (Core.Name "annotations") - -_ClassType_qualifier = (Core.Name "qualifier") - -_ClassType_identifier = (Core.Name "identifier") - -_ClassType_arguments = (Core.Name "arguments") - -data ClassTypeQualifier = - ClassTypeQualifierNone | - ClassTypeQualifierPackage PackageName | - ClassTypeQualifierParent ClassOrInterfaceType - deriving (Eq, Ord, Read, Show) - -_ClassTypeQualifier = (Core.Name "hydra/langs/java/syntax.ClassTypeQualifier") - -_ClassTypeQualifier_none = (Core.Name "none") - -_ClassTypeQualifier_package = (Core.Name "package") - -_ClassTypeQualifier_parent = (Core.Name "parent") - -newtype InterfaceType = - InterfaceType { - unInterfaceType :: ClassType} - deriving (Eq, Ord, Read, Show) - -_InterfaceType = (Core.Name "hydra/langs/java/syntax.InterfaceType") - -data TypeVariable = - TypeVariable { - typeVariableAnnotations :: [Annotation], - typeVariableIdentifier :: TypeIdentifier} - deriving (Eq, Ord, Read, Show) - -_TypeVariable = (Core.Name "hydra/langs/java/syntax.TypeVariable") - -_TypeVariable_annotations = (Core.Name "annotations") - -_TypeVariable_identifier = (Core.Name "identifier") - -data ArrayType = - ArrayType { - arrayTypeDims :: Dims, - arrayTypeVariant :: ArrayType_Variant} - deriving (Eq, Ord, Read, Show) - -_ArrayType = (Core.Name "hydra/langs/java/syntax.ArrayType") - -_ArrayType_dims = (Core.Name "dims") - -_ArrayType_variant = (Core.Name "variant") - -data ArrayType_Variant = - ArrayType_VariantPrimitive PrimitiveTypeWithAnnotations | - ArrayType_VariantClassOrInterface ClassOrInterfaceType | - ArrayType_VariantVariable TypeVariable - deriving (Eq, Ord, Read, Show) - -_ArrayType_Variant = (Core.Name "hydra/langs/java/syntax.ArrayType.Variant") - -_ArrayType_Variant_primitive = (Core.Name "primitive") - -_ArrayType_Variant_classOrInterface = (Core.Name "classOrInterface") - -_ArrayType_Variant_variable = (Core.Name "variable") - -newtype Dims = - Dims { - unDims :: [[Annotation]]} - deriving (Eq, Ord, Read, Show) - -_Dims = (Core.Name "hydra/langs/java/syntax.Dims") - -data TypeParameter = - TypeParameter { - typeParameterModifiers :: [TypeParameterModifier], - typeParameterIdentifier :: TypeIdentifier, - typeParameterBound :: (Maybe TypeBound)} - deriving (Eq, Ord, Read, Show) - -_TypeParameter = (Core.Name "hydra/langs/java/syntax.TypeParameter") - -_TypeParameter_modifiers = (Core.Name "modifiers") - -_TypeParameter_identifier = (Core.Name "identifier") - -_TypeParameter_bound = (Core.Name "bound") - -newtype TypeParameterModifier = - TypeParameterModifier { - unTypeParameterModifier :: Annotation} - deriving (Eq, Ord, Read, Show) - -_TypeParameterModifier = (Core.Name "hydra/langs/java/syntax.TypeParameterModifier") - -data TypeBound = - TypeBoundVariable TypeVariable | - TypeBoundClassOrInterface TypeBound_ClassOrInterface - deriving (Eq, Ord, Read, Show) - -_TypeBound = (Core.Name "hydra/langs/java/syntax.TypeBound") - -_TypeBound_variable = (Core.Name "variable") - -_TypeBound_classOrInterface = (Core.Name "classOrInterface") - -data TypeBound_ClassOrInterface = - TypeBound_ClassOrInterface { - typeBound_ClassOrInterfaceType :: ClassOrInterfaceType, - typeBound_ClassOrInterfaceAdditional :: [AdditionalBound]} - deriving (Eq, Ord, Read, Show) - -_TypeBound_ClassOrInterface = (Core.Name "hydra/langs/java/syntax.TypeBound.ClassOrInterface") - -_TypeBound_ClassOrInterface_type = (Core.Name "type") - -_TypeBound_ClassOrInterface_additional = (Core.Name "additional") - -newtype AdditionalBound = - AdditionalBound { - unAdditionalBound :: InterfaceType} - deriving (Eq, Ord, Read, Show) - -_AdditionalBound = (Core.Name "hydra/langs/java/syntax.AdditionalBound") - -data TypeArgument = - TypeArgumentReference ReferenceType | - TypeArgumentWildcard Wildcard - deriving (Eq, Ord, Read, Show) - -_TypeArgument = (Core.Name "hydra/langs/java/syntax.TypeArgument") - -_TypeArgument_reference = (Core.Name "reference") - -_TypeArgument_wildcard = (Core.Name "wildcard") - -data Wildcard = - Wildcard { - wildcardAnnotations :: [Annotation], - wildcardWildcard :: (Maybe WildcardBounds)} - deriving (Eq, Ord, Read, Show) - -_Wildcard = (Core.Name "hydra/langs/java/syntax.Wildcard") - -_Wildcard_annotations = (Core.Name "annotations") - -_Wildcard_wildcard = (Core.Name "wildcard") - -data WildcardBounds = - WildcardBoundsExtends ReferenceType | - WildcardBoundsSuper ReferenceType - deriving (Eq, Ord, Read, Show) - -_WildcardBounds = (Core.Name "hydra/langs/java/syntax.WildcardBounds") - -_WildcardBounds_extends = (Core.Name "extends") - -_WildcardBounds_super = (Core.Name "super") - -data ModuleName = - ModuleName { - moduleNameIdentifier :: Identifier, - moduleNameName :: (Maybe ModuleName)} - deriving (Eq, Ord, Read, Show) - -_ModuleName = (Core.Name "hydra/langs/java/syntax.ModuleName") - -_ModuleName_identifier = (Core.Name "identifier") - -_ModuleName_name = (Core.Name "name") - -newtype PackageName = - PackageName { - unPackageName :: [Identifier]} - deriving (Eq, Ord, Read, Show) - -_PackageName = (Core.Name "hydra/langs/java/syntax.PackageName") - -data TypeName = - TypeName { - typeNameIdentifier :: TypeIdentifier, - typeNameQualifier :: (Maybe PackageOrTypeName)} - deriving (Eq, Ord, Read, Show) - -_TypeName = (Core.Name "hydra/langs/java/syntax.TypeName") - -_TypeName_identifier = (Core.Name "identifier") - -_TypeName_qualifier = (Core.Name "qualifier") - -data ExpressionName = - ExpressionName { - expressionNameQualifier :: (Maybe AmbiguousName), - expressionNameIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_ExpressionName = (Core.Name "hydra/langs/java/syntax.ExpressionName") - -_ExpressionName_qualifier = (Core.Name "qualifier") - -_ExpressionName_identifier = (Core.Name "identifier") - -newtype MethodName = - MethodName { - unMethodName :: Identifier} - deriving (Eq, Ord, Read, Show) - -_MethodName = (Core.Name "hydra/langs/java/syntax.MethodName") - -newtype PackageOrTypeName = - PackageOrTypeName { - unPackageOrTypeName :: [Identifier]} - deriving (Eq, Ord, Read, Show) - -_PackageOrTypeName = (Core.Name "hydra/langs/java/syntax.PackageOrTypeName") - -newtype AmbiguousName = - AmbiguousName { - unAmbiguousName :: [Identifier]} - deriving (Eq, Ord, Read, Show) - -_AmbiguousName = (Core.Name "hydra/langs/java/syntax.AmbiguousName") - -data CompilationUnit = - CompilationUnitOrdinary OrdinaryCompilationUnit | - CompilationUnitModular ModularCompilationUnit - deriving (Eq, Ord, Read, Show) - -_CompilationUnit = (Core.Name "hydra/langs/java/syntax.CompilationUnit") - -_CompilationUnit_ordinary = (Core.Name "ordinary") - -_CompilationUnit_modular = (Core.Name "modular") - -data OrdinaryCompilationUnit = - OrdinaryCompilationUnit { - ordinaryCompilationUnitPackage :: (Maybe PackageDeclaration), - ordinaryCompilationUnitImports :: [ImportDeclaration], - ordinaryCompilationUnitTypes :: [TypeDeclarationWithComments]} - deriving (Eq, Ord, Read, Show) - -_OrdinaryCompilationUnit = (Core.Name "hydra/langs/java/syntax.OrdinaryCompilationUnit") - -_OrdinaryCompilationUnit_package = (Core.Name "package") - -_OrdinaryCompilationUnit_imports = (Core.Name "imports") - -_OrdinaryCompilationUnit_types = (Core.Name "types") - -data ModularCompilationUnit = - ModularCompilationUnit { - modularCompilationUnitImports :: [ImportDeclaration], - modularCompilationUnitModule :: ModuleDeclaration} - deriving (Eq, Ord, Read, Show) - -_ModularCompilationUnit = (Core.Name "hydra/langs/java/syntax.ModularCompilationUnit") - -_ModularCompilationUnit_imports = (Core.Name "imports") - -_ModularCompilationUnit_module = (Core.Name "module") - -data PackageDeclaration = - PackageDeclaration { - packageDeclarationModifiers :: [PackageModifier], - packageDeclarationIdentifiers :: [Identifier]} - deriving (Eq, Ord, Read, Show) - -_PackageDeclaration = (Core.Name "hydra/langs/java/syntax.PackageDeclaration") - -_PackageDeclaration_modifiers = (Core.Name "modifiers") - -_PackageDeclaration_identifiers = (Core.Name "identifiers") - -newtype PackageModifier = - PackageModifier { - unPackageModifier :: Annotation} - deriving (Eq, Ord, Read, Show) - -_PackageModifier = (Core.Name "hydra/langs/java/syntax.PackageModifier") - -data ImportDeclaration = - ImportDeclarationSingleType SingleTypeImportDeclaration | - ImportDeclarationTypeImportOnDemand TypeImportOnDemandDeclaration | - ImportDeclarationSingleStaticImport SingleStaticImportDeclaration | - ImportDeclarationStaticImportOnDemand StaticImportOnDemandDeclaration - deriving (Eq, Ord, Read, Show) - -_ImportDeclaration = (Core.Name "hydra/langs/java/syntax.ImportDeclaration") - -_ImportDeclaration_singleType = (Core.Name "singleType") - -_ImportDeclaration_typeImportOnDemand = (Core.Name "typeImportOnDemand") - -_ImportDeclaration_singleStaticImport = (Core.Name "singleStaticImport") - -_ImportDeclaration_staticImportOnDemand = (Core.Name "staticImportOnDemand") - -newtype SingleTypeImportDeclaration = - SingleTypeImportDeclaration { - unSingleTypeImportDeclaration :: TypeName} - deriving (Eq, Ord, Read, Show) - -_SingleTypeImportDeclaration = (Core.Name "hydra/langs/java/syntax.SingleTypeImportDeclaration") - -newtype TypeImportOnDemandDeclaration = - TypeImportOnDemandDeclaration { - unTypeImportOnDemandDeclaration :: PackageOrTypeName} - deriving (Eq, Ord, Read, Show) - -_TypeImportOnDemandDeclaration = (Core.Name "hydra/langs/java/syntax.TypeImportOnDemandDeclaration") - -data SingleStaticImportDeclaration = - SingleStaticImportDeclaration { - singleStaticImportDeclarationTypeName :: TypeName, - singleStaticImportDeclarationIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_SingleStaticImportDeclaration = (Core.Name "hydra/langs/java/syntax.SingleStaticImportDeclaration") - -_SingleStaticImportDeclaration_typeName = (Core.Name "typeName") - -_SingleStaticImportDeclaration_identifier = (Core.Name "identifier") - -newtype StaticImportOnDemandDeclaration = - StaticImportOnDemandDeclaration { - unStaticImportOnDemandDeclaration :: TypeName} - deriving (Eq, Ord, Read, Show) - -_StaticImportOnDemandDeclaration = (Core.Name "hydra/langs/java/syntax.StaticImportOnDemandDeclaration") - -data TypeDeclaration = - TypeDeclarationClass ClassDeclaration | - TypeDeclarationInterface InterfaceDeclaration | - TypeDeclarationNone - deriving (Eq, Ord, Read, Show) - -_TypeDeclaration = (Core.Name "hydra/langs/java/syntax.TypeDeclaration") - -_TypeDeclaration_class = (Core.Name "class") - -_TypeDeclaration_interface = (Core.Name "interface") - -_TypeDeclaration_none = (Core.Name "none") - -data TypeDeclarationWithComments = - TypeDeclarationWithComments { - typeDeclarationWithCommentsValue :: TypeDeclaration, - typeDeclarationWithCommentsComments :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_TypeDeclarationWithComments = (Core.Name "hydra/langs/java/syntax.TypeDeclarationWithComments") - -_TypeDeclarationWithComments_value = (Core.Name "value") - -_TypeDeclarationWithComments_comments = (Core.Name "comments") - -data ModuleDeclaration = - ModuleDeclaration { - moduleDeclarationAnnotations :: [Annotation], - moduleDeclarationOpen :: Bool, - moduleDeclarationIdentifiers :: [Identifier], - moduleDeclarationDirectives :: [[ModuleDirective]]} - deriving (Eq, Ord, Read, Show) - -_ModuleDeclaration = (Core.Name "hydra/langs/java/syntax.ModuleDeclaration") - -_ModuleDeclaration_annotations = (Core.Name "annotations") - -_ModuleDeclaration_open = (Core.Name "open") - -_ModuleDeclaration_identifiers = (Core.Name "identifiers") - -_ModuleDeclaration_directives = (Core.Name "directives") - -data ModuleDirective = - ModuleDirectiveRequires ModuleDirective_Requires | - ModuleDirectiveExports ModuleDirective_ExportsOrOpens | - ModuleDirectiveOpens ModuleDirective_ExportsOrOpens | - ModuleDirectiveUses TypeName | - ModuleDirectiveProvides ModuleDirective_Provides - deriving (Eq, Ord, Read, Show) - -_ModuleDirective = (Core.Name "hydra/langs/java/syntax.ModuleDirective") - -_ModuleDirective_requires = (Core.Name "requires") - -_ModuleDirective_exports = (Core.Name "exports") - -_ModuleDirective_opens = (Core.Name "opens") - -_ModuleDirective_uses = (Core.Name "uses") - -_ModuleDirective_provides = (Core.Name "provides") - -data ModuleDirective_Requires = - ModuleDirective_Requires { - moduleDirective_RequiresModifiers :: [RequiresModifier], - moduleDirective_RequiresModule :: ModuleName} - deriving (Eq, Ord, Read, Show) - -_ModuleDirective_Requires = (Core.Name "hydra/langs/java/syntax.ModuleDirective.Requires") - -_ModuleDirective_Requires_modifiers = (Core.Name "modifiers") - -_ModuleDirective_Requires_module = (Core.Name "module") - -data ModuleDirective_ExportsOrOpens = - ModuleDirective_ExportsOrOpens { - moduleDirective_ExportsOrOpensPackage :: PackageName, - -- | At least one module - moduleDirective_ExportsOrOpensModules :: [ModuleName]} - deriving (Eq, Ord, Read, Show) - -_ModuleDirective_ExportsOrOpens = (Core.Name "hydra/langs/java/syntax.ModuleDirective.ExportsOrOpens") - -_ModuleDirective_ExportsOrOpens_package = (Core.Name "package") - -_ModuleDirective_ExportsOrOpens_modules = (Core.Name "modules") - -data ModuleDirective_Provides = - ModuleDirective_Provides { - moduleDirective_ProvidesTo :: TypeName, - -- | At least one type - moduleDirective_ProvidesWith :: [TypeName]} - deriving (Eq, Ord, Read, Show) - -_ModuleDirective_Provides = (Core.Name "hydra/langs/java/syntax.ModuleDirective.Provides") - -_ModuleDirective_Provides_to = (Core.Name "to") - -_ModuleDirective_Provides_with = (Core.Name "with") - -data RequiresModifier = - RequiresModifierTransitive | - RequiresModifierStatic - deriving (Eq, Ord, Read, Show) - -_RequiresModifier = (Core.Name "hydra/langs/java/syntax.RequiresModifier") - -_RequiresModifier_transitive = (Core.Name "transitive") - -_RequiresModifier_static = (Core.Name "static") - -data ClassDeclaration = - ClassDeclarationNormal NormalClassDeclaration | - ClassDeclarationEnum EnumDeclaration - deriving (Eq, Ord, Read, Show) - -_ClassDeclaration = (Core.Name "hydra/langs/java/syntax.ClassDeclaration") - -_ClassDeclaration_normal = (Core.Name "normal") - -_ClassDeclaration_enum = (Core.Name "enum") - -data NormalClassDeclaration = - NormalClassDeclaration { - normalClassDeclarationModifiers :: [ClassModifier], - normalClassDeclarationIdentifier :: TypeIdentifier, - normalClassDeclarationParameters :: [TypeParameter], - normalClassDeclarationExtends :: (Maybe ClassType), - normalClassDeclarationImplements :: [InterfaceType], - normalClassDeclarationBody :: ClassBody} - deriving (Eq, Ord, Read, Show) - -_NormalClassDeclaration = (Core.Name "hydra/langs/java/syntax.NormalClassDeclaration") - -_NormalClassDeclaration_modifiers = (Core.Name "modifiers") - -_NormalClassDeclaration_identifier = (Core.Name "identifier") - -_NormalClassDeclaration_parameters = (Core.Name "parameters") - -_NormalClassDeclaration_extends = (Core.Name "extends") - -_NormalClassDeclaration_implements = (Core.Name "implements") - -_NormalClassDeclaration_body = (Core.Name "body") - -data ClassModifier = - ClassModifierAnnotation Annotation | - ClassModifierPublic | - ClassModifierProtected | - ClassModifierPrivate | - ClassModifierAbstract | - ClassModifierStatic | - ClassModifierFinal | - ClassModifierStrictfp - deriving (Eq, Ord, Read, Show) - -_ClassModifier = (Core.Name "hydra/langs/java/syntax.ClassModifier") - -_ClassModifier_annotation = (Core.Name "annotation") - -_ClassModifier_public = (Core.Name "public") - -_ClassModifier_protected = (Core.Name "protected") - -_ClassModifier_private = (Core.Name "private") - -_ClassModifier_abstract = (Core.Name "abstract") - -_ClassModifier_static = (Core.Name "static") - -_ClassModifier_final = (Core.Name "final") - -_ClassModifier_strictfp = (Core.Name "strictfp") - -newtype ClassBody = - ClassBody { - unClassBody :: [ClassBodyDeclarationWithComments]} - deriving (Eq, Ord, Read, Show) - -_ClassBody = (Core.Name "hydra/langs/java/syntax.ClassBody") - -data ClassBodyDeclaration = - ClassBodyDeclarationClassMember ClassMemberDeclaration | - ClassBodyDeclarationInstanceInitializer InstanceInitializer | - ClassBodyDeclarationStaticInitializer StaticInitializer | - ClassBodyDeclarationConstructorDeclaration ConstructorDeclaration - deriving (Eq, Ord, Read, Show) - -_ClassBodyDeclaration = (Core.Name "hydra/langs/java/syntax.ClassBodyDeclaration") - -_ClassBodyDeclaration_classMember = (Core.Name "classMember") - -_ClassBodyDeclaration_instanceInitializer = (Core.Name "instanceInitializer") - -_ClassBodyDeclaration_staticInitializer = (Core.Name "staticInitializer") - -_ClassBodyDeclaration_constructorDeclaration = (Core.Name "constructorDeclaration") - -data ClassBodyDeclarationWithComments = - ClassBodyDeclarationWithComments { - classBodyDeclarationWithCommentsValue :: ClassBodyDeclaration, - classBodyDeclarationWithCommentsComments :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_ClassBodyDeclarationWithComments = (Core.Name "hydra/langs/java/syntax.ClassBodyDeclarationWithComments") - -_ClassBodyDeclarationWithComments_value = (Core.Name "value") - -_ClassBodyDeclarationWithComments_comments = (Core.Name "comments") - -data ClassMemberDeclaration = - ClassMemberDeclarationField FieldDeclaration | - ClassMemberDeclarationMethod MethodDeclaration | - ClassMemberDeclarationClass ClassDeclaration | - ClassMemberDeclarationInterface InterfaceDeclaration | - ClassMemberDeclarationNone - deriving (Eq, Ord, Read, Show) - -_ClassMemberDeclaration = (Core.Name "hydra/langs/java/syntax.ClassMemberDeclaration") - -_ClassMemberDeclaration_field = (Core.Name "field") - -_ClassMemberDeclaration_method = (Core.Name "method") - -_ClassMemberDeclaration_class = (Core.Name "class") - -_ClassMemberDeclaration_interface = (Core.Name "interface") - -_ClassMemberDeclaration_none = (Core.Name "none") - -data FieldDeclaration = - FieldDeclaration { - fieldDeclarationModifiers :: [FieldModifier], - fieldDeclarationUnannType :: UnannType, - fieldDeclarationVariableDeclarators :: [VariableDeclarator]} - deriving (Eq, Ord, Read, Show) - -_FieldDeclaration = (Core.Name "hydra/langs/java/syntax.FieldDeclaration") - -_FieldDeclaration_modifiers = (Core.Name "modifiers") - -_FieldDeclaration_unannType = (Core.Name "unannType") - -_FieldDeclaration_variableDeclarators = (Core.Name "variableDeclarators") - -data FieldModifier = - FieldModifierAnnotation Annotation | - FieldModifierPublic | - FieldModifierProtected | - FieldModifierPrivate | - FieldModifierStatic | - FieldModifierFinal | - FieldModifierTransient | - FieldModifierVolatile - deriving (Eq, Ord, Read, Show) - -_FieldModifier = (Core.Name "hydra/langs/java/syntax.FieldModifier") - -_FieldModifier_annotation = (Core.Name "annotation") - -_FieldModifier_public = (Core.Name "public") - -_FieldModifier_protected = (Core.Name "protected") - -_FieldModifier_private = (Core.Name "private") - -_FieldModifier_static = (Core.Name "static") - -_FieldModifier_final = (Core.Name "final") - -_FieldModifier_transient = (Core.Name "transient") - -_FieldModifier_volatile = (Core.Name "volatile") - -data VariableDeclarator = - VariableDeclarator { - variableDeclaratorId :: VariableDeclaratorId, - variableDeclaratorInitializer :: (Maybe VariableInitializer)} - deriving (Eq, Ord, Read, Show) - -_VariableDeclarator = (Core.Name "hydra/langs/java/syntax.VariableDeclarator") - -_VariableDeclarator_id = (Core.Name "id") - -_VariableDeclarator_initializer = (Core.Name "initializer") - -data VariableDeclaratorId = - VariableDeclaratorId { - variableDeclaratorIdIdentifier :: Identifier, - variableDeclaratorIdDims :: (Maybe Dims)} - deriving (Eq, Ord, Read, Show) - -_VariableDeclaratorId = (Core.Name "hydra/langs/java/syntax.VariableDeclaratorId") - -_VariableDeclaratorId_identifier = (Core.Name "identifier") - -_VariableDeclaratorId_dims = (Core.Name "dims") - -data VariableInitializer = - VariableInitializerExpression Expression | - VariableInitializerArrayInitializer ArrayInitializer - deriving (Eq, Ord, Read, Show) - -_VariableInitializer = (Core.Name "hydra/langs/java/syntax.VariableInitializer") - -_VariableInitializer_expression = (Core.Name "expression") - -_VariableInitializer_arrayInitializer = (Core.Name "arrayInitializer") - --- | A Type which does not allow annotations -newtype UnannType = - UnannType { - unUnannType :: Type} - deriving (Eq, Ord, Read, Show) - -_UnannType = (Core.Name "hydra/langs/java/syntax.UnannType") - --- | A ClassType which does not allow annotations -newtype UnannClassType = - UnannClassType { - unUnannClassType :: ClassType} - deriving (Eq, Ord, Read, Show) - -_UnannClassType = (Core.Name "hydra/langs/java/syntax.UnannClassType") - -data MethodDeclaration = - MethodDeclaration { - -- | Note: simple methods cannot have annotations - methodDeclarationAnnotations :: [Annotation], - methodDeclarationModifiers :: [MethodModifier], - methodDeclarationHeader :: MethodHeader, - methodDeclarationBody :: MethodBody} - deriving (Eq, Ord, Read, Show) - -_MethodDeclaration = (Core.Name "hydra/langs/java/syntax.MethodDeclaration") - -_MethodDeclaration_annotations = (Core.Name "annotations") - -_MethodDeclaration_modifiers = (Core.Name "modifiers") - -_MethodDeclaration_header = (Core.Name "header") - -_MethodDeclaration_body = (Core.Name "body") - -data MethodModifier = - MethodModifierAnnotation Annotation | - MethodModifierPublic | - MethodModifierProtected | - MethodModifierPrivate | - MethodModifierAbstract | - MethodModifierStatic | - MethodModifierFinal | - MethodModifierSynchronized | - MethodModifierNative | - MethodModifierStrictfb - deriving (Eq, Ord, Read, Show) - -_MethodModifier = (Core.Name "hydra/langs/java/syntax.MethodModifier") - -_MethodModifier_annotation = (Core.Name "annotation") - -_MethodModifier_public = (Core.Name "public") - -_MethodModifier_protected = (Core.Name "protected") - -_MethodModifier_private = (Core.Name "private") - -_MethodModifier_abstract = (Core.Name "abstract") - -_MethodModifier_static = (Core.Name "static") - -_MethodModifier_final = (Core.Name "final") - -_MethodModifier_synchronized = (Core.Name "synchronized") - -_MethodModifier_native = (Core.Name "native") - -_MethodModifier_strictfb = (Core.Name "strictfb") - -data MethodHeader = - MethodHeader { - methodHeaderParameters :: [TypeParameter], - methodHeaderResult :: Result, - methodHeaderDeclarator :: MethodDeclarator, - methodHeaderThrows :: (Maybe Throws)} - deriving (Eq, Ord, Read, Show) - -_MethodHeader = (Core.Name "hydra/langs/java/syntax.MethodHeader") - -_MethodHeader_parameters = (Core.Name "parameters") - -_MethodHeader_result = (Core.Name "result") - -_MethodHeader_declarator = (Core.Name "declarator") - -_MethodHeader_throws = (Core.Name "throws") - -data Result = - ResultType UnannType | - ResultVoid - deriving (Eq, Ord, Read, Show) - -_Result = (Core.Name "hydra/langs/java/syntax.Result") - -_Result_type = (Core.Name "type") - -_Result_void = (Core.Name "void") - -data MethodDeclarator = - MethodDeclarator { - methodDeclaratorIdentifier :: Identifier, - methodDeclaratorReceiverParameter :: (Maybe ReceiverParameter), - methodDeclaratorFormalParameters :: [FormalParameter]} - deriving (Eq, Ord, Read, Show) - -_MethodDeclarator = (Core.Name "hydra/langs/java/syntax.MethodDeclarator") - -_MethodDeclarator_identifier = (Core.Name "identifier") - -_MethodDeclarator_receiverParameter = (Core.Name "receiverParameter") - -_MethodDeclarator_formalParameters = (Core.Name "formalParameters") - -data ReceiverParameter = - ReceiverParameter { - receiverParameterAnnotations :: [Annotation], - receiverParameterUnannType :: UnannType, - receiverParameterIdentifier :: (Maybe Identifier)} - deriving (Eq, Ord, Read, Show) - -_ReceiverParameter = (Core.Name "hydra/langs/java/syntax.ReceiverParameter") - -_ReceiverParameter_annotations = (Core.Name "annotations") - -_ReceiverParameter_unannType = (Core.Name "unannType") - -_ReceiverParameter_identifier = (Core.Name "identifier") - -data FormalParameter = - FormalParameterSimple FormalParameter_Simple | - FormalParameterVariableArity VariableArityParameter - deriving (Eq, Ord, Read, Show) - -_FormalParameter = (Core.Name "hydra/langs/java/syntax.FormalParameter") - -_FormalParameter_simple = (Core.Name "simple") - -_FormalParameter_variableArity = (Core.Name "variableArity") - -data FormalParameter_Simple = - FormalParameter_Simple { - formalParameter_SimpleModifiers :: [VariableModifier], - formalParameter_SimpleType :: UnannType, - formalParameter_SimpleId :: VariableDeclaratorId} - deriving (Eq, Ord, Read, Show) - -_FormalParameter_Simple = (Core.Name "hydra/langs/java/syntax.FormalParameter.Simple") - -_FormalParameter_Simple_modifiers = (Core.Name "modifiers") - -_FormalParameter_Simple_type = (Core.Name "type") - -_FormalParameter_Simple_id = (Core.Name "id") - -data VariableArityParameter = - VariableArityParameter { - variableArityParameterModifiers :: VariableModifier, - variableArityParameterType :: UnannType, - variableArityParameterAnnotations :: [Annotation], - variableArityParameterIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_VariableArityParameter = (Core.Name "hydra/langs/java/syntax.VariableArityParameter") - -_VariableArityParameter_modifiers = (Core.Name "modifiers") - -_VariableArityParameter_type = (Core.Name "type") - -_VariableArityParameter_annotations = (Core.Name "annotations") - -_VariableArityParameter_identifier = (Core.Name "identifier") - -data VariableModifier = - VariableModifierAnnotation Annotation | - VariableModifierFinal - deriving (Eq, Ord, Read, Show) - -_VariableModifier = (Core.Name "hydra/langs/java/syntax.VariableModifier") - -_VariableModifier_annotation = (Core.Name "annotation") - -_VariableModifier_final = (Core.Name "final") - -newtype Throws = - Throws { - unThrows :: [ExceptionType]} - deriving (Eq, Ord, Read, Show) - -_Throws = (Core.Name "hydra/langs/java/syntax.Throws") - -data ExceptionType = - ExceptionTypeClass ClassType | - ExceptionTypeVariable TypeVariable - deriving (Eq, Ord, Read, Show) - -_ExceptionType = (Core.Name "hydra/langs/java/syntax.ExceptionType") - -_ExceptionType_class = (Core.Name "class") - -_ExceptionType_variable = (Core.Name "variable") - -data MethodBody = - MethodBodyBlock Block | - MethodBodyNone - deriving (Eq, Ord, Read, Show) - -_MethodBody = (Core.Name "hydra/langs/java/syntax.MethodBody") - -_MethodBody_block = (Core.Name "block") - -_MethodBody_none = (Core.Name "none") - -newtype InstanceInitializer = - InstanceInitializer { - unInstanceInitializer :: Block} - deriving (Eq, Ord, Read, Show) - -_InstanceInitializer = (Core.Name "hydra/langs/java/syntax.InstanceInitializer") - -newtype StaticInitializer = - StaticInitializer { - unStaticInitializer :: Block} - deriving (Eq, Ord, Read, Show) - -_StaticInitializer = (Core.Name "hydra/langs/java/syntax.StaticInitializer") - -data ConstructorDeclaration = - ConstructorDeclaration { - constructorDeclarationModifiers :: [ConstructorModifier], - constructorDeclarationConstructor :: ConstructorDeclarator, - constructorDeclarationThrows :: (Maybe Throws), - constructorDeclarationBody :: ConstructorBody} - deriving (Eq, Ord, Read, Show) - -_ConstructorDeclaration = (Core.Name "hydra/langs/java/syntax.ConstructorDeclaration") - -_ConstructorDeclaration_modifiers = (Core.Name "modifiers") - -_ConstructorDeclaration_constructor = (Core.Name "constructor") - -_ConstructorDeclaration_throws = (Core.Name "throws") - -_ConstructorDeclaration_body = (Core.Name "body") - -data ConstructorModifier = - ConstructorModifierAnnotation Annotation | - ConstructorModifierPublic | - ConstructorModifierProtected | - ConstructorModifierPrivate - deriving (Eq, Ord, Read, Show) - -_ConstructorModifier = (Core.Name "hydra/langs/java/syntax.ConstructorModifier") - -_ConstructorModifier_annotation = (Core.Name "annotation") - -_ConstructorModifier_public = (Core.Name "public") - -_ConstructorModifier_protected = (Core.Name "protected") - -_ConstructorModifier_private = (Core.Name "private") - -data ConstructorDeclarator = - ConstructorDeclarator { - constructorDeclaratorParameters :: [TypeParameter], - constructorDeclaratorName :: SimpleTypeName, - constructorDeclaratorReceiverParameter :: (Maybe ReceiverParameter), - constructorDeclaratorFormalParameters :: [FormalParameter]} - deriving (Eq, Ord, Read, Show) - -_ConstructorDeclarator = (Core.Name "hydra/langs/java/syntax.ConstructorDeclarator") - -_ConstructorDeclarator_parameters = (Core.Name "parameters") - -_ConstructorDeclarator_name = (Core.Name "name") - -_ConstructorDeclarator_receiverParameter = (Core.Name "receiverParameter") - -_ConstructorDeclarator_formalParameters = (Core.Name "formalParameters") - -newtype SimpleTypeName = - SimpleTypeName { - unSimpleTypeName :: TypeIdentifier} - deriving (Eq, Ord, Read, Show) - -_SimpleTypeName = (Core.Name "hydra/langs/java/syntax.SimpleTypeName") - -data ConstructorBody = - ConstructorBody { - constructorBodyInvocation :: (Maybe ExplicitConstructorInvocation), - constructorBodyStatements :: [BlockStatement]} - deriving (Eq, Ord, Read, Show) - -_ConstructorBody = (Core.Name "hydra/langs/java/syntax.ConstructorBody") - -_ConstructorBody_invocation = (Core.Name "invocation") - -_ConstructorBody_statements = (Core.Name "statements") - -data ExplicitConstructorInvocation = - ExplicitConstructorInvocation { - explicitConstructorInvocationTypeArguments :: [TypeArgument], - explicitConstructorInvocationArguments :: [Expression], - explicitConstructorInvocationVariant :: ExplicitConstructorInvocation_Variant} - deriving (Eq, Ord, Read, Show) - -_ExplicitConstructorInvocation = (Core.Name "hydra/langs/java/syntax.ExplicitConstructorInvocation") - -_ExplicitConstructorInvocation_typeArguments = (Core.Name "typeArguments") - -_ExplicitConstructorInvocation_arguments = (Core.Name "arguments") - -_ExplicitConstructorInvocation_variant = (Core.Name "variant") - -data ExplicitConstructorInvocation_Variant = - ExplicitConstructorInvocation_VariantThis | - ExplicitConstructorInvocation_VariantSuper (Maybe ExpressionName) | - ExplicitConstructorInvocation_VariantPrimary Primary - deriving (Eq, Ord, Read, Show) - -_ExplicitConstructorInvocation_Variant = (Core.Name "hydra/langs/java/syntax.ExplicitConstructorInvocation.Variant") - -_ExplicitConstructorInvocation_Variant_this = (Core.Name "this") - -_ExplicitConstructorInvocation_Variant_super = (Core.Name "super") - -_ExplicitConstructorInvocation_Variant_primary = (Core.Name "primary") - -data EnumDeclaration = - EnumDeclaration { - enumDeclarationModifiers :: [ClassModifier], - enumDeclarationIdentifier :: TypeIdentifier, - enumDeclarationImplements :: [InterfaceType], - enumDeclarationBody :: EnumBody} - deriving (Eq, Ord, Read, Show) - -_EnumDeclaration = (Core.Name "hydra/langs/java/syntax.EnumDeclaration") - -_EnumDeclaration_modifiers = (Core.Name "modifiers") - -_EnumDeclaration_identifier = (Core.Name "identifier") - -_EnumDeclaration_implements = (Core.Name "implements") - -_EnumDeclaration_body = (Core.Name "body") - -newtype EnumBody = - EnumBody { - unEnumBody :: [EnumBody_Element]} - deriving (Eq, Ord, Read, Show) - -_EnumBody = (Core.Name "hydra/langs/java/syntax.EnumBody") - -data EnumBody_Element = - EnumBody_Element { - enumBody_ElementConstants :: [EnumConstant], - enumBody_ElementBodyDeclarations :: [ClassBodyDeclaration]} - deriving (Eq, Ord, Read, Show) - -_EnumBody_Element = (Core.Name "hydra/langs/java/syntax.EnumBody.Element") - -_EnumBody_Element_constants = (Core.Name "constants") - -_EnumBody_Element_bodyDeclarations = (Core.Name "bodyDeclarations") - -data EnumConstant = - EnumConstant { - enumConstantModifiers :: [EnumConstantModifier], - enumConstantIdentifier :: Identifier, - enumConstantArguments :: [[Expression]], - enumConstantBody :: (Maybe ClassBody)} - deriving (Eq, Ord, Read, Show) - -_EnumConstant = (Core.Name "hydra/langs/java/syntax.EnumConstant") - -_EnumConstant_modifiers = (Core.Name "modifiers") - -_EnumConstant_identifier = (Core.Name "identifier") - -_EnumConstant_arguments = (Core.Name "arguments") - -_EnumConstant_body = (Core.Name "body") - -newtype EnumConstantModifier = - EnumConstantModifier { - unEnumConstantModifier :: Annotation} - deriving (Eq, Ord, Read, Show) - -_EnumConstantModifier = (Core.Name "hydra/langs/java/syntax.EnumConstantModifier") - -data InterfaceDeclaration = - InterfaceDeclarationNormalInterface NormalInterfaceDeclaration | - InterfaceDeclarationAnnotationType AnnotationTypeDeclaration - deriving (Eq, Ord, Read, Show) - -_InterfaceDeclaration = (Core.Name "hydra/langs/java/syntax.InterfaceDeclaration") - -_InterfaceDeclaration_normalInterface = (Core.Name "normalInterface") - -_InterfaceDeclaration_annotationType = (Core.Name "annotationType") - -data NormalInterfaceDeclaration = - NormalInterfaceDeclaration { - normalInterfaceDeclarationModifiers :: [InterfaceModifier], - normalInterfaceDeclarationIdentifier :: TypeIdentifier, - normalInterfaceDeclarationParameters :: [TypeParameter], - normalInterfaceDeclarationExtends :: [InterfaceType], - normalInterfaceDeclarationBody :: InterfaceBody} - deriving (Eq, Ord, Read, Show) - -_NormalInterfaceDeclaration = (Core.Name "hydra/langs/java/syntax.NormalInterfaceDeclaration") - -_NormalInterfaceDeclaration_modifiers = (Core.Name "modifiers") - -_NormalInterfaceDeclaration_identifier = (Core.Name "identifier") - -_NormalInterfaceDeclaration_parameters = (Core.Name "parameters") - -_NormalInterfaceDeclaration_extends = (Core.Name "extends") - -_NormalInterfaceDeclaration_body = (Core.Name "body") - -data InterfaceModifier = - InterfaceModifierAnnotation Annotation | - InterfaceModifierPublic | - InterfaceModifierProtected | - InterfaceModifierPrivate | - InterfaceModifierAbstract | - InterfaceModifierStatic | - InterfaceModifierStrictfb - deriving (Eq, Ord, Read, Show) - -_InterfaceModifier = (Core.Name "hydra/langs/java/syntax.InterfaceModifier") - -_InterfaceModifier_annotation = (Core.Name "annotation") - -_InterfaceModifier_public = (Core.Name "public") - -_InterfaceModifier_protected = (Core.Name "protected") - -_InterfaceModifier_private = (Core.Name "private") - -_InterfaceModifier_abstract = (Core.Name "abstract") - -_InterfaceModifier_static = (Core.Name "static") - -_InterfaceModifier_strictfb = (Core.Name "strictfb") - -newtype InterfaceBody = - InterfaceBody { - unInterfaceBody :: [InterfaceMemberDeclaration]} - deriving (Eq, Ord, Read, Show) - -_InterfaceBody = (Core.Name "hydra/langs/java/syntax.InterfaceBody") - -data InterfaceMemberDeclaration = - InterfaceMemberDeclarationConstant ConstantDeclaration | - InterfaceMemberDeclarationInterfaceMethod InterfaceMethodDeclaration | - InterfaceMemberDeclarationClass ClassDeclaration | - InterfaceMemberDeclarationInterface InterfaceDeclaration - deriving (Eq, Ord, Read, Show) - -_InterfaceMemberDeclaration = (Core.Name "hydra/langs/java/syntax.InterfaceMemberDeclaration") - -_InterfaceMemberDeclaration_constant = (Core.Name "constant") - -_InterfaceMemberDeclaration_interfaceMethod = (Core.Name "interfaceMethod") - -_InterfaceMemberDeclaration_class = (Core.Name "class") - -_InterfaceMemberDeclaration_interface = (Core.Name "interface") - -data ConstantDeclaration = - ConstantDeclaration { - constantDeclarationModifiers :: [ConstantModifier], - constantDeclarationType :: UnannType, - constantDeclarationVariables :: [VariableDeclarator]} - deriving (Eq, Ord, Read, Show) - -_ConstantDeclaration = (Core.Name "hydra/langs/java/syntax.ConstantDeclaration") - -_ConstantDeclaration_modifiers = (Core.Name "modifiers") - -_ConstantDeclaration_type = (Core.Name "type") - -_ConstantDeclaration_variables = (Core.Name "variables") - -data ConstantModifier = - ConstantModifierAnnotation Annotation | - ConstantModifierPublic | - ConstantModifierStatic | - ConstantModifierFinal - deriving (Eq, Ord, Read, Show) - -_ConstantModifier = (Core.Name "hydra/langs/java/syntax.ConstantModifier") - -_ConstantModifier_annotation = (Core.Name "annotation") - -_ConstantModifier_public = (Core.Name "public") - -_ConstantModifier_static = (Core.Name "static") - -_ConstantModifier_final = (Core.Name "final") - -data InterfaceMethodDeclaration = - InterfaceMethodDeclaration { - interfaceMethodDeclarationModifiers :: [InterfaceMethodModifier], - interfaceMethodDeclarationHeader :: MethodHeader, - interfaceMethodDeclarationBody :: MethodBody} - deriving (Eq, Ord, Read, Show) - -_InterfaceMethodDeclaration = (Core.Name "hydra/langs/java/syntax.InterfaceMethodDeclaration") - -_InterfaceMethodDeclaration_modifiers = (Core.Name "modifiers") - -_InterfaceMethodDeclaration_header = (Core.Name "header") - -_InterfaceMethodDeclaration_body = (Core.Name "body") - -data InterfaceMethodModifier = - InterfaceMethodModifierAnnotation Annotation | - InterfaceMethodModifierPublic | - InterfaceMethodModifierPrivate | - InterfaceMethodModifierAbstract | - InterfaceMethodModifierDefault | - InterfaceMethodModifierStatic | - InterfaceMethodModifierStrictfp - deriving (Eq, Ord, Read, Show) - -_InterfaceMethodModifier = (Core.Name "hydra/langs/java/syntax.InterfaceMethodModifier") - -_InterfaceMethodModifier_annotation = (Core.Name "annotation") - -_InterfaceMethodModifier_public = (Core.Name "public") - -_InterfaceMethodModifier_private = (Core.Name "private") - -_InterfaceMethodModifier_abstract = (Core.Name "abstract") - -_InterfaceMethodModifier_default = (Core.Name "default") - -_InterfaceMethodModifier_static = (Core.Name "static") - -_InterfaceMethodModifier_strictfp = (Core.Name "strictfp") - -data AnnotationTypeDeclaration = - AnnotationTypeDeclaration { - annotationTypeDeclarationModifiers :: [InterfaceModifier], - annotationTypeDeclarationIdentifier :: TypeIdentifier, - annotationTypeDeclarationBody :: AnnotationTypeBody} - deriving (Eq, Ord, Read, Show) - -_AnnotationTypeDeclaration = (Core.Name "hydra/langs/java/syntax.AnnotationTypeDeclaration") - -_AnnotationTypeDeclaration_modifiers = (Core.Name "modifiers") - -_AnnotationTypeDeclaration_identifier = (Core.Name "identifier") - -_AnnotationTypeDeclaration_body = (Core.Name "body") - -newtype AnnotationTypeBody = - AnnotationTypeBody { - unAnnotationTypeBody :: [[AnnotationTypeMemberDeclaration]]} - deriving (Eq, Ord, Read, Show) - -_AnnotationTypeBody = (Core.Name "hydra/langs/java/syntax.AnnotationTypeBody") - -data AnnotationTypeMemberDeclaration = - AnnotationTypeMemberDeclarationAnnotationType AnnotationTypeElementDeclaration | - AnnotationTypeMemberDeclarationConstant ConstantDeclaration | - AnnotationTypeMemberDeclarationClass ClassDeclaration | - AnnotationTypeMemberDeclarationInterface InterfaceDeclaration - deriving (Eq, Ord, Read, Show) - -_AnnotationTypeMemberDeclaration = (Core.Name "hydra/langs/java/syntax.AnnotationTypeMemberDeclaration") - -_AnnotationTypeMemberDeclaration_annotationType = (Core.Name "annotationType") - -_AnnotationTypeMemberDeclaration_constant = (Core.Name "constant") - -_AnnotationTypeMemberDeclaration_class = (Core.Name "class") - -_AnnotationTypeMemberDeclaration_interface = (Core.Name "interface") - -data AnnotationTypeElementDeclaration = - AnnotationTypeElementDeclaration { - annotationTypeElementDeclarationModifiers :: [AnnotationTypeElementModifier], - annotationTypeElementDeclarationType :: UnannType, - annotationTypeElementDeclarationIdentifier :: Identifier, - annotationTypeElementDeclarationDims :: (Maybe Dims), - annotationTypeElementDeclarationDefault :: (Maybe DefaultValue)} - deriving (Eq, Ord, Read, Show) - -_AnnotationTypeElementDeclaration = (Core.Name "hydra/langs/java/syntax.AnnotationTypeElementDeclaration") - -_AnnotationTypeElementDeclaration_modifiers = (Core.Name "modifiers") - -_AnnotationTypeElementDeclaration_type = (Core.Name "type") - -_AnnotationTypeElementDeclaration_identifier = (Core.Name "identifier") - -_AnnotationTypeElementDeclaration_dims = (Core.Name "dims") - -_AnnotationTypeElementDeclaration_default = (Core.Name "default") - -data AnnotationTypeElementModifier = - AnnotationTypeElementModifierPublic Annotation | - AnnotationTypeElementModifierAbstract - deriving (Eq, Ord, Read, Show) - -_AnnotationTypeElementModifier = (Core.Name "hydra/langs/java/syntax.AnnotationTypeElementModifier") - -_AnnotationTypeElementModifier_public = (Core.Name "public") - -_AnnotationTypeElementModifier_abstract = (Core.Name "abstract") - -newtype DefaultValue = - DefaultValue { - unDefaultValue :: ElementValue} - deriving (Eq, Ord, Read, Show) - -_DefaultValue = (Core.Name "hydra/langs/java/syntax.DefaultValue") - -data Annotation = - AnnotationNormal NormalAnnotation | - AnnotationMarker MarkerAnnotation | - AnnotationSingleElement SingleElementAnnotation - deriving (Eq, Ord, Read, Show) - -_Annotation = (Core.Name "hydra/langs/java/syntax.Annotation") - -_Annotation_normal = (Core.Name "normal") - -_Annotation_marker = (Core.Name "marker") - -_Annotation_singleElement = (Core.Name "singleElement") - -data NormalAnnotation = - NormalAnnotation { - normalAnnotationTypeName :: TypeName, - normalAnnotationPairs :: [ElementValuePair]} - deriving (Eq, Ord, Read, Show) - -_NormalAnnotation = (Core.Name "hydra/langs/java/syntax.NormalAnnotation") - -_NormalAnnotation_typeName = (Core.Name "typeName") - -_NormalAnnotation_pairs = (Core.Name "pairs") - -data ElementValuePair = - ElementValuePair { - elementValuePairKey :: Identifier, - elementValuePairValue :: ElementValue} - deriving (Eq, Ord, Read, Show) - -_ElementValuePair = (Core.Name "hydra/langs/java/syntax.ElementValuePair") - -_ElementValuePair_key = (Core.Name "key") - -_ElementValuePair_value = (Core.Name "value") - -data ElementValue = - ElementValueConditionalExpression ConditionalExpression | - ElementValueElementValueArrayInitializer ElementValueArrayInitializer | - ElementValueAnnotation Annotation - deriving (Eq, Ord, Read, Show) - -_ElementValue = (Core.Name "hydra/langs/java/syntax.ElementValue") - -_ElementValue_conditionalExpression = (Core.Name "conditionalExpression") - -_ElementValue_elementValueArrayInitializer = (Core.Name "elementValueArrayInitializer") - -_ElementValue_annotation = (Core.Name "annotation") - -newtype ElementValueArrayInitializer = - ElementValueArrayInitializer { - unElementValueArrayInitializer :: [ElementValue]} - deriving (Eq, Ord, Read, Show) - -_ElementValueArrayInitializer = (Core.Name "hydra/langs/java/syntax.ElementValueArrayInitializer") - -newtype MarkerAnnotation = - MarkerAnnotation { - unMarkerAnnotation :: TypeName} - deriving (Eq, Ord, Read, Show) - -_MarkerAnnotation = (Core.Name "hydra/langs/java/syntax.MarkerAnnotation") - -data SingleElementAnnotation = - SingleElementAnnotation { - singleElementAnnotationName :: TypeName, - singleElementAnnotationValue :: (Maybe ElementValue)} - deriving (Eq, Ord, Read, Show) - -_SingleElementAnnotation = (Core.Name "hydra/langs/java/syntax.SingleElementAnnotation") - -_SingleElementAnnotation_name = (Core.Name "name") - -_SingleElementAnnotation_value = (Core.Name "value") - -newtype ArrayInitializer = - ArrayInitializer { - unArrayInitializer :: [[VariableInitializer]]} - deriving (Eq, Ord, Read, Show) - -_ArrayInitializer = (Core.Name "hydra/langs/java/syntax.ArrayInitializer") - -newtype Block = - Block { - unBlock :: [BlockStatement]} - deriving (Eq, Ord, Read, Show) - -_Block = (Core.Name "hydra/langs/java/syntax.Block") - -data BlockStatement = - BlockStatementLocalVariableDeclaration LocalVariableDeclarationStatement | - BlockStatementClass ClassDeclaration | - BlockStatementStatement Statement - deriving (Eq, Ord, Read, Show) - -_BlockStatement = (Core.Name "hydra/langs/java/syntax.BlockStatement") - -_BlockStatement_localVariableDeclaration = (Core.Name "localVariableDeclaration") - -_BlockStatement_class = (Core.Name "class") - -_BlockStatement_statement = (Core.Name "statement") - -newtype LocalVariableDeclarationStatement = - LocalVariableDeclarationStatement { - unLocalVariableDeclarationStatement :: LocalVariableDeclaration} - deriving (Eq, Ord, Read, Show) - -_LocalVariableDeclarationStatement = (Core.Name "hydra/langs/java/syntax.LocalVariableDeclarationStatement") - -data LocalVariableDeclaration = - LocalVariableDeclaration { - localVariableDeclarationModifiers :: [VariableModifier], - localVariableDeclarationType :: LocalVariableType, - localVariableDeclarationDeclarators :: [VariableDeclarator]} - deriving (Eq, Ord, Read, Show) - -_LocalVariableDeclaration = (Core.Name "hydra/langs/java/syntax.LocalVariableDeclaration") - -_LocalVariableDeclaration_modifiers = (Core.Name "modifiers") - -_LocalVariableDeclaration_type = (Core.Name "type") - -_LocalVariableDeclaration_declarators = (Core.Name "declarators") - -data LocalVariableType = - LocalVariableTypeType UnannType | - LocalVariableTypeVar - deriving (Eq, Ord, Read, Show) - -_LocalVariableType = (Core.Name "hydra/langs/java/syntax.LocalVariableType") - -_LocalVariableType_type = (Core.Name "type") - -_LocalVariableType_var = (Core.Name "var") - -data Statement = - StatementWithoutTrailing StatementWithoutTrailingSubstatement | - StatementLabeled LabeledStatement | - StatementIfThen IfThenStatement | - StatementIfThenElse IfThenElseStatement | - StatementWhile WhileStatement | - StatementFor ForStatement - deriving (Eq, Ord, Read, Show) - -_Statement = (Core.Name "hydra/langs/java/syntax.Statement") - -_Statement_withoutTrailing = (Core.Name "withoutTrailing") - -_Statement_labeled = (Core.Name "labeled") - -_Statement_ifThen = (Core.Name "ifThen") - -_Statement_ifThenElse = (Core.Name "ifThenElse") - -_Statement_while = (Core.Name "while") - -_Statement_for = (Core.Name "for") - -data StatementNoShortIf = - StatementNoShortIfWithoutTrailing StatementWithoutTrailingSubstatement | - StatementNoShortIfLabeled LabeledStatementNoShortIf | - StatementNoShortIfIfThenElse IfThenElseStatementNoShortIf | - StatementNoShortIfWhile WhileStatementNoShortIf | - StatementNoShortIfFor ForStatementNoShortIf - deriving (Eq, Ord, Read, Show) - -_StatementNoShortIf = (Core.Name "hydra/langs/java/syntax.StatementNoShortIf") - -_StatementNoShortIf_withoutTrailing = (Core.Name "withoutTrailing") - -_StatementNoShortIf_labeled = (Core.Name "labeled") - -_StatementNoShortIf_ifThenElse = (Core.Name "ifThenElse") - -_StatementNoShortIf_while = (Core.Name "while") - -_StatementNoShortIf_for = (Core.Name "for") - -data StatementWithoutTrailingSubstatement = - StatementWithoutTrailingSubstatementBlock Block | - StatementWithoutTrailingSubstatementEmpty EmptyStatement | - StatementWithoutTrailingSubstatementExpression ExpressionStatement | - StatementWithoutTrailingSubstatementAssert AssertStatement | - StatementWithoutTrailingSubstatementSwitch SwitchStatement | - StatementWithoutTrailingSubstatementDo DoStatement | - StatementWithoutTrailingSubstatementBreak BreakStatement | - StatementWithoutTrailingSubstatementContinue ContinueStatement | - StatementWithoutTrailingSubstatementReturn ReturnStatement | - StatementWithoutTrailingSubstatementSynchronized SynchronizedStatement | - StatementWithoutTrailingSubstatementThrow ThrowStatement | - StatementWithoutTrailingSubstatementTry TryStatement - deriving (Eq, Ord, Read, Show) - -_StatementWithoutTrailingSubstatement = (Core.Name "hydra/langs/java/syntax.StatementWithoutTrailingSubstatement") - -_StatementWithoutTrailingSubstatement_block = (Core.Name "block") - -_StatementWithoutTrailingSubstatement_empty = (Core.Name "empty") - -_StatementWithoutTrailingSubstatement_expression = (Core.Name "expression") - -_StatementWithoutTrailingSubstatement_assert = (Core.Name "assert") - -_StatementWithoutTrailingSubstatement_switch = (Core.Name "switch") - -_StatementWithoutTrailingSubstatement_do = (Core.Name "do") - -_StatementWithoutTrailingSubstatement_break = (Core.Name "break") - -_StatementWithoutTrailingSubstatement_continue = (Core.Name "continue") - -_StatementWithoutTrailingSubstatement_return = (Core.Name "return") - -_StatementWithoutTrailingSubstatement_synchronized = (Core.Name "synchronized") - -_StatementWithoutTrailingSubstatement_throw = (Core.Name "throw") - -_StatementWithoutTrailingSubstatement_try = (Core.Name "try") - -data EmptyStatement = - EmptyStatement {} - deriving (Eq, Ord, Read, Show) - -_EmptyStatement = (Core.Name "hydra/langs/java/syntax.EmptyStatement") - -data LabeledStatement = - LabeledStatement { - labeledStatementIdentifier :: Identifier, - labeledStatementStatement :: Statement} - deriving (Eq, Ord, Read, Show) - -_LabeledStatement = (Core.Name "hydra/langs/java/syntax.LabeledStatement") - -_LabeledStatement_identifier = (Core.Name "identifier") - -_LabeledStatement_statement = (Core.Name "statement") - -data LabeledStatementNoShortIf = - LabeledStatementNoShortIf { - labeledStatementNoShortIfIdentifier :: Identifier, - labeledStatementNoShortIfStatement :: StatementNoShortIf} - deriving (Eq, Ord, Read, Show) - -_LabeledStatementNoShortIf = (Core.Name "hydra/langs/java/syntax.LabeledStatementNoShortIf") - -_LabeledStatementNoShortIf_identifier = (Core.Name "identifier") - -_LabeledStatementNoShortIf_statement = (Core.Name "statement") - -newtype ExpressionStatement = - ExpressionStatement { - unExpressionStatement :: StatementExpression} - deriving (Eq, Ord, Read, Show) - -_ExpressionStatement = (Core.Name "hydra/langs/java/syntax.ExpressionStatement") - -data StatementExpression = - StatementExpressionAssignment Assignment | - StatementExpressionPreIncrement PreIncrementExpression | - StatementExpressionPreDecrement PreDecrementExpression | - StatementExpressionPostIncrement PostIncrementExpression | - StatementExpressionPostDecrement PostDecrementExpression | - StatementExpressionMethodInvocation MethodInvocation | - StatementExpressionClassInstanceCreation ClassInstanceCreationExpression - deriving (Eq, Ord, Read, Show) - -_StatementExpression = (Core.Name "hydra/langs/java/syntax.StatementExpression") - -_StatementExpression_assignment = (Core.Name "assignment") - -_StatementExpression_preIncrement = (Core.Name "preIncrement") - -_StatementExpression_preDecrement = (Core.Name "preDecrement") - -_StatementExpression_postIncrement = (Core.Name "postIncrement") - -_StatementExpression_postDecrement = (Core.Name "postDecrement") - -_StatementExpression_methodInvocation = (Core.Name "methodInvocation") - -_StatementExpression_classInstanceCreation = (Core.Name "classInstanceCreation") - -data IfThenStatement = - IfThenStatement { - ifThenStatementExpression :: Expression, - ifThenStatementStatement :: Statement} - deriving (Eq, Ord, Read, Show) - -_IfThenStatement = (Core.Name "hydra/langs/java/syntax.IfThenStatement") - -_IfThenStatement_expression = (Core.Name "expression") - -_IfThenStatement_statement = (Core.Name "statement") - -data IfThenElseStatement = - IfThenElseStatement { - ifThenElseStatementCond :: (Maybe Expression), - ifThenElseStatementThen :: StatementNoShortIf, - ifThenElseStatementElse :: Statement} - deriving (Eq, Ord, Read, Show) - -_IfThenElseStatement = (Core.Name "hydra/langs/java/syntax.IfThenElseStatement") - -_IfThenElseStatement_cond = (Core.Name "cond") - -_IfThenElseStatement_then = (Core.Name "then") - -_IfThenElseStatement_else = (Core.Name "else") - -data IfThenElseStatementNoShortIf = - IfThenElseStatementNoShortIf { - ifThenElseStatementNoShortIfCond :: (Maybe Expression), - ifThenElseStatementNoShortIfThen :: StatementNoShortIf, - ifThenElseStatementNoShortIfElse :: StatementNoShortIf} - deriving (Eq, Ord, Read, Show) - -_IfThenElseStatementNoShortIf = (Core.Name "hydra/langs/java/syntax.IfThenElseStatementNoShortIf") - -_IfThenElseStatementNoShortIf_cond = (Core.Name "cond") - -_IfThenElseStatementNoShortIf_then = (Core.Name "then") - -_IfThenElseStatementNoShortIf_else = (Core.Name "else") - -data AssertStatement = - AssertStatementSingle Expression | - AssertStatementPair AssertStatement_Pair - deriving (Eq, Ord, Read, Show) - -_AssertStatement = (Core.Name "hydra/langs/java/syntax.AssertStatement") - -_AssertStatement_single = (Core.Name "single") - -_AssertStatement_pair = (Core.Name "pair") - -data AssertStatement_Pair = - AssertStatement_Pair { - assertStatement_PairFirst :: Expression, - assertStatement_PairSecond :: Expression} - deriving (Eq, Ord, Read, Show) - -_AssertStatement_Pair = (Core.Name "hydra/langs/java/syntax.AssertStatement.Pair") - -_AssertStatement_Pair_first = (Core.Name "first") - -_AssertStatement_Pair_second = (Core.Name "second") - -data SwitchStatement = - SwitchStatement { - switchStatementCond :: Expression, - switchStatementBlock :: SwitchBlock} - deriving (Eq, Ord, Read, Show) - -_SwitchStatement = (Core.Name "hydra/langs/java/syntax.SwitchStatement") - -_SwitchStatement_cond = (Core.Name "cond") - -_SwitchStatement_block = (Core.Name "block") - -newtype SwitchBlock = - SwitchBlock { - unSwitchBlock :: [SwitchBlock_Pair]} - deriving (Eq, Ord, Read, Show) - -_SwitchBlock = (Core.Name "hydra/langs/java/syntax.SwitchBlock") - -data SwitchBlock_Pair = - SwitchBlock_Pair { - switchBlock_PairStatements :: [SwitchBlockStatementGroup], - switchBlock_PairLabels :: [SwitchLabel]} - deriving (Eq, Ord, Read, Show) - -_SwitchBlock_Pair = (Core.Name "hydra/langs/java/syntax.SwitchBlock.Pair") - -_SwitchBlock_Pair_statements = (Core.Name "statements") - -_SwitchBlock_Pair_labels = (Core.Name "labels") - -data SwitchBlockStatementGroup = - SwitchBlockStatementGroup { - switchBlockStatementGroupLabels :: [SwitchLabel], - switchBlockStatementGroupStatements :: [BlockStatement]} - deriving (Eq, Ord, Read, Show) - -_SwitchBlockStatementGroup = (Core.Name "hydra/langs/java/syntax.SwitchBlockStatementGroup") - -_SwitchBlockStatementGroup_labels = (Core.Name "labels") - -_SwitchBlockStatementGroup_statements = (Core.Name "statements") - -data SwitchLabel = - SwitchLabelConstant ConstantExpression | - SwitchLabelEnumConstant EnumConstantName | - SwitchLabelDefault - deriving (Eq, Ord, Read, Show) - -_SwitchLabel = (Core.Name "hydra/langs/java/syntax.SwitchLabel") - -_SwitchLabel_constant = (Core.Name "constant") - -_SwitchLabel_enumConstant = (Core.Name "enumConstant") - -_SwitchLabel_default = (Core.Name "default") - -newtype EnumConstantName = - EnumConstantName { - unEnumConstantName :: Identifier} - deriving (Eq, Ord, Read, Show) - -_EnumConstantName = (Core.Name "hydra/langs/java/syntax.EnumConstantName") - -data WhileStatement = - WhileStatement { - whileStatementCond :: (Maybe Expression), - whileStatementBody :: Statement} - deriving (Eq, Ord, Read, Show) - -_WhileStatement = (Core.Name "hydra/langs/java/syntax.WhileStatement") - -_WhileStatement_cond = (Core.Name "cond") - -_WhileStatement_body = (Core.Name "body") - -data WhileStatementNoShortIf = - WhileStatementNoShortIf { - whileStatementNoShortIfCond :: (Maybe Expression), - whileStatementNoShortIfBody :: StatementNoShortIf} - deriving (Eq, Ord, Read, Show) - -_WhileStatementNoShortIf = (Core.Name "hydra/langs/java/syntax.WhileStatementNoShortIf") - -_WhileStatementNoShortIf_cond = (Core.Name "cond") - -_WhileStatementNoShortIf_body = (Core.Name "body") - -data DoStatement = - DoStatement { - doStatementBody :: Statement, - doStatementConde :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_DoStatement = (Core.Name "hydra/langs/java/syntax.DoStatement") - -_DoStatement_body = (Core.Name "body") - -_DoStatement_conde = (Core.Name "conde") - -data ForStatement = - ForStatementBasic BasicForStatement | - ForStatementEnhanced EnhancedForStatement - deriving (Eq, Ord, Read, Show) - -_ForStatement = (Core.Name "hydra/langs/java/syntax.ForStatement") - -_ForStatement_basic = (Core.Name "basic") - -_ForStatement_enhanced = (Core.Name "enhanced") - -data ForStatementNoShortIf = - ForStatementNoShortIfBasic BasicForStatementNoShortIf | - ForStatementNoShortIfEnhanced EnhancedForStatementNoShortIf - deriving (Eq, Ord, Read, Show) - -_ForStatementNoShortIf = (Core.Name "hydra/langs/java/syntax.ForStatementNoShortIf") - -_ForStatementNoShortIf_basic = (Core.Name "basic") - -_ForStatementNoShortIf_enhanced = (Core.Name "enhanced") - -data BasicForStatement = - BasicForStatement { - basicForStatementCond :: ForCond, - basicForStatementBody :: Statement} - deriving (Eq, Ord, Read, Show) - -_BasicForStatement = (Core.Name "hydra/langs/java/syntax.BasicForStatement") - -_BasicForStatement_cond = (Core.Name "cond") - -_BasicForStatement_body = (Core.Name "body") - -data ForCond = - ForCond { - forCondInit :: (Maybe ForInit), - forCondCond :: (Maybe Expression), - forCondUpdate :: (Maybe ForUpdate)} - deriving (Eq, Ord, Read, Show) - -_ForCond = (Core.Name "hydra/langs/java/syntax.ForCond") - -_ForCond_init = (Core.Name "init") - -_ForCond_cond = (Core.Name "cond") - -_ForCond_update = (Core.Name "update") - -data BasicForStatementNoShortIf = - BasicForStatementNoShortIf { - basicForStatementNoShortIfCond :: ForCond, - basicForStatementNoShortIfBody :: StatementNoShortIf} - deriving (Eq, Ord, Read, Show) - -_BasicForStatementNoShortIf = (Core.Name "hydra/langs/java/syntax.BasicForStatementNoShortIf") - -_BasicForStatementNoShortIf_cond = (Core.Name "cond") - -_BasicForStatementNoShortIf_body = (Core.Name "body") - -data ForInit = - ForInitStatements [StatementExpression] | - ForInitLocalVariable LocalVariableDeclaration - deriving (Eq, Ord, Read, Show) - -_ForInit = (Core.Name "hydra/langs/java/syntax.ForInit") - -_ForInit_statements = (Core.Name "statements") - -_ForInit_localVariable = (Core.Name "localVariable") - -newtype ForUpdate = - ForUpdate { - unForUpdate :: [StatementExpression]} - deriving (Eq, Ord, Read, Show) - -_ForUpdate = (Core.Name "hydra/langs/java/syntax.ForUpdate") - -data EnhancedForStatement = - EnhancedForStatement { - enhancedForStatementCond :: EnhancedForCond, - enhancedForStatementBody :: Statement} - deriving (Eq, Ord, Read, Show) - -_EnhancedForStatement = (Core.Name "hydra/langs/java/syntax.EnhancedForStatement") - -_EnhancedForStatement_cond = (Core.Name "cond") - -_EnhancedForStatement_body = (Core.Name "body") - -data EnhancedForCond = - EnhancedForCond { - enhancedForCondModifiers :: [VariableModifier], - enhancedForCondType :: LocalVariableType, - enhancedForCondId :: VariableDeclaratorId, - enhancedForCondExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_EnhancedForCond = (Core.Name "hydra/langs/java/syntax.EnhancedForCond") - -_EnhancedForCond_modifiers = (Core.Name "modifiers") - -_EnhancedForCond_type = (Core.Name "type") - -_EnhancedForCond_id = (Core.Name "id") - -_EnhancedForCond_expression = (Core.Name "expression") - -data EnhancedForStatementNoShortIf = - EnhancedForStatementNoShortIf { - enhancedForStatementNoShortIfCond :: EnhancedForCond, - enhancedForStatementNoShortIfBody :: StatementNoShortIf} - deriving (Eq, Ord, Read, Show) - -_EnhancedForStatementNoShortIf = (Core.Name "hydra/langs/java/syntax.EnhancedForStatementNoShortIf") - -_EnhancedForStatementNoShortIf_cond = (Core.Name "cond") - -_EnhancedForStatementNoShortIf_body = (Core.Name "body") - -newtype BreakStatement = - BreakStatement { - unBreakStatement :: (Maybe Identifier)} - deriving (Eq, Ord, Read, Show) - -_BreakStatement = (Core.Name "hydra/langs/java/syntax.BreakStatement") - -newtype ContinueStatement = - ContinueStatement { - unContinueStatement :: (Maybe Identifier)} - deriving (Eq, Ord, Read, Show) - -_ContinueStatement = (Core.Name "hydra/langs/java/syntax.ContinueStatement") - -newtype ReturnStatement = - ReturnStatement { - unReturnStatement :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_ReturnStatement = (Core.Name "hydra/langs/java/syntax.ReturnStatement") - -newtype ThrowStatement = - ThrowStatement { - unThrowStatement :: Expression} - deriving (Eq, Ord, Read, Show) - -_ThrowStatement = (Core.Name "hydra/langs/java/syntax.ThrowStatement") - -data SynchronizedStatement = - SynchronizedStatement { - synchronizedStatementExpression :: Expression, - synchronizedStatementBlock :: Block} - deriving (Eq, Ord, Read, Show) - -_SynchronizedStatement = (Core.Name "hydra/langs/java/syntax.SynchronizedStatement") - -_SynchronizedStatement_expression = (Core.Name "expression") - -_SynchronizedStatement_block = (Core.Name "block") - -data TryStatement = - TryStatementSimple TryStatement_Simple | - TryStatementWithFinally TryStatement_WithFinally | - TryStatementWithResources TryWithResourcesStatement - deriving (Eq, Ord, Read, Show) - -_TryStatement = (Core.Name "hydra/langs/java/syntax.TryStatement") - -_TryStatement_simple = (Core.Name "simple") - -_TryStatement_withFinally = (Core.Name "withFinally") - -_TryStatement_withResources = (Core.Name "withResources") - -data TryStatement_Simple = - TryStatement_Simple { - tryStatement_SimpleBlock :: Block, - tryStatement_SimpleCatches :: Catches} - deriving (Eq, Ord, Read, Show) - -_TryStatement_Simple = (Core.Name "hydra/langs/java/syntax.TryStatement.Simple") - -_TryStatement_Simple_block = (Core.Name "block") - -_TryStatement_Simple_catches = (Core.Name "catches") - -data TryStatement_WithFinally = - TryStatement_WithFinally { - tryStatement_WithFinallyBlock :: Block, - tryStatement_WithFinallyCatches :: (Maybe Catches), - tryStatement_WithFinallyFinally :: Finally} - deriving (Eq, Ord, Read, Show) - -_TryStatement_WithFinally = (Core.Name "hydra/langs/java/syntax.TryStatement.WithFinally") - -_TryStatement_WithFinally_block = (Core.Name "block") - -_TryStatement_WithFinally_catches = (Core.Name "catches") - -_TryStatement_WithFinally_finally = (Core.Name "finally") - -newtype Catches = - Catches { - unCatches :: [CatchClause]} - deriving (Eq, Ord, Read, Show) - -_Catches = (Core.Name "hydra/langs/java/syntax.Catches") - -data CatchClause = - CatchClause { - catchClauseParameter :: (Maybe CatchFormalParameter), - catchClauseBlock :: Block} - deriving (Eq, Ord, Read, Show) - -_CatchClause = (Core.Name "hydra/langs/java/syntax.CatchClause") - -_CatchClause_parameter = (Core.Name "parameter") - -_CatchClause_block = (Core.Name "block") - -data CatchFormalParameter = - CatchFormalParameter { - catchFormalParameterModifiers :: [VariableModifier], - catchFormalParameterType :: CatchType, - catchFormalParameterId :: VariableDeclaratorId} - deriving (Eq, Ord, Read, Show) - -_CatchFormalParameter = (Core.Name "hydra/langs/java/syntax.CatchFormalParameter") - -_CatchFormalParameter_modifiers = (Core.Name "modifiers") - -_CatchFormalParameter_type = (Core.Name "type") - -_CatchFormalParameter_id = (Core.Name "id") - -data CatchType = - CatchType { - catchTypeType :: UnannClassType, - catchTypeTypes :: [ClassType]} - deriving (Eq, Ord, Read, Show) - -_CatchType = (Core.Name "hydra/langs/java/syntax.CatchType") - -_CatchType_type = (Core.Name "type") - -_CatchType_types = (Core.Name "types") - -newtype Finally = - Finally { - unFinally :: Block} - deriving (Eq, Ord, Read, Show) - -_Finally = (Core.Name "hydra/langs/java/syntax.Finally") - -data TryWithResourcesStatement = - TryWithResourcesStatement { - tryWithResourcesStatementResourceSpecification :: ResourceSpecification, - tryWithResourcesStatementBlock :: Block, - tryWithResourcesStatementCatches :: (Maybe Catches), - tryWithResourcesStatementFinally :: (Maybe Finally)} - deriving (Eq, Ord, Read, Show) - -_TryWithResourcesStatement = (Core.Name "hydra/langs/java/syntax.TryWithResourcesStatement") - -_TryWithResourcesStatement_resourceSpecification = (Core.Name "resourceSpecification") - -_TryWithResourcesStatement_block = (Core.Name "block") - -_TryWithResourcesStatement_catches = (Core.Name "catches") - -_TryWithResourcesStatement_finally = (Core.Name "finally") - -newtype ResourceSpecification = - ResourceSpecification { - unResourceSpecification :: [Resource]} - deriving (Eq, Ord, Read, Show) - -_ResourceSpecification = (Core.Name "hydra/langs/java/syntax.ResourceSpecification") - -data Resource = - ResourceLocal Resource_Local | - ResourceVariable VariableAccess - deriving (Eq, Ord, Read, Show) - -_Resource = (Core.Name "hydra/langs/java/syntax.Resource") - -_Resource_local = (Core.Name "local") - -_Resource_variable = (Core.Name "variable") - -data Resource_Local = - Resource_Local { - resource_LocalModifiers :: [VariableModifier], - resource_LocalType :: LocalVariableType, - resource_LocalIdentifier :: Identifier, - resource_LocalExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_Resource_Local = (Core.Name "hydra/langs/java/syntax.Resource.Local") - -_Resource_Local_modifiers = (Core.Name "modifiers") - -_Resource_Local_type = (Core.Name "type") - -_Resource_Local_identifier = (Core.Name "identifier") - -_Resource_Local_expression = (Core.Name "expression") - -data VariableAccess = - VariableAccessExpressionName ExpressionName | - VariableAccessFieldAccess FieldAccess - deriving (Eq, Ord, Read, Show) - -_VariableAccess = (Core.Name "hydra/langs/java/syntax.VariableAccess") - -_VariableAccess_expressionName = (Core.Name "expressionName") - -_VariableAccess_fieldAccess = (Core.Name "fieldAccess") - -data Primary = - PrimaryNoNewArray PrimaryNoNewArray | - PrimaryArrayCreation ArrayCreationExpression - deriving (Eq, Ord, Read, Show) - -_Primary = (Core.Name "hydra/langs/java/syntax.Primary") - -_Primary_noNewArray = (Core.Name "noNewArray") - -_Primary_arrayCreation = (Core.Name "arrayCreation") - -data PrimaryNoNewArray = - PrimaryNoNewArrayLiteral Literal | - PrimaryNoNewArrayClassLiteral ClassLiteral | - PrimaryNoNewArrayThis | - PrimaryNoNewArrayDotThis TypeName | - PrimaryNoNewArrayParens Expression | - PrimaryNoNewArrayClassInstance ClassInstanceCreationExpression | - PrimaryNoNewArrayFieldAccess FieldAccess | - PrimaryNoNewArrayArrayAccess ArrayAccess | - PrimaryNoNewArrayMethodInvocation MethodInvocation | - PrimaryNoNewArrayMethodReference MethodReference - deriving (Eq, Ord, Read, Show) - -_PrimaryNoNewArray = (Core.Name "hydra/langs/java/syntax.PrimaryNoNewArray") - -_PrimaryNoNewArray_literal = (Core.Name "literal") - -_PrimaryNoNewArray_classLiteral = (Core.Name "classLiteral") - -_PrimaryNoNewArray_this = (Core.Name "this") - -_PrimaryNoNewArray_dotThis = (Core.Name "dotThis") - -_PrimaryNoNewArray_parens = (Core.Name "parens") - -_PrimaryNoNewArray_classInstance = (Core.Name "classInstance") - -_PrimaryNoNewArray_fieldAccess = (Core.Name "fieldAccess") - -_PrimaryNoNewArray_arrayAccess = (Core.Name "arrayAccess") - -_PrimaryNoNewArray_methodInvocation = (Core.Name "methodInvocation") - -_PrimaryNoNewArray_methodReference = (Core.Name "methodReference") - -data ClassLiteral = - ClassLiteralType TypeNameArray | - ClassLiteralNumericType NumericTypeArray | - ClassLiteralBoolean BooleanArray | - ClassLiteralVoid - deriving (Eq, Ord, Read, Show) - -_ClassLiteral = (Core.Name "hydra/langs/java/syntax.ClassLiteral") - -_ClassLiteral_type = (Core.Name "type") - -_ClassLiteral_numericType = (Core.Name "numericType") - -_ClassLiteral_boolean = (Core.Name "boolean") - -_ClassLiteral_void = (Core.Name "void") - -data TypeNameArray = - TypeNameArraySimple TypeName | - TypeNameArrayArray TypeNameArray - deriving (Eq, Ord, Read, Show) - -_TypeNameArray = (Core.Name "hydra/langs/java/syntax.TypeNameArray") - -_TypeNameArray_simple = (Core.Name "simple") - -_TypeNameArray_array = (Core.Name "array") - -data NumericTypeArray = - NumericTypeArraySimple NumericType | - NumericTypeArrayArray NumericTypeArray - deriving (Eq, Ord, Read, Show) - -_NumericTypeArray = (Core.Name "hydra/langs/java/syntax.NumericTypeArray") - -_NumericTypeArray_simple = (Core.Name "simple") - -_NumericTypeArray_array = (Core.Name "array") - -data BooleanArray = - BooleanArraySimple | - BooleanArrayArray BooleanArray - deriving (Eq, Ord, Read, Show) - -_BooleanArray = (Core.Name "hydra/langs/java/syntax.BooleanArray") - -_BooleanArray_simple = (Core.Name "simple") - -_BooleanArray_array = (Core.Name "array") - -data ClassInstanceCreationExpression = - ClassInstanceCreationExpression { - classInstanceCreationExpressionQualifier :: (Maybe ClassInstanceCreationExpression_Qualifier), - classInstanceCreationExpressionExpression :: UnqualifiedClassInstanceCreationExpression} - deriving (Eq, Ord, Read, Show) - -_ClassInstanceCreationExpression = (Core.Name "hydra/langs/java/syntax.ClassInstanceCreationExpression") - -_ClassInstanceCreationExpression_qualifier = (Core.Name "qualifier") - -_ClassInstanceCreationExpression_expression = (Core.Name "expression") - -data ClassInstanceCreationExpression_Qualifier = - ClassInstanceCreationExpression_QualifierExpression ExpressionName | - ClassInstanceCreationExpression_QualifierPrimary Primary - deriving (Eq, Ord, Read, Show) - -_ClassInstanceCreationExpression_Qualifier = (Core.Name "hydra/langs/java/syntax.ClassInstanceCreationExpression.Qualifier") - -_ClassInstanceCreationExpression_Qualifier_expression = (Core.Name "expression") - -_ClassInstanceCreationExpression_Qualifier_primary = (Core.Name "primary") - -data UnqualifiedClassInstanceCreationExpression = - UnqualifiedClassInstanceCreationExpression { - unqualifiedClassInstanceCreationExpressionTypeArguments :: [TypeArgument], - unqualifiedClassInstanceCreationExpressionClassOrInterface :: ClassOrInterfaceTypeToInstantiate, - unqualifiedClassInstanceCreationExpressionArguments :: [Expression], - unqualifiedClassInstanceCreationExpressionBody :: (Maybe ClassBody)} - deriving (Eq, Ord, Read, Show) - -_UnqualifiedClassInstanceCreationExpression = (Core.Name "hydra/langs/java/syntax.UnqualifiedClassInstanceCreationExpression") - -_UnqualifiedClassInstanceCreationExpression_typeArguments = (Core.Name "typeArguments") - -_UnqualifiedClassInstanceCreationExpression_classOrInterface = (Core.Name "classOrInterface") - -_UnqualifiedClassInstanceCreationExpression_arguments = (Core.Name "arguments") - -_UnqualifiedClassInstanceCreationExpression_body = (Core.Name "body") - -data ClassOrInterfaceTypeToInstantiate = - ClassOrInterfaceTypeToInstantiate { - classOrInterfaceTypeToInstantiateIdentifiers :: [AnnotatedIdentifier], - classOrInterfaceTypeToInstantiateTypeArguments :: (Maybe TypeArgumentsOrDiamond)} - deriving (Eq, Ord, Read, Show) - -_ClassOrInterfaceTypeToInstantiate = (Core.Name "hydra/langs/java/syntax.ClassOrInterfaceTypeToInstantiate") - -_ClassOrInterfaceTypeToInstantiate_identifiers = (Core.Name "identifiers") - -_ClassOrInterfaceTypeToInstantiate_typeArguments = (Core.Name "typeArguments") - -data AnnotatedIdentifier = - AnnotatedIdentifier { - annotatedIdentifierAnnotations :: [Annotation], - annotatedIdentifierIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_AnnotatedIdentifier = (Core.Name "hydra/langs/java/syntax.AnnotatedIdentifier") - -_AnnotatedIdentifier_annotations = (Core.Name "annotations") - -_AnnotatedIdentifier_identifier = (Core.Name "identifier") - -data TypeArgumentsOrDiamond = - TypeArgumentsOrDiamondArguments [TypeArgument] | - TypeArgumentsOrDiamondDiamond - deriving (Eq, Ord, Read, Show) - -_TypeArgumentsOrDiamond = (Core.Name "hydra/langs/java/syntax.TypeArgumentsOrDiamond") - -_TypeArgumentsOrDiamond_arguments = (Core.Name "arguments") - -_TypeArgumentsOrDiamond_diamond = (Core.Name "diamond") - -data FieldAccess = - FieldAccess { - fieldAccessQualifier :: FieldAccess_Qualifier, - fieldAccessIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_FieldAccess = (Core.Name "hydra/langs/java/syntax.FieldAccess") - -_FieldAccess_qualifier = (Core.Name "qualifier") - -_FieldAccess_identifier = (Core.Name "identifier") - -data FieldAccess_Qualifier = - FieldAccess_QualifierPrimary Primary | - FieldAccess_QualifierSuper | - FieldAccess_QualifierTyped TypeName - deriving (Eq, Ord, Read, Show) - -_FieldAccess_Qualifier = (Core.Name "hydra/langs/java/syntax.FieldAccess.Qualifier") - -_FieldAccess_Qualifier_primary = (Core.Name "primary") - -_FieldAccess_Qualifier_super = (Core.Name "super") - -_FieldAccess_Qualifier_typed = (Core.Name "typed") - -data ArrayAccess = - ArrayAccess { - arrayAccessExpression :: (Maybe Expression), - arrayAccessVariant :: ArrayAccess_Variant} - deriving (Eq, Ord, Read, Show) - -_ArrayAccess = (Core.Name "hydra/langs/java/syntax.ArrayAccess") - -_ArrayAccess_expression = (Core.Name "expression") - -_ArrayAccess_variant = (Core.Name "variant") - -data ArrayAccess_Variant = - ArrayAccess_VariantName ExpressionName | - ArrayAccess_VariantPrimary PrimaryNoNewArray - deriving (Eq, Ord, Read, Show) - -_ArrayAccess_Variant = (Core.Name "hydra/langs/java/syntax.ArrayAccess.Variant") - -_ArrayAccess_Variant_name = (Core.Name "name") - -_ArrayAccess_Variant_primary = (Core.Name "primary") - -data MethodInvocation = - MethodInvocation { - methodInvocationHeader :: MethodInvocation_Header, - methodInvocationArguments :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_MethodInvocation = (Core.Name "hydra/langs/java/syntax.MethodInvocation") - -_MethodInvocation_header = (Core.Name "header") - -_MethodInvocation_arguments = (Core.Name "arguments") - -data MethodInvocation_Header = - MethodInvocation_HeaderSimple MethodName | - MethodInvocation_HeaderComplex MethodInvocation_Complex - deriving (Eq, Ord, Read, Show) - -_MethodInvocation_Header = (Core.Name "hydra/langs/java/syntax.MethodInvocation.Header") - -_MethodInvocation_Header_simple = (Core.Name "simple") - -_MethodInvocation_Header_complex = (Core.Name "complex") - -data MethodInvocation_Complex = - MethodInvocation_Complex { - methodInvocation_ComplexVariant :: MethodInvocation_Variant, - methodInvocation_ComplexTypeArguments :: [TypeArgument], - methodInvocation_ComplexIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_MethodInvocation_Complex = (Core.Name "hydra/langs/java/syntax.MethodInvocation.Complex") - -_MethodInvocation_Complex_variant = (Core.Name "variant") - -_MethodInvocation_Complex_typeArguments = (Core.Name "typeArguments") - -_MethodInvocation_Complex_identifier = (Core.Name "identifier") - -data MethodInvocation_Variant = - MethodInvocation_VariantType TypeName | - MethodInvocation_VariantExpression ExpressionName | - MethodInvocation_VariantPrimary Primary | - MethodInvocation_VariantSuper | - MethodInvocation_VariantTypeSuper TypeName - deriving (Eq, Ord, Read, Show) - -_MethodInvocation_Variant = (Core.Name "hydra/langs/java/syntax.MethodInvocation.Variant") - -_MethodInvocation_Variant_type = (Core.Name "type") - -_MethodInvocation_Variant_expression = (Core.Name "expression") - -_MethodInvocation_Variant_primary = (Core.Name "primary") - -_MethodInvocation_Variant_super = (Core.Name "super") - -_MethodInvocation_Variant_typeSuper = (Core.Name "typeSuper") - -data MethodReference = - MethodReferenceExpression MethodReference_Expression | - MethodReferencePrimary MethodReference_Primary | - MethodReferenceReferenceType MethodReference_ReferenceType | - MethodReferenceSuper MethodReference_Super | - MethodReferenceNew MethodReference_New | - MethodReferenceArray MethodReference_Array - deriving (Eq, Ord, Read, Show) - -_MethodReference = (Core.Name "hydra/langs/java/syntax.MethodReference") - -_MethodReference_expression = (Core.Name "expression") - -_MethodReference_primary = (Core.Name "primary") - -_MethodReference_referenceType = (Core.Name "referenceType") - -_MethodReference_super = (Core.Name "super") - -_MethodReference_new = (Core.Name "new") - -_MethodReference_array = (Core.Name "array") - -data MethodReference_Expression = - MethodReference_Expression { - methodReference_ExpressionName :: ExpressionName, - methodReference_ExpressionTypeArguments :: [TypeArgument], - methodReference_ExpressionIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_MethodReference_Expression = (Core.Name "hydra/langs/java/syntax.MethodReference.Expression") - -_MethodReference_Expression_name = (Core.Name "name") - -_MethodReference_Expression_typeArguments = (Core.Name "typeArguments") - -_MethodReference_Expression_identifier = (Core.Name "identifier") - -data MethodReference_Primary = - MethodReference_Primary { - methodReference_PrimaryPrimary :: Primary, - methodReference_PrimaryTypeArguments :: [TypeArgument], - methodReference_PrimaryIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_MethodReference_Primary = (Core.Name "hydra/langs/java/syntax.MethodReference.Primary") - -_MethodReference_Primary_primary = (Core.Name "primary") - -_MethodReference_Primary_typeArguments = (Core.Name "typeArguments") - -_MethodReference_Primary_identifier = (Core.Name "identifier") - -data MethodReference_ReferenceType = - MethodReference_ReferenceType { - methodReference_ReferenceTypeReferenceType :: ReferenceType, - methodReference_ReferenceTypeTypeArguments :: [TypeArgument], - methodReference_ReferenceTypeIdentifier :: Identifier} - deriving (Eq, Ord, Read, Show) - -_MethodReference_ReferenceType = (Core.Name "hydra/langs/java/syntax.MethodReference.ReferenceType") - -_MethodReference_ReferenceType_referenceType = (Core.Name "referenceType") - -_MethodReference_ReferenceType_typeArguments = (Core.Name "typeArguments") - -_MethodReference_ReferenceType_identifier = (Core.Name "identifier") - -data MethodReference_Super = - MethodReference_Super { - methodReference_SuperTypeArguments :: [TypeArgument], - methodReference_SuperIdentifier :: Identifier, - methodReference_SuperSuper :: Bool} - deriving (Eq, Ord, Read, Show) - -_MethodReference_Super = (Core.Name "hydra/langs/java/syntax.MethodReference.Super") - -_MethodReference_Super_typeArguments = (Core.Name "typeArguments") - -_MethodReference_Super_identifier = (Core.Name "identifier") - -_MethodReference_Super_super = (Core.Name "super") - -data MethodReference_New = - MethodReference_New { - methodReference_NewClassType :: ClassType, - methodReference_NewTypeArguments :: [TypeArgument]} - deriving (Eq, Ord, Read, Show) - -_MethodReference_New = (Core.Name "hydra/langs/java/syntax.MethodReference.New") - -_MethodReference_New_classType = (Core.Name "classType") - -_MethodReference_New_typeArguments = (Core.Name "typeArguments") - -newtype MethodReference_Array = - MethodReference_Array { - unMethodReference_Array :: ArrayType} - deriving (Eq, Ord, Read, Show) - -_MethodReference_Array = (Core.Name "hydra/langs/java/syntax.MethodReference.Array") - -data ArrayCreationExpression = - ArrayCreationExpressionPrimitive ArrayCreationExpression_Primitive | - ArrayCreationExpressionClassOrInterface ArrayCreationExpression_ClassOrInterface | - ArrayCreationExpressionPrimitiveArray ArrayCreationExpression_PrimitiveArray | - ArrayCreationExpressionClassOrInterfaceArray ArrayCreationExpression_ClassOrInterfaceArray - deriving (Eq, Ord, Read, Show) - -_ArrayCreationExpression = (Core.Name "hydra/langs/java/syntax.ArrayCreationExpression") - -_ArrayCreationExpression_primitive = (Core.Name "primitive") - -_ArrayCreationExpression_classOrInterface = (Core.Name "classOrInterface") - -_ArrayCreationExpression_primitiveArray = (Core.Name "primitiveArray") - -_ArrayCreationExpression_classOrInterfaceArray = (Core.Name "classOrInterfaceArray") - -data ArrayCreationExpression_Primitive = - ArrayCreationExpression_Primitive { - arrayCreationExpression_PrimitiveType :: PrimitiveTypeWithAnnotations, - arrayCreationExpression_PrimitiveDimExprs :: [DimExpr], - arrayCreationExpression_PrimitiveDims :: (Maybe Dims)} - deriving (Eq, Ord, Read, Show) - -_ArrayCreationExpression_Primitive = (Core.Name "hydra/langs/java/syntax.ArrayCreationExpression.Primitive") - -_ArrayCreationExpression_Primitive_type = (Core.Name "type") - -_ArrayCreationExpression_Primitive_dimExprs = (Core.Name "dimExprs") - -_ArrayCreationExpression_Primitive_dims = (Core.Name "dims") - -data ArrayCreationExpression_ClassOrInterface = - ArrayCreationExpression_ClassOrInterface { - arrayCreationExpression_ClassOrInterfaceType :: ClassOrInterfaceType, - arrayCreationExpression_ClassOrInterfaceDimExprs :: [DimExpr], - arrayCreationExpression_ClassOrInterfaceDims :: (Maybe Dims)} - deriving (Eq, Ord, Read, Show) - -_ArrayCreationExpression_ClassOrInterface = (Core.Name "hydra/langs/java/syntax.ArrayCreationExpression.ClassOrInterface") - -_ArrayCreationExpression_ClassOrInterface_type = (Core.Name "type") - -_ArrayCreationExpression_ClassOrInterface_dimExprs = (Core.Name "dimExprs") - -_ArrayCreationExpression_ClassOrInterface_dims = (Core.Name "dims") - -data ArrayCreationExpression_PrimitiveArray = - ArrayCreationExpression_PrimitiveArray { - arrayCreationExpression_PrimitiveArrayType :: PrimitiveTypeWithAnnotations, - arrayCreationExpression_PrimitiveArrayDims :: [Dims], - arrayCreationExpression_PrimitiveArrayArray :: ArrayInitializer} - deriving (Eq, Ord, Read, Show) - -_ArrayCreationExpression_PrimitiveArray = (Core.Name "hydra/langs/java/syntax.ArrayCreationExpression.PrimitiveArray") - -_ArrayCreationExpression_PrimitiveArray_type = (Core.Name "type") - -_ArrayCreationExpression_PrimitiveArray_dims = (Core.Name "dims") - -_ArrayCreationExpression_PrimitiveArray_array = (Core.Name "array") - -data ArrayCreationExpression_ClassOrInterfaceArray = - ArrayCreationExpression_ClassOrInterfaceArray { - arrayCreationExpression_ClassOrInterfaceArrayType :: ClassOrInterfaceType, - arrayCreationExpression_ClassOrInterfaceArrayDims :: [Dims], - arrayCreationExpression_ClassOrInterfaceArrayArray :: ArrayInitializer} - deriving (Eq, Ord, Read, Show) - -_ArrayCreationExpression_ClassOrInterfaceArray = (Core.Name "hydra/langs/java/syntax.ArrayCreationExpression.ClassOrInterfaceArray") - -_ArrayCreationExpression_ClassOrInterfaceArray_type = (Core.Name "type") - -_ArrayCreationExpression_ClassOrInterfaceArray_dims = (Core.Name "dims") - -_ArrayCreationExpression_ClassOrInterfaceArray_array = (Core.Name "array") - -data DimExpr = - DimExpr { - dimExprAnnotations :: [Annotation], - dimExprExpression :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_DimExpr = (Core.Name "hydra/langs/java/syntax.DimExpr") - -_DimExpr_annotations = (Core.Name "annotations") - -_DimExpr_expression = (Core.Name "expression") - -data Expression = - ExpressionLambda LambdaExpression | - ExpressionAssignment AssignmentExpression - deriving (Eq, Ord, Read, Show) - -_Expression = (Core.Name "hydra/langs/java/syntax.Expression") - -_Expression_lambda = (Core.Name "lambda") - -_Expression_assignment = (Core.Name "assignment") - -data LambdaExpression = - LambdaExpression { - lambdaExpressionParameters :: LambdaParameters, - lambdaExpressionBody :: LambdaBody} - deriving (Eq, Ord, Read, Show) - -_LambdaExpression = (Core.Name "hydra/langs/java/syntax.LambdaExpression") - -_LambdaExpression_parameters = (Core.Name "parameters") - -_LambdaExpression_body = (Core.Name "body") - -data LambdaParameters = - LambdaParametersTuple [LambdaParameters] | - LambdaParametersSingle Identifier - deriving (Eq, Ord, Read, Show) - -_LambdaParameters = (Core.Name "hydra/langs/java/syntax.LambdaParameters") - -_LambdaParameters_tuple = (Core.Name "tuple") - -_LambdaParameters_single = (Core.Name "single") - -data LambdaParameter = - LambdaParameterNormal LambdaParameter_Normal | - LambdaParameterVariableArity VariableArityParameter - deriving (Eq, Ord, Read, Show) - -_LambdaParameter = (Core.Name "hydra/langs/java/syntax.LambdaParameter") - -_LambdaParameter_normal = (Core.Name "normal") - -_LambdaParameter_variableArity = (Core.Name "variableArity") - -data LambdaParameter_Normal = - LambdaParameter_Normal { - lambdaParameter_NormalModifiers :: [VariableModifier], - lambdaParameter_NormalType :: LambdaParameterType, - lambdaParameter_NormalId :: VariableDeclaratorId} - deriving (Eq, Ord, Read, Show) - -_LambdaParameter_Normal = (Core.Name "hydra/langs/java/syntax.LambdaParameter.Normal") - -_LambdaParameter_Normal_modifiers = (Core.Name "modifiers") - -_LambdaParameter_Normal_type = (Core.Name "type") - -_LambdaParameter_Normal_id = (Core.Name "id") - -data LambdaParameterType = - LambdaParameterTypeType UnannType | - LambdaParameterTypeVar - deriving (Eq, Ord, Read, Show) - -_LambdaParameterType = (Core.Name "hydra/langs/java/syntax.LambdaParameterType") - -_LambdaParameterType_type = (Core.Name "type") - -_LambdaParameterType_var = (Core.Name "var") - -data LambdaBody = - LambdaBodyExpression Expression | - LambdaBodyBlock Block - deriving (Eq, Ord, Read, Show) - -_LambdaBody = (Core.Name "hydra/langs/java/syntax.LambdaBody") - -_LambdaBody_expression = (Core.Name "expression") - -_LambdaBody_block = (Core.Name "block") - -data AssignmentExpression = - AssignmentExpressionConditional ConditionalExpression | - AssignmentExpressionAssignment Assignment - deriving (Eq, Ord, Read, Show) - -_AssignmentExpression = (Core.Name "hydra/langs/java/syntax.AssignmentExpression") - -_AssignmentExpression_conditional = (Core.Name "conditional") - -_AssignmentExpression_assignment = (Core.Name "assignment") - -data Assignment = - Assignment { - assignmentLhs :: LeftHandSide, - assignmentOp :: AssignmentOperator, - assignmentExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_Assignment = (Core.Name "hydra/langs/java/syntax.Assignment") - -_Assignment_lhs = (Core.Name "lhs") - -_Assignment_op = (Core.Name "op") - -_Assignment_expression = (Core.Name "expression") - -data LeftHandSide = - LeftHandSideExpressionName ExpressionName | - LeftHandSideFieldAccess FieldAccess | - LeftHandSideArrayAccess ArrayAccess - deriving (Eq, Ord, Read, Show) - -_LeftHandSide = (Core.Name "hydra/langs/java/syntax.LeftHandSide") - -_LeftHandSide_expressionName = (Core.Name "expressionName") - -_LeftHandSide_fieldAccess = (Core.Name "fieldAccess") - -_LeftHandSide_arrayAccess = (Core.Name "arrayAccess") - -data AssignmentOperator = - AssignmentOperatorSimple | - AssignmentOperatorTimes | - AssignmentOperatorDiv | - AssignmentOperatorMod | - AssignmentOperatorPlus | - AssignmentOperatorMinus | - AssignmentOperatorShiftLeft | - AssignmentOperatorShiftRight | - AssignmentOperatorShiftRightZeroFill | - AssignmentOperatorAnd | - AssignmentOperatorXor | - AssignmentOperatorOr - deriving (Eq, Ord, Read, Show) - -_AssignmentOperator = (Core.Name "hydra/langs/java/syntax.AssignmentOperator") - -_AssignmentOperator_simple = (Core.Name "simple") - -_AssignmentOperator_times = (Core.Name "times") - -_AssignmentOperator_div = (Core.Name "div") - -_AssignmentOperator_mod = (Core.Name "mod") - -_AssignmentOperator_plus = (Core.Name "plus") - -_AssignmentOperator_minus = (Core.Name "minus") - -_AssignmentOperator_shiftLeft = (Core.Name "shiftLeft") - -_AssignmentOperator_shiftRight = (Core.Name "shiftRight") - -_AssignmentOperator_shiftRightZeroFill = (Core.Name "shiftRightZeroFill") - -_AssignmentOperator_and = (Core.Name "and") - -_AssignmentOperator_xor = (Core.Name "xor") - -_AssignmentOperator_or = (Core.Name "or") - -data ConditionalExpression = - ConditionalExpressionSimple ConditionalOrExpression | - ConditionalExpressionTernaryCond ConditionalExpression_TernaryCond | - ConditionalExpressionTernaryLambda ConditionalExpression_TernaryLambda - deriving (Eq, Ord, Read, Show) - -_ConditionalExpression = (Core.Name "hydra/langs/java/syntax.ConditionalExpression") - -_ConditionalExpression_simple = (Core.Name "simple") - -_ConditionalExpression_ternaryCond = (Core.Name "ternaryCond") - -_ConditionalExpression_ternaryLambda = (Core.Name "ternaryLambda") - -data ConditionalExpression_TernaryCond = - ConditionalExpression_TernaryCond { - conditionalExpression_TernaryCondCond :: ConditionalOrExpression, - conditionalExpression_TernaryCondIfTrue :: Expression, - conditionalExpression_TernaryCondIfFalse :: ConditionalExpression} - deriving (Eq, Ord, Read, Show) - -_ConditionalExpression_TernaryCond = (Core.Name "hydra/langs/java/syntax.ConditionalExpression.TernaryCond") - -_ConditionalExpression_TernaryCond_cond = (Core.Name "cond") - -_ConditionalExpression_TernaryCond_ifTrue = (Core.Name "ifTrue") - -_ConditionalExpression_TernaryCond_ifFalse = (Core.Name "ifFalse") - -data ConditionalExpression_TernaryLambda = - ConditionalExpression_TernaryLambda { - conditionalExpression_TernaryLambdaCond :: ConditionalOrExpression, - conditionalExpression_TernaryLambdaIfTrue :: Expression, - conditionalExpression_TernaryLambdaIfFalse :: LambdaExpression} - deriving (Eq, Ord, Read, Show) - -_ConditionalExpression_TernaryLambda = (Core.Name "hydra/langs/java/syntax.ConditionalExpression.TernaryLambda") - -_ConditionalExpression_TernaryLambda_cond = (Core.Name "cond") - -_ConditionalExpression_TernaryLambda_ifTrue = (Core.Name "ifTrue") - -_ConditionalExpression_TernaryLambda_ifFalse = (Core.Name "ifFalse") - -newtype ConditionalOrExpression = - ConditionalOrExpression { - unConditionalOrExpression :: [ConditionalAndExpression]} - deriving (Eq, Ord, Read, Show) - -_ConditionalOrExpression = (Core.Name "hydra/langs/java/syntax.ConditionalOrExpression") - -newtype ConditionalAndExpression = - ConditionalAndExpression { - unConditionalAndExpression :: [InclusiveOrExpression]} - deriving (Eq, Ord, Read, Show) - -_ConditionalAndExpression = (Core.Name "hydra/langs/java/syntax.ConditionalAndExpression") - -newtype InclusiveOrExpression = - InclusiveOrExpression { - unInclusiveOrExpression :: [ExclusiveOrExpression]} - deriving (Eq, Ord, Read, Show) - -_InclusiveOrExpression = (Core.Name "hydra/langs/java/syntax.InclusiveOrExpression") - -newtype ExclusiveOrExpression = - ExclusiveOrExpression { - unExclusiveOrExpression :: [AndExpression]} - deriving (Eq, Ord, Read, Show) - -_ExclusiveOrExpression = (Core.Name "hydra/langs/java/syntax.ExclusiveOrExpression") - -newtype AndExpression = - AndExpression { - unAndExpression :: [EqualityExpression]} - deriving (Eq, Ord, Read, Show) - -_AndExpression = (Core.Name "hydra/langs/java/syntax.AndExpression") - -data EqualityExpression = - EqualityExpressionUnary RelationalExpression | - EqualityExpressionEqual EqualityExpression_Binary | - EqualityExpressionNotEqual EqualityExpression_Binary - deriving (Eq, Ord, Read, Show) - -_EqualityExpression = (Core.Name "hydra/langs/java/syntax.EqualityExpression") - -_EqualityExpression_unary = (Core.Name "unary") - -_EqualityExpression_equal = (Core.Name "equal") - -_EqualityExpression_notEqual = (Core.Name "notEqual") - -data EqualityExpression_Binary = - EqualityExpression_Binary { - equalityExpression_BinaryLhs :: EqualityExpression, - equalityExpression_BinaryRhs :: RelationalExpression} - deriving (Eq, Ord, Read, Show) - -_EqualityExpression_Binary = (Core.Name "hydra/langs/java/syntax.EqualityExpression.Binary") - -_EqualityExpression_Binary_lhs = (Core.Name "lhs") - -_EqualityExpression_Binary_rhs = (Core.Name "rhs") - -data RelationalExpression = - RelationalExpressionSimple ShiftExpression | - RelationalExpressionLessThan RelationalExpression_LessThan | - RelationalExpressionGreaterThan RelationalExpression_GreaterThan | - RelationalExpressionLessThanEqual RelationalExpression_LessThanEqual | - RelationalExpressionGreaterThanEqual RelationalExpression_GreaterThanEqual | - RelationalExpressionInstanceof RelationalExpression_InstanceOf - deriving (Eq, Ord, Read, Show) - -_RelationalExpression = (Core.Name "hydra/langs/java/syntax.RelationalExpression") - -_RelationalExpression_simple = (Core.Name "simple") - -_RelationalExpression_lessThan = (Core.Name "lessThan") - -_RelationalExpression_greaterThan = (Core.Name "greaterThan") - -_RelationalExpression_lessThanEqual = (Core.Name "lessThanEqual") - -_RelationalExpression_greaterThanEqual = (Core.Name "greaterThanEqual") - -_RelationalExpression_instanceof = (Core.Name "instanceof") - -data RelationalExpression_LessThan = - RelationalExpression_LessThan { - relationalExpression_LessThanLhs :: RelationalExpression, - relationalExpression_LessThanRhs :: ShiftExpression} - deriving (Eq, Ord, Read, Show) - -_RelationalExpression_LessThan = (Core.Name "hydra/langs/java/syntax.RelationalExpression.LessThan") - -_RelationalExpression_LessThan_lhs = (Core.Name "lhs") - -_RelationalExpression_LessThan_rhs = (Core.Name "rhs") - -data RelationalExpression_GreaterThan = - RelationalExpression_GreaterThan { - relationalExpression_GreaterThanLhs :: RelationalExpression, - relationalExpression_GreaterThanRhs :: ShiftExpression} - deriving (Eq, Ord, Read, Show) - -_RelationalExpression_GreaterThan = (Core.Name "hydra/langs/java/syntax.RelationalExpression.GreaterThan") - -_RelationalExpression_GreaterThan_lhs = (Core.Name "lhs") - -_RelationalExpression_GreaterThan_rhs = (Core.Name "rhs") - -data RelationalExpression_LessThanEqual = - RelationalExpression_LessThanEqual { - relationalExpression_LessThanEqualLhs :: RelationalExpression, - relationalExpression_LessThanEqualRhs :: ShiftExpression} - deriving (Eq, Ord, Read, Show) - -_RelationalExpression_LessThanEqual = (Core.Name "hydra/langs/java/syntax.RelationalExpression.LessThanEqual") - -_RelationalExpression_LessThanEqual_lhs = (Core.Name "lhs") - -_RelationalExpression_LessThanEqual_rhs = (Core.Name "rhs") - -data RelationalExpression_GreaterThanEqual = - RelationalExpression_GreaterThanEqual { - relationalExpression_GreaterThanEqualLhs :: RelationalExpression, - relationalExpression_GreaterThanEqualRhs :: ShiftExpression} - deriving (Eq, Ord, Read, Show) - -_RelationalExpression_GreaterThanEqual = (Core.Name "hydra/langs/java/syntax.RelationalExpression.GreaterThanEqual") - -_RelationalExpression_GreaterThanEqual_lhs = (Core.Name "lhs") - -_RelationalExpression_GreaterThanEqual_rhs = (Core.Name "rhs") - -data RelationalExpression_InstanceOf = - RelationalExpression_InstanceOf { - relationalExpression_InstanceOfLhs :: RelationalExpression, - relationalExpression_InstanceOfRhs :: ReferenceType} - deriving (Eq, Ord, Read, Show) - -_RelationalExpression_InstanceOf = (Core.Name "hydra/langs/java/syntax.RelationalExpression.InstanceOf") - -_RelationalExpression_InstanceOf_lhs = (Core.Name "lhs") - -_RelationalExpression_InstanceOf_rhs = (Core.Name "rhs") - -data ShiftExpression = - ShiftExpressionUnary AdditiveExpression | - ShiftExpressionShiftLeft ShiftExpression_Binary | - ShiftExpressionShiftRight ShiftExpression_Binary | - ShiftExpressionShiftRightZeroFill ShiftExpression_Binary - deriving (Eq, Ord, Read, Show) - -_ShiftExpression = (Core.Name "hydra/langs/java/syntax.ShiftExpression") - -_ShiftExpression_unary = (Core.Name "unary") - -_ShiftExpression_shiftLeft = (Core.Name "shiftLeft") - -_ShiftExpression_shiftRight = (Core.Name "shiftRight") - -_ShiftExpression_shiftRightZeroFill = (Core.Name "shiftRightZeroFill") - -data ShiftExpression_Binary = - ShiftExpression_Binary { - shiftExpression_BinaryLhs :: ShiftExpression, - shiftExpression_BinaryRhs :: AdditiveExpression} - deriving (Eq, Ord, Read, Show) - -_ShiftExpression_Binary = (Core.Name "hydra/langs/java/syntax.ShiftExpression.Binary") - -_ShiftExpression_Binary_lhs = (Core.Name "lhs") - -_ShiftExpression_Binary_rhs = (Core.Name "rhs") - -data AdditiveExpression = - AdditiveExpressionUnary MultiplicativeExpression | - AdditiveExpressionPlus AdditiveExpression_Binary | - AdditiveExpressionMinus AdditiveExpression_Binary - deriving (Eq, Ord, Read, Show) - -_AdditiveExpression = (Core.Name "hydra/langs/java/syntax.AdditiveExpression") - -_AdditiveExpression_unary = (Core.Name "unary") - -_AdditiveExpression_plus = (Core.Name "plus") - -_AdditiveExpression_minus = (Core.Name "minus") - -data AdditiveExpression_Binary = - AdditiveExpression_Binary { - additiveExpression_BinaryLhs :: AdditiveExpression, - additiveExpression_BinaryRhs :: MultiplicativeExpression} - deriving (Eq, Ord, Read, Show) - -_AdditiveExpression_Binary = (Core.Name "hydra/langs/java/syntax.AdditiveExpression.Binary") - -_AdditiveExpression_Binary_lhs = (Core.Name "lhs") - -_AdditiveExpression_Binary_rhs = (Core.Name "rhs") - -data MultiplicativeExpression = - MultiplicativeExpressionUnary UnaryExpression | - MultiplicativeExpressionTimes MultiplicativeExpression_Binary | - MultiplicativeExpressionDivide MultiplicativeExpression_Binary | - MultiplicativeExpressionMod MultiplicativeExpression_Binary - deriving (Eq, Ord, Read, Show) - -_MultiplicativeExpression = (Core.Name "hydra/langs/java/syntax.MultiplicativeExpression") - -_MultiplicativeExpression_unary = (Core.Name "unary") - -_MultiplicativeExpression_times = (Core.Name "times") - -_MultiplicativeExpression_divide = (Core.Name "divide") - -_MultiplicativeExpression_mod = (Core.Name "mod") - -data MultiplicativeExpression_Binary = - MultiplicativeExpression_Binary { - multiplicativeExpression_BinaryLhs :: MultiplicativeExpression, - multiplicativeExpression_BinaryRhs :: UnaryExpression} - deriving (Eq, Ord, Read, Show) - -_MultiplicativeExpression_Binary = (Core.Name "hydra/langs/java/syntax.MultiplicativeExpression.Binary") - -_MultiplicativeExpression_Binary_lhs = (Core.Name "lhs") - -_MultiplicativeExpression_Binary_rhs = (Core.Name "rhs") - -data UnaryExpression = - UnaryExpressionPreIncrement PreIncrementExpression | - UnaryExpressionPreDecrement PreDecrementExpression | - UnaryExpressionPlus UnaryExpression | - UnaryExpressionMinus UnaryExpression | - UnaryExpressionOther UnaryExpressionNotPlusMinus - deriving (Eq, Ord, Read, Show) - -_UnaryExpression = (Core.Name "hydra/langs/java/syntax.UnaryExpression") - -_UnaryExpression_preIncrement = (Core.Name "preIncrement") - -_UnaryExpression_preDecrement = (Core.Name "preDecrement") - -_UnaryExpression_plus = (Core.Name "plus") - -_UnaryExpression_minus = (Core.Name "minus") - -_UnaryExpression_other = (Core.Name "other") - -newtype PreIncrementExpression = - PreIncrementExpression { - unPreIncrementExpression :: UnaryExpression} - deriving (Eq, Ord, Read, Show) - -_PreIncrementExpression = (Core.Name "hydra/langs/java/syntax.PreIncrementExpression") - -newtype PreDecrementExpression = - PreDecrementExpression { - unPreDecrementExpression :: UnaryExpression} - deriving (Eq, Ord, Read, Show) - -_PreDecrementExpression = (Core.Name "hydra/langs/java/syntax.PreDecrementExpression") - -data UnaryExpressionNotPlusMinus = - UnaryExpressionNotPlusMinusPostfix PostfixExpression | - UnaryExpressionNotPlusMinusTilde UnaryExpression | - UnaryExpressionNotPlusMinusNot UnaryExpression | - UnaryExpressionNotPlusMinusCast CastExpression - deriving (Eq, Ord, Read, Show) - -_UnaryExpressionNotPlusMinus = (Core.Name "hydra/langs/java/syntax.UnaryExpressionNotPlusMinus") - -_UnaryExpressionNotPlusMinus_postfix = (Core.Name "postfix") - -_UnaryExpressionNotPlusMinus_tilde = (Core.Name "tilde") - -_UnaryExpressionNotPlusMinus_not = (Core.Name "not") - -_UnaryExpressionNotPlusMinus_cast = (Core.Name "cast") - -data PostfixExpression = - PostfixExpressionPrimary Primary | - PostfixExpressionName ExpressionName | - PostfixExpressionPostIncrement PostIncrementExpression | - PostfixExpressionPostDecrement PostDecrementExpression - deriving (Eq, Ord, Read, Show) - -_PostfixExpression = (Core.Name "hydra/langs/java/syntax.PostfixExpression") - -_PostfixExpression_primary = (Core.Name "primary") - -_PostfixExpression_name = (Core.Name "name") - -_PostfixExpression_postIncrement = (Core.Name "postIncrement") - -_PostfixExpression_postDecrement = (Core.Name "postDecrement") - -newtype PostIncrementExpression = - PostIncrementExpression { - unPostIncrementExpression :: PostfixExpression} - deriving (Eq, Ord, Read, Show) - -_PostIncrementExpression = (Core.Name "hydra/langs/java/syntax.PostIncrementExpression") - -newtype PostDecrementExpression = - PostDecrementExpression { - unPostDecrementExpression :: PostfixExpression} - deriving (Eq, Ord, Read, Show) - -_PostDecrementExpression = (Core.Name "hydra/langs/java/syntax.PostDecrementExpression") - -data CastExpression = - CastExpressionPrimitive CastExpression_Primitive | - CastExpressionNotPlusMinus CastExpression_NotPlusMinus | - CastExpressionLambda CastExpression_Lambda - deriving (Eq, Ord, Read, Show) - -_CastExpression = (Core.Name "hydra/langs/java/syntax.CastExpression") - -_CastExpression_primitive = (Core.Name "primitive") - -_CastExpression_notPlusMinus = (Core.Name "notPlusMinus") - -_CastExpression_lambda = (Core.Name "lambda") - -data CastExpression_Primitive = - CastExpression_Primitive { - castExpression_PrimitiveType :: PrimitiveTypeWithAnnotations, - castExpression_PrimitiveExpression :: UnaryExpression} - deriving (Eq, Ord, Read, Show) - -_CastExpression_Primitive = (Core.Name "hydra/langs/java/syntax.CastExpression.Primitive") - -_CastExpression_Primitive_type = (Core.Name "type") - -_CastExpression_Primitive_expression = (Core.Name "expression") - -data CastExpression_NotPlusMinus = - CastExpression_NotPlusMinus { - castExpression_NotPlusMinusRefAndBounds :: CastExpression_RefAndBounds, - castExpression_NotPlusMinusExpression :: UnaryExpression} - deriving (Eq, Ord, Read, Show) - -_CastExpression_NotPlusMinus = (Core.Name "hydra/langs/java/syntax.CastExpression.NotPlusMinus") - -_CastExpression_NotPlusMinus_refAndBounds = (Core.Name "refAndBounds") - -_CastExpression_NotPlusMinus_expression = (Core.Name "expression") - -data CastExpression_Lambda = - CastExpression_Lambda { - castExpression_LambdaRefAndBounds :: CastExpression_RefAndBounds, - castExpression_LambdaExpression :: LambdaExpression} - deriving (Eq, Ord, Read, Show) - -_CastExpression_Lambda = (Core.Name "hydra/langs/java/syntax.CastExpression.Lambda") - -_CastExpression_Lambda_refAndBounds = (Core.Name "refAndBounds") - -_CastExpression_Lambda_expression = (Core.Name "expression") - -data CastExpression_RefAndBounds = - CastExpression_RefAndBounds { - castExpression_RefAndBoundsType :: ReferenceType, - castExpression_RefAndBoundsBounds :: [AdditionalBound]} - deriving (Eq, Ord, Read, Show) - -_CastExpression_RefAndBounds = (Core.Name "hydra/langs/java/syntax.CastExpression.RefAndBounds") - -_CastExpression_RefAndBounds_type = (Core.Name "type") - -_CastExpression_RefAndBounds_bounds = (Core.Name "bounds") - -newtype ConstantExpression = - ConstantExpression { - unConstantExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_ConstantExpression = (Core.Name "hydra/langs/java/syntax.ConstantExpression") diff --git a/src/gen-main/haskell/Hydra/Langs/Json/Decoding.hs b/src/gen-main/haskell/Hydra/Langs/Json/Decoding.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Json/Decoding.hs +++ /dev/null @@ -1,50 +0,0 @@ --- | Decoding functions for JSON data - -module Hydra.Langs.Json.Decoding where - -import qualified Hydra.Compute as Compute -import qualified Hydra.Json as Json -import qualified Hydra.Lib.Flows as Flows -import qualified Hydra.Lib.Maps as Maps -import qualified Hydra.Lib.Strings as Strings -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -decodeString :: (Json.Value -> Compute.Flow s String) -decodeString x = case x of - Json.ValueString v277 -> (Flows.pure v277) - _ -> (Flows.fail "expected a string") - -decodeNumber :: (Json.Value -> Compute.Flow s Double) -decodeNumber x = case x of - Json.ValueNumber v278 -> (Flows.pure v278) - _ -> (Flows.fail "expected a number") - -decodeBoolean :: (Json.Value -> Compute.Flow s Bool) -decodeBoolean x = case x of - Json.ValueBoolean v279 -> (Flows.pure v279) - _ -> (Flows.fail "expected a boolean") - -decodeArray :: ((Json.Value -> Compute.Flow s a) -> Json.Value -> Compute.Flow s [a]) -decodeArray decodeElem x = case x of - Json.ValueArray v280 -> (Flows.mapList decodeElem v280) - _ -> (Flows.fail "expected an array") - -decodeObject :: (Json.Value -> Compute.Flow s (Map String Json.Value)) -decodeObject x = case x of - Json.ValueObject v281 -> (Flows.pure v281) - _ -> (Flows.fail "expected an object") - -decodeField :: ((Json.Value -> Compute.Flow s a) -> String -> Map String Json.Value -> Compute.Flow s a) -decodeField decodeValue name m = (Flows.bind (decodeOptionalField decodeValue name m) (\x -> case x of - Nothing -> (Flows.fail (Strings.cat [ - "missing field: ", - name])) - Just v282 -> (Flows.pure v282))) - -decodeOptionalField :: ((Json.Value -> Compute.Flow s a) -> String -> Map String Json.Value -> Compute.Flow s (Maybe a)) -decodeOptionalField decodeValue name m = ((\x -> case x of - Nothing -> (Flows.pure Nothing) - Just v283 -> (Flows.map (\x -> Just x) (decodeValue v283))) (Maps.lookup name m)) diff --git a/src/gen-main/haskell/Hydra/Langs/Kusto/Kql.hs b/src/gen-main/haskell/Hydra/Langs/Kusto/Kql.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Kusto/Kql.hs +++ /dev/null @@ -1,695 +0,0 @@ --- | A partial KQL (Kusto Query Language) model, based on examples from the documentation. Not normative. - -module Hydra.Langs.Kusto.Kql where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data BetweenExpression = - BetweenExpression { - betweenExpressionNot :: Bool, - betweenExpressionExpression :: Expression, - betweenExpressionLowerBound :: Expression, - betweenExpressionUpperBound :: Expression} - deriving (Eq, Ord, Read, Show) - -_BetweenExpression = (Core.Name "hydra/langs/kusto/kql.BetweenExpression") - -_BetweenExpression_not = (Core.Name "not") - -_BetweenExpression_expression = (Core.Name "expression") - -_BetweenExpression_lowerBound = (Core.Name "lowerBound") - -_BetweenExpression_upperBound = (Core.Name "upperBound") - -data BinaryExpression = - BinaryExpression { - binaryExpressionLeft :: Expression, - binaryExpressionOperator :: BinaryOperator, - binaryExpressionRight :: Expression} - deriving (Eq, Ord, Read, Show) - -_BinaryExpression = (Core.Name "hydra/langs/kusto/kql.BinaryExpression") - -_BinaryExpression_left = (Core.Name "left") - -_BinaryExpression_operator = (Core.Name "operator") - -_BinaryExpression_right = (Core.Name "right") - -data BinaryOperator = - BinaryOperatorCaseInsensitiveEqual | - BinaryOperatorContains | - BinaryOperatorDivide | - BinaryOperatorEndsWith | - BinaryOperatorEqual | - BinaryOperatorGreater | - BinaryOperatorGreaterOrEqual | - BinaryOperatorHas | - BinaryOperatorHasPrefix | - BinaryOperatorHasSuffix | - BinaryOperatorLess | - BinaryOperatorLessOrEqual | - BinaryOperatorMatchesRegex | - BinaryOperatorMinus | - BinaryOperatorNotEqual | - BinaryOperatorPlus | - BinaryOperatorStartsWith | - BinaryOperatorTimes - deriving (Eq, Ord, Read, Show) - -_BinaryOperator = (Core.Name "hydra/langs/kusto/kql.BinaryOperator") - -_BinaryOperator_caseInsensitiveEqual = (Core.Name "caseInsensitiveEqual") - -_BinaryOperator_contains = (Core.Name "contains") - -_BinaryOperator_divide = (Core.Name "divide") - -_BinaryOperator_endsWith = (Core.Name "endsWith") - -_BinaryOperator_equal = (Core.Name "equal") - -_BinaryOperator_greater = (Core.Name "greater") - -_BinaryOperator_greaterOrEqual = (Core.Name "greaterOrEqual") - -_BinaryOperator_has = (Core.Name "has") - -_BinaryOperator_hasPrefix = (Core.Name "hasPrefix") - -_BinaryOperator_hasSuffix = (Core.Name "hasSuffix") - -_BinaryOperator_less = (Core.Name "less") - -_BinaryOperator_lessOrEqual = (Core.Name "lessOrEqual") - -_BinaryOperator_matchesRegex = (Core.Name "matchesRegex") - -_BinaryOperator_minus = (Core.Name "minus") - -_BinaryOperator_notEqual = (Core.Name "notEqual") - -_BinaryOperator_plus = (Core.Name "plus") - -_BinaryOperator_startsWith = (Core.Name "startsWith") - -_BinaryOperator_times = (Core.Name "times") - -data BuiltInFunction = - BuiltInFunctionAgo | - BuiltInFunctionBin | - BuiltInFunctionCount | - BuiltInFunctionDcount | - BuiltInFunctionEndofday | - BuiltInFunctionExtract | - BuiltInFunctionFormat_datetime | - BuiltInFunctionMaterialize | - BuiltInFunctionNow | - BuiltInFunctionRange | - BuiltInFunctionStartofday | - BuiltInFunctionStrcat | - BuiltInFunctionTodynamic - deriving (Eq, Ord, Read, Show) - -_BuiltInFunction = (Core.Name "hydra/langs/kusto/kql.BuiltInFunction") - -_BuiltInFunction_ago = (Core.Name "ago") - -_BuiltInFunction_bin = (Core.Name "bin") - -_BuiltInFunction_count = (Core.Name "count") - -_BuiltInFunction_dcount = (Core.Name "dcount") - -_BuiltInFunction_endofday = (Core.Name "endofday") - -_BuiltInFunction_extract = (Core.Name "extract") - -_BuiltInFunction_format_datetime = (Core.Name "format_datetime") - -_BuiltInFunction_materialize = (Core.Name "materialize") - -_BuiltInFunction_now = (Core.Name "now") - -_BuiltInFunction_range = (Core.Name "range") - -_BuiltInFunction_startofday = (Core.Name "startofday") - -_BuiltInFunction_strcat = (Core.Name "strcat") - -_BuiltInFunction_todynamic = (Core.Name "todynamic") - -data ColumnAlias = - ColumnAlias { - columnAliasColumn :: ColumnName, - columnAliasAlias :: ColumnName} - deriving (Eq, Ord, Read, Show) - -_ColumnAlias = (Core.Name "hydra/langs/kusto/kql.ColumnAlias") - -_ColumnAlias_column = (Core.Name "column") - -_ColumnAlias_alias = (Core.Name "alias") - -data ColumnAssignment = - ColumnAssignment { - columnAssignmentColumn :: ColumnName, - columnAssignmentExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_ColumnAssignment = (Core.Name "hydra/langs/kusto/kql.ColumnAssignment") - -_ColumnAssignment_column = (Core.Name "column") - -_ColumnAssignment_expression = (Core.Name "expression") - -newtype ColumnName = - ColumnName { - unColumnName :: String} - deriving (Eq, Ord, Read, Show) - -_ColumnName = (Core.Name "hydra/langs/kusto/kql.ColumnName") - -data Columns = - ColumnsAll | - ColumnsSingle ColumnName - deriving (Eq, Ord, Read, Show) - -_Columns = (Core.Name "hydra/langs/kusto/kql.Columns") - -_Columns_all = (Core.Name "all") - -_Columns_single = (Core.Name "single") - -data Command = - CommandCount | - -- | See https://learn.microsoft.com/en-us/azure/data-explorer/kusto/query/distinct-operator - CommandDistinct [ColumnName] | - CommandExtend [ColumnAssignment] | - CommandJoin JoinCommand | - CommandLimit Int | - CommandMvexpand ColumnName | - CommandOrderBy [SortBy] | - CommandParse ParseCommand | - CommandPrint PrintCommand | - CommandProject [Projection] | - CommandProjectAway [ColumnName] | - CommandProjectRename [ColumnAlias] | - CommandRender String | - CommandSearch SearchCommand | - CommandSortBy [SortBy] | - CommandSummarize SummarizeCommand | - -- | Limit a search to a specified number of results - CommandTake Int | - CommandTop TopCommand | - CommandUnion UnionCommand | - CommandWhere Expression - deriving (Eq, Ord, Read, Show) - -_Command = (Core.Name "hydra/langs/kusto/kql.Command") - -_Command_count = (Core.Name "count") - -_Command_distinct = (Core.Name "distinct") - -_Command_extend = (Core.Name "extend") - -_Command_join = (Core.Name "join") - -_Command_limit = (Core.Name "limit") - -_Command_mvexpand = (Core.Name "mvexpand") - -_Command_orderBy = (Core.Name "orderBy") - -_Command_parse = (Core.Name "parse") - -_Command_print = (Core.Name "print") - -_Command_project = (Core.Name "project") - -_Command_projectAway = (Core.Name "projectAway") - -_Command_projectRename = (Core.Name "projectRename") - -_Command_render = (Core.Name "render") - -_Command_search = (Core.Name "search") - -_Command_sortBy = (Core.Name "sortBy") - -_Command_summarize = (Core.Name "summarize") - -_Command_take = (Core.Name "take") - -_Command_top = (Core.Name "top") - -_Command_union = (Core.Name "union") - -_Command_where = (Core.Name "where") - -newtype Datetime = - Datetime { - unDatetime :: String} - deriving (Eq, Ord, Read, Show) - -_Datetime = (Core.Name "hydra/langs/kusto/kql.Datetime") - -data Duration = - Duration { - durationValue :: Int, - durationUnit :: DurationUnit} - deriving (Eq, Ord, Read, Show) - -_Duration = (Core.Name "hydra/langs/kusto/kql.Duration") - -_Duration_value = (Core.Name "value") - -_Duration_unit = (Core.Name "unit") - -data DurationUnit = - DurationUnitSecond | - DurationUnitMinute | - DurationUnitHour - deriving (Eq, Ord, Read, Show) - -_DurationUnit = (Core.Name "hydra/langs/kusto/kql.DurationUnit") - -_DurationUnit_second = (Core.Name "second") - -_DurationUnit_minute = (Core.Name "minute") - -_DurationUnit_hour = (Core.Name "hour") - -data Expression = - ExpressionAnd [Expression] | - ExpressionAny | - ExpressionBetween BetweenExpression | - ExpressionBinary BinaryExpression | - ExpressionBraces Expression | - ExpressionColumn ColumnName | - ExpressionDataset TableName | - ExpressionIndex IndexExpression | - ExpressionList [Expression] | - ExpressionLiteral Literal | - ExpressionOr [Expression] | - ExpressionParentheses Expression | - ExpressionProperty PropertyExpression | - ExpressionUnary UnaryExpression - deriving (Eq, Ord, Read, Show) - -_Expression = (Core.Name "hydra/langs/kusto/kql.Expression") - -_Expression_and = (Core.Name "and") - -_Expression_any = (Core.Name "any") - -_Expression_between = (Core.Name "between") - -_Expression_binary = (Core.Name "binary") - -_Expression_braces = (Core.Name "braces") - -_Expression_column = (Core.Name "column") - -_Expression_dataset = (Core.Name "dataset") - -_Expression_index = (Core.Name "index") - -_Expression_list = (Core.Name "list") - -_Expression_literal = (Core.Name "literal") - -_Expression_or = (Core.Name "or") - -_Expression_parentheses = (Core.Name "parentheses") - -_Expression_property = (Core.Name "property") - -_Expression_unary = (Core.Name "unary") - -data Function = - FunctionBuiltIn BuiltInFunction | - FunctionCustom FunctionName - deriving (Eq, Ord, Read, Show) - -_Function = (Core.Name "hydra/langs/kusto/kql.Function") - -_Function_builtIn = (Core.Name "builtIn") - -_Function_custom = (Core.Name "custom") - -data FunctionExpression = - FunctionExpression { - functionExpressionFunction :: Function, - functionExpressionArguments :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_FunctionExpression = (Core.Name "hydra/langs/kusto/kql.FunctionExpression") - -_FunctionExpression_function = (Core.Name "function") - -_FunctionExpression_arguments = (Core.Name "arguments") - -newtype FunctionName = - FunctionName { - unFunctionName :: String} - deriving (Eq, Ord, Read, Show) - -_FunctionName = (Core.Name "hydra/langs/kusto/kql.FunctionName") - -data IndexExpression = - IndexExpression { - indexExpressionExpression :: Expression, - indexExpressionIndex :: String} - deriving (Eq, Ord, Read, Show) - -_IndexExpression = (Core.Name "hydra/langs/kusto/kql.IndexExpression") - -_IndexExpression_expression = (Core.Name "expression") - -_IndexExpression_index = (Core.Name "index") - -data JoinCommand = - JoinCommand { - joinCommandKind :: JoinKind, - joinCommandExpression :: TableName, - joinCommandOn :: Expression} - deriving (Eq, Ord, Read, Show) - -_JoinCommand = (Core.Name "hydra/langs/kusto/kql.JoinCommand") - -_JoinCommand_kind = (Core.Name "kind") - -_JoinCommand_expression = (Core.Name "expression") - -_JoinCommand_on = (Core.Name "on") - -data JoinKind = - JoinKindLeftouter | - JoinKindLeftsemi | - JoinKindLeftanti | - JoinKindFullouter | - JoinKindInner | - JoinKindInnerunique | - JoinKindRightouter | - JoinKindRightsemi | - JoinKindRightanti - deriving (Eq, Ord, Read, Show) - -_JoinKind = (Core.Name "hydra/langs/kusto/kql.JoinKind") - -_JoinKind_leftouter = (Core.Name "leftouter") - -_JoinKind_leftsemi = (Core.Name "leftsemi") - -_JoinKind_leftanti = (Core.Name "leftanti") - -_JoinKind_fullouter = (Core.Name "fullouter") - -_JoinKind_inner = (Core.Name "inner") - -_JoinKind_innerunique = (Core.Name "innerunique") - -_JoinKind_rightouter = (Core.Name "rightouter") - -_JoinKind_rightsemi = (Core.Name "rightsemi") - -_JoinKind_rightanti = (Core.Name "rightanti") - -data KeyValuePair = - KeyValuePair { - keyValuePairKey :: String, - keyValuePairValue :: Expression} - deriving (Eq, Ord, Read, Show) - -_KeyValuePair = (Core.Name "hydra/langs/kusto/kql.KeyValuePair") - -_KeyValuePair_key = (Core.Name "key") - -_KeyValuePair_value = (Core.Name "value") - -data LetBinding = - LetBinding { - letBindingName :: ColumnName, - letBindingExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_LetBinding = (Core.Name "hydra/langs/kusto/kql.LetBinding") - -_LetBinding_name = (Core.Name "name") - -_LetBinding_expression = (Core.Name "expression") - -data LetExpression = - LetExpression { - letExpressionBindings :: [LetBinding], - letExpressionExpression :: TabularExpression} - deriving (Eq, Ord, Read, Show) - -_LetExpression = (Core.Name "hydra/langs/kusto/kql.LetExpression") - -_LetExpression_bindings = (Core.Name "bindings") - -_LetExpression_expression = (Core.Name "expression") - -data Literal = - LiteralDuration Duration | - LiteralDatetime Datetime | - LiteralString String | - LiteralInt Int | - LiteralLong Int64 | - LiteralDouble Double | - LiteralBoolean Bool - deriving (Eq, Ord, Read, Show) - -_Literal = (Core.Name "hydra/langs/kusto/kql.Literal") - -_Literal_duration = (Core.Name "duration") - -_Literal_datetime = (Core.Name "datetime") - -_Literal_string = (Core.Name "string") - -_Literal_int = (Core.Name "int") - -_Literal_long = (Core.Name "long") - -_Literal_double = (Core.Name "double") - -_Literal_boolean = (Core.Name "boolean") - -data Order = - OrderAscending | - OrderDescending - deriving (Eq, Ord, Read, Show) - -_Order = (Core.Name "hydra/langs/kusto/kql.Order") - -_Order_ascending = (Core.Name "ascending") - -_Order_descending = (Core.Name "descending") - -data Parameter = - Parameter { - parameterKey :: String, - parameterValue :: Literal} - deriving (Eq, Ord, Read, Show) - -_Parameter = (Core.Name "hydra/langs/kusto/kql.Parameter") - -_Parameter_key = (Core.Name "key") - -_Parameter_value = (Core.Name "value") - -data ParseCommand = - ParseCommand { - parseCommandColumn :: ColumnName, - parseCommandPairs :: [KeyValuePair]} - deriving (Eq, Ord, Read, Show) - -_ParseCommand = (Core.Name "hydra/langs/kusto/kql.ParseCommand") - -_ParseCommand_column = (Core.Name "column") - -_ParseCommand_pairs = (Core.Name "pairs") - -newtype PipelineExpression = - PipelineExpression { - unPipelineExpression :: [TabularExpression]} - deriving (Eq, Ord, Read, Show) - -_PipelineExpression = (Core.Name "hydra/langs/kusto/kql.PipelineExpression") - -data PrintCommand = - PrintCommand { - printCommandColumn :: (Maybe ColumnName), - printCommandExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_PrintCommand = (Core.Name "hydra/langs/kusto/kql.PrintCommand") - -_PrintCommand_column = (Core.Name "column") - -_PrintCommand_expression = (Core.Name "expression") - -data Projection = - Projection { - projectionExpression :: Expression, - projectionAlias :: (Maybe ColumnName)} - deriving (Eq, Ord, Read, Show) - -_Projection = (Core.Name "hydra/langs/kusto/kql.Projection") - -_Projection_expression = (Core.Name "expression") - -_Projection_alias = (Core.Name "alias") - -data PropertyExpression = - PropertyExpression { - propertyExpressionExpression :: Expression, - propertyExpressionProperty :: String} - deriving (Eq, Ord, Read, Show) - -_PropertyExpression = (Core.Name "hydra/langs/kusto/kql.PropertyExpression") - -_PropertyExpression_expression = (Core.Name "expression") - -_PropertyExpression_property = (Core.Name "property") - -newtype Query = - Query { - unQuery :: TabularExpression} - deriving (Eq, Ord, Read, Show) - -_Query = (Core.Name "hydra/langs/kusto/kql.Query") - --- | Search across all datasets and columns or, if provided, specific datasets and/or columns -data SearchCommand = - SearchCommand { - searchCommandDatasets :: [TableName], - searchCommandPattern :: Expression} - deriving (Eq, Ord, Read, Show) - -_SearchCommand = (Core.Name "hydra/langs/kusto/kql.SearchCommand") - -_SearchCommand_datasets = (Core.Name "datasets") - -_SearchCommand_pattern = (Core.Name "pattern") - -data SummarizeCommand = - SummarizeCommand { - summarizeCommandColumns :: [ColumnAssignment], - summarizeCommandBy :: [ColumnName]} - deriving (Eq, Ord, Read, Show) - -_SummarizeCommand = (Core.Name "hydra/langs/kusto/kql.SummarizeCommand") - -_SummarizeCommand_columns = (Core.Name "columns") - -_SummarizeCommand_by = (Core.Name "by") - -newtype TableName = - TableName { - unTableName :: String} - deriving (Eq, Ord, Read, Show) - -_TableName = (Core.Name "hydra/langs/kusto/kql.TableName") - -data TopCommand = - TopCommand { - topCommandCount :: Int, - topCommandSort :: [SortBy]} - deriving (Eq, Ord, Read, Show) - -_TopCommand = (Core.Name "hydra/langs/kusto/kql.TopCommand") - -_TopCommand_count = (Core.Name "count") - -_TopCommand_sort = (Core.Name "sort") - -data SortBy = - SortBy { - sortByColumn :: ColumnName, - sortByOrder :: (Maybe Order)} - deriving (Eq, Ord, Read, Show) - -_SortBy = (Core.Name "hydra/langs/kusto/kql.SortBy") - -_SortBy_column = (Core.Name "column") - -_SortBy_order = (Core.Name "order") - -data TabularExpression = - TabularExpressionCommand Command | - TabularExpressionPipeline PipelineExpression | - TabularExpressionLet LetExpression | - TabularExpressionTable TableName - deriving (Eq, Ord, Read, Show) - -_TabularExpression = (Core.Name "hydra/langs/kusto/kql.TabularExpression") - -_TabularExpression_command = (Core.Name "command") - -_TabularExpression_pipeline = (Core.Name "pipeline") - -_TabularExpression_let = (Core.Name "let") - -_TabularExpression_table = (Core.Name "table") - -data UnaryExpression = - UnaryExpression { - unaryExpressionOperator :: UnaryOperator, - unaryExpressionExpression :: Expression} - deriving (Eq, Ord, Read, Show) - -_UnaryExpression = (Core.Name "hydra/langs/kusto/kql.UnaryExpression") - -_UnaryExpression_operator = (Core.Name "operator") - -_UnaryExpression_expression = (Core.Name "expression") - -data UnaryOperator = - UnaryOperatorNot - deriving (Eq, Ord, Read, Show) - -_UnaryOperator = (Core.Name "hydra/langs/kusto/kql.UnaryOperator") - -_UnaryOperator_not = (Core.Name "not") - -data UnionCommand = - UnionCommand { - unionCommandParameters :: [Parameter], - unionCommandKind :: (Maybe UnionKind), - unionCommandWithSource :: (Maybe ColumnName), - unionCommandIsFuzzy :: (Maybe Bool), - unionCommandTables :: [TableName]} - deriving (Eq, Ord, Read, Show) - -_UnionCommand = (Core.Name "hydra/langs/kusto/kql.UnionCommand") - -_UnionCommand_parameters = (Core.Name "parameters") - -_UnionCommand_kind = (Core.Name "kind") - -_UnionCommand_withSource = (Core.Name "withSource") - -_UnionCommand_isFuzzy = (Core.Name "isFuzzy") - -_UnionCommand_tables = (Core.Name "tables") - -data UnionKind = - UnionKindInner | - UnionKindOuter - deriving (Eq, Ord, Read, Show) - -_UnionKind = (Core.Name "hydra/langs/kusto/kql.UnionKind") - -_UnionKind_inner = (Core.Name "inner") - -_UnionKind_outer = (Core.Name "outer") diff --git a/src/gen-main/haskell/Hydra/Langs/Owl/Syntax.hs b/src/gen-main/haskell/Hydra/Langs/Owl/Syntax.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Owl/Syntax.hs +++ /dev/null @@ -1,1208 +0,0 @@ --- | An OWL 2 syntax model. See https://www.w3.org/TR/owl2-syntax - -module Hydra.Langs.Owl.Syntax where - -import qualified Hydra.Core as Core -import qualified Hydra.Langs.Rdf.Syntax as Syntax -import qualified Hydra.Langs.Xml.Schema as Schema -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data Ontology = - Ontology { - ontologyDirectImports :: [Ontology], - ontologyAnnotations :: [Annotation], - ontologyAxioms :: [Axiom]} - deriving (Eq, Ord, Read, Show) - -_Ontology = (Core.Name "hydra/langs/owl/syntax.Ontology") - -_Ontology_directImports = (Core.Name "directImports") - -_Ontology_annotations = (Core.Name "annotations") - -_Ontology_axioms = (Core.Name "axioms") - -data Declaration = - Declaration { - declarationAnnotations :: [Annotation], - declarationEntity :: Entity} - deriving (Eq, Ord, Read, Show) - -_Declaration = (Core.Name "hydra/langs/owl/syntax.Declaration") - -_Declaration_annotations = (Core.Name "annotations") - -_Declaration_entity = (Core.Name "entity") - -data Entity = - EntityAnnotationProperty AnnotationProperty | - EntityClass Class | - EntityDataProperty DataProperty | - EntityDatatype Datatype | - EntityNamedIndividual NamedIndividual | - EntityObjectProperty ObjectProperty - deriving (Eq, Ord, Read, Show) - -_Entity = (Core.Name "hydra/langs/owl/syntax.Entity") - -_Entity_annotationProperty = (Core.Name "annotationProperty") - -_Entity_class = (Core.Name "class") - -_Entity_dataProperty = (Core.Name "dataProperty") - -_Entity_datatype = (Core.Name "datatype") - -_Entity_namedIndividual = (Core.Name "namedIndividual") - -_Entity_objectProperty = (Core.Name "objectProperty") - -data AnnotationSubject = - AnnotationSubjectIri Syntax.Iri | - AnnotationSubjectAnonymousIndividual AnonymousIndividual - deriving (Eq, Ord, Read, Show) - -_AnnotationSubject = (Core.Name "hydra/langs/owl/syntax.AnnotationSubject") - -_AnnotationSubject_iri = (Core.Name "iri") - -_AnnotationSubject_anonymousIndividual = (Core.Name "anonymousIndividual") - -data AnnotationValue = - AnnotationValueAnonymousIndividual AnonymousIndividual | - AnnotationValueIri Syntax.Iri | - AnnotationValueLiteral Syntax.Literal - deriving (Eq, Ord, Read, Show) - -_AnnotationValue = (Core.Name "hydra/langs/owl/syntax.AnnotationValue") - -_AnnotationValue_anonymousIndividual = (Core.Name "anonymousIndividual") - -_AnnotationValue_iri = (Core.Name "iri") - -_AnnotationValue_literal = (Core.Name "literal") - -data Annotation = - Annotation { - annotationAnnotations :: [Annotation], - annotationProperty :: AnnotationProperty, - annotationValue :: AnnotationValue} - deriving (Eq, Ord, Read, Show) - -_Annotation = (Core.Name "hydra/langs/owl/syntax.Annotation") - -_Annotation_annotations = (Core.Name "annotations") - -_Annotation_property = (Core.Name "property") - -_Annotation_value = (Core.Name "value") - -data AnnotationAxiom = - AnnotationAxiomAnnotationAssertion AnnotationAssertion | - AnnotationAxiomAnnotationPropertyDomain AnnotationPropertyDomain | - AnnotationAxiomAnnotationPropertyRange AnnotationPropertyRange | - AnnotationAxiomSubAnnotationPropertyOf SubAnnotationPropertyOf - deriving (Eq, Ord, Read, Show) - -_AnnotationAxiom = (Core.Name "hydra/langs/owl/syntax.AnnotationAxiom") - -_AnnotationAxiom_annotationAssertion = (Core.Name "annotationAssertion") - -_AnnotationAxiom_annotationPropertyDomain = (Core.Name "annotationPropertyDomain") - -_AnnotationAxiom_annotationPropertyRange = (Core.Name "annotationPropertyRange") - -_AnnotationAxiom_subAnnotationPropertyOf = (Core.Name "subAnnotationPropertyOf") - -data AnnotationAssertion = - AnnotationAssertion { - annotationAssertionAnnotations :: [Annotation], - annotationAssertionProperty :: AnnotationProperty, - annotationAssertionSubject :: AnnotationSubject, - annotationAssertionValue :: AnnotationValue} - deriving (Eq, Ord, Read, Show) - -_AnnotationAssertion = (Core.Name "hydra/langs/owl/syntax.AnnotationAssertion") - -_AnnotationAssertion_annotations = (Core.Name "annotations") - -_AnnotationAssertion_property = (Core.Name "property") - -_AnnotationAssertion_subject = (Core.Name "subject") - -_AnnotationAssertion_value = (Core.Name "value") - -data SubAnnotationPropertyOf = - SubAnnotationPropertyOf { - subAnnotationPropertyOfAnnotations :: [Annotation], - subAnnotationPropertyOfSubProperty :: AnnotationProperty, - subAnnotationPropertyOfSuperProperty :: AnnotationProperty} - deriving (Eq, Ord, Read, Show) - -_SubAnnotationPropertyOf = (Core.Name "hydra/langs/owl/syntax.SubAnnotationPropertyOf") - -_SubAnnotationPropertyOf_annotations = (Core.Name "annotations") - -_SubAnnotationPropertyOf_subProperty = (Core.Name "subProperty") - -_SubAnnotationPropertyOf_superProperty = (Core.Name "superProperty") - -data AnnotationPropertyDomain = - AnnotationPropertyDomain { - annotationPropertyDomainAnnotations :: [Annotation], - annotationPropertyDomainProperty :: AnnotationProperty, - annotationPropertyDomainIri :: Syntax.Iri} - deriving (Eq, Ord, Read, Show) - -_AnnotationPropertyDomain = (Core.Name "hydra/langs/owl/syntax.AnnotationPropertyDomain") - -_AnnotationPropertyDomain_annotations = (Core.Name "annotations") - -_AnnotationPropertyDomain_property = (Core.Name "property") - -_AnnotationPropertyDomain_iri = (Core.Name "iri") - -data AnnotationPropertyRange = - AnnotationPropertyRange { - annotationPropertyRangeAnnotations :: [Annotation], - annotationPropertyRangeProperty :: AnnotationProperty, - annotationPropertyRangeIri :: Syntax.Iri} - deriving (Eq, Ord, Read, Show) - -_AnnotationPropertyRange = (Core.Name "hydra/langs/owl/syntax.AnnotationPropertyRange") - -_AnnotationPropertyRange_annotations = (Core.Name "annotations") - -_AnnotationPropertyRange_property = (Core.Name "property") - -_AnnotationPropertyRange_iri = (Core.Name "iri") - --- | See https://www.w3.org/TR/owl2-syntax/#Classes -data Class = - Class {} - deriving (Eq, Ord, Read, Show) - -_Class = (Core.Name "hydra/langs/owl/syntax.Class") - --- | See https://www.w3.org/TR/owl2-syntax/#Datatypes -data Datatype = - -- | Note: XML Schema datatypes are treated as a special case in this model (not in the OWL 2 specification itself) because they are particularly common - DatatypeXmlSchema Schema.Datatype | - DatatypeOther Syntax.Iri - deriving (Eq, Ord, Read, Show) - -_Datatype = (Core.Name "hydra/langs/owl/syntax.Datatype") - -_Datatype_xmlSchema = (Core.Name "xmlSchema") - -_Datatype_other = (Core.Name "other") - --- | See https://www.w3.org/TR/owl2-syntax/#Object_Properties -data ObjectProperty = - ObjectProperty {} - deriving (Eq, Ord, Read, Show) - -_ObjectProperty = (Core.Name "hydra/langs/owl/syntax.ObjectProperty") - -data DataProperty = - DataProperty {} - deriving (Eq, Ord, Read, Show) - -_DataProperty = (Core.Name "hydra/langs/owl/syntax.DataProperty") - -data AnnotationProperty = - AnnotationProperty {} - deriving (Eq, Ord, Read, Show) - -_AnnotationProperty = (Core.Name "hydra/langs/owl/syntax.AnnotationProperty") - -data Individual = - IndividualNamed NamedIndividual | - IndividualAnonymous AnonymousIndividual - deriving (Eq, Ord, Read, Show) - -_Individual = (Core.Name "hydra/langs/owl/syntax.Individual") - -_Individual_named = (Core.Name "named") - -_Individual_anonymous = (Core.Name "anonymous") - -data NamedIndividual = - NamedIndividual {} - deriving (Eq, Ord, Read, Show) - -_NamedIndividual = (Core.Name "hydra/langs/owl/syntax.NamedIndividual") - -data AnonymousIndividual = - AnonymousIndividual {} - deriving (Eq, Ord, Read, Show) - -_AnonymousIndividual = (Core.Name "hydra/langs/owl/syntax.AnonymousIndividual") - -data ObjectPropertyExpression = - ObjectPropertyExpressionObject ObjectProperty | - ObjectPropertyExpressionInverseObject InverseObjectProperty - deriving (Eq, Ord, Read, Show) - -_ObjectPropertyExpression = (Core.Name "hydra/langs/owl/syntax.ObjectPropertyExpression") - -_ObjectPropertyExpression_object = (Core.Name "object") - -_ObjectPropertyExpression_inverseObject = (Core.Name "inverseObject") - -newtype InverseObjectProperty = - InverseObjectProperty { - unInverseObjectProperty :: ObjectProperty} - deriving (Eq, Ord, Read, Show) - -_InverseObjectProperty = (Core.Name "hydra/langs/owl/syntax.InverseObjectProperty") - -newtype DataPropertyExpression = - DataPropertyExpression { - unDataPropertyExpression :: DataProperty} - deriving (Eq, Ord, Read, Show) - -_DataPropertyExpression = (Core.Name "hydra/langs/owl/syntax.DataPropertyExpression") - --- | See https://www.w3.org/TR/owl2-syntax/#Data_Ranges -data DataRange = - DataRangeDataComplementOf DataComplementOf | - DataRangeDataIntersectionOf DataIntersectionOf | - DataRangeDataOneOf DataOneOf | - DataRangeDataUnionOf DataUnionOf | - DataRangeDatatype Datatype | - DataRangeDatatypeRestriction DatatypeRestriction - deriving (Eq, Ord, Read, Show) - -_DataRange = (Core.Name "hydra/langs/owl/syntax.DataRange") - -_DataRange_dataComplementOf = (Core.Name "dataComplementOf") - -_DataRange_dataIntersectionOf = (Core.Name "dataIntersectionOf") - -_DataRange_dataOneOf = (Core.Name "dataOneOf") - -_DataRange_dataUnionOf = (Core.Name "dataUnionOf") - -_DataRange_datatype = (Core.Name "datatype") - -_DataRange_datatypeRestriction = (Core.Name "datatypeRestriction") - --- | See https://www.w3.org/TR/owl2-syntax/#Intersection_of_Data_Ranges -newtype DataIntersectionOf = - DataIntersectionOf { - unDataIntersectionOf :: [DataRange]} - deriving (Eq, Ord, Read, Show) - -_DataIntersectionOf = (Core.Name "hydra/langs/owl/syntax.DataIntersectionOf") - --- | See https://www.w3.org/TR/owl2-syntax/#Union_of_Data_Ranges -newtype DataUnionOf = - DataUnionOf { - unDataUnionOf :: [DataRange]} - deriving (Eq, Ord, Read, Show) - -_DataUnionOf = (Core.Name "hydra/langs/owl/syntax.DataUnionOf") - --- | See https://www.w3.org/TR/owl2-syntax/#Complement_of_Data_Ranges -newtype DataComplementOf = - DataComplementOf { - unDataComplementOf :: DataRange} - deriving (Eq, Ord, Read, Show) - -_DataComplementOf = (Core.Name "hydra/langs/owl/syntax.DataComplementOf") - --- | See https://www.w3.org/TR/owl2-syntax/#Enumeration_of_Literals -newtype DataOneOf = - DataOneOf { - unDataOneOf :: [Syntax.Literal]} - deriving (Eq, Ord, Read, Show) - -_DataOneOf = (Core.Name "hydra/langs/owl/syntax.DataOneOf") - --- | See https://www.w3.org/TR/owl2-syntax/#Datatype_Restrictions -data DatatypeRestriction = - DatatypeRestriction { - datatypeRestrictionDatatype :: Datatype, - datatypeRestrictionConstraints :: [DatatypeRestriction_Constraint]} - deriving (Eq, Ord, Read, Show) - -_DatatypeRestriction = (Core.Name "hydra/langs/owl/syntax.DatatypeRestriction") - -_DatatypeRestriction_datatype = (Core.Name "datatype") - -_DatatypeRestriction_constraints = (Core.Name "constraints") - -data DatatypeRestriction_Constraint = - DatatypeRestriction_Constraint { - datatypeRestriction_ConstraintConstrainingFacet :: DatatypeRestriction_ConstrainingFacet, - datatypeRestriction_ConstraintRestrictionValue :: Syntax.Literal} - deriving (Eq, Ord, Read, Show) - -_DatatypeRestriction_Constraint = (Core.Name "hydra/langs/owl/syntax.DatatypeRestriction.Constraint") - -_DatatypeRestriction_Constraint_constrainingFacet = (Core.Name "constrainingFacet") - -_DatatypeRestriction_Constraint_restrictionValue = (Core.Name "restrictionValue") - -data DatatypeRestriction_ConstrainingFacet = - -- | Note: XML Schema constraining facets are treated as a special case in this model (not in the OWL 2 specification itself) because they are particularly common - DatatypeRestriction_ConstrainingFacetXmlSchema Schema.ConstrainingFacet | - DatatypeRestriction_ConstrainingFacetOther Syntax.Iri - deriving (Eq, Ord, Read, Show) - -_DatatypeRestriction_ConstrainingFacet = (Core.Name "hydra/langs/owl/syntax.DatatypeRestriction.ConstrainingFacet") - -_DatatypeRestriction_ConstrainingFacet_xmlSchema = (Core.Name "xmlSchema") - -_DatatypeRestriction_ConstrainingFacet_other = (Core.Name "other") - -data ClassExpression = - ClassExpressionClass Class | - ClassExpressionDataSomeValuesFrom DataSomeValuesFrom | - ClassExpressionDataAllValuesFrom DataAllValuesFrom | - ClassExpressionDataHasValue DataHasValue | - ClassExpressionDataMinCardinality DataMinCardinality | - ClassExpressionDataMaxCardinality DataMaxCardinality | - ClassExpressionDataExactCardinality DataExactCardinality | - ClassExpressionObjectAllValuesFrom ObjectAllValuesFrom | - ClassExpressionObjectExactCardinality ObjectExactCardinality | - ClassExpressionObjectHasSelf ObjectHasSelf | - ClassExpressionObjectHasValue ObjectHasValue | - ClassExpressionObjectIntersectionOf ObjectIntersectionOf | - ClassExpressionObjectMaxCardinality ObjectMaxCardinality | - ClassExpressionObjectMinCardinality ObjectMinCardinality | - ClassExpressionObjectOneOf ObjectOneOf | - ClassExpressionObjectSomeValuesFrom ObjectSomeValuesFrom | - ClassExpressionObjectUnionOf ObjectUnionOf - deriving (Eq, Ord, Read, Show) - -_ClassExpression = (Core.Name "hydra/langs/owl/syntax.ClassExpression") - -_ClassExpression_class = (Core.Name "class") - -_ClassExpression_dataSomeValuesFrom = (Core.Name "dataSomeValuesFrom") - -_ClassExpression_dataAllValuesFrom = (Core.Name "dataAllValuesFrom") - -_ClassExpression_dataHasValue = (Core.Name "dataHasValue") - -_ClassExpression_dataMinCardinality = (Core.Name "dataMinCardinality") - -_ClassExpression_dataMaxCardinality = (Core.Name "dataMaxCardinality") - -_ClassExpression_dataExactCardinality = (Core.Name "dataExactCardinality") - -_ClassExpression_objectAllValuesFrom = (Core.Name "objectAllValuesFrom") - -_ClassExpression_objectExactCardinality = (Core.Name "objectExactCardinality") - -_ClassExpression_objectHasSelf = (Core.Name "objectHasSelf") - -_ClassExpression_objectHasValue = (Core.Name "objectHasValue") - -_ClassExpression_objectIntersectionOf = (Core.Name "objectIntersectionOf") - -_ClassExpression_objectMaxCardinality = (Core.Name "objectMaxCardinality") - -_ClassExpression_objectMinCardinality = (Core.Name "objectMinCardinality") - -_ClassExpression_objectOneOf = (Core.Name "objectOneOf") - -_ClassExpression_objectSomeValuesFrom = (Core.Name "objectSomeValuesFrom") - -_ClassExpression_objectUnionOf = (Core.Name "objectUnionOf") - -newtype ObjectIntersectionOf = - ObjectIntersectionOf { - unObjectIntersectionOf :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_ObjectIntersectionOf = (Core.Name "hydra/langs/owl/syntax.ObjectIntersectionOf") - -newtype ObjectUnionOf = - ObjectUnionOf { - unObjectUnionOf :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_ObjectUnionOf = (Core.Name "hydra/langs/owl/syntax.ObjectUnionOf") - -newtype ObjectComplementOf = - ObjectComplementOf { - unObjectComplementOf :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_ObjectComplementOf = (Core.Name "hydra/langs/owl/syntax.ObjectComplementOf") - -newtype ObjectOneOf = - ObjectOneOf { - unObjectOneOf :: [Individual]} - deriving (Eq, Ord, Read, Show) - -_ObjectOneOf = (Core.Name "hydra/langs/owl/syntax.ObjectOneOf") - -data ObjectSomeValuesFrom = - ObjectSomeValuesFrom { - objectSomeValuesFromProperty :: ObjectPropertyExpression, - objectSomeValuesFromClass :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_ObjectSomeValuesFrom = (Core.Name "hydra/langs/owl/syntax.ObjectSomeValuesFrom") - -_ObjectSomeValuesFrom_property = (Core.Name "property") - -_ObjectSomeValuesFrom_class = (Core.Name "class") - -data ObjectAllValuesFrom = - ObjectAllValuesFrom { - objectAllValuesFromProperty :: ObjectPropertyExpression, - objectAllValuesFromClass :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_ObjectAllValuesFrom = (Core.Name "hydra/langs/owl/syntax.ObjectAllValuesFrom") - -_ObjectAllValuesFrom_property = (Core.Name "property") - -_ObjectAllValuesFrom_class = (Core.Name "class") - -data ObjectHasValue = - ObjectHasValue { - objectHasValueProperty :: ObjectPropertyExpression, - objectHasValueIndividual :: Individual} - deriving (Eq, Ord, Read, Show) - -_ObjectHasValue = (Core.Name "hydra/langs/owl/syntax.ObjectHasValue") - -_ObjectHasValue_property = (Core.Name "property") - -_ObjectHasValue_individual = (Core.Name "individual") - -newtype ObjectHasSelf = - ObjectHasSelf { - unObjectHasSelf :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_ObjectHasSelf = (Core.Name "hydra/langs/owl/syntax.ObjectHasSelf") - --- | See https://www.w3.org/TR/owl2-syntax/#Minimum_Cardinality -data ObjectMinCardinality = - ObjectMinCardinality { - objectMinCardinalityBound :: Integer, - objectMinCardinalityProperty :: ObjectPropertyExpression, - objectMinCardinalityClass :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_ObjectMinCardinality = (Core.Name "hydra/langs/owl/syntax.ObjectMinCardinality") - -_ObjectMinCardinality_bound = (Core.Name "bound") - -_ObjectMinCardinality_property = (Core.Name "property") - -_ObjectMinCardinality_class = (Core.Name "class") - --- | See https://www.w3.org/TR/owl2-syntax/#Maximum_Cardinality -data ObjectMaxCardinality = - ObjectMaxCardinality { - objectMaxCardinalityBound :: Integer, - objectMaxCardinalityProperty :: ObjectPropertyExpression, - objectMaxCardinalityClass :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_ObjectMaxCardinality = (Core.Name "hydra/langs/owl/syntax.ObjectMaxCardinality") - -_ObjectMaxCardinality_bound = (Core.Name "bound") - -_ObjectMaxCardinality_property = (Core.Name "property") - -_ObjectMaxCardinality_class = (Core.Name "class") - --- | See https://www.w3.org/TR/owl2-syntax/#Exact_Cardinality -data ObjectExactCardinality = - ObjectExactCardinality { - objectExactCardinalityBound :: Integer, - objectExactCardinalityProperty :: ObjectPropertyExpression, - objectExactCardinalityClass :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_ObjectExactCardinality = (Core.Name "hydra/langs/owl/syntax.ObjectExactCardinality") - -_ObjectExactCardinality_bound = (Core.Name "bound") - -_ObjectExactCardinality_property = (Core.Name "property") - -_ObjectExactCardinality_class = (Core.Name "class") - -data DataSomeValuesFrom = - DataSomeValuesFrom { - dataSomeValuesFromProperty :: [DataPropertyExpression], - dataSomeValuesFromRange :: DataRange} - deriving (Eq, Ord, Read, Show) - -_DataSomeValuesFrom = (Core.Name "hydra/langs/owl/syntax.DataSomeValuesFrom") - -_DataSomeValuesFrom_property = (Core.Name "property") - -_DataSomeValuesFrom_range = (Core.Name "range") - -data DataAllValuesFrom = - DataAllValuesFrom { - dataAllValuesFromProperty :: [DataPropertyExpression], - dataAllValuesFromRange :: DataRange} - deriving (Eq, Ord, Read, Show) - -_DataAllValuesFrom = (Core.Name "hydra/langs/owl/syntax.DataAllValuesFrom") - -_DataAllValuesFrom_property = (Core.Name "property") - -_DataAllValuesFrom_range = (Core.Name "range") - -data DataHasValue = - DataHasValue { - dataHasValueProperty :: DataPropertyExpression, - dataHasValueValue :: Syntax.Literal} - deriving (Eq, Ord, Read, Show) - -_DataHasValue = (Core.Name "hydra/langs/owl/syntax.DataHasValue") - -_DataHasValue_property = (Core.Name "property") - -_DataHasValue_value = (Core.Name "value") - -data DataMinCardinality = - DataMinCardinality { - dataMinCardinalityBound :: Integer, - dataMinCardinalityProperty :: DataPropertyExpression, - dataMinCardinalityRange :: [DataRange]} - deriving (Eq, Ord, Read, Show) - -_DataMinCardinality = (Core.Name "hydra/langs/owl/syntax.DataMinCardinality") - -_DataMinCardinality_bound = (Core.Name "bound") - -_DataMinCardinality_property = (Core.Name "property") - -_DataMinCardinality_range = (Core.Name "range") - -data DataMaxCardinality = - DataMaxCardinality { - dataMaxCardinalityBound :: Integer, - dataMaxCardinalityProperty :: DataPropertyExpression, - dataMaxCardinalityRange :: [DataRange]} - deriving (Eq, Ord, Read, Show) - -_DataMaxCardinality = (Core.Name "hydra/langs/owl/syntax.DataMaxCardinality") - -_DataMaxCardinality_bound = (Core.Name "bound") - -_DataMaxCardinality_property = (Core.Name "property") - -_DataMaxCardinality_range = (Core.Name "range") - -data DataExactCardinality = - DataExactCardinality { - dataExactCardinalityBound :: Integer, - dataExactCardinalityProperty :: DataPropertyExpression, - dataExactCardinalityRange :: [DataRange]} - deriving (Eq, Ord, Read, Show) - -_DataExactCardinality = (Core.Name "hydra/langs/owl/syntax.DataExactCardinality") - -_DataExactCardinality_bound = (Core.Name "bound") - -_DataExactCardinality_property = (Core.Name "property") - -_DataExactCardinality_range = (Core.Name "range") - --- | See https://www.w3.org/TR/owl2-syntax/#Axioms -data Axiom = - AxiomAnnotationAxiom AnnotationAxiom | - AxiomAssertion Assertion | - AxiomClassAxiom ClassAxiom | - AxiomDataPropertyAxiom DataPropertyAxiom | - AxiomDatatypeDefinition DatatypeDefinition | - AxiomDeclaration Declaration | - AxiomHasKey HasKey | - AxiomObjectPropertyAxiom ObjectPropertyAxiom - deriving (Eq, Ord, Read, Show) - -_Axiom = (Core.Name "hydra/langs/owl/syntax.Axiom") - -_Axiom_annotationAxiom = (Core.Name "annotationAxiom") - -_Axiom_assertion = (Core.Name "assertion") - -_Axiom_classAxiom = (Core.Name "classAxiom") - -_Axiom_dataPropertyAxiom = (Core.Name "dataPropertyAxiom") - -_Axiom_datatypeDefinition = (Core.Name "datatypeDefinition") - -_Axiom_declaration = (Core.Name "declaration") - -_Axiom_hasKey = (Core.Name "hasKey") - -_Axiom_objectPropertyAxiom = (Core.Name "objectPropertyAxiom") - -data ClassAxiom = - ClassAxiomDisjointClasses DisjointClasses | - ClassAxiomDisjointUnion DisjointUnion | - ClassAxiomEquivalentClasses EquivalentClasses | - ClassAxiomSubClassOf SubClassOf - deriving (Eq, Ord, Read, Show) - -_ClassAxiom = (Core.Name "hydra/langs/owl/syntax.ClassAxiom") - -_ClassAxiom_disjointClasses = (Core.Name "disjointClasses") - -_ClassAxiom_disjointUnion = (Core.Name "disjointUnion") - -_ClassAxiom_equivalentClasses = (Core.Name "equivalentClasses") - -_ClassAxiom_subClassOf = (Core.Name "subClassOf") - -data SubClassOf = - SubClassOf { - subClassOfAnnotations :: [Annotation], - subClassOfSubClass :: ClassExpression, - subClassOfSuperClass :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_SubClassOf = (Core.Name "hydra/langs/owl/syntax.SubClassOf") - -_SubClassOf_annotations = (Core.Name "annotations") - -_SubClassOf_subClass = (Core.Name "subClass") - -_SubClassOf_superClass = (Core.Name "superClass") - -data EquivalentClasses = - EquivalentClasses { - equivalentClassesAnnotations :: [Annotation], - equivalentClassesClasses :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_EquivalentClasses = (Core.Name "hydra/langs/owl/syntax.EquivalentClasses") - -_EquivalentClasses_annotations = (Core.Name "annotations") - -_EquivalentClasses_classes = (Core.Name "classes") - -data DisjointClasses = - DisjointClasses { - disjointClassesAnnotations :: [Annotation], - disjointClassesClasses :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_DisjointClasses = (Core.Name "hydra/langs/owl/syntax.DisjointClasses") - -_DisjointClasses_annotations = (Core.Name "annotations") - -_DisjointClasses_classes = (Core.Name "classes") - --- | See https://www.w3.org/TR/owl2-syntax/#Disjoint_Union_of_Class_Expressions -data DisjointUnion = - DisjointUnion { - disjointUnionAnnotations :: [Annotation], - disjointUnionClass :: Class, - disjointUnionClasses :: [ClassExpression]} - deriving (Eq, Ord, Read, Show) - -_DisjointUnion = (Core.Name "hydra/langs/owl/syntax.DisjointUnion") - -_DisjointUnion_annotations = (Core.Name "annotations") - -_DisjointUnion_class = (Core.Name "class") - -_DisjointUnion_classes = (Core.Name "classes") - -data ObjectPropertyAxiom = - ObjectPropertyAxiomAsymmetricObjectProperty AsymmetricObjectProperty | - ObjectPropertyAxiomDisjointObjectProperties DisjointObjectProperties | - ObjectPropertyAxiomEquivalentObjectProperties EquivalentObjectProperties | - ObjectPropertyAxiomFunctionalObjectProperty FunctionalObjectProperty | - ObjectPropertyAxiomInverseFunctionalObjectProperty InverseFunctionalObjectProperty | - ObjectPropertyAxiomInverseObjectProperties InverseObjectProperties | - ObjectPropertyAxiomIrreflexiveObjectProperty IrreflexiveObjectProperty | - ObjectPropertyAxiomObjectPropertyDomain ObjectPropertyDomain | - ObjectPropertyAxiomObjectPropertyRange ObjectPropertyRange | - ObjectPropertyAxiomReflexiveObjectProperty ReflexiveObjectProperty | - ObjectPropertyAxiomSubObjectPropertyOf SubObjectPropertyOf | - ObjectPropertyAxiomSymmetricObjectProperty SymmetricObjectProperty | - ObjectPropertyAxiomTransitiveObjectProperty TransitiveObjectProperty - deriving (Eq, Ord, Read, Show) - -_ObjectPropertyAxiom = (Core.Name "hydra/langs/owl/syntax.ObjectPropertyAxiom") - -_ObjectPropertyAxiom_asymmetricObjectProperty = (Core.Name "asymmetricObjectProperty") - -_ObjectPropertyAxiom_disjointObjectProperties = (Core.Name "disjointObjectProperties") - -_ObjectPropertyAxiom_equivalentObjectProperties = (Core.Name "equivalentObjectProperties") - -_ObjectPropertyAxiom_functionalObjectProperty = (Core.Name "functionalObjectProperty") - -_ObjectPropertyAxiom_inverseFunctionalObjectProperty = (Core.Name "inverseFunctionalObjectProperty") - -_ObjectPropertyAxiom_inverseObjectProperties = (Core.Name "inverseObjectProperties") - -_ObjectPropertyAxiom_irreflexiveObjectProperty = (Core.Name "irreflexiveObjectProperty") - -_ObjectPropertyAxiom_objectPropertyDomain = (Core.Name "objectPropertyDomain") - -_ObjectPropertyAxiom_objectPropertyRange = (Core.Name "objectPropertyRange") - -_ObjectPropertyAxiom_reflexiveObjectProperty = (Core.Name "reflexiveObjectProperty") - -_ObjectPropertyAxiom_subObjectPropertyOf = (Core.Name "subObjectPropertyOf") - -_ObjectPropertyAxiom_symmetricObjectProperty = (Core.Name "symmetricObjectProperty") - -_ObjectPropertyAxiom_transitiveObjectProperty = (Core.Name "transitiveObjectProperty") - -data SubObjectPropertyOf = - SubObjectPropertyOf { - subObjectPropertyOfAnnotations :: [Annotation], - subObjectPropertyOfSubProperty :: [ObjectPropertyExpression], - subObjectPropertyOfSuperProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_SubObjectPropertyOf = (Core.Name "hydra/langs/owl/syntax.SubObjectPropertyOf") - -_SubObjectPropertyOf_annotations = (Core.Name "annotations") - -_SubObjectPropertyOf_subProperty = (Core.Name "subProperty") - -_SubObjectPropertyOf_superProperty = (Core.Name "superProperty") - -data EquivalentObjectProperties = - EquivalentObjectProperties { - equivalentObjectPropertiesAnnotations :: [Annotation], - equivalentObjectPropertiesProperties :: [ObjectPropertyExpression]} - deriving (Eq, Ord, Read, Show) - -_EquivalentObjectProperties = (Core.Name "hydra/langs/owl/syntax.EquivalentObjectProperties") - -_EquivalentObjectProperties_annotations = (Core.Name "annotations") - -_EquivalentObjectProperties_properties = (Core.Name "properties") - -data DisjointObjectProperties = - DisjointObjectProperties { - disjointObjectPropertiesAnnotations :: [Annotation], - disjointObjectPropertiesProperties :: [ObjectPropertyExpression]} - deriving (Eq, Ord, Read, Show) - -_DisjointObjectProperties = (Core.Name "hydra/langs/owl/syntax.DisjointObjectProperties") - -_DisjointObjectProperties_annotations = (Core.Name "annotations") - -_DisjointObjectProperties_properties = (Core.Name "properties") - --- | See https://www.w3.org/TR/owl2-syntax/#Object_Property_Domain -data ObjectPropertyDomain = - ObjectPropertyDomain { - objectPropertyDomainAnnotations :: [Annotation], - objectPropertyDomainProperty :: ObjectPropertyExpression, - objectPropertyDomainDomain :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_ObjectPropertyDomain = (Core.Name "hydra/langs/owl/syntax.ObjectPropertyDomain") - -_ObjectPropertyDomain_annotations = (Core.Name "annotations") - -_ObjectPropertyDomain_property = (Core.Name "property") - -_ObjectPropertyDomain_domain = (Core.Name "domain") - --- | See https://www.w3.org/TR/owl2-syntax/#Object_Property_Range -data ObjectPropertyRange = - ObjectPropertyRange { - objectPropertyRangeAnnotations :: [Annotation], - objectPropertyRangeProperty :: ObjectPropertyExpression, - objectPropertyRangeRange :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_ObjectPropertyRange = (Core.Name "hydra/langs/owl/syntax.ObjectPropertyRange") - -_ObjectPropertyRange_annotations = (Core.Name "annotations") - -_ObjectPropertyRange_property = (Core.Name "property") - -_ObjectPropertyRange_range = (Core.Name "range") - -data InverseObjectProperties = - InverseObjectProperties { - inverseObjectPropertiesAnnotations :: [Annotation], - inverseObjectPropertiesProperty1 :: ObjectPropertyExpression, - inverseObjectPropertiesProperty2 :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_InverseObjectProperties = (Core.Name "hydra/langs/owl/syntax.InverseObjectProperties") - -_InverseObjectProperties_annotations = (Core.Name "annotations") - -_InverseObjectProperties_property1 = (Core.Name "property1") - -_InverseObjectProperties_property2 = (Core.Name "property2") - -data FunctionalObjectProperty = - FunctionalObjectProperty { - functionalObjectPropertyAnnotations :: [Annotation], - functionalObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_FunctionalObjectProperty = (Core.Name "hydra/langs/owl/syntax.FunctionalObjectProperty") - -_FunctionalObjectProperty_annotations = (Core.Name "annotations") - -_FunctionalObjectProperty_property = (Core.Name "property") - -data InverseFunctionalObjectProperty = - InverseFunctionalObjectProperty { - inverseFunctionalObjectPropertyAnnotations :: [Annotation], - inverseFunctionalObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_InverseFunctionalObjectProperty = (Core.Name "hydra/langs/owl/syntax.InverseFunctionalObjectProperty") - -_InverseFunctionalObjectProperty_annotations = (Core.Name "annotations") - -_InverseFunctionalObjectProperty_property = (Core.Name "property") - -data ReflexiveObjectProperty = - ReflexiveObjectProperty { - reflexiveObjectPropertyAnnotations :: [Annotation], - reflexiveObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_ReflexiveObjectProperty = (Core.Name "hydra/langs/owl/syntax.ReflexiveObjectProperty") - -_ReflexiveObjectProperty_annotations = (Core.Name "annotations") - -_ReflexiveObjectProperty_property = (Core.Name "property") - -data IrreflexiveObjectProperty = - IrreflexiveObjectProperty { - irreflexiveObjectPropertyAnnotations :: [Annotation], - irreflexiveObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_IrreflexiveObjectProperty = (Core.Name "hydra/langs/owl/syntax.IrreflexiveObjectProperty") - -_IrreflexiveObjectProperty_annotations = (Core.Name "annotations") - -_IrreflexiveObjectProperty_property = (Core.Name "property") - -data SymmetricObjectProperty = - SymmetricObjectProperty { - symmetricObjectPropertyAnnotations :: [Annotation], - symmetricObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_SymmetricObjectProperty = (Core.Name "hydra/langs/owl/syntax.SymmetricObjectProperty") - -_SymmetricObjectProperty_annotations = (Core.Name "annotations") - -_SymmetricObjectProperty_property = (Core.Name "property") - -data AsymmetricObjectProperty = - AsymmetricObjectProperty { - asymmetricObjectPropertyAnnotations :: [Annotation], - asymmetricObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_AsymmetricObjectProperty = (Core.Name "hydra/langs/owl/syntax.AsymmetricObjectProperty") - -_AsymmetricObjectProperty_annotations = (Core.Name "annotations") - -_AsymmetricObjectProperty_property = (Core.Name "property") - -data TransitiveObjectProperty = - TransitiveObjectProperty { - transitiveObjectPropertyAnnotations :: [Annotation], - transitiveObjectPropertyProperty :: ObjectPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_TransitiveObjectProperty = (Core.Name "hydra/langs/owl/syntax.TransitiveObjectProperty") - -_TransitiveObjectProperty_annotations = (Core.Name "annotations") - -_TransitiveObjectProperty_property = (Core.Name "property") - -data DataPropertyAxiom = - DataPropertyAxiomDataPropertyAxiom DataPropertyAxiom | - DataPropertyAxiomDataPropertyRange DataPropertyRange | - DataPropertyAxiomDisjointDataProperties DisjointDataProperties | - DataPropertyAxiomEquivalentDataProperties EquivalentDataProperties | - DataPropertyAxiomFunctionalDataProperty FunctionalDataProperty | - DataPropertyAxiomSubDataPropertyOf SubDataPropertyOf - deriving (Eq, Ord, Read, Show) - -_DataPropertyAxiom = (Core.Name "hydra/langs/owl/syntax.DataPropertyAxiom") - -_DataPropertyAxiom_dataPropertyAxiom = (Core.Name "dataPropertyAxiom") - -_DataPropertyAxiom_dataPropertyRange = (Core.Name "dataPropertyRange") - -_DataPropertyAxiom_disjointDataProperties = (Core.Name "disjointDataProperties") - -_DataPropertyAxiom_equivalentDataProperties = (Core.Name "equivalentDataProperties") - -_DataPropertyAxiom_functionalDataProperty = (Core.Name "functionalDataProperty") - -_DataPropertyAxiom_subDataPropertyOf = (Core.Name "subDataPropertyOf") - -data SubDataPropertyOf = - SubDataPropertyOf { - subDataPropertyOfAnnotations :: [Annotation], - subDataPropertyOfSubProperty :: DataPropertyExpression, - subDataPropertyOfSuperProperty :: DataPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_SubDataPropertyOf = (Core.Name "hydra/langs/owl/syntax.SubDataPropertyOf") - -_SubDataPropertyOf_annotations = (Core.Name "annotations") - -_SubDataPropertyOf_subProperty = (Core.Name "subProperty") - -_SubDataPropertyOf_superProperty = (Core.Name "superProperty") - -data EquivalentDataProperties = - EquivalentDataProperties { - equivalentDataPropertiesAnnotations :: [Annotation], - equivalentDataPropertiesProperties :: [DataPropertyExpression]} - deriving (Eq, Ord, Read, Show) - -_EquivalentDataProperties = (Core.Name "hydra/langs/owl/syntax.EquivalentDataProperties") - -_EquivalentDataProperties_annotations = (Core.Name "annotations") - -_EquivalentDataProperties_properties = (Core.Name "properties") - -data DisjointDataProperties = - DisjointDataProperties { - disjointDataPropertiesAnnotations :: [Annotation], - disjointDataPropertiesProperties :: [DataPropertyExpression]} - deriving (Eq, Ord, Read, Show) - -_DisjointDataProperties = (Core.Name "hydra/langs/owl/syntax.DisjointDataProperties") - -_DisjointDataProperties_annotations = (Core.Name "annotations") - -_DisjointDataProperties_properties = (Core.Name "properties") - -data DataPropertyDomain = - DataPropertyDomain { - dataPropertyDomainAnnotations :: [Annotation], - dataPropertyDomainProperty :: DataPropertyExpression, - dataPropertyDomainDomain :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_DataPropertyDomain = (Core.Name "hydra/langs/owl/syntax.DataPropertyDomain") - -_DataPropertyDomain_annotations = (Core.Name "annotations") - -_DataPropertyDomain_property = (Core.Name "property") - -_DataPropertyDomain_domain = (Core.Name "domain") - -data DataPropertyRange = - DataPropertyRange { - dataPropertyRangeAnnotations :: [Annotation], - dataPropertyRangeProperty :: DataPropertyExpression, - dataPropertyRangeRange :: ClassExpression} - deriving (Eq, Ord, Read, Show) - -_DataPropertyRange = (Core.Name "hydra/langs/owl/syntax.DataPropertyRange") - -_DataPropertyRange_annotations = (Core.Name "annotations") - -_DataPropertyRange_property = (Core.Name "property") - -_DataPropertyRange_range = (Core.Name "range") - -data FunctionalDataProperty = - FunctionalDataProperty { - functionalDataPropertyAnnotations :: [Annotation], - functionalDataPropertyProperty :: DataPropertyExpression} - deriving (Eq, Ord, Read, Show) - -_FunctionalDataProperty = (Core.Name "hydra/langs/owl/syntax.FunctionalDataProperty") - -_FunctionalDataProperty_annotations = (Core.Name "annotations") - -_FunctionalDataProperty_property = (Core.Name "property") - -data DatatypeDefinition = - DatatypeDefinition { - datatypeDefinitionAnnotations :: [Annotation], - datatypeDefinitionDatatype :: Datatype, - datatypeDefinitionRange :: DataRange} - deriving (Eq, Ord, Read, Show) - -_DatatypeDefinition = (Core.Name "hydra/langs/owl/syntax.DatatypeDefinition") - -_DatatypeDefinition_annotations = (Core.Name "annotations") - -_DatatypeDefinition_datatype = (Core.Name "datatype") - -_DatatypeDefinition_range = (Core.Name "range") - --- | See https://www.w3.org/TR/owl2-syntax/#Keys -data HasKey = - HasKey { - hasKeyAnnotations :: [Annotation], - hasKeyClass :: ClassExpression, - hasKeyObjectProperties :: [ObjectPropertyExpression], - hasKeyDataProperties :: [DataPropertyExpression]} - deriving (Eq, Ord, Read, Show) - -_HasKey = (Core.Name "hydra/langs/owl/syntax.HasKey") - -_HasKey_annotations = (Core.Name "annotations") - -_HasKey_class = (Core.Name "class") - -_HasKey_objectProperties = (Core.Name "objectProperties") - -_HasKey_dataProperties = (Core.Name "dataProperties") - -data Assertion = - AssertionClassAssertion ClassAssertion | - AssertionDataPropertyAssertion DataPropertyAssertion | - AssertionDifferentIndividuals DifferentIndividuals | - AssertionObjectPropertyAssertion ObjectPropertyAssertion | - AssertionNegativeDataPropertyAssertion NegativeDataPropertyAssertion | - AssertionNegativeObjectPropertyAssertion NegativeObjectPropertyAssertion | - AssertionSameIndividual SameIndividual - deriving (Eq, Ord, Read, Show) - -_Assertion = (Core.Name "hydra/langs/owl/syntax.Assertion") - -_Assertion_classAssertion = (Core.Name "classAssertion") - -_Assertion_dataPropertyAssertion = (Core.Name "dataPropertyAssertion") - -_Assertion_differentIndividuals = (Core.Name "differentIndividuals") - -_Assertion_objectPropertyAssertion = (Core.Name "objectPropertyAssertion") - -_Assertion_negativeDataPropertyAssertion = (Core.Name "negativeDataPropertyAssertion") - -_Assertion_negativeObjectPropertyAssertion = (Core.Name "negativeObjectPropertyAssertion") - -_Assertion_sameIndividual = (Core.Name "sameIndividual") - -data SameIndividual = - SameIndividual { - sameIndividualAnnotations :: [Annotation], - sameIndividualIndividuals :: [Individual]} - deriving (Eq, Ord, Read, Show) - -_SameIndividual = (Core.Name "hydra/langs/owl/syntax.SameIndividual") - -_SameIndividual_annotations = (Core.Name "annotations") - -_SameIndividual_individuals = (Core.Name "individuals") - -data DifferentIndividuals = - DifferentIndividuals { - differentIndividualsAnnotations :: [Annotation], - differentIndividualsIndividuals :: [Individual]} - deriving (Eq, Ord, Read, Show) - -_DifferentIndividuals = (Core.Name "hydra/langs/owl/syntax.DifferentIndividuals") - -_DifferentIndividuals_annotations = (Core.Name "annotations") - -_DifferentIndividuals_individuals = (Core.Name "individuals") - -data ClassAssertion = - ClassAssertion { - classAssertionAnnotations :: [Annotation], - classAssertionClass :: ClassExpression, - classAssertionIndividual :: Individual} - deriving (Eq, Ord, Read, Show) - -_ClassAssertion = (Core.Name "hydra/langs/owl/syntax.ClassAssertion") - -_ClassAssertion_annotations = (Core.Name "annotations") - -_ClassAssertion_class = (Core.Name "class") - -_ClassAssertion_individual = (Core.Name "individual") - -data ObjectPropertyAssertion = - ObjectPropertyAssertion { - objectPropertyAssertionAnnotations :: [Annotation], - objectPropertyAssertionProperty :: ObjectPropertyExpression, - objectPropertyAssertionSource :: Individual, - objectPropertyAssertionTarget :: Individual} - deriving (Eq, Ord, Read, Show) - -_ObjectPropertyAssertion = (Core.Name "hydra/langs/owl/syntax.ObjectPropertyAssertion") - -_ObjectPropertyAssertion_annotations = (Core.Name "annotations") - -_ObjectPropertyAssertion_property = (Core.Name "property") - -_ObjectPropertyAssertion_source = (Core.Name "source") - -_ObjectPropertyAssertion_target = (Core.Name "target") - -data NegativeObjectPropertyAssertion = - NegativeObjectPropertyAssertion { - negativeObjectPropertyAssertionAnnotations :: [Annotation], - negativeObjectPropertyAssertionProperty :: ObjectPropertyExpression, - negativeObjectPropertyAssertionSource :: Individual, - negativeObjectPropertyAssertionTarget :: Individual} - deriving (Eq, Ord, Read, Show) - -_NegativeObjectPropertyAssertion = (Core.Name "hydra/langs/owl/syntax.NegativeObjectPropertyAssertion") - -_NegativeObjectPropertyAssertion_annotations = (Core.Name "annotations") - -_NegativeObjectPropertyAssertion_property = (Core.Name "property") - -_NegativeObjectPropertyAssertion_source = (Core.Name "source") - -_NegativeObjectPropertyAssertion_target = (Core.Name "target") - -data DataPropertyAssertion = - DataPropertyAssertion { - dataPropertyAssertionAnnotations :: [Annotation], - dataPropertyAssertionProperty :: DataPropertyExpression, - dataPropertyAssertionSource :: Individual, - dataPropertyAssertionTarget :: Individual} - deriving (Eq, Ord, Read, Show) - -_DataPropertyAssertion = (Core.Name "hydra/langs/owl/syntax.DataPropertyAssertion") - -_DataPropertyAssertion_annotations = (Core.Name "annotations") - -_DataPropertyAssertion_property = (Core.Name "property") - -_DataPropertyAssertion_source = (Core.Name "source") - -_DataPropertyAssertion_target = (Core.Name "target") - -data NegativeDataPropertyAssertion = - NegativeDataPropertyAssertion { - negativeDataPropertyAssertionAnnotations :: [Annotation], - negativeDataPropertyAssertionProperty :: DataPropertyExpression, - negativeDataPropertyAssertionSource :: Individual, - negativeDataPropertyAssertionTarget :: Individual} - deriving (Eq, Ord, Read, Show) - -_NegativeDataPropertyAssertion = (Core.Name "hydra/langs/owl/syntax.NegativeDataPropertyAssertion") - -_NegativeDataPropertyAssertion_annotations = (Core.Name "annotations") - -_NegativeDataPropertyAssertion_property = (Core.Name "property") - -_NegativeDataPropertyAssertion_source = (Core.Name "source") - -_NegativeDataPropertyAssertion_target = (Core.Name "target") diff --git a/src/gen-main/haskell/Hydra/Langs/Parquet/Delta.hs b/src/gen-main/haskell/Hydra/Langs/Parquet/Delta.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Parquet/Delta.hs +++ /dev/null @@ -1,122 +0,0 @@ --- | A partial Delta Parquet model - -module Hydra.Langs.Parquet.Delta where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data ArrayType = - ArrayType { - arrayTypeElementType :: DataType, - arrayTypeContainsNull :: Bool} - deriving (Eq, Ord, Read, Show) - -_ArrayType = (Core.Name "hydra/langs/parquet/delta.ArrayType") - -_ArrayType_elementType = (Core.Name "elementType") - -_ArrayType_containsNull = (Core.Name "containsNull") - -data DataType = - DataTypeArray ArrayType | - DataTypeBinary | - DataTypeBoolean | - DataTypeByte | - DataTypeDate | - DataTypeDecimal DecimalType | - DataTypeDouble | - DataTypeFloat | - DataTypeInteger | - DataTypeLong | - DataTypeMap MapType | - DataTypeNull | - DataTypeShort | - DataTypeString | - DataTypeStruct StructType - deriving (Eq, Ord, Read, Show) - -_DataType = (Core.Name "hydra/langs/parquet/delta.DataType") - -_DataType_array = (Core.Name "array") - -_DataType_binary = (Core.Name "binary") - -_DataType_boolean = (Core.Name "boolean") - -_DataType_byte = (Core.Name "byte") - -_DataType_date = (Core.Name "date") - -_DataType_decimal = (Core.Name "decimal") - -_DataType_double = (Core.Name "double") - -_DataType_float = (Core.Name "float") - -_DataType_integer = (Core.Name "integer") - -_DataType_long = (Core.Name "long") - -_DataType_map = (Core.Name "map") - -_DataType_null = (Core.Name "null") - -_DataType_short = (Core.Name "short") - -_DataType_string = (Core.Name "string") - -_DataType_struct = (Core.Name "struct") - -data DecimalType = - DecimalType { - decimalTypePrecision :: Int, - decimalTypeScale :: Int} - deriving (Eq, Ord, Read, Show) - -_DecimalType = (Core.Name "hydra/langs/parquet/delta.DecimalType") - -_DecimalType_precision = (Core.Name "precision") - -_DecimalType_scale = (Core.Name "scale") - -data MapType = - MapType { - mapTypeKeyType :: DataType, - mapTypeValueType :: DataType, - mapTypeValueContainsNull :: Bool} - deriving (Eq, Ord, Read, Show) - -_MapType = (Core.Name "hydra/langs/parquet/delta.MapType") - -_MapType_keyType = (Core.Name "keyType") - -_MapType_valueType = (Core.Name "valueType") - -_MapType_valueContainsNull = (Core.Name "valueContainsNull") - -data StructField = - StructField { - structFieldName :: String, - structFieldDataType :: DataType, - structFieldNullable :: Bool} - deriving (Eq, Ord, Read, Show) - -_StructField = (Core.Name "hydra/langs/parquet/delta.StructField") - -_StructField_name = (Core.Name "name") - -_StructField_dataType = (Core.Name "dataType") - -_StructField_nullable = (Core.Name "nullable") - -data StructType = - StructType { - structTypeFields :: [StructField]} - deriving (Eq, Ord, Read, Show) - -_StructType = (Core.Name "hydra/langs/parquet/delta.StructType") - -_StructType_fields = (Core.Name "fields") diff --git a/src/gen-main/haskell/Hydra/Langs/Parquet/Format.hs b/src/gen-main/haskell/Hydra/Langs/Parquet/Format.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Parquet/Format.hs +++ /dev/null @@ -1,977 +0,0 @@ --- | A model for the Parquet format. Based on the Thrift-based specification at: --- | https://github.com/apache/parquet-format/blob/master/src/main/thrift/parquet.thrift - -module Hydra.Langs.Parquet.Format where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | Types supported by Parquet. These types are intended to be used in combination with the encodings to control the on disk storage format. For example INT16 is not included as a type since a good encoding of INT32 would handle this. -data Type = - TypeBoolean | - TypeInt32 | - TypeInt64 | - TypeFloat | - TypeDouble | - TypeByteArray | - TypeFixedLenByteArray - deriving (Eq, Ord, Read, Show) - -_Type = (Core.Name "hydra/langs/parquet/format.Type") - -_Type_boolean = (Core.Name "boolean") - -_Type_int32 = (Core.Name "int32") - -_Type_int64 = (Core.Name "int64") - -_Type_float = (Core.Name "float") - -_Type_double = (Core.Name "double") - -_Type_byteArray = (Core.Name "byteArray") - -_Type_fixedLenByteArray = (Core.Name "fixedLenByteArray") - --- | Representation of Schemas -data FieldRepetitionType = - -- | This field is required (can not be null) and each record has exactly 1 value. - FieldRepetitionTypeRequired | - -- | The field is optional (can be null) and each record has 0 or 1 values. - FieldRepetitionTypeOptional | - -- | The field is repeated and can contain 0 or more values - FieldRepetitionTypeRepeated - deriving (Eq, Ord, Read, Show) - -_FieldRepetitionType = (Core.Name "hydra/langs/parquet/format.FieldRepetitionType") - -_FieldRepetitionType_required = (Core.Name "required") - -_FieldRepetitionType_optional = (Core.Name "optional") - -_FieldRepetitionType_repeated = (Core.Name "repeated") - --- | Statistics per row group and per page. All fields are optional. -data Statistics = - Statistics { - statisticsNullCount :: (Maybe Integer), - statisticsDistinctCount :: (Maybe Integer), - -- | Max value for the column, determined by its ColumnOrder. Values are encoded using PLAIN encoding, except that variable-length byte arrays do not include a length prefix. - statisticsMaxValue :: (Maybe String), - -- | Max value for the column, determined by its ColumnOrder. Values are encoded using PLAIN encoding, except that variable-length byte arrays do not include a length prefix. - statisticsMinValue :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_Statistics = (Core.Name "hydra/langs/parquet/format.Statistics") - -_Statistics_nullCount = (Core.Name "nullCount") - -_Statistics_distinctCount = (Core.Name "distinctCount") - -_Statistics_maxValue = (Core.Name "maxValue") - -_Statistics_minValue = (Core.Name "minValue") - --- | Decimal logical type annotation. To maintain forward-compatibility in v1, implementations using this logical type must also set scale and precision on the annotated SchemaElement. Allowed for physical types: INT32, INT64, FIXED, and BINARY -data DecimalType = - DecimalType { - decimalTypeScale :: Int, - decimalTypePrecision :: Int} - deriving (Eq, Ord, Read, Show) - -_DecimalType = (Core.Name "hydra/langs/parquet/format.DecimalType") - -_DecimalType_scale = (Core.Name "scale") - -_DecimalType_precision = (Core.Name "precision") - -data TimeUnit = - TimeUnitMillis | - TimeUnitMicros | - TimeUnitNanos - deriving (Eq, Ord, Read, Show) - -_TimeUnit = (Core.Name "hydra/langs/parquet/format.TimeUnit") - -_TimeUnit_millis = (Core.Name "millis") - -_TimeUnit_micros = (Core.Name "micros") - -_TimeUnit_nanos = (Core.Name "nanos") - --- | Timestamp logical type annotation. Allowed for physical types: INT64 -data TimestampType = - TimestampType { - timestampTypeIsAdjustedToUtc :: Bool, - timestampTypeUnit :: TimeUnit} - deriving (Eq, Ord, Read, Show) - -_TimestampType = (Core.Name "hydra/langs/parquet/format.TimestampType") - -_TimestampType_isAdjustedToUtc = (Core.Name "isAdjustedToUtc") - -_TimestampType_unit = (Core.Name "unit") - --- | Time logical type annotation. Allowed for physical types: INT32 (millis), INT64 (micros, nanos) -data TimeType = - TimeType { - timeTypeIsAdjustedToUtc :: Bool, - timeTypeUnit :: TimeUnit} - deriving (Eq, Ord, Read, Show) - -_TimeType = (Core.Name "hydra/langs/parquet/format.TimeType") - -_TimeType_isAdjustedToUtc = (Core.Name "isAdjustedToUtc") - -_TimeType_unit = (Core.Name "unit") - --- | Integer logical type annotation. bitWidth must be 8, 16, 32, or 64. Allowed for physical types: INT32, INT64 -data IntType = - IntType { - intTypeBitWidth :: Int16, - intTypeIsSigned :: Bool} - deriving (Eq, Ord, Read, Show) - -_IntType = (Core.Name "hydra/langs/parquet/format.IntType") - -_IntType_bitWidth = (Core.Name "bitWidth") - -_IntType_isSigned = (Core.Name "isSigned") - --- | LogicalType annotations to replace ConvertedType. To maintain compatibility, implementations using LogicalType for a SchemaElement aust also set the corresponding ConvertedType (if any) from the following table. -data LogicalType = - -- | use ConvertedType UTF8 - LogicalTypeString | - -- | use ConvertedType MAP - LogicalTypeMap | - -- | use ConvertedType LIST - LogicalTypeList | - -- | use ConvertedType ENUM - LogicalTypeEnum | - -- | use ConvertedType DECIMAL + SchemaElement.{scale, precision} - LogicalTypeDecimal DecimalType | - -- | use ConvertedType DATE - LogicalTypeDate | - -- | use ConvertedType TIME_MICROS for TIME(isAdjustedToUTC = *, unit = MICROS). use ConvertedType TIME_MILLIS for TIME(isAdjustedToUTC = *, unit = MILLIS) - LogicalTypeTime TimeType | - -- | use ConvertedType TIMESTAMP_MICROS for TIMESTAMP(isAdjustedToUTC = *, unit = MICROS). use ConvertedType TIMESTAMP_MILLIS for TIMESTAMP(isAdjustedToUTC = *, unit = MILLIS) - LogicalTypeTimestamp TimestampType | - -- | use ConvertedType INT_* or UINT_* - LogicalTypeInteger IntType | - -- | no compatible ConvertedType - LogicalTypeUnknown | - -- | use ConvertedType JSON - LogicalTypeJson | - -- | use ConvertedType BSON - LogicalTypeBson | - -- | no compatible ConvertedType - LogicalTypeUuid - deriving (Eq, Ord, Read, Show) - -_LogicalType = (Core.Name "hydra/langs/parquet/format.LogicalType") - -_LogicalType_string = (Core.Name "string") - -_LogicalType_map = (Core.Name "map") - -_LogicalType_list = (Core.Name "list") - -_LogicalType_enum = (Core.Name "enum") - -_LogicalType_decimal = (Core.Name "decimal") - -_LogicalType_date = (Core.Name "date") - -_LogicalType_time = (Core.Name "time") - -_LogicalType_timestamp = (Core.Name "timestamp") - -_LogicalType_integer = (Core.Name "integer") - -_LogicalType_unknown = (Core.Name "unknown") - -_LogicalType_json = (Core.Name "json") - -_LogicalType_bson = (Core.Name "bson") - -_LogicalType_uuid = (Core.Name "uuid") - --- | Represents a element inside a schema definition. --- | - if it is a group (inner node) then type is undefined and num_children is defined --- | - if it is a primitive type (leaf) then type is defined and num_children is undefined --- | the nodes are listed in depth first traversal order. -data SchemaElement = - SchemaElement { - -- | Data type for this field. Not set if the current element is a non-leaf node - schemaElementType :: (Maybe Type), - -- | If type is FIXED_LEN_BYTE_ARRAY, this is the byte length of the values. Otherwise, if specified, this is the maximum bit length to store any of the values. (e.g. a low cardinality INT col could have this set to 3). Note that this is in the schema, and therefore fixed for the entire file. - schemaElementTypeLength :: (Maybe Int), - -- | repetition of the field. The root of the schema does not have a repetition_type. All other nodes must have one - schemaElementRepetitionType :: (Maybe FieldRepetitionType), - -- | Name of the field in the schema - schemaElementName :: String, - -- | Nested fields. Since thrift does not support nested fields, the nesting is flattened to a single list by a depth-first traversal. The children count is used to construct the nested relationship. This field is not set when the element is a primitive type - schemaElementNumChildren :: (Maybe Int), - -- | When the original schema supports field ids, this will save the original field id in the parquet schema - schemaElementFieldId :: (Maybe Int), - -- | The logical type of this SchemaElement. LogicalType replaces ConvertedType, but ConvertedType is still required for some logical types to ensure forward-compatibility in format v1. - schemaElementLogicalType :: (Maybe LogicalType)} - deriving (Eq, Ord, Read, Show) - -_SchemaElement = (Core.Name "hydra/langs/parquet/format.SchemaElement") - -_SchemaElement_type = (Core.Name "type") - -_SchemaElement_typeLength = (Core.Name "typeLength") - -_SchemaElement_repetitionType = (Core.Name "repetitionType") - -_SchemaElement_name = (Core.Name "name") - -_SchemaElement_numChildren = (Core.Name "numChildren") - -_SchemaElement_fieldId = (Core.Name "fieldId") - -_SchemaElement_logicalType = (Core.Name "logicalType") - --- | Encodings supported by Parquet. Not all encodings are valid for all types. These enums are also used to specify the encoding of definition and repetition levels. See the accompanying doc for the details of the more complicated encodings. -data Encoding = - -- | Default encoding. - -- | BOOLEAN - 1 bit per value. 0 is false; 1 is true. - -- | INT32 - 4 bytes per value. Stored as little-endian. - -- | INT64 - 8 bytes per value. Stored as little-endian. - -- | FLOAT - 4 bytes per value. IEEE. Stored as little-endian. - -- | DOUBLE - 8 bytes per value. IEEE. Stored as little-endian. - -- | BYTE_ARRAY - 4 byte length stored as little endian, followed by bytes. - -- | FIXED_LEN_BYTE_ARRAY - Just the bytes. - EncodingPlain | - -- | Group packed run length encoding. Usable for definition/repetition levels encoding and Booleans (on one bit: 0 is false; 1 is true.) - EncodingRle | - -- | Bit packed encoding. This can only be used if the data has a known max width. Usable for definition/repetition levels encoding. - EncodingBitPacked | - -- | Delta encoding for integers. This can be used for int columns and works best on sorted data - EncodingDeltaBinaryPacked | - -- | Encoding for byte arrays to separate the length values and the data. The lengths are encoded using DELTA_BINARY_PACKED - EncodingDeltaLengthByteArray | - -- | Incremental-encoded byte array. Prefix lengths are encoded using DELTA_BINARY_PACKED. Suffixes are stored as delta length byte arrays. - EncodingDeltaByteArray | - -- | Dictionary encoding: the ids are encoded using the RLE encoding - EncodingRleDictionary | - -- | Encoding for floating-point data. K byte-streams are created where K is the size in bytes of the data type. The individual bytes of an FP value are scattered to the corresponding stream and the streams are concatenated. This itself does not reduce the size of the data but can lead to better compression afterwards. - EncodingByteStreamSplit - deriving (Eq, Ord, Read, Show) - -_Encoding = (Core.Name "hydra/langs/parquet/format.Encoding") - -_Encoding_plain = (Core.Name "plain") - -_Encoding_rle = (Core.Name "rle") - -_Encoding_bitPacked = (Core.Name "bitPacked") - -_Encoding_deltaBinaryPacked = (Core.Name "deltaBinaryPacked") - -_Encoding_deltaLengthByteArray = (Core.Name "deltaLengthByteArray") - -_Encoding_deltaByteArray = (Core.Name "deltaByteArray") - -_Encoding_rleDictionary = (Core.Name "rleDictionary") - -_Encoding_byteStreamSplit = (Core.Name "byteStreamSplit") - --- | Supported compression algorithms. Codecs added in format version X.Y can be read by readers based on X.Y and later. Codec support may vary between readers based on the format version and libraries available at runtime. See Compression.md for a detailed specification of these algorithms. -data CompressionCodec = - CompressionCodecUncompressed | - CompressionCodecSnappy | - CompressionCodecGzip | - CompressionCodecLzo | - -- | Added in 2.4 - CompressionCodecBrotli | - -- | Added in 2.4 - CompressionCodecZstd | - -- | Added in 2.9 - CompressionCodecLz4Raw - deriving (Eq, Ord, Read, Show) - -_CompressionCodec = (Core.Name "hydra/langs/parquet/format.CompressionCodec") - -_CompressionCodec_uncompressed = (Core.Name "uncompressed") - -_CompressionCodec_snappy = (Core.Name "snappy") - -_CompressionCodec_gzip = (Core.Name "gzip") - -_CompressionCodec_lzo = (Core.Name "lzo") - -_CompressionCodec_brotli = (Core.Name "brotli") - -_CompressionCodec_zstd = (Core.Name "zstd") - -_CompressionCodec_lz4Raw = (Core.Name "lz4Raw") - -data PageType = - PageTypeDataPage | - PageTypeIndexPage | - PageTypeDictionaryPage | - PageTypeDataPageV2 - deriving (Eq, Ord, Read, Show) - -_PageType = (Core.Name "hydra/langs/parquet/format.PageType") - -_PageType_dataPage = (Core.Name "dataPage") - -_PageType_indexPage = (Core.Name "indexPage") - -_PageType_dictionaryPage = (Core.Name "dictionaryPage") - -_PageType_dataPageV2 = (Core.Name "dataPageV2") - --- | Enum to annotate whether lists of min/max elements inside ColumnIndex are ordered and if so, in which direction. -data BoundaryOrder = - BoundaryOrderUnordered | - BoundaryOrderAscending | - BoundaryOrderDescending - deriving (Eq, Ord, Read, Show) - -_BoundaryOrder = (Core.Name "hydra/langs/parquet/format.BoundaryOrder") - -_BoundaryOrder_unordered = (Core.Name "unordered") - -_BoundaryOrder_ascending = (Core.Name "ascending") - -_BoundaryOrder_descending = (Core.Name "descending") - --- | Data page header -data DataPageHeader = - DataPageHeader { - -- | Number of values, including NULLs, in this data page. - dataPageHeaderNumValues :: Int, - -- | Encoding used for this data page - dataPageHeaderEncoding :: Encoding, - -- | Encoding used for definition levels - dataPageHeaderDefinitionLevelEncoding :: Encoding, - -- | Encoding used for repetition levels - dataPageHeaderRepetitionLevelEncoding :: Encoding, - -- | Optional statistics for the data in this page - dataPageHeaderStatistics :: (Maybe Statistics)} - deriving (Eq, Ord, Read, Show) - -_DataPageHeader = (Core.Name "hydra/langs/parquet/format.DataPageHeader") - -_DataPageHeader_numValues = (Core.Name "numValues") - -_DataPageHeader_encoding = (Core.Name "encoding") - -_DataPageHeader_definitionLevelEncoding = (Core.Name "definitionLevelEncoding") - -_DataPageHeader_repetitionLevelEncoding = (Core.Name "repetitionLevelEncoding") - -_DataPageHeader_statistics = (Core.Name "statistics") - -data IndexPageHeader = - IndexPageHeader {} - deriving (Eq, Ord, Read, Show) - -_IndexPageHeader = (Core.Name "hydra/langs/parquet/format.IndexPageHeader") - --- | The dictionary page must be placed at the first position of the column chunk if it is partly or completely dictionary encoded. At most one dictionary page can be placed in a column chunk. -data DictionaryPageHeader = - DictionaryPageHeader { - -- | Number of values in the dictionary - dictionaryPageHeaderNumValues :: Int, - -- | Encoding using this dictionary page - dictionaryPageHeaderEncoding :: Encoding, - -- | If true, the entries in the dictionary are sorted in ascending order - dictionaryPageHeaderIsSorted :: (Maybe Bool)} - deriving (Eq, Ord, Read, Show) - -_DictionaryPageHeader = (Core.Name "hydra/langs/parquet/format.DictionaryPageHeader") - -_DictionaryPageHeader_numValues = (Core.Name "numValues") - -_DictionaryPageHeader_encoding = (Core.Name "encoding") - -_DictionaryPageHeader_isSorted = (Core.Name "isSorted") - --- | New page format allowing reading levels without decompressing the data Repetition and definition levels are uncompressed The remaining section containing the data is compressed if is_compressed is true -data DataPageHeaderV2 = - DataPageHeaderV2 { - -- | Number of values, including NULLs, in this data page. - dataPageHeaderV2NumValues :: Int, - -- | Number of NULL values, in this data page. Number of non-null = num_values - num_nulls which is also the number of values in the data section - dataPageHeaderV2NumNulls :: Int, - -- | Number of rows in this data page. which means pages change on record boundaries (r = 0) - dataPageHeaderV2NumRows :: Int, - -- | Encoding used for data in this page - dataPageHeaderV2Encoding :: Encoding, - -- | length of the definition levels - dataPageHeaderV2DefinitionLevelsByteLength :: Int, - -- | length of the repetition levels - dataPageHeaderV2RepetitionLevelsByteLength :: Int, - -- | whether the values are compressed. Which means the section of the page between definition_levels_byte_length + repetition_levels_byte_length + 1 and compressed_page_size (included) is compressed with the compression_codec. If missing it is considered compressed - dataPageHeaderV2IsCompressed :: (Maybe Bool), - -- | optional statistics for the data in this page - dataPageHeaderV2Statistics :: (Maybe Statistics)} - deriving (Eq, Ord, Read, Show) - -_DataPageHeaderV2 = (Core.Name "hydra/langs/parquet/format.DataPageHeaderV2") - -_DataPageHeaderV2_numValues = (Core.Name "numValues") - -_DataPageHeaderV2_numNulls = (Core.Name "numNulls") - -_DataPageHeaderV2_numRows = (Core.Name "numRows") - -_DataPageHeaderV2_encoding = (Core.Name "encoding") - -_DataPageHeaderV2_definitionLevelsByteLength = (Core.Name "definitionLevelsByteLength") - -_DataPageHeaderV2_repetitionLevelsByteLength = (Core.Name "repetitionLevelsByteLength") - -_DataPageHeaderV2_isCompressed = (Core.Name "isCompressed") - -_DataPageHeaderV2_statistics = (Core.Name "statistics") - --- | The algorithm used in Bloom filter. -data BloomFilterAlgorithm = - -- | Block-based Bloom filter. - BloomFilterAlgorithmBlock - deriving (Eq, Ord, Read, Show) - -_BloomFilterAlgorithm = (Core.Name "hydra/langs/parquet/format.BloomFilterAlgorithm") - -_BloomFilterAlgorithm_block = (Core.Name "block") - --- | The hash function used in Bloom filter. This function takes the hash of a column value using plain encoding. -data BloomFilterHash = - -- | xxHash Strategy. - BloomFilterHashXxhash - deriving (Eq, Ord, Read, Show) - -_BloomFilterHash = (Core.Name "hydra/langs/parquet/format.BloomFilterHash") - -_BloomFilterHash_xxhash = (Core.Name "xxhash") - --- | The compression used in the Bloom filter. -data BloomFilterCompression = - BloomFilterCompressionUncompressed - deriving (Eq, Ord, Read, Show) - -_BloomFilterCompression = (Core.Name "hydra/langs/parquet/format.BloomFilterCompression") - -_BloomFilterCompression_uncompressed = (Core.Name "uncompressed") - --- | Bloom filter header is stored at beginning of Bloom filter data of each column and followed by its bitset. -data BloomFilterHeader = - BloomFilterHeader { - -- | The size of bitset in bytes - bloomFilterHeaderNumBytes :: Int, - -- | The algorithm for setting bits. - bloomFilterHeaderAlgorithm :: BloomFilterAlgorithm, - -- | The hash function used for Bloom filter. - bloomFilterHeaderHash :: BloomFilterHash, - -- | The compression used in the Bloom filter - bloomFilterHeaderCompression :: BloomFilterCompression} - deriving (Eq, Ord, Read, Show) - -_BloomFilterHeader = (Core.Name "hydra/langs/parquet/format.BloomFilterHeader") - -_BloomFilterHeader_numBytes = (Core.Name "numBytes") - -_BloomFilterHeader_algorithm = (Core.Name "algorithm") - -_BloomFilterHeader_hash = (Core.Name "hash") - -_BloomFilterHeader_compression = (Core.Name "compression") - -data PageHeader = - PageHeader { - -- | the type of the page: indicates which of the *_header fields is set - pageHeaderType :: PageType, - -- | Uncompressed page size in bytes (not including this header) - pageHeaderUncompressedPageSize :: Int, - -- | Compressed (and potentially encrypted) page size in bytes, not including this header - pageHeaderCompressedPageSize :: Int, - -- | The 32bit CRC for the page, to be be calculated as follows: - -- | - Using the standard CRC32 algorithm - -- | - On the data only, i.e. this header should not be included. 'Data' - -- | hereby refers to the concatenation of the repetition levels, the - -- | definition levels and the column value, in this exact order. - -- | - On the encoded versions of the repetition levels, definition levels and - -- | column values - -- | - On the compressed versions of the repetition levels, definition levels - -- | and column values where possible; - -- | - For v1 data pages, the repetition levels, definition levels and column - -- | values are always compressed together. If a compression scheme is - -- | specified, the CRC shall be calculated on the compressed version of - -- | this concatenation. If no compression scheme is specified, the CRC - -- | shall be calculated on the uncompressed version of this concatenation. - -- | - For v2 data pages, the repetition levels and definition levels are - -- | handled separately from the data and are never compressed (only - -- | encoded). If a compression scheme is specified, the CRC shall be - -- | calculated on the concatenation of the uncompressed repetition levels, - -- | uncompressed definition levels and the compressed column values. - -- | If no compression scheme is specified, the CRC shall be calculated on - -- | the uncompressed concatenation. - -- | - In encrypted columns, CRC is calculated after page encryption; the - -- | encryption itself is performed after page compression (if compressed) - -- | If enabled, this allows for disabling checksumming in HDFS if only a few pages need to be read. - pageHeaderCrc :: (Maybe Int), - pageHeaderDataPageHeader :: (Maybe DataPageHeader), - pageHeaderIndexPageHeader :: (Maybe IndexPageHeader), - pageHeaderDictionaryPageHeader :: (Maybe DictionaryPageHeader), - pageHeaderDataPageHeaderV2 :: (Maybe DataPageHeaderV2)} - deriving (Eq, Ord, Read, Show) - -_PageHeader = (Core.Name "hydra/langs/parquet/format.PageHeader") - -_PageHeader_type = (Core.Name "type") - -_PageHeader_uncompressedPageSize = (Core.Name "uncompressedPageSize") - -_PageHeader_compressedPageSize = (Core.Name "compressedPageSize") - -_PageHeader_crc = (Core.Name "crc") - -_PageHeader_dataPageHeader = (Core.Name "dataPageHeader") - -_PageHeader_indexPageHeader = (Core.Name "indexPageHeader") - -_PageHeader_dictionaryPageHeader = (Core.Name "dictionaryPageHeader") - -_PageHeader_dataPageHeaderV2 = (Core.Name "dataPageHeaderV2") - --- | Wrapper struct to store key values -data KeyValue = - KeyValue { - keyValueKey :: String, - keyValueValue :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_KeyValue = (Core.Name "hydra/langs/parquet/format.KeyValue") - -_KeyValue_key = (Core.Name "key") - -_KeyValue_value = (Core.Name "value") - --- | Wrapper struct to specify sort order -data SortingColumn = - SortingColumn { - -- | The column index (in this row group) - sortingColumnColumnIdx :: Int, - -- | If true, indicates this column is sorted in descending order. - sortingColumnDescending :: Bool, - -- | If true, nulls will come before non-null values, otherwise, nulls go at the end. - sortingColumnNullsFirst :: Bool} - deriving (Eq, Ord, Read, Show) - -_SortingColumn = (Core.Name "hydra/langs/parquet/format.SortingColumn") - -_SortingColumn_columnIdx = (Core.Name "columnIdx") - -_SortingColumn_descending = (Core.Name "descending") - -_SortingColumn_nullsFirst = (Core.Name "nullsFirst") - --- | statistics of a given page type and encoding -data PageEncodingStats = - PageEncodingStats { - -- | the page type (data/dic/...) - pageEncodingStatsPageType :: PageType, - -- | encoding of the page - pageEncodingStatsEncoding :: Encoding, - -- | number of pages of this type with this encoding - pageEncodingStatsCount :: Int} - deriving (Eq, Ord, Read, Show) - -_PageEncodingStats = (Core.Name "hydra/langs/parquet/format.PageEncodingStats") - -_PageEncodingStats_pageType = (Core.Name "pageType") - -_PageEncodingStats_encoding = (Core.Name "encoding") - -_PageEncodingStats_count = (Core.Name "count") - --- | Description for column metadata -data ColumnMetaData = - ColumnMetaData { - -- | Type of this column - columnMetaDataType :: Type, - -- | Set of all encodings used for this column. The purpose is to validate whether we can decode those pages. - columnMetaDataEncodings :: [Encoding], - -- | Path in schema - columnMetaDataPathInSchema :: [String], - -- | Compression codec - columnMetaDataCodec :: CompressionCodec, - -- | Number of values in this column - columnMetaDataNumValues :: Int64, - -- | total byte size of all uncompressed pages in this column chunk (including the headers) - columnMetaDataTotalUncompressedSize :: Int64, - -- | total byte size of all compressed, and potentially encrypted, pages in this column chunk (including the headers) - columnMetaDataTotalCompressedSize :: Int64, - -- | Optional key/value metadata - columnMetaDataKeyValueMetadata :: (Maybe [KeyValue]), - -- | Byte offset from beginning of file to first data page - columnMetaDataDataPageOffset :: Int64, - -- | Byte offset from beginning of file to root index page - columnMetaDataIndexPageOffset :: (Maybe Int64), - -- | Byte offset from the beginning of file to first (only) dictionary page - columnMetaDataDictionaryPageOffset :: (Maybe Int64), - -- | optional statistics for this column chunk - columnMetaDataStatistics :: (Maybe Statistics), - -- | Set of all encodings used for pages in this column chunk. This information can be used to determine if all data pages are dictionary encoded for example - columnMetaDataEncodingStats :: (Maybe [PageEncodingStats]), - -- | Byte offset from beginning of file to Bloom filter data. - columnMetaDataBloomFilterOffset :: (Maybe Int64)} - deriving (Eq, Ord, Read, Show) - -_ColumnMetaData = (Core.Name "hydra/langs/parquet/format.ColumnMetaData") - -_ColumnMetaData_type = (Core.Name "type") - -_ColumnMetaData_encodings = (Core.Name "encodings") - -_ColumnMetaData_pathInSchema = (Core.Name "pathInSchema") - -_ColumnMetaData_codec = (Core.Name "codec") - -_ColumnMetaData_numValues = (Core.Name "numValues") - -_ColumnMetaData_totalUncompressedSize = (Core.Name "totalUncompressedSize") - -_ColumnMetaData_totalCompressedSize = (Core.Name "totalCompressedSize") - -_ColumnMetaData_keyValueMetadata = (Core.Name "keyValueMetadata") - -_ColumnMetaData_dataPageOffset = (Core.Name "dataPageOffset") - -_ColumnMetaData_indexPageOffset = (Core.Name "indexPageOffset") - -_ColumnMetaData_dictionaryPageOffset = (Core.Name "dictionaryPageOffset") - -_ColumnMetaData_statistics = (Core.Name "statistics") - -_ColumnMetaData_encodingStats = (Core.Name "encodingStats") - -_ColumnMetaData_bloomFilterOffset = (Core.Name "bloomFilterOffset") - -data EncryptionWithFooterKey = - EncryptionWithFooterKey {} - deriving (Eq, Ord, Read, Show) - -_EncryptionWithFooterKey = (Core.Name "hydra/langs/parquet/format.EncryptionWithFooterKey") - -data EncryptionWithColumnKey = - EncryptionWithColumnKey { - -- | Column path in schema - encryptionWithColumnKeyPathInSchema :: [String], - -- | Retrieval metadata of column encryption key - encryptionWithColumnKeyKeyMetadata :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_EncryptionWithColumnKey = (Core.Name "hydra/langs/parquet/format.EncryptionWithColumnKey") - -_EncryptionWithColumnKey_pathInSchema = (Core.Name "pathInSchema") - -_EncryptionWithColumnKey_keyMetadata = (Core.Name "keyMetadata") - -data ColumnCryptoMetaData = - ColumnCryptoMetaDataEncryptionWithFooterKey EncryptionWithFooterKey | - ColumnCryptoMetaDataEncryptionWithColumnKey EncryptionWithColumnKey - deriving (Eq, Ord, Read, Show) - -_ColumnCryptoMetaData = (Core.Name "hydra/langs/parquet/format.ColumnCryptoMetaData") - -_ColumnCryptoMetaData_encryptionWithFooterKey = (Core.Name "encryptionWithFooterKey") - -_ColumnCryptoMetaData_encryptionWithColumnKey = (Core.Name "encryptionWithColumnKey") - -data ColumnChunk = - ColumnChunk { - -- | File where column data is stored. If not set, assumed to be same file as metadata. This path is relative to the current file. - columnChunkFilePath :: (Maybe String), - -- | Byte offset in file_path to the ColumnMetaData - columnChunkFileOffset :: Int64, - -- | Column metadata for this chunk. This is the same content as what is at file_path/file_offset. Having it here has it replicated in the file metadata. - columnChunkMetaData :: (Maybe ColumnMetaData), - -- | File offset of ColumnChunk's OffsetIndex - columnChunkOffsetIndexOffset :: (Maybe Int64), - -- | Size of ColumnChunk's OffsetIndex, in bytes - columnChunkOffsetIndexLength :: (Maybe Int), - -- | File offset of ColumnChunk's ColumnIndex - columnChunkColumnIndexOffset :: (Maybe Int64), - -- | Size of ColumnChunk's ColumnIndex, in bytes - columnChunkColumnIndexLength :: (Maybe Int), - -- | Crypto metadata of encrypted columns - columnChunkCryptoMetadata :: (Maybe ColumnCryptoMetaData), - -- | Encrypted column metadata for this chunk - columnChunkEncryptedColumnMetadata :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_ColumnChunk = (Core.Name "hydra/langs/parquet/format.ColumnChunk") - -_ColumnChunk_filePath = (Core.Name "filePath") - -_ColumnChunk_fileOffset = (Core.Name "fileOffset") - -_ColumnChunk_metaData = (Core.Name "metaData") - -_ColumnChunk_offsetIndexOffset = (Core.Name "offsetIndexOffset") - -_ColumnChunk_offsetIndexLength = (Core.Name "offsetIndexLength") - -_ColumnChunk_columnIndexOffset = (Core.Name "columnIndexOffset") - -_ColumnChunk_columnIndexLength = (Core.Name "columnIndexLength") - -_ColumnChunk_cryptoMetadata = (Core.Name "cryptoMetadata") - -_ColumnChunk_encryptedColumnMetadata = (Core.Name "encryptedColumnMetadata") - -data RowGroup = - RowGroup { - -- | Metadata for each column chunk in this row group. This list must have the same order as the SchemaElement list in FileMetaData. - rowGroupColumns :: [ColumnChunk], - -- | Total byte size of all the uncompressed column data in this row group - rowGroupTotalByteSize :: Int64, - -- | Number of rows in this row group - rowGroupNumRows :: Int64, - -- | If set, specifies a sort ordering of the rows in this RowGroup. The sorting columns can be a subset of all the columns. - rowGroupSortingColumns :: (Maybe [SortingColumn]), - -- | Byte offset from beginning of file to first page (data or dictionary) in this row group - rowGroupFileOffset :: (Maybe Int64), - -- | Total byte size of all compressed (and potentially encrypted) column data in this row group - rowGroupTotalCompressedSize :: (Maybe Int64), - -- | Row group ordinal in the file - rowGroupOrdinal :: (Maybe Int16)} - deriving (Eq, Ord, Read, Show) - -_RowGroup = (Core.Name "hydra/langs/parquet/format.RowGroup") - -_RowGroup_columns = (Core.Name "columns") - -_RowGroup_totalByteSize = (Core.Name "totalByteSize") - -_RowGroup_numRows = (Core.Name "numRows") - -_RowGroup_sortingColumns = (Core.Name "sortingColumns") - -_RowGroup_fileOffset = (Core.Name "fileOffset") - -_RowGroup_totalCompressedSize = (Core.Name "totalCompressedSize") - -_RowGroup_ordinal = (Core.Name "ordinal") - --- | Union to specify the order used for the min_value and max_value fields for a column. This union takes the role of an enhanced enum that allows rich elements (which will be needed for a collation-based ordering in the future). Possible values are: --- | * TypeDefinedOrder - the column uses the order defined by its logical or physical type (if there is no logical type). --- | If the reader does not support the value of this union, min and max stats for this column should be ignored. -data ColumnOrder = - -- | The sort orders for logical types are: - -- | UTF8 - unsigned byte-wise comparison - -- | INT8 - signed comparison - -- | INT16 - signed comparison - -- | INT32 - signed comparison - -- | INT64 - signed comparison - -- | UINT8 - unsigned comparison - -- | UINT16 - unsigned comparison - -- | UINT32 - unsigned comparison - -- | UINT64 - unsigned comparison - -- | DECIMAL - signed comparison of the represented value - -- | DATE - signed comparison - -- | TIME_MILLIS - signed comparison - -- | TIME_MICROS - signed comparison - -- | TIMESTAMP_MILLIS - signed comparison - -- | TIMESTAMP_MICROS - signed comparison - -- | INTERVAL - unsigned comparison - -- | JSON - unsigned byte-wise comparison - -- | BSON - unsigned byte-wise comparison - -- | ENUM - unsigned byte-wise comparison - -- | LIST - undefined - -- | MAP - undefined - -- | In the absence of logical types, the sort order is determined by the physical type: - -- | BOOLEAN - false, true - -- | INT32 - signed comparison - -- | INT64 - signed comparison - -- | INT96 (only used for legacy timestamps) - undefined - -- | FLOAT - signed comparison of the represented value (*) - -- | DOUBLE - signed comparison of the represented value (*) - -- | BYTE_ARRAY - unsigned byte-wise comparison - -- | FIXED_LEN_BYTE_ARRAY - unsigned byte-wise comparison - -- | (*) Because the sorting order is not specified properly for floating - -- | point values (relations vs. total ordering) the following - -- | compatibility rules should be applied when reading statistics: - -- | - If the min is a NaN, it should be ignored. - -- | - If the max is a NaN, it should be ignored. - -- | - If the min is +0, the row group may contain -0 values as well. - -- | - If the max is -0, the row group may contain +0 values as well. - -- | - When looking for NaN values, min and max should be ignored. - ColumnOrderTypeOrder - deriving (Eq, Ord, Read, Show) - -_ColumnOrder = (Core.Name "hydra/langs/parquet/format.ColumnOrder") - -_ColumnOrder_typeOrder = (Core.Name "typeOrder") - -data PageLocation = - PageLocation { - -- | Offset of the page in the file - pageLocationOffset :: Int64, - -- | Size of the page, including header. Sum of compressed_page_size and header length - pageLocationCompressedPageSize :: Int, - -- | Index within the RowGroup of the first row of the page; this means pages change on record boundaries (r = 0). - pageLocationFirstRowIndex :: Int64} - deriving (Eq, Ord, Read, Show) - -_PageLocation = (Core.Name "hydra/langs/parquet/format.PageLocation") - -_PageLocation_offset = (Core.Name "offset") - -_PageLocation_compressedPageSize = (Core.Name "compressedPageSize") - -_PageLocation_firstRowIndex = (Core.Name "firstRowIndex") - -data OffsetIndex = - OffsetIndex { - -- | PageLocations, ordered by increasing PageLocation.offset. It is required that page_locations[i].first_row_index < page_locations[i+1].first_row_index. - offsetIndexPageLocations :: [PageLocation]} - deriving (Eq, Ord, Read, Show) - -_OffsetIndex = (Core.Name "hydra/langs/parquet/format.OffsetIndex") - -_OffsetIndex_pageLocations = (Core.Name "pageLocations") - --- | Description for ColumnIndex. Each [i] refers to the page at OffsetIndex.page_locations[i] -data ColumnIndex = - ColumnIndex { - -- | A list of Boolean values to determine the validity of the corresponding min and max values. If true, a page contains only null values, and writers have to set the corresponding entries in min_values and max_values to byte[0], so that all lists have the same length. If false, the corresponding entries in min_values and max_values must be valid. - columnIndexNullPages :: [Bool], - -- | minValues and maxValues are lists containing lower and upper bounds for the values of each page determined by the ColumnOrder of the column. These may be the actual minimum and maximum values found on a page, but can also be (more compact) values that do not exist on a page. For example, instead of storing "Blart Versenwald III", a writer may set min_values[i]="B", max_values[i]="C". Such more compact values must still be valid values within the column's logical type. Readers must make sure that list entries are populated before using them by inspecting null_pages. - columnIndexMinValues :: [String], - columnIndexMaxValues :: [String], - -- | Stores whether both min_values and max_values are orderd and if so, in which direction. This allows readers to perform binary searches in both lists. Readers cannot assume that max_values[i] <= min_values[i+1], even if the lists are ordered. - columnIndexBoundaryOrder :: BoundaryOrder, - -- | A list containing the number of null values for each page - columnIndexNullCounts :: (Maybe [Int64])} - deriving (Eq, Ord, Read, Show) - -_ColumnIndex = (Core.Name "hydra/langs/parquet/format.ColumnIndex") - -_ColumnIndex_nullPages = (Core.Name "nullPages") - -_ColumnIndex_minValues = (Core.Name "minValues") - -_ColumnIndex_maxValues = (Core.Name "maxValues") - -_ColumnIndex_boundaryOrder = (Core.Name "boundaryOrder") - -_ColumnIndex_nullCounts = (Core.Name "nullCounts") - -data AesGcmV1 = - AesGcmV1 { - -- | AAD prefix - aesGcmV1AadPrefix :: (Maybe String), - -- | Unique file identifier part of AAD suffix - aesGcmV1AadFileUnique :: (Maybe String), - -- | In files encrypted with AAD prefix without storing it, readers must supply the prefix - aesGcmV1SupplyAadPrefix :: (Maybe Bool)} - deriving (Eq, Ord, Read, Show) - -_AesGcmV1 = (Core.Name "hydra/langs/parquet/format.AesGcmV1") - -_AesGcmV1_aadPrefix = (Core.Name "aadPrefix") - -_AesGcmV1_aadFileUnique = (Core.Name "aadFileUnique") - -_AesGcmV1_supplyAadPrefix = (Core.Name "supplyAadPrefix") - -data AesGcmCtrV1 = - AesGcmCtrV1 { - -- | AAD prefix - aesGcmCtrV1AadPrefix :: (Maybe String), - -- | Unique file identifier part of AAD suffix - aesGcmCtrV1AadFileUnique :: (Maybe String), - -- | In files encrypted with AAD prefix without storing it, readers must supply the prefix - aesGcmCtrV1SupplyAadPrefix :: (Maybe Bool)} - deriving (Eq, Ord, Read, Show) - -_AesGcmCtrV1 = (Core.Name "hydra/langs/parquet/format.AesGcmCtrV1") - -_AesGcmCtrV1_aadPrefix = (Core.Name "aadPrefix") - -_AesGcmCtrV1_aadFileUnique = (Core.Name "aadFileUnique") - -_AesGcmCtrV1_supplyAadPrefix = (Core.Name "supplyAadPrefix") - -data EncryptionAlgorithm = - EncryptionAlgorithmAesGcmV1 AesGcmV1 | - EncryptionAlgorithmAesGcmCtrV1 AesGcmCtrV1 - deriving (Eq, Ord, Read, Show) - -_EncryptionAlgorithm = (Core.Name "hydra/langs/parquet/format.EncryptionAlgorithm") - -_EncryptionAlgorithm_aesGcmV1 = (Core.Name "aesGcmV1") - -_EncryptionAlgorithm_aesGcmCtrV1 = (Core.Name "aesGcmCtrV1") - --- | Description for file metadata -data FileMetaData = - FileMetaData { - -- | Version of this file - fileMetaDataVersion :: Int, - -- | Parquet schema for this file. This schema contains metadata for all the columns. The schema is represented as a tree with a single root. The nodes of the tree are flattened to a list by doing a depth-first traversal. The column metadata contains the path in the schema for that column which can be used to map columns to nodes in the schema. The first element is the root - fileMetaDataSchema :: [SchemaElement], - -- | Number of rows in this file - fileMetaDataNumRows :: Int64, - -- | Row groups in this file - fileMetaDataRowGroups :: [RowGroup], - -- | Optional key/value metadata - fileMetaDataKeyValueMetadata :: (Maybe [KeyValue]), - -- | String for application that wrote this file. This should be in the format version (build ). e.g. impala version 1.0 (build 6cf94d29b2b7115df4de2c06e2ab4326d721eb55) - fileMetaDataCreatedBy :: (Maybe String), - -- | Sort order used for the min_value and max_value fields in the Statistics objects and the min_values and max_values fields in the ColumnIndex objects of each column in this file. Sort orders are listed in the order matching the columns in the schema. The indexes are not necessary the same though, because only leaf nodes of the schema are represented in the list of sort orders. - -- | Without column_orders, the meaning of the min_value and max_value fields in the Statistics object and the ColumnIndex object is undefined. To ensure well-defined behaviour, if these fields are written to a Parquet file, column_orders must be written as well. - -- | The obsolete min and max fields in the Statistics object are always sorted by signed comparison regardless of column_orders. - fileMetaDataColumnOrders :: (Maybe [ColumnOrder]), - -- | Encryption algorithm. This field is set only in encrypted files with plaintext footer. Files with encrypted footer store algorithm id in FileCryptoMetaData structure. - fileMetaDataEncryptionAlgorithm :: (Maybe EncryptionAlgorithm), - -- | Retrieval metadata of key used for signing the footer. Used only in encrypted files with plaintext footer. - fileMetaDataFooterSigningKeyMetadata :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_FileMetaData = (Core.Name "hydra/langs/parquet/format.FileMetaData") - -_FileMetaData_version = (Core.Name "version") - -_FileMetaData_schema = (Core.Name "schema") - -_FileMetaData_numRows = (Core.Name "numRows") - -_FileMetaData_rowGroups = (Core.Name "rowGroups") - -_FileMetaData_keyValueMetadata = (Core.Name "keyValueMetadata") - -_FileMetaData_createdBy = (Core.Name "createdBy") - -_FileMetaData_columnOrders = (Core.Name "columnOrders") - -_FileMetaData_encryptionAlgorithm = (Core.Name "encryptionAlgorithm") - -_FileMetaData_footerSigningKeyMetadata = (Core.Name "footerSigningKeyMetadata") - --- | Crypto metadata for files with encrypted footer -data FileCryptoMetaData = - FileCryptoMetaData { - -- | Encryption algorithm. This field is only used for files with encrypted footer. Files with plaintext footer store algorithm id inside footer (FileMetaData structure). - fileCryptoMetaDataEncryptionAlgorithm :: EncryptionAlgorithm, - -- | Retrieval metadata of key used for encryption of footer, and (possibly) columns - fileCryptoMetaDataKeyMetadata :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_FileCryptoMetaData = (Core.Name "hydra/langs/parquet/format.FileCryptoMetaData") - -_FileCryptoMetaData_encryptionAlgorithm = (Core.Name "encryptionAlgorithm") - -_FileCryptoMetaData_keyMetadata = (Core.Name "keyMetadata") diff --git a/src/gen-main/haskell/Hydra/Langs/Pegasus/Pdl.hs b/src/gen-main/haskell/Hydra/Langs/Pegasus/Pdl.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Pegasus/Pdl.hs +++ /dev/null @@ -1,268 +0,0 @@ --- | A model for PDL (Pegasus Data Language) schemas. Based on the specification at: --- | https://linkedin.github.io/rest.li/pdl_schema - -module Hydra.Langs.Pegasus.Pdl where - -import qualified Hydra.Core as Core -import qualified Hydra.Json as Json -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas -data Annotations = - Annotations { - annotationsDoc :: (Maybe String), - annotationsDeprecated :: Bool} - deriving (Eq, Ord, Read, Show) - -_Annotations = (Core.Name "hydra/langs/pegasus/pdl.Annotations") - -_Annotations_doc = (Core.Name "doc") - -_Annotations_deprecated = (Core.Name "deprecated") - -data EnumField = - EnumField { - enumFieldName :: EnumFieldName, - enumFieldAnnotations :: Annotations} - deriving (Eq, Ord, Read, Show) - -_EnumField = (Core.Name "hydra/langs/pegasus/pdl.EnumField") - -_EnumField_name = (Core.Name "name") - -_EnumField_annotations = (Core.Name "annotations") - -newtype EnumFieldName = - EnumFieldName { - unEnumFieldName :: String} - deriving (Eq, Ord, Read, Show) - -_EnumFieldName = (Core.Name "hydra/langs/pegasus/pdl.EnumFieldName") - -data EnumSchema = - EnumSchema { - enumSchemaFields :: [EnumField]} - deriving (Eq, Ord, Read, Show) - -_EnumSchema = (Core.Name "hydra/langs/pegasus/pdl.EnumSchema") - -_EnumSchema_fields = (Core.Name "fields") - -newtype FieldName = - FieldName { - unFieldName :: String} - deriving (Eq, Ord, Read, Show) - -_FieldName = (Core.Name "hydra/langs/pegasus/pdl.FieldName") - -data NamedSchema = - NamedSchema { - namedSchemaQualifiedName :: QualifiedName, - namedSchemaType :: NamedSchema_Type, - namedSchemaAnnotations :: Annotations} - deriving (Eq, Ord, Read, Show) - -_NamedSchema = (Core.Name "hydra/langs/pegasus/pdl.NamedSchema") - -_NamedSchema_qualifiedName = (Core.Name "qualifiedName") - -_NamedSchema_type = (Core.Name "type") - -_NamedSchema_annotations = (Core.Name "annotations") - -data NamedSchema_Type = - NamedSchema_TypeRecord RecordSchema | - NamedSchema_TypeEnum EnumSchema | - NamedSchema_TypeTyperef Schema - deriving (Eq, Ord, Read, Show) - -_NamedSchema_Type = (Core.Name "hydra/langs/pegasus/pdl.NamedSchema.Type") - -_NamedSchema_Type_record = (Core.Name "record") - -_NamedSchema_Type_enum = (Core.Name "enum") - -_NamedSchema_Type_typeref = (Core.Name "typeref") - -newtype Name = - Name { - unName :: String} - deriving (Eq, Ord, Read, Show) - -_Name = (Core.Name "hydra/langs/pegasus/pdl.Name") - -newtype Namespace = - Namespace { - unNamespace :: String} - deriving (Eq, Ord, Read, Show) - -_Namespace = (Core.Name "hydra/langs/pegasus/pdl.Namespace") - -newtype Package = - Package { - unPackage :: String} - deriving (Eq, Ord, Read, Show) - -_Package = (Core.Name "hydra/langs/pegasus/pdl.Package") - -data PrimitiveType = - PrimitiveTypeBoolean | - PrimitiveTypeBytes | - PrimitiveTypeDouble | - PrimitiveTypeFloat | - PrimitiveTypeInt | - PrimitiveTypeLong | - PrimitiveTypeString - deriving (Eq, Ord, Read, Show) - -_PrimitiveType = (Core.Name "hydra/langs/pegasus/pdl.PrimitiveType") - -_PrimitiveType_boolean = (Core.Name "boolean") - -_PrimitiveType_bytes = (Core.Name "bytes") - -_PrimitiveType_double = (Core.Name "double") - -_PrimitiveType_float = (Core.Name "float") - -_PrimitiveType_int = (Core.Name "int") - -_PrimitiveType_long = (Core.Name "long") - -_PrimitiveType_string = (Core.Name "string") - -newtype PropertyKey = - PropertyKey { - unPropertyKey :: String} - deriving (Eq, Ord, Read, Show) - -_PropertyKey = (Core.Name "hydra/langs/pegasus/pdl.PropertyKey") - -data Property = - Property { - propertyKey :: PropertyKey, - propertyValue :: (Maybe Json.Value)} - deriving (Eq, Ord, Read, Show) - -_Property = (Core.Name "hydra/langs/pegasus/pdl.Property") - -_Property_key = (Core.Name "key") - -_Property_value = (Core.Name "value") - -data QualifiedName = - QualifiedName { - qualifiedNameName :: Name, - qualifiedNameNamespace :: (Maybe Namespace)} - deriving (Eq, Ord, Read, Show) - -_QualifiedName = (Core.Name "hydra/langs/pegasus/pdl.QualifiedName") - -_QualifiedName_name = (Core.Name "name") - -_QualifiedName_namespace = (Core.Name "namespace") - -data RecordField = - RecordField { - recordFieldName :: FieldName, - recordFieldValue :: Schema, - recordFieldOptional :: Bool, - recordFieldDefault :: (Maybe Json.Value), - recordFieldAnnotations :: Annotations} - deriving (Eq, Ord, Read, Show) - -_RecordField = (Core.Name "hydra/langs/pegasus/pdl.RecordField") - -_RecordField_name = (Core.Name "name") - -_RecordField_value = (Core.Name "value") - -_RecordField_optional = (Core.Name "optional") - -_RecordField_default = (Core.Name "default") - -_RecordField_annotations = (Core.Name "annotations") - -data RecordSchema = - RecordSchema { - recordSchemaFields :: [RecordField], - recordSchemaIncludes :: [NamedSchema]} - deriving (Eq, Ord, Read, Show) - -_RecordSchema = (Core.Name "hydra/langs/pegasus/pdl.RecordSchema") - -_RecordSchema_fields = (Core.Name "fields") - -_RecordSchema_includes = (Core.Name "includes") - -data Schema = - SchemaArray Schema | - SchemaFixed Int | - SchemaInline NamedSchema | - SchemaMap Schema | - SchemaNamed QualifiedName | - SchemaNull | - SchemaPrimitive PrimitiveType | - SchemaUnion UnionSchema - deriving (Eq, Ord, Read, Show) - -_Schema = (Core.Name "hydra/langs/pegasus/pdl.Schema") - -_Schema_array = (Core.Name "array") - -_Schema_fixed = (Core.Name "fixed") - -_Schema_inline = (Core.Name "inline") - -_Schema_map = (Core.Name "map") - -_Schema_named = (Core.Name "named") - -_Schema_null = (Core.Name "null") - -_Schema_primitive = (Core.Name "primitive") - -_Schema_union = (Core.Name "union") - -data SchemaFile = - SchemaFile { - schemaFileNamespace :: Namespace, - schemaFilePackage :: (Maybe Package), - schemaFileImports :: [QualifiedName], - schemaFileSchemas :: [NamedSchema]} - deriving (Eq, Ord, Read, Show) - -_SchemaFile = (Core.Name "hydra/langs/pegasus/pdl.SchemaFile") - -_SchemaFile_namespace = (Core.Name "namespace") - -_SchemaFile_package = (Core.Name "package") - -_SchemaFile_imports = (Core.Name "imports") - -_SchemaFile_schemas = (Core.Name "schemas") - -data UnionMember = - UnionMember { - unionMemberAlias :: (Maybe FieldName), - unionMemberValue :: Schema, - unionMemberAnnotations :: Annotations} - deriving (Eq, Ord, Read, Show) - -_UnionMember = (Core.Name "hydra/langs/pegasus/pdl.UnionMember") - -_UnionMember_alias = (Core.Name "alias") - -_UnionMember_value = (Core.Name "value") - -_UnionMember_annotations = (Core.Name "annotations") - -newtype UnionSchema = - UnionSchema { - unUnionSchema :: [UnionMember]} - deriving (Eq, Ord, Read, Show) - -_UnionSchema = (Core.Name "hydra/langs/pegasus/pdl.UnionSchema") diff --git a/src/gen-main/haskell/Hydra/Langs/Protobuf/Any.hs b/src/gen-main/haskell/Hydra/Langs/Protobuf/Any.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Protobuf/Any.hs +++ /dev/null @@ -1,24 +0,0 @@ --- | Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/any.proto - -module Hydra.Langs.Protobuf.Any where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | `Any` contains an arbitrary serialized protocol buffer message along with a URL that describes the type of the serialized message. -data Any = - Any { - -- | A URL/resource name that uniquely identifies the type of the serialized protocol buffer message. - anyTypeUrl :: String, - -- | Must be a valid serialized protocol buffer of the above specified type. - anyValue :: String} - deriving (Eq, Ord, Read, Show) - -_Any = (Core.Name "hydra/langs/protobuf/any.Any") - -_Any_typeUrl = (Core.Name "typeUrl") - -_Any_value = (Core.Name "value") diff --git a/src/gen-main/haskell/Hydra/Langs/Protobuf/Language.hs b/src/gen-main/haskell/Hydra/Langs/Protobuf/Language.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Protobuf/Language.hs +++ /dev/null @@ -1,90 +0,0 @@ --- | Language constraints for Protobuf v3 - -module Hydra.Langs.Protobuf.Language where - -import qualified Hydra.Coders as Coders -import qualified Hydra.Core as Core -import qualified Hydra.Lib.Lists as Lists -import qualified Hydra.Lib.Sets as Sets -import qualified Hydra.Mantle as Mantle -import qualified Hydra.Strip as Strip -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | Language constraints for Protocol Buffers v3 -protobufLanguage :: Coders.Language -protobufLanguage = Coders.Language { - Coders.languageName = (Coders.LanguageName "hydra/langs/protobuf"), - Coders.languageConstraints = Coders.LanguageConstraints { - Coders.languageConstraintsEliminationVariants = Sets.empty, - Coders.languageConstraintsLiteralVariants = (Sets.fromList [ - Mantle.LiteralVariantBinary, - Mantle.LiteralVariantBoolean, - Mantle.LiteralVariantFloat, - Mantle.LiteralVariantInteger, - Mantle.LiteralVariantString]), - Coders.languageConstraintsFloatTypes = (Sets.fromList [ - Core.FloatTypeFloat32, - Core.FloatTypeFloat64]), - Coders.languageConstraintsFunctionVariants = Sets.empty, - Coders.languageConstraintsIntegerTypes = (Sets.fromList [ - Core.IntegerTypeInt32, - Core.IntegerTypeInt64, - Core.IntegerTypeUint32, - Core.IntegerTypeUint64]), - Coders.languageConstraintsTermVariants = (Sets.fromList [ - Mantle.TermVariantList, - Mantle.TermVariantLiteral, - Mantle.TermVariantMap, - Mantle.TermVariantOptional, - Mantle.TermVariantRecord, - Mantle.TermVariantUnion]), - Coders.languageConstraintsTypeVariants = (Sets.fromList [ - Mantle.TypeVariantAnnotated, - Mantle.TypeVariantList, - Mantle.TypeVariantLiteral, - Mantle.TypeVariantMap, - Mantle.TypeVariantOptional, - Mantle.TypeVariantRecord, - Mantle.TypeVariantUnion, - Mantle.TypeVariantVariable]), - Coders.languageConstraintsTypes = (\x -> case x of - Core.TypeMap v284 -> ((\x -> case x of - Core.TypeOptional _ -> False - _ -> True) (Strip.stripType (Core.mapTypeValues v284))) - _ -> True)}} - --- | A set of reserved words in Protobuf -protobufReservedWords :: (Set String) -protobufReservedWords = (Sets.fromList (Lists.concat [ - fieldNames])) - where - fieldNames = [ - "case", - "class", - "data", - "default", - "deriving", - "do", - "else", - "foreign", - "if", - "import", - "in", - "infix", - "infixl", - "infixr", - "instance", - "let", - "mdo", - "module", - "newtype", - "of", - "pattern", - "proc", - "rec", - "then", - "type", - "where"] diff --git a/src/gen-main/haskell/Hydra/Langs/Protobuf/Proto3.hs b/src/gen-main/haskell/Hydra/Langs/Protobuf/Proto3.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Protobuf/Proto3.hs +++ /dev/null @@ -1,275 +0,0 @@ --- | A model for Protocol Buffers v3 enum and message types, designed as a target for transformations.This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto, as well as the proto3 reference documentation - -module Hydra.Langs.Protobuf.Proto3 where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data Definition = - DefinitionEnum EnumDefinition | - DefinitionMessage MessageDefinition - deriving (Eq, Ord, Read, Show) - -_Definition = (Core.Name "hydra/langs/protobuf/proto3.Definition") - -_Definition_enum = (Core.Name "enum") - -_Definition_message = (Core.Name "message") - --- | Enum type definition -data EnumDefinition = - EnumDefinition { - -- | Enum type name - enumDefinitionName :: TypeName, - -- | Enum value definitions - enumDefinitionValues :: [EnumValue], - -- | Protocol buffer options - enumDefinitionOptions :: [Option]} - deriving (Eq, Ord, Read, Show) - -_EnumDefinition = (Core.Name "hydra/langs/protobuf/proto3.EnumDefinition") - -_EnumDefinition_name = (Core.Name "name") - -_EnumDefinition_values = (Core.Name "values") - -_EnumDefinition_options = (Core.Name "options") - --- | Enum value definition -data EnumValue = - EnumValue { - -- | Enum value name - enumValueName :: EnumValueName, - -- | Enum value number - enumValueNumber :: Int, - -- | Protocol buffer options - enumValueOptions :: [Option]} - deriving (Eq, Ord, Read, Show) - -_EnumValue = (Core.Name "hydra/langs/protobuf/proto3.EnumValue") - -_EnumValue_name = (Core.Name "name") - -_EnumValue_number = (Core.Name "number") - -_EnumValue_options = (Core.Name "options") - -newtype EnumValueName = - EnumValueName { - unEnumValueName :: String} - deriving (Eq, Ord, Read, Show) - -_EnumValueName = (Core.Name "hydra/langs/protobuf/proto3.EnumValueName") - --- | A single field of a message type -data Field = - Field { - -- | The field name - fieldName :: FieldName, - -- | The field JSON name - fieldJsonName :: (Maybe String), - -- | The datatype of the field - fieldType :: FieldType, - -- | The field number - fieldNumber :: Int, - -- | The protocol buffer options - fieldOptions :: [Option]} - deriving (Eq, Ord, Read, Show) - -_Field = (Core.Name "hydra/langs/protobuf/proto3.Field") - -_Field_name = (Core.Name "name") - -_Field_jsonName = (Core.Name "jsonName") - -_Field_type = (Core.Name "type") - -_Field_number = (Core.Name "number") - -_Field_options = (Core.Name "options") - --- | The name of a field -newtype FieldName = - FieldName { - unFieldName :: String} - deriving (Eq, Ord, Read, Show) - -_FieldName = (Core.Name "hydra/langs/protobuf/proto3.FieldName") - -data FieldType = - FieldTypeMap SimpleType | - FieldTypeOneof [Field] | - FieldTypeRepeated SimpleType | - FieldTypeSimple SimpleType - deriving (Eq, Ord, Read, Show) - -_FieldType = (Core.Name "hydra/langs/protobuf/proto3.FieldType") - -_FieldType_map = (Core.Name "map") - -_FieldType_oneof = (Core.Name "oneof") - -_FieldType_repeated = (Core.Name "repeated") - -_FieldType_simple = (Core.Name "simple") - -newtype FileReference = - FileReference { - unFileReference :: String} - deriving (Eq, Ord, Read, Show) - -_FileReference = (Core.Name "hydra/langs/protobuf/proto3.FileReference") - --- | A protocol buffer message type -data MessageDefinition = - MessageDefinition { - -- | The fully qualified message name - messageDefinitionName :: TypeName, - -- | The list of fields - messageDefinitionFields :: [Field], - -- | The protocol buffer options - messageDefinitionOptions :: [Option]} - deriving (Eq, Ord, Read, Show) - -_MessageDefinition = (Core.Name "hydra/langs/protobuf/proto3.MessageDefinition") - -_MessageDefinition_name = (Core.Name "name") - -_MessageDefinition_fields = (Core.Name "fields") - -_MessageDefinition_options = (Core.Name "options") - --- | A protocol buffer option, which can be attached to a message, field, enumeration, etc -data Option = - Option { - -- | The option's name. For protobuf built-in options (options defined in descriptor.proto), this is the short name. For example, `"map_entry"`. For custom options, it should be the fully-qualified name. For example, `"google.api.http"`. - optionName :: String, - -- | The option's value - optionValue :: Value} - deriving (Eq, Ord, Read, Show) - -_Option = (Core.Name "hydra/langs/protobuf/proto3.Option") - -_Option_name = (Core.Name "name") - -_Option_value = (Core.Name "value") - -newtype PackageName = - PackageName { - unPackageName :: String} - deriving (Eq, Ord, Read, Show) - -_PackageName = (Core.Name "hydra/langs/protobuf/proto3.PackageName") - --- | A .proto file, usually containing one or more enum or message type definitions -data ProtoFile = - ProtoFile { - protoFilePackage :: PackageName, - protoFileImports :: [FileReference], - protoFileTypes :: [Definition], - protoFileOptions :: [Option]} - deriving (Eq, Ord, Read, Show) - -_ProtoFile = (Core.Name "hydra/langs/protobuf/proto3.ProtoFile") - -_ProtoFile_package = (Core.Name "package") - -_ProtoFile_imports = (Core.Name "imports") - -_ProtoFile_types = (Core.Name "types") - -_ProtoFile_options = (Core.Name "options") - --- | One of several Proto3 scalar types -data ScalarType = - ScalarTypeBool | - ScalarTypeBytes | - ScalarTypeDouble | - ScalarTypeFixed32 | - ScalarTypeFixed64 | - ScalarTypeFloat | - ScalarTypeInt32 | - ScalarTypeInt64 | - ScalarTypeSfixed32 | - ScalarTypeSfixed64 | - ScalarTypeSint32 | - ScalarTypeSint64 | - ScalarTypeString | - ScalarTypeUint32 | - ScalarTypeUint64 - deriving (Eq, Ord, Read, Show) - -_ScalarType = (Core.Name "hydra/langs/protobuf/proto3.ScalarType") - -_ScalarType_bool = (Core.Name "bool") - -_ScalarType_bytes = (Core.Name "bytes") - -_ScalarType_double = (Core.Name "double") - -_ScalarType_fixed32 = (Core.Name "fixed32") - -_ScalarType_fixed64 = (Core.Name "fixed64") - -_ScalarType_float = (Core.Name "float") - -_ScalarType_int32 = (Core.Name "int32") - -_ScalarType_int64 = (Core.Name "int64") - -_ScalarType_sfixed32 = (Core.Name "sfixed32") - -_ScalarType_sfixed64 = (Core.Name "sfixed64") - -_ScalarType_sint32 = (Core.Name "sint32") - -_ScalarType_sint64 = (Core.Name "sint64") - -_ScalarType_string = (Core.Name "string") - -_ScalarType_uint32 = (Core.Name "uint32") - -_ScalarType_uint64 = (Core.Name "uint64") - --- | A scalar type or a reference to an enum type or message type -data SimpleType = - SimpleTypeReference TypeName | - SimpleTypeScalar ScalarType - deriving (Eq, Ord, Read, Show) - -_SimpleType = (Core.Name "hydra/langs/protobuf/proto3.SimpleType") - -_SimpleType_reference = (Core.Name "reference") - -_SimpleType_scalar = (Core.Name "scalar") - --- | The local name of an enum type or message type -newtype TypeName = - TypeName { - unTypeName :: String} - deriving (Eq, Ord, Read, Show) - -_TypeName = (Core.Name "hydra/langs/protobuf/proto3.TypeName") - --- | A reference to an enum type or message type -newtype TypeReference = - TypeReference { - unTypeReference :: String} - deriving (Eq, Ord, Read, Show) - -_TypeReference = (Core.Name "hydra/langs/protobuf/proto3.TypeReference") - --- | A scalar value -data Value = - ValueBoolean Bool | - ValueString String - deriving (Eq, Ord, Read, Show) - -_Value = (Core.Name "hydra/langs/protobuf/proto3.Value") - -_Value_boolean = (Core.Name "boolean") - -_Value_string = (Core.Name "string") diff --git a/src/gen-main/haskell/Hydra/Langs/Protobuf/SourceContext.hs b/src/gen-main/haskell/Hydra/Langs/Protobuf/SourceContext.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Protobuf/SourceContext.hs +++ /dev/null @@ -1,20 +0,0 @@ --- | Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/source_context.proto - -module Hydra.Langs.Protobuf.SourceContext where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | `SourceContext` represents information about the source of a protobuf element, like the file in which it is defined. -data SourceContext = - SourceContext { - -- | The path-qualified name of the .proto file that contained the associated protobuf element. For example: `"google/protobuf/source_context.proto"`. - sourceContextFileName :: String} - deriving (Eq, Ord, Read, Show) - -_SourceContext = (Core.Name "hydra/langs/protobuf/sourceContext.SourceContext") - -_SourceContext_fileName = (Core.Name "fileName") diff --git a/src/gen-main/haskell/Hydra/Langs/Rdf/Syntax.hs b/src/gen-main/haskell/Hydra/Langs/Rdf/Syntax.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Rdf/Syntax.hs +++ /dev/null @@ -1,183 +0,0 @@ --- | An RDF 1.1 syntax model - -module Hydra.Langs.Rdf.Syntax where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype BlankNode = - BlankNode { - unBlankNode :: String} - deriving (Eq, Ord, Read, Show) - -_BlankNode = (Core.Name "hydra/langs/rdf/syntax.BlankNode") - --- | Stand-in for rdfs:Class -data RdfsClass = - RdfsClass {} - deriving (Eq, Ord, Read, Show) - -_RdfsClass = (Core.Name "hydra/langs/rdf/syntax.RdfsClass") - -newtype Dataset = - Dataset { - unDataset :: (Set Quad)} - deriving (Eq, Ord, Read, Show) - -_Dataset = (Core.Name "hydra/langs/rdf/syntax.Dataset") - --- | A graph of RDF statements together with a distinguished subject and/or object node -data Description = - Description { - descriptionSubject :: Node, - descriptionGraph :: Graph} - deriving (Eq, Ord, Read, Show) - -_Description = (Core.Name "hydra/langs/rdf/syntax.Description") - -_Description_subject = (Core.Name "subject") - -_Description_graph = (Core.Name "graph") - -newtype Graph = - Graph { - unGraph :: (Set Triple)} - deriving (Eq, Ord, Read, Show) - -_Graph = (Core.Name "hydra/langs/rdf/syntax.Graph") - --- | An Internationalized Resource Identifier -newtype Iri = - Iri { - unIri :: String} - deriving (Eq, Ord, Read, Show) - -_Iri = (Core.Name "hydra/langs/rdf/syntax.Iri") - --- | An IRI or a literal; this type is a convenience for downstream models like SHACL which may exclude blank nodes -data IriOrLiteral = - IriOrLiteralIri Iri | - IriOrLiteralLiteral Literal - deriving (Eq, Ord, Read, Show) - -_IriOrLiteral = (Core.Name "hydra/langs/rdf/syntax.IriOrLiteral") - -_IriOrLiteral_iri = (Core.Name "iri") - -_IriOrLiteral_literal = (Core.Name "literal") - --- | A convenience type which provides at most one string value per language, and optionally a value without a language -newtype LangStrings = - LangStrings { - unLangStrings :: (Map (Maybe LanguageTag) String)} - deriving (Eq, Ord, Read, Show) - -_LangStrings = (Core.Name "hydra/langs/rdf/syntax.LangStrings") - --- | A BCP47 language tag -newtype LanguageTag = - LanguageTag { - unLanguageTag :: String} - deriving (Eq, Ord, Read, Show) - -_LanguageTag = (Core.Name "hydra/langs/rdf/syntax.LanguageTag") - --- | A value such as a string, number, or date -data Literal = - Literal { - -- | a Unicode string, which should be in Normal Form C - literalLexicalForm :: String, - -- | an IRI identifying a datatype that determines how the lexical form maps to a literal value - literalDatatypeIri :: Iri, - -- | An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString - literalLanguageTag :: (Maybe LanguageTag)} - deriving (Eq, Ord, Read, Show) - -_Literal = (Core.Name "hydra/langs/rdf/syntax.Literal") - -_Literal_lexicalForm = (Core.Name "lexicalForm") - -_Literal_datatypeIri = (Core.Name "datatypeIri") - -_Literal_languageTag = (Core.Name "languageTag") - -data Node = - NodeIri Iri | - NodeBnode BlankNode | - NodeLiteral Literal - deriving (Eq, Ord, Read, Show) - -_Node = (Core.Name "hydra/langs/rdf/syntax.Node") - -_Node_iri = (Core.Name "iri") - -_Node_bnode = (Core.Name "bnode") - -_Node_literal = (Core.Name "literal") - --- | A type representing an RDF property, and encapsulating its domain, range, and subclass relationships -data Property = - Property { - -- | State that any resource that has a given property is an instance of one or more classes - propertyDomain :: (Set RdfsClass), - -- | States that the values of a property are instances of one or more classes - propertyRange :: (Set RdfsClass), - propertySubPropertyOf :: (Set Property)} - deriving (Eq, Ord, Read, Show) - -_Property = (Core.Name "hydra/langs/rdf/syntax.Property") - -_Property_domain = (Core.Name "domain") - -_Property_range = (Core.Name "range") - -_Property_subPropertyOf = (Core.Name "subPropertyOf") - --- | An RDF triple with an optional named graph component -data Quad = - Quad { - quadSubject :: Resource, - quadPredicate :: Iri, - quadObject :: Node, - quadGraph :: (Maybe Iri)} - deriving (Eq, Ord, Read, Show) - -_Quad = (Core.Name "hydra/langs/rdf/syntax.Quad") - -_Quad_subject = (Core.Name "subject") - -_Quad_predicate = (Core.Name "predicate") - -_Quad_object = (Core.Name "object") - -_Quad_graph = (Core.Name "graph") - -data Resource = - ResourceIri Iri | - ResourceBnode BlankNode - deriving (Eq, Ord, Read, Show) - -_Resource = (Core.Name "hydra/langs/rdf/syntax.Resource") - -_Resource_iri = (Core.Name "iri") - -_Resource_bnode = (Core.Name "bnode") - --- | An RDF triple defined by a subject, predicate, and object -data Triple = - Triple { - tripleSubject :: Resource, - triplePredicate :: Iri, - tripleObject :: Node} - deriving (Eq, Ord, Read, Show) - -_Triple = (Core.Name "hydra/langs/rdf/syntax.Triple") - -_Triple_subject = (Core.Name "subject") - -_Triple_predicate = (Core.Name "predicate") - -_Triple_object = (Core.Name "object") diff --git a/src/gen-main/haskell/Hydra/Langs/RelationalModel.hs b/src/gen-main/haskell/Hydra/Langs/RelationalModel.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/RelationalModel.hs +++ /dev/null @@ -1,113 +0,0 @@ --- | An interpretation of Codd's Relational Model, as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). Types ('domains') and values are parameterized so as to allow for application-specific implementations. No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized. - -module Hydra.Langs.RelationalModel where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd -newtype ColumnName = - ColumnName { - unColumnName :: String} - deriving (Eq, Ord, Read, Show) - -_ColumnName = (Core.Name "hydra/langs/relationalModel.ColumnName") - --- | An abstract specification of the domain represented by a column in a relation; a role -data ColumnSchema t = - ColumnSchema { - -- | A unique name for the column - columnSchemaName :: ColumnName, - -- | The domain (type) of the column - columnSchemaDomain :: t, - -- | Whether this column represents the primary key of its relation - columnSchemaIsPrimaryKey :: Bool} - deriving (Eq, Ord, Read, Show) - -_ColumnSchema = (Core.Name "hydra/langs/relationalModel.ColumnSchema") - -_ColumnSchema_name = (Core.Name "name") - -_ColumnSchema_domain = (Core.Name "domain") - -_ColumnSchema_isPrimaryKey = (Core.Name "isPrimaryKey") - --- | A mapping from certain columns of a source relation to primary key columns of a target relation -data ForeignKey = - ForeignKey { - -- | The name of the target relation - foreignKeyForeignRelation :: RelationName, - foreignKeyKeys :: (Map ColumnName ColumnName)} - deriving (Eq, Ord, Read, Show) - -_ForeignKey = (Core.Name "hydra/langs/relationalModel.ForeignKey") - -_ForeignKey_foreignRelation = (Core.Name "foreignRelation") - -_ForeignKey_keys = (Core.Name "keys") - --- | A primary key of a relation, specified either as a single column, or as a list of columns -newtype PrimaryKey = - PrimaryKey { - unPrimaryKey :: [ColumnName]} - deriving (Eq, Ord, Read, Show) - -_PrimaryKey = (Core.Name "hydra/langs/relationalModel.PrimaryKey") - --- | A set of distinct n-tuples; a table -newtype Relation v = - Relation { - unRelation :: (Set [v])} - deriving (Eq, Ord, Read, Show) - -_Relation = (Core.Name "hydra/langs/relationalModel.Relation") - --- | A unique relation (table) name -newtype RelationName = - RelationName { - unRelationName :: String} - deriving (Eq, Ord, Read, Show) - -_RelationName = (Core.Name "hydra/langs/relationalModel.RelationName") - --- | An abstract relation; the name and columns of a relation without its actual data -data RelationSchema t = - RelationSchema { - -- | A unique name for the relation - relationSchemaName :: RelationName, - -- | A list of column specifications - relationSchemaColumns :: [ColumnSchema t], - -- | Any number of primary keys for the relation, each of which must be valid for this relation - relationSchemaPrimaryKeys :: [PrimaryKey], - -- | Any number of foreign keys, each of which must be valid for both this relation and the target relation - relationSchemaForeignKeys :: [ForeignKey]} - deriving (Eq, Ord, Read, Show) - -_RelationSchema = (Core.Name "hydra/langs/relationalModel.RelationSchema") - -_RelationSchema_name = (Core.Name "name") - -_RelationSchema_columns = (Core.Name "columns") - -_RelationSchema_primaryKeys = (Core.Name "primaryKeys") - -_RelationSchema_foreignKeys = (Core.Name "foreignKeys") - --- | A domain-unordered (string-indexed, rather than position-indexed) relation -newtype Relationship v = - Relationship { - unRelationship :: (Set (Map ColumnName v))} - deriving (Eq, Ord, Read, Show) - -_Relationship = (Core.Name "hydra/langs/relationalModel.Relationship") - --- | An n-tuple which is an element of a given relation -newtype Row v = - Row { - unRow :: [v]} - deriving (Eq, Ord, Read, Show) - -_Row = (Core.Name "hydra/langs/relationalModel.Row") diff --git a/src/gen-main/haskell/Hydra/Langs/Scala/Meta.hs b/src/gen-main/haskell/Hydra/Langs/Scala/Meta.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Scala/Meta.hs +++ /dev/null @@ -1,2265 +0,0 @@ --- | A Scala syntax model based on Scalameta (https://scalameta.org) - -module Hydra.Langs.Scala.Meta where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype PredefString = - PredefString { - unPredefString :: String} - deriving (Eq, Ord, Read, Show) - -_PredefString = (Core.Name "hydra/langs/scala/meta.PredefString") - -data ScalaSymbol = - ScalaSymbol { - scalaSymbolName :: String} - deriving (Eq, Ord, Read, Show) - -_ScalaSymbol = (Core.Name "hydra/langs/scala/meta.ScalaSymbol") - -_ScalaSymbol_name = (Core.Name "name") - -data Tree = - TreeRef Ref | - TreeStat Stat | - TreeType Type | - TreeBounds Type_Bounds | - TreePat Pat | - TreeMember Member | - TreeCtor Ctor | - TreeTemplate Template | - TreeMod Mod | - TreeEnumerator Enumerator | - TreeImporter Importer | - TreeImportee Importee | - TreeCaseTree CaseTree | - TreeSource Source | - TreeQuasi Quasi - deriving (Eq, Ord, Read, Show) - -_Tree = (Core.Name "hydra/langs/scala/meta.Tree") - -_Tree_ref = (Core.Name "ref") - -_Tree_stat = (Core.Name "stat") - -_Tree_type = (Core.Name "type") - -_Tree_bounds = (Core.Name "bounds") - -_Tree_pat = (Core.Name "pat") - -_Tree_member = (Core.Name "member") - -_Tree_ctor = (Core.Name "ctor") - -_Tree_template = (Core.Name "template") - -_Tree_mod = (Core.Name "mod") - -_Tree_enumerator = (Core.Name "enumerator") - -_Tree_importer = (Core.Name "importer") - -_Tree_importee = (Core.Name "importee") - -_Tree_caseTree = (Core.Name "caseTree") - -_Tree_source = (Core.Name "source") - -_Tree_quasi = (Core.Name "quasi") - -data Ref = - RefName Name | - RefInit Init - deriving (Eq, Ord, Read, Show) - -_Ref = (Core.Name "hydra/langs/scala/meta.Ref") - -_Ref_name = (Core.Name "name") - -_Ref_init = (Core.Name "init") - -data Stat = - StatTerm Data | - StatDecl Decl | - StatDefn Defn | - StatImportExport ImportExportStat - deriving (Eq, Ord, Read, Show) - -_Stat = (Core.Name "hydra/langs/scala/meta.Stat") - -_Stat_term = (Core.Name "term") - -_Stat_decl = (Core.Name "decl") - -_Stat_defn = (Core.Name "defn") - -_Stat_importExport = (Core.Name "importExport") - -data Name = - NameValue String | - NameAnonymous | - NameIndeterminate PredefString - deriving (Eq, Ord, Read, Show) - -_Name = (Core.Name "hydra/langs/scala/meta.Name") - -_Name_value = (Core.Name "value") - -_Name_anonymous = (Core.Name "anonymous") - -_Name_indeterminate = (Core.Name "indeterminate") - -data Lit = - LitNull | - LitInt Int | - LitDouble Double | - LitFloat Float | - LitByte Int8 | - LitShort Int16 | - LitChar Int | - LitLong Int64 | - LitBoolean Bool | - LitUnit | - LitString String | - LitSymbol ScalaSymbol - deriving (Eq, Ord, Read, Show) - -_Lit = (Core.Name "hydra/langs/scala/meta.Lit") - -_Lit_null = (Core.Name "null") - -_Lit_int = (Core.Name "int") - -_Lit_double = (Core.Name "double") - -_Lit_float = (Core.Name "float") - -_Lit_byte = (Core.Name "byte") - -_Lit_short = (Core.Name "short") - -_Lit_char = (Core.Name "char") - -_Lit_long = (Core.Name "long") - -_Lit_boolean = (Core.Name "boolean") - -_Lit_unit = (Core.Name "unit") - -_Lit_string = (Core.Name "string") - -_Lit_symbol = (Core.Name "symbol") - -data Data = - DataLit Lit | - DataRef Data_Ref | - DataInterpolate Data_Interpolate | - DataXml Data_Xml | - DataApply Data_Apply | - DataApplyUsing Data_ApplyUsing | - DataApplyType Data_ApplyType | - DataAssign Data_Assign | - DataReturn Data_Return | - DataThrow Data_Throw | - DataAscribe Data_Ascribe | - DataAnnotate Data_Annotate | - DataTuple Data_Tuple | - DataBlock Data_Block | - DataEndMarker Data_EndMarker | - DataIf Data_If | - DataQuotedMacroExpr Data_QuotedMacroExpr | - DataQuotedMacroType Data_QuotedMacroType | - DataSplicedMacroExpr Data_SplicedMacroExpr | - DataMatch Data_Match | - DataTry Data_Try | - DataTryWithHandler Data_TryWithHandler | - DataFunctionData Data_FunctionData | - DataPolyFunction Data_PolyFunction | - DataPartialFunction Data_PartialFunction | - DataWhile Data_While | - DataDo Data_Do | - DataFor Data_For | - DataForYield Data_ForYield | - DataNew Data_New | - DataNewAnonymous Data_NewAnonymous | - DataPlaceholder Data_Placeholder | - DataEta Data_Eta | - DataRepeated Data_Repeated | - DataParam Data_Param - deriving (Eq, Ord, Read, Show) - -_Data = (Core.Name "hydra/langs/scala/meta.Data") - -_Data_lit = (Core.Name "lit") - -_Data_ref = (Core.Name "ref") - -_Data_interpolate = (Core.Name "interpolate") - -_Data_xml = (Core.Name "xml") - -_Data_apply = (Core.Name "apply") - -_Data_applyUsing = (Core.Name "applyUsing") - -_Data_applyType = (Core.Name "applyType") - -_Data_assign = (Core.Name "assign") - -_Data_return = (Core.Name "return") - -_Data_throw = (Core.Name "throw") - -_Data_ascribe = (Core.Name "ascribe") - -_Data_annotate = (Core.Name "annotate") - -_Data_tuple = (Core.Name "tuple") - -_Data_block = (Core.Name "block") - -_Data_endMarker = (Core.Name "endMarker") - -_Data_if = (Core.Name "if") - -_Data_quotedMacroExpr = (Core.Name "quotedMacroExpr") - -_Data_quotedMacroType = (Core.Name "quotedMacroType") - -_Data_splicedMacroExpr = (Core.Name "splicedMacroExpr") - -_Data_match = (Core.Name "match") - -_Data_try = (Core.Name "try") - -_Data_tryWithHandler = (Core.Name "tryWithHandler") - -_Data_functionData = (Core.Name "functionData") - -_Data_polyFunction = (Core.Name "polyFunction") - -_Data_partialFunction = (Core.Name "partialFunction") - -_Data_while = (Core.Name "while") - -_Data_do = (Core.Name "do") - -_Data_for = (Core.Name "for") - -_Data_forYield = (Core.Name "forYield") - -_Data_new = (Core.Name "new") - -_Data_newAnonymous = (Core.Name "newAnonymous") - -_Data_placeholder = (Core.Name "placeholder") - -_Data_eta = (Core.Name "eta") - -_Data_repeated = (Core.Name "repeated") - -_Data_param = (Core.Name "param") - -data Data_Ref = - Data_RefThis Data_This | - Data_RefSuper Data_Super | - Data_RefName Data_Name | - Data_RefAnonymous Data_Anonymous | - Data_RefSelect Data_Select | - Data_RefApplyUnary Data_ApplyUnary - deriving (Eq, Ord, Read, Show) - -_Data_Ref = (Core.Name "hydra/langs/scala/meta.Data.Ref") - -_Data_Ref_this = (Core.Name "this") - -_Data_Ref_super = (Core.Name "super") - -_Data_Ref_name = (Core.Name "name") - -_Data_Ref_anonymous = (Core.Name "anonymous") - -_Data_Ref_select = (Core.Name "select") - -_Data_Ref_applyUnary = (Core.Name "applyUnary") - -data Data_This = - Data_This {} - deriving (Eq, Ord, Read, Show) - -_Data_This = (Core.Name "hydra/langs/scala/meta.Data.This") - -data Data_Super = - Data_Super { - data_SuperThisp :: Name, - data_SuperSuperp :: Name} - deriving (Eq, Ord, Read, Show) - -_Data_Super = (Core.Name "hydra/langs/scala/meta.Data.Super") - -_Data_Super_thisp = (Core.Name "thisp") - -_Data_Super_superp = (Core.Name "superp") - -data Data_Name = - Data_Name { - data_NameValue :: PredefString} - deriving (Eq, Ord, Read, Show) - -_Data_Name = (Core.Name "hydra/langs/scala/meta.Data.Name") - -_Data_Name_value = (Core.Name "value") - -data Data_Anonymous = - Data_Anonymous {} - deriving (Eq, Ord, Read, Show) - -_Data_Anonymous = (Core.Name "hydra/langs/scala/meta.Data.Anonymous") - -data Data_Select = - Data_Select { - data_SelectQual :: Data, - data_SelectName :: Data_Name} - deriving (Eq, Ord, Read, Show) - -_Data_Select = (Core.Name "hydra/langs/scala/meta.Data.Select") - -_Data_Select_qual = (Core.Name "qual") - -_Data_Select_name = (Core.Name "name") - -data Data_Interpolate = - Data_Interpolate { - data_InterpolatePrefix :: Data_Name, - data_InterpolateParts :: [Lit], - data_InterpolateArgs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_Interpolate = (Core.Name "hydra/langs/scala/meta.Data.Interpolate") - -_Data_Interpolate_prefix = (Core.Name "prefix") - -_Data_Interpolate_parts = (Core.Name "parts") - -_Data_Interpolate_args = (Core.Name "args") - -data Data_Xml = - Data_Xml { - data_XmlParts :: [Lit], - data_XmlArgs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_Xml = (Core.Name "hydra/langs/scala/meta.Data.Xml") - -_Data_Xml_parts = (Core.Name "parts") - -_Data_Xml_args = (Core.Name "args") - -data Data_Apply = - Data_Apply { - data_ApplyFun :: Data, - data_ApplyArgs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_Apply = (Core.Name "hydra/langs/scala/meta.Data.Apply") - -_Data_Apply_fun = (Core.Name "fun") - -_Data_Apply_args = (Core.Name "args") - -data Data_ApplyUsing = - Data_ApplyUsing { - data_ApplyUsingFun :: Data, - data_ApplyUsingTargs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_ApplyUsing = (Core.Name "hydra/langs/scala/meta.Data.ApplyUsing") - -_Data_ApplyUsing_fun = (Core.Name "fun") - -_Data_ApplyUsing_targs = (Core.Name "targs") - -data Data_ApplyType = - Data_ApplyType { - data_ApplyTypeLhs :: Data, - data_ApplyTypeOp :: Data_Name, - data_ApplyTypeTargs :: [Type], - data_ApplyTypeArgs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_ApplyType = (Core.Name "hydra/langs/scala/meta.Data.ApplyType") - -_Data_ApplyType_lhs = (Core.Name "lhs") - -_Data_ApplyType_op = (Core.Name "op") - -_Data_ApplyType_targs = (Core.Name "targs") - -_Data_ApplyType_args = (Core.Name "args") - -data Data_ApplyInfix = - Data_ApplyInfix { - data_ApplyInfixLhs :: Data, - data_ApplyInfixOp :: Data_Name, - data_ApplyInfixTargs :: [Type], - data_ApplyInfixArgs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_ApplyInfix = (Core.Name "hydra/langs/scala/meta.Data.ApplyInfix") - -_Data_ApplyInfix_lhs = (Core.Name "lhs") - -_Data_ApplyInfix_op = (Core.Name "op") - -_Data_ApplyInfix_targs = (Core.Name "targs") - -_Data_ApplyInfix_args = (Core.Name "args") - -data Data_ApplyUnary = - Data_ApplyUnary { - data_ApplyUnaryOp :: Data_Name, - data_ApplyUnaryArg :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_ApplyUnary = (Core.Name "hydra/langs/scala/meta.Data.ApplyUnary") - -_Data_ApplyUnary_op = (Core.Name "op") - -_Data_ApplyUnary_arg = (Core.Name "arg") - -data Data_Assign = - Data_Assign { - data_AssignLhs :: Data, - data_AssignRhs :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Assign = (Core.Name "hydra/langs/scala/meta.Data.Assign") - -_Data_Assign_lhs = (Core.Name "lhs") - -_Data_Assign_rhs = (Core.Name "rhs") - -data Data_Return = - Data_Return { - data_ReturnExpr :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Return = (Core.Name "hydra/langs/scala/meta.Data.Return") - -_Data_Return_expr = (Core.Name "expr") - -data Data_Throw = - Data_Throw { - data_ThrowExpr :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Throw = (Core.Name "hydra/langs/scala/meta.Data.Throw") - -_Data_Throw_expr = (Core.Name "expr") - -data Data_Ascribe = - Data_Ascribe { - data_AscribeExpr :: Data, - data_AscribeTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Data_Ascribe = (Core.Name "hydra/langs/scala/meta.Data.Ascribe") - -_Data_Ascribe_expr = (Core.Name "expr") - -_Data_Ascribe_tpe = (Core.Name "tpe") - -data Data_Annotate = - Data_Annotate { - data_AnnotateExpr :: Data, - data_AnnotateAnnots :: [Mod_Annot]} - deriving (Eq, Ord, Read, Show) - -_Data_Annotate = (Core.Name "hydra/langs/scala/meta.Data.Annotate") - -_Data_Annotate_expr = (Core.Name "expr") - -_Data_Annotate_annots = (Core.Name "annots") - -data Data_Tuple = - Data_Tuple { - data_TupleArgs :: [Data]} - deriving (Eq, Ord, Read, Show) - -_Data_Tuple = (Core.Name "hydra/langs/scala/meta.Data.Tuple") - -_Data_Tuple_args = (Core.Name "args") - -data Data_Block = - Data_Block { - data_BlockStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Data_Block = (Core.Name "hydra/langs/scala/meta.Data.Block") - -_Data_Block_stats = (Core.Name "stats") - -data Data_EndMarker = - Data_EndMarker { - data_EndMarkerName :: Data_Name} - deriving (Eq, Ord, Read, Show) - -_Data_EndMarker = (Core.Name "hydra/langs/scala/meta.Data.EndMarker") - -_Data_EndMarker_name = (Core.Name "name") - -data Data_If = - Data_If { - data_IfCond :: Data, - data_IfThenp :: Data, - data_IfElsep :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_If = (Core.Name "hydra/langs/scala/meta.Data.If") - -_Data_If_cond = (Core.Name "cond") - -_Data_If_thenp = (Core.Name "thenp") - -_Data_If_elsep = (Core.Name "elsep") - -data Data_QuotedMacroExpr = - Data_QuotedMacroExpr { - data_QuotedMacroExprBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_QuotedMacroExpr = (Core.Name "hydra/langs/scala/meta.Data.QuotedMacroExpr") - -_Data_QuotedMacroExpr_body = (Core.Name "body") - -data Data_QuotedMacroType = - Data_QuotedMacroType { - data_QuotedMacroTypeTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Data_QuotedMacroType = (Core.Name "hydra/langs/scala/meta.Data.QuotedMacroType") - -_Data_QuotedMacroType_tpe = (Core.Name "tpe") - -data Data_SplicedMacroExpr = - Data_SplicedMacroExpr { - data_SplicedMacroExprBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_SplicedMacroExpr = (Core.Name "hydra/langs/scala/meta.Data.SplicedMacroExpr") - -_Data_SplicedMacroExpr_body = (Core.Name "body") - -data Data_Match = - Data_Match { - data_MatchExpr :: Data, - data_MatchCases :: [Case]} - deriving (Eq, Ord, Read, Show) - -_Data_Match = (Core.Name "hydra/langs/scala/meta.Data.Match") - -_Data_Match_expr = (Core.Name "expr") - -_Data_Match_cases = (Core.Name "cases") - -data Data_Try = - Data_Try { - data_TryExpr :: Data, - data_TryCatchp :: [Case], - data_TryFinallyp :: (Maybe Data)} - deriving (Eq, Ord, Read, Show) - -_Data_Try = (Core.Name "hydra/langs/scala/meta.Data.Try") - -_Data_Try_expr = (Core.Name "expr") - -_Data_Try_catchp = (Core.Name "catchp") - -_Data_Try_finallyp = (Core.Name "finallyp") - -data Data_TryWithHandler = - Data_TryWithHandler { - data_TryWithHandlerExpr :: Data, - data_TryWithHandlerCatchp :: Data, - data_TryWithHandlerFinallyp :: (Maybe Data)} - deriving (Eq, Ord, Read, Show) - -_Data_TryWithHandler = (Core.Name "hydra/langs/scala/meta.Data.TryWithHandler") - -_Data_TryWithHandler_expr = (Core.Name "expr") - -_Data_TryWithHandler_catchp = (Core.Name "catchp") - -_Data_TryWithHandler_finallyp = (Core.Name "finallyp") - -data Data_FunctionData = - Data_FunctionDataContextFunction Data_ContextFunction | - Data_FunctionDataFunction Data_Function - deriving (Eq, Ord, Read, Show) - -_Data_FunctionData = (Core.Name "hydra/langs/scala/meta.Data.FunctionData") - -_Data_FunctionData_contextFunction = (Core.Name "contextFunction") - -_Data_FunctionData_function = (Core.Name "function") - -data Data_ContextFunction = - Data_ContextFunction { - data_ContextFunctionParams :: [Data_Param], - data_ContextFunctionBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_ContextFunction = (Core.Name "hydra/langs/scala/meta.Data.ContextFunction") - -_Data_ContextFunction_params = (Core.Name "params") - -_Data_ContextFunction_body = (Core.Name "body") - -data Data_Function = - Data_Function { - data_FunctionParams :: [Data_Param], - data_FunctionBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Function = (Core.Name "hydra/langs/scala/meta.Data.Function") - -_Data_Function_params = (Core.Name "params") - -_Data_Function_body = (Core.Name "body") - -data Data_PolyFunction = - Data_PolyFunction { - data_PolyFunctionTparams :: [Type_Param], - data_PolyFunctionBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_PolyFunction = (Core.Name "hydra/langs/scala/meta.Data.PolyFunction") - -_Data_PolyFunction_tparams = (Core.Name "tparams") - -_Data_PolyFunction_body = (Core.Name "body") - -data Data_PartialFunction = - Data_PartialFunction { - data_PartialFunctionCases :: [Case]} - deriving (Eq, Ord, Read, Show) - -_Data_PartialFunction = (Core.Name "hydra/langs/scala/meta.Data.PartialFunction") - -_Data_PartialFunction_cases = (Core.Name "cases") - -data Data_While = - Data_While { - data_WhileExpr :: Data, - data_WhileBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_While = (Core.Name "hydra/langs/scala/meta.Data.While") - -_Data_While_expr = (Core.Name "expr") - -_Data_While_body = (Core.Name "body") - -data Data_Do = - Data_Do { - data_DoBody :: Data, - data_DoExpr :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Do = (Core.Name "hydra/langs/scala/meta.Data.Do") - -_Data_Do_body = (Core.Name "body") - -_Data_Do_expr = (Core.Name "expr") - -data Data_For = - Data_For { - data_ForEnums :: [Enumerator]} - deriving (Eq, Ord, Read, Show) - -_Data_For = (Core.Name "hydra/langs/scala/meta.Data.For") - -_Data_For_enums = (Core.Name "enums") - -data Data_ForYield = - Data_ForYield { - data_ForYieldEnums :: [Enumerator]} - deriving (Eq, Ord, Read, Show) - -_Data_ForYield = (Core.Name "hydra/langs/scala/meta.Data.ForYield") - -_Data_ForYield_enums = (Core.Name "enums") - -data Data_New = - Data_New { - data_NewInit :: Init} - deriving (Eq, Ord, Read, Show) - -_Data_New = (Core.Name "hydra/langs/scala/meta.Data.New") - -_Data_New_init = (Core.Name "init") - -data Data_NewAnonymous = - Data_NewAnonymous { - data_NewAnonymousTempl :: Template} - deriving (Eq, Ord, Read, Show) - -_Data_NewAnonymous = (Core.Name "hydra/langs/scala/meta.Data.NewAnonymous") - -_Data_NewAnonymous_templ = (Core.Name "templ") - -data Data_Placeholder = - Data_Placeholder {} - deriving (Eq, Ord, Read, Show) - -_Data_Placeholder = (Core.Name "hydra/langs/scala/meta.Data.Placeholder") - -data Data_Eta = - Data_Eta { - data_EtaExpr :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Eta = (Core.Name "hydra/langs/scala/meta.Data.Eta") - -_Data_Eta_expr = (Core.Name "expr") - -data Data_Repeated = - Data_Repeated { - data_RepeatedExpr :: Data} - deriving (Eq, Ord, Read, Show) - -_Data_Repeated = (Core.Name "hydra/langs/scala/meta.Data.Repeated") - -_Data_Repeated_expr = (Core.Name "expr") - -data Data_Param = - Data_Param { - data_ParamMods :: [Mod], - data_ParamName :: Name, - data_ParamDecltpe :: (Maybe Type), - data_ParamDefault :: (Maybe Data)} - deriving (Eq, Ord, Read, Show) - -_Data_Param = (Core.Name "hydra/langs/scala/meta.Data.Param") - -_Data_Param_mods = (Core.Name "mods") - -_Data_Param_name = (Core.Name "name") - -_Data_Param_decltpe = (Core.Name "decltpe") - -_Data_Param_default = (Core.Name "default") - -data Type = - TypeRef Type_Ref | - TypeAnonymousName Type_AnonymousName | - TypeApply Type_Apply | - TypeApplyInfix Type_ApplyInfix | - TypeFunctionType Type_FunctionType | - TypePolyFunction Type_PolyFunction | - TypeImplicitFunction Type_ImplicitFunction | - TypeTuple Type_Tuple | - TypeWith Type_With | - TypeAnd Type_And | - TypeOr Type_Or | - TypeRefine Type_Refine | - TypeExistential Type_Existential | - TypeAnnotate Type_Annotate | - TypeLambda Type_Lambda | - TypeMacro Type_Macro | - TypeMethod Type_Method | - TypePlaceholder Type_Placeholder | - TypeByName Type_ByName | - TypeRepeated Type_Repeated | - TypeVar Type_Var | - TypeTypedParam Type_TypedParam | - TypeMatch Type_Match - deriving (Eq, Ord, Read, Show) - -_Type = (Core.Name "hydra/langs/scala/meta.Type") - -_Type_ref = (Core.Name "ref") - -_Type_anonymousName = (Core.Name "anonymousName") - -_Type_apply = (Core.Name "apply") - -_Type_applyInfix = (Core.Name "applyInfix") - -_Type_functionType = (Core.Name "functionType") - -_Type_polyFunction = (Core.Name "polyFunction") - -_Type_implicitFunction = (Core.Name "implicitFunction") - -_Type_tuple = (Core.Name "tuple") - -_Type_with = (Core.Name "with") - -_Type_and = (Core.Name "and") - -_Type_or = (Core.Name "or") - -_Type_refine = (Core.Name "refine") - -_Type_existential = (Core.Name "existential") - -_Type_annotate = (Core.Name "annotate") - -_Type_lambda = (Core.Name "lambda") - -_Type_macro = (Core.Name "macro") - -_Type_method = (Core.Name "method") - -_Type_placeholder = (Core.Name "placeholder") - -_Type_byName = (Core.Name "byName") - -_Type_repeated = (Core.Name "repeated") - -_Type_var = (Core.Name "var") - -_Type_typedParam = (Core.Name "typedParam") - -_Type_match = (Core.Name "match") - -data Type_Ref = - Type_RefName Type_Name | - Type_RefSelect Type_Select | - Type_RefProject Type_Project | - Type_RefSingleton Type_Singleton - deriving (Eq, Ord, Read, Show) - -_Type_Ref = (Core.Name "hydra/langs/scala/meta.Type.Ref") - -_Type_Ref_name = (Core.Name "name") - -_Type_Ref_select = (Core.Name "select") - -_Type_Ref_project = (Core.Name "project") - -_Type_Ref_singleton = (Core.Name "singleton") - -data Type_Name = - Type_Name { - type_NameValue :: String} - deriving (Eq, Ord, Read, Show) - -_Type_Name = (Core.Name "hydra/langs/scala/meta.Type.Name") - -_Type_Name_value = (Core.Name "value") - -data Type_AnonymousName = - Type_AnonymousName {} - deriving (Eq, Ord, Read, Show) - -_Type_AnonymousName = (Core.Name "hydra/langs/scala/meta.Type.AnonymousName") - -data Type_Select = - Type_Select { - type_SelectQual :: Data_Ref, - type_SelectName :: Type_Name} - deriving (Eq, Ord, Read, Show) - -_Type_Select = (Core.Name "hydra/langs/scala/meta.Type.Select") - -_Type_Select_qual = (Core.Name "qual") - -_Type_Select_name = (Core.Name "name") - -data Type_Project = - Type_Project { - type_ProjectQual :: Type, - type_ProjectName :: Type_Name} - deriving (Eq, Ord, Read, Show) - -_Type_Project = (Core.Name "hydra/langs/scala/meta.Type.Project") - -_Type_Project_qual = (Core.Name "qual") - -_Type_Project_name = (Core.Name "name") - -data Type_Singleton = - Type_Singleton { - type_SingletonRef :: Data_Ref} - deriving (Eq, Ord, Read, Show) - -_Type_Singleton = (Core.Name "hydra/langs/scala/meta.Type.Singleton") - -_Type_Singleton_ref = (Core.Name "ref") - -data Type_Apply = - Type_Apply { - type_ApplyTpe :: Type, - type_ApplyArgs :: [Type]} - deriving (Eq, Ord, Read, Show) - -_Type_Apply = (Core.Name "hydra/langs/scala/meta.Type.Apply") - -_Type_Apply_tpe = (Core.Name "tpe") - -_Type_Apply_args = (Core.Name "args") - -data Type_ApplyInfix = - Type_ApplyInfix { - type_ApplyInfixLhs :: Type, - type_ApplyInfixOp :: Type_Name, - type_ApplyInfixRhs :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_ApplyInfix = (Core.Name "hydra/langs/scala/meta.Type.ApplyInfix") - -_Type_ApplyInfix_lhs = (Core.Name "lhs") - -_Type_ApplyInfix_op = (Core.Name "op") - -_Type_ApplyInfix_rhs = (Core.Name "rhs") - -data Type_FunctionType = - Type_FunctionTypeFunction Type_Function | - Type_FunctionTypeContextFunction Type_ContextFunction - deriving (Eq, Ord, Read, Show) - -_Type_FunctionType = (Core.Name "hydra/langs/scala/meta.Type.FunctionType") - -_Type_FunctionType_function = (Core.Name "function") - -_Type_FunctionType_contextFunction = (Core.Name "contextFunction") - -data Type_Function = - Type_Function { - type_FunctionParams :: [Type], - type_FunctionRes :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Function = (Core.Name "hydra/langs/scala/meta.Type.Function") - -_Type_Function_params = (Core.Name "params") - -_Type_Function_res = (Core.Name "res") - -data Type_PolyFunction = - Type_PolyFunction { - type_PolyFunctionTparams :: [Type_Param], - type_PolyFunctionTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_PolyFunction = (Core.Name "hydra/langs/scala/meta.Type.PolyFunction") - -_Type_PolyFunction_tparams = (Core.Name "tparams") - -_Type_PolyFunction_tpe = (Core.Name "tpe") - -data Type_ContextFunction = - Type_ContextFunction { - type_ContextFunctionParams :: [Type], - type_ContextFunctionRes :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_ContextFunction = (Core.Name "hydra/langs/scala/meta.Type.ContextFunction") - -_Type_ContextFunction_params = (Core.Name "params") - -_Type_ContextFunction_res = (Core.Name "res") - -data Type_ImplicitFunction = - Type_ImplicitFunction { - type_ImplicitFunctionParams :: [Type], - type_ImplicitFunctionRes :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_ImplicitFunction = (Core.Name "hydra/langs/scala/meta.Type.ImplicitFunction") - -_Type_ImplicitFunction_params = (Core.Name "params") - -_Type_ImplicitFunction_res = (Core.Name "res") - -data Type_Tuple = - Type_Tuple { - type_TupleArgs :: [Type]} - deriving (Eq, Ord, Read, Show) - -_Type_Tuple = (Core.Name "hydra/langs/scala/meta.Type.Tuple") - -_Type_Tuple_args = (Core.Name "args") - -data Type_With = - Type_With { - type_WithLhs :: Type, - type_WithRhs :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_With = (Core.Name "hydra/langs/scala/meta.Type.With") - -_Type_With_lhs = (Core.Name "lhs") - -_Type_With_rhs = (Core.Name "rhs") - -data Type_And = - Type_And { - type_AndLhs :: Type, - type_AndRhs :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_And = (Core.Name "hydra/langs/scala/meta.Type.And") - -_Type_And_lhs = (Core.Name "lhs") - -_Type_And_rhs = (Core.Name "rhs") - -data Type_Or = - Type_Or { - type_OrLhs :: Type, - type_OrRhs :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Or = (Core.Name "hydra/langs/scala/meta.Type.Or") - -_Type_Or_lhs = (Core.Name "lhs") - -_Type_Or_rhs = (Core.Name "rhs") - -data Type_Refine = - Type_Refine { - type_RefineTpe :: (Maybe Type), - type_RefineStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Type_Refine = (Core.Name "hydra/langs/scala/meta.Type.Refine") - -_Type_Refine_tpe = (Core.Name "tpe") - -_Type_Refine_stats = (Core.Name "stats") - -data Type_Existential = - Type_Existential { - type_ExistentialTpe :: Type, - type_ExistentialStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Type_Existential = (Core.Name "hydra/langs/scala/meta.Type.Existential") - -_Type_Existential_tpe = (Core.Name "tpe") - -_Type_Existential_stats = (Core.Name "stats") - -data Type_Annotate = - Type_Annotate { - type_AnnotateTpe :: Type, - type_AnnotateAnnots :: [Mod_Annot]} - deriving (Eq, Ord, Read, Show) - -_Type_Annotate = (Core.Name "hydra/langs/scala/meta.Type.Annotate") - -_Type_Annotate_tpe = (Core.Name "tpe") - -_Type_Annotate_annots = (Core.Name "annots") - -data Type_Lambda = - Type_Lambda { - type_LambdaTparams :: [Type_Param], - type_LambdaTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Lambda = (Core.Name "hydra/langs/scala/meta.Type.Lambda") - -_Type_Lambda_tparams = (Core.Name "tparams") - -_Type_Lambda_tpe = (Core.Name "tpe") - -data Type_Macro = - Type_Macro { - type_MacroBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Type_Macro = (Core.Name "hydra/langs/scala/meta.Type.Macro") - -_Type_Macro_body = (Core.Name "body") - -data Type_Method = - Type_Method { - type_MethodParamss :: [[Data_Param]], - type_MethodTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Method = (Core.Name "hydra/langs/scala/meta.Type.Method") - -_Type_Method_paramss = (Core.Name "paramss") - -_Type_Method_tpe = (Core.Name "tpe") - -data Type_Placeholder = - Type_Placeholder { - type_PlaceholderBounds :: Type_Bounds} - deriving (Eq, Ord, Read, Show) - -_Type_Placeholder = (Core.Name "hydra/langs/scala/meta.Type.Placeholder") - -_Type_Placeholder_bounds = (Core.Name "bounds") - -data Type_Bounds = - Type_Bounds { - type_BoundsLo :: (Maybe Type), - type_BoundsHi :: (Maybe Type)} - deriving (Eq, Ord, Read, Show) - -_Type_Bounds = (Core.Name "hydra/langs/scala/meta.Type.Bounds") - -_Type_Bounds_lo = (Core.Name "lo") - -_Type_Bounds_hi = (Core.Name "hi") - -data Type_ByName = - Type_ByName { - type_ByNameTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_ByName = (Core.Name "hydra/langs/scala/meta.Type.ByName") - -_Type_ByName_tpe = (Core.Name "tpe") - -data Type_Repeated = - Type_Repeated { - type_RepeatedTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_Repeated = (Core.Name "hydra/langs/scala/meta.Type.Repeated") - -_Type_Repeated_tpe = (Core.Name "tpe") - -data Type_Var = - Type_Var { - type_VarName :: Type_Name} - deriving (Eq, Ord, Read, Show) - -_Type_Var = (Core.Name "hydra/langs/scala/meta.Type.Var") - -_Type_Var_name = (Core.Name "name") - -data Type_TypedParam = - Type_TypedParam { - type_TypedParamName :: Name, - type_TypedParamTyp :: Type} - deriving (Eq, Ord, Read, Show) - -_Type_TypedParam = (Core.Name "hydra/langs/scala/meta.Type.TypedParam") - -_Type_TypedParam_name = (Core.Name "name") - -_Type_TypedParam_typ = (Core.Name "typ") - -data Type_Param = - Type_Param { - type_ParamMods :: [Mod], - type_ParamName :: Name, - type_ParamTparams :: [Type_Param], - type_ParamTbounds :: [Type_Bounds], - type_ParamVbounds :: [Type], - type_ParamCbounds :: [Type]} - deriving (Eq, Ord, Read, Show) - -_Type_Param = (Core.Name "hydra/langs/scala/meta.Type.Param") - -_Type_Param_mods = (Core.Name "mods") - -_Type_Param_name = (Core.Name "name") - -_Type_Param_tparams = (Core.Name "tparams") - -_Type_Param_tbounds = (Core.Name "tbounds") - -_Type_Param_vbounds = (Core.Name "vbounds") - -_Type_Param_cbounds = (Core.Name "cbounds") - -data Type_Match = - Type_Match { - type_MatchTpe :: Type, - type_MatchCases :: [TypeCase]} - deriving (Eq, Ord, Read, Show) - -_Type_Match = (Core.Name "hydra/langs/scala/meta.Type.Match") - -_Type_Match_tpe = (Core.Name "tpe") - -_Type_Match_cases = (Core.Name "cases") - -data Pat = - PatVar Pat_Var | - PatWildcard | - PatSeqWildcard | - PatBind Pat_Bind | - PatAlternative Pat_Alternative | - PatTuple Pat_Tuple | - PatRepeated Pat_Repeated | - PatExtract Pat_Extract | - PatExtractInfix Pat_ExtractInfix | - PatInterpolate Pat_Interpolate | - PatXml Pat_Xml | - PatTyped Pat_Typed | - PatMacro Pat_Macro | - PatGiven Pat_Given - deriving (Eq, Ord, Read, Show) - -_Pat = (Core.Name "hydra/langs/scala/meta.Pat") - -_Pat_var = (Core.Name "var") - -_Pat_wildcard = (Core.Name "wildcard") - -_Pat_seqWildcard = (Core.Name "seqWildcard") - -_Pat_bind = (Core.Name "bind") - -_Pat_alternative = (Core.Name "alternative") - -_Pat_tuple = (Core.Name "tuple") - -_Pat_repeated = (Core.Name "repeated") - -_Pat_extract = (Core.Name "extract") - -_Pat_extractInfix = (Core.Name "extractInfix") - -_Pat_interpolate = (Core.Name "interpolate") - -_Pat_xml = (Core.Name "xml") - -_Pat_typed = (Core.Name "typed") - -_Pat_macro = (Core.Name "macro") - -_Pat_given = (Core.Name "given") - -data Pat_Var = - Pat_Var { - pat_VarName :: Data_Name} - deriving (Eq, Ord, Read, Show) - -_Pat_Var = (Core.Name "hydra/langs/scala/meta.Pat.Var") - -_Pat_Var_name = (Core.Name "name") - -data Pat_Bind = - Pat_Bind { - pat_BindLhs :: Pat, - pat_BindRhs :: Pat} - deriving (Eq, Ord, Read, Show) - -_Pat_Bind = (Core.Name "hydra/langs/scala/meta.Pat.Bind") - -_Pat_Bind_lhs = (Core.Name "lhs") - -_Pat_Bind_rhs = (Core.Name "rhs") - -data Pat_Alternative = - Pat_Alternative { - pat_AlternativeLhs :: Pat, - pat_AlternativeRhs :: Pat} - deriving (Eq, Ord, Read, Show) - -_Pat_Alternative = (Core.Name "hydra/langs/scala/meta.Pat.Alternative") - -_Pat_Alternative_lhs = (Core.Name "lhs") - -_Pat_Alternative_rhs = (Core.Name "rhs") - -data Pat_Tuple = - Pat_Tuple { - pat_TupleArgs :: [Pat]} - deriving (Eq, Ord, Read, Show) - -_Pat_Tuple = (Core.Name "hydra/langs/scala/meta.Pat.Tuple") - -_Pat_Tuple_args = (Core.Name "args") - -data Pat_Repeated = - Pat_Repeated { - pat_RepeatedName :: Data_Name} - deriving (Eq, Ord, Read, Show) - -_Pat_Repeated = (Core.Name "hydra/langs/scala/meta.Pat.Repeated") - -_Pat_Repeated_name = (Core.Name "name") - -data Pat_Extract = - Pat_Extract { - pat_ExtractFun :: Data, - pat_ExtractArgs :: [Pat]} - deriving (Eq, Ord, Read, Show) - -_Pat_Extract = (Core.Name "hydra/langs/scala/meta.Pat.Extract") - -_Pat_Extract_fun = (Core.Name "fun") - -_Pat_Extract_args = (Core.Name "args") - -data Pat_ExtractInfix = - Pat_ExtractInfix { - pat_ExtractInfixLhs :: Pat, - pat_ExtractInfixOp :: Data_Name, - pat_ExtractInfixRhs :: [Pat]} - deriving (Eq, Ord, Read, Show) - -_Pat_ExtractInfix = (Core.Name "hydra/langs/scala/meta.Pat.ExtractInfix") - -_Pat_ExtractInfix_lhs = (Core.Name "lhs") - -_Pat_ExtractInfix_op = (Core.Name "op") - -_Pat_ExtractInfix_rhs = (Core.Name "rhs") - -data Pat_Interpolate = - Pat_Interpolate { - pat_InterpolatePrefix :: Data_Name, - pat_InterpolateParts :: [Lit]} - deriving (Eq, Ord, Read, Show) - -_Pat_Interpolate = (Core.Name "hydra/langs/scala/meta.Pat.Interpolate") - -_Pat_Interpolate_prefix = (Core.Name "prefix") - -_Pat_Interpolate_parts = (Core.Name "parts") - -data Pat_Xml = - Pat_Xml { - pat_XmlParts :: [Lit], - pat_XmlArgs :: [Pat]} - deriving (Eq, Ord, Read, Show) - -_Pat_Xml = (Core.Name "hydra/langs/scala/meta.Pat.Xml") - -_Pat_Xml_parts = (Core.Name "parts") - -_Pat_Xml_args = (Core.Name "args") - -data Pat_Typed = - Pat_Typed { - pat_TypedLhs :: Pat, - pat_TypedRhs :: Type} - deriving (Eq, Ord, Read, Show) - -_Pat_Typed = (Core.Name "hydra/langs/scala/meta.Pat.Typed") - -_Pat_Typed_lhs = (Core.Name "lhs") - -_Pat_Typed_rhs = (Core.Name "rhs") - -data Pat_Macro = - Pat_Macro { - pat_MacroBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Pat_Macro = (Core.Name "hydra/langs/scala/meta.Pat.Macro") - -_Pat_Macro_body = (Core.Name "body") - -data Pat_Given = - Pat_Given { - pat_GivenTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Pat_Given = (Core.Name "hydra/langs/scala/meta.Pat.Given") - -_Pat_Given_tpe = (Core.Name "tpe") - -data Member = - MemberTerm Member_Data | - MemberType Member_Type | - MemberTermParam Data_Param | - MemberTypeParam Type_Param | - MemberSelf Self - deriving (Eq, Ord, Read, Show) - -_Member = (Core.Name "hydra/langs/scala/meta.Member") - -_Member_term = (Core.Name "term") - -_Member_type = (Core.Name "type") - -_Member_termParam = (Core.Name "termParam") - -_Member_typeParam = (Core.Name "typeParam") - -_Member_self = (Core.Name "self") - -data Member_Data = - Member_DataPkg Pkg | - Member_DataObject Pkg_Object - deriving (Eq, Ord, Read, Show) - -_Member_Data = (Core.Name "hydra/langs/scala/meta.Member.Data") - -_Member_Data_pkg = (Core.Name "pkg") - -_Member_Data_object = (Core.Name "object") - -data Member_Type = - Member_Type { - member_TypeName :: Type_Name} - deriving (Eq, Ord, Read, Show) - -_Member_Type = (Core.Name "hydra/langs/scala/meta.Member.Type") - -_Member_Type_name = (Core.Name "name") - -data Decl = - DeclVal Decl_Val | - DeclVar Decl_Var | - DeclDef Decl_Def | - DeclType Decl_Type | - DeclGiven Decl_Given - deriving (Eq, Ord, Read, Show) - -_Decl = (Core.Name "hydra/langs/scala/meta.Decl") - -_Decl_val = (Core.Name "val") - -_Decl_var = (Core.Name "var") - -_Decl_def = (Core.Name "def") - -_Decl_type = (Core.Name "type") - -_Decl_given = (Core.Name "given") - -data Decl_Val = - Decl_Val { - decl_ValMods :: [Mod], - decl_ValPats :: [Pat], - decl_ValDecltpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Decl_Val = (Core.Name "hydra/langs/scala/meta.Decl.Val") - -_Decl_Val_mods = (Core.Name "mods") - -_Decl_Val_pats = (Core.Name "pats") - -_Decl_Val_decltpe = (Core.Name "decltpe") - -data Decl_Var = - Decl_Var { - decl_VarMods :: [Mod], - decl_VarPats :: [Pat], - decl_VarDecltpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Decl_Var = (Core.Name "hydra/langs/scala/meta.Decl.Var") - -_Decl_Var_mods = (Core.Name "mods") - -_Decl_Var_pats = (Core.Name "pats") - -_Decl_Var_decltpe = (Core.Name "decltpe") - -data Decl_Def = - Decl_Def { - decl_DefMods :: [Mod], - decl_DefName :: Data_Name, - decl_DefTparams :: [Type_Param], - decl_DefParamss :: [[Data_Param]], - decl_DefDecltpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Decl_Def = (Core.Name "hydra/langs/scala/meta.Decl.Def") - -_Decl_Def_mods = (Core.Name "mods") - -_Decl_Def_name = (Core.Name "name") - -_Decl_Def_tparams = (Core.Name "tparams") - -_Decl_Def_paramss = (Core.Name "paramss") - -_Decl_Def_decltpe = (Core.Name "decltpe") - -data Decl_Type = - Decl_Type { - decl_TypeMods :: [Mod], - decl_TypeName :: Type_Name, - decl_TypeTparams :: [Type_Param], - decl_TypeBounds :: Type_Bounds} - deriving (Eq, Ord, Read, Show) - -_Decl_Type = (Core.Name "hydra/langs/scala/meta.Decl.Type") - -_Decl_Type_mods = (Core.Name "mods") - -_Decl_Type_name = (Core.Name "name") - -_Decl_Type_tparams = (Core.Name "tparams") - -_Decl_Type_bounds = (Core.Name "bounds") - -data Decl_Given = - Decl_Given { - decl_GivenMods :: [Mod], - decl_GivenName :: Data_Name, - decl_GivenTparams :: [Type_Param], - decl_GivenSparams :: [[Data_Param]], - decl_GivenDecltpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Decl_Given = (Core.Name "hydra/langs/scala/meta.Decl.Given") - -_Decl_Given_mods = (Core.Name "mods") - -_Decl_Given_name = (Core.Name "name") - -_Decl_Given_tparams = (Core.Name "tparams") - -_Decl_Given_sparams = (Core.Name "sparams") - -_Decl_Given_decltpe = (Core.Name "decltpe") - -data Defn = - DefnVal Defn_Val | - DefnVar Defn_Var | - DefnGiven Defn_Given | - DefnEnum Defn_Enum | - DefnEnumCase Defn_EnumCase | - DefnRepeatedEnumCase Defn_RepeatedEnumCase | - DefnGivenAlias Defn_GivenAlias | - DefnExtensionGroup Defn_ExtensionGroup | - DefnDef Defn_Def | - DefnMacro Defn_Macro | - DefnType Defn_Type | - DefnClass Defn_Class | - DefnTrait Defn_Trait | - DefnObject Defn_Object - deriving (Eq, Ord, Read, Show) - -_Defn = (Core.Name "hydra/langs/scala/meta.Defn") - -_Defn_val = (Core.Name "val") - -_Defn_var = (Core.Name "var") - -_Defn_given = (Core.Name "given") - -_Defn_enum = (Core.Name "enum") - -_Defn_enumCase = (Core.Name "enumCase") - -_Defn_repeatedEnumCase = (Core.Name "repeatedEnumCase") - -_Defn_givenAlias = (Core.Name "givenAlias") - -_Defn_extensionGroup = (Core.Name "extensionGroup") - -_Defn_def = (Core.Name "def") - -_Defn_macro = (Core.Name "macro") - -_Defn_type = (Core.Name "type") - -_Defn_class = (Core.Name "class") - -_Defn_trait = (Core.Name "trait") - -_Defn_object = (Core.Name "object") - -data Defn_Val = - Defn_Val { - defn_ValMods :: [Mod], - defn_ValPats :: [Pat], - defn_ValDecltpe :: (Maybe Type), - defn_ValRhs :: Data} - deriving (Eq, Ord, Read, Show) - -_Defn_Val = (Core.Name "hydra/langs/scala/meta.Defn.Val") - -_Defn_Val_mods = (Core.Name "mods") - -_Defn_Val_pats = (Core.Name "pats") - -_Defn_Val_decltpe = (Core.Name "decltpe") - -_Defn_Val_rhs = (Core.Name "rhs") - -data Defn_Var = - Defn_Var { - defn_VarMods :: [Mod], - defn_VarPats :: [Pat], - defn_VarDecltpe :: Type, - defn_VarRhs :: (Maybe Data)} - deriving (Eq, Ord, Read, Show) - -_Defn_Var = (Core.Name "hydra/langs/scala/meta.Defn.Var") - -_Defn_Var_mods = (Core.Name "mods") - -_Defn_Var_pats = (Core.Name "pats") - -_Defn_Var_decltpe = (Core.Name "decltpe") - -_Defn_Var_rhs = (Core.Name "rhs") - -data Defn_Given = - Defn_Given { - defn_GivenMods :: [Mod], - defn_GivenName :: Name, - defn_GivenTparams :: [[Type_Param]], - defn_GivenSparams :: [[Data_Param]], - defn_GivenTempl :: Template} - deriving (Eq, Ord, Read, Show) - -_Defn_Given = (Core.Name "hydra/langs/scala/meta.Defn.Given") - -_Defn_Given_mods = (Core.Name "mods") - -_Defn_Given_name = (Core.Name "name") - -_Defn_Given_tparams = (Core.Name "tparams") - -_Defn_Given_sparams = (Core.Name "sparams") - -_Defn_Given_templ = (Core.Name "templ") - -data Defn_Enum = - Defn_Enum { - defn_EnumMods :: [Mod], - defn_EnumName :: Type_Name, - defn_EnumTparams :: [Type_Param], - defn_EnumCtor :: Ctor_Primary, - defn_EnumTemplate :: Template} - deriving (Eq, Ord, Read, Show) - -_Defn_Enum = (Core.Name "hydra/langs/scala/meta.Defn.Enum") - -_Defn_Enum_mods = (Core.Name "mods") - -_Defn_Enum_name = (Core.Name "name") - -_Defn_Enum_tparams = (Core.Name "tparams") - -_Defn_Enum_ctor = (Core.Name "ctor") - -_Defn_Enum_template = (Core.Name "template") - -data Defn_EnumCase = - Defn_EnumCase { - defn_EnumCaseMods :: [Mod], - defn_EnumCaseName :: Data_Name, - defn_EnumCaseTparams :: [Type_Param], - defn_EnumCaseCtor :: Ctor_Primary, - defn_EnumCaseInits :: [Init]} - deriving (Eq, Ord, Read, Show) - -_Defn_EnumCase = (Core.Name "hydra/langs/scala/meta.Defn.EnumCase") - -_Defn_EnumCase_mods = (Core.Name "mods") - -_Defn_EnumCase_name = (Core.Name "name") - -_Defn_EnumCase_tparams = (Core.Name "tparams") - -_Defn_EnumCase_ctor = (Core.Name "ctor") - -_Defn_EnumCase_inits = (Core.Name "inits") - -data Defn_RepeatedEnumCase = - Defn_RepeatedEnumCase { - defn_RepeatedEnumCaseMods :: [Mod], - defn_RepeatedEnumCaseCases :: [Data_Name]} - deriving (Eq, Ord, Read, Show) - -_Defn_RepeatedEnumCase = (Core.Name "hydra/langs/scala/meta.Defn.RepeatedEnumCase") - -_Defn_RepeatedEnumCase_mods = (Core.Name "mods") - -_Defn_RepeatedEnumCase_cases = (Core.Name "cases") - -data Defn_GivenAlias = - Defn_GivenAlias { - defn_GivenAliasMods :: [Mod], - defn_GivenAliasName :: Name, - defn_GivenAliasTparams :: [[Type_Param]], - defn_GivenAliasSparams :: [[Data_Param]], - defn_GivenAliasDecltpe :: Type, - defn_GivenAliasBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Defn_GivenAlias = (Core.Name "hydra/langs/scala/meta.Defn.GivenAlias") - -_Defn_GivenAlias_mods = (Core.Name "mods") - -_Defn_GivenAlias_name = (Core.Name "name") - -_Defn_GivenAlias_tparams = (Core.Name "tparams") - -_Defn_GivenAlias_sparams = (Core.Name "sparams") - -_Defn_GivenAlias_decltpe = (Core.Name "decltpe") - -_Defn_GivenAlias_body = (Core.Name "body") - -data Defn_ExtensionGroup = - Defn_ExtensionGroup { - defn_ExtensionGroupTparams :: [Type_Param], - defn_ExtensionGroupParmss :: [[Data_Param]], - defn_ExtensionGroupBody :: Stat} - deriving (Eq, Ord, Read, Show) - -_Defn_ExtensionGroup = (Core.Name "hydra/langs/scala/meta.Defn.ExtensionGroup") - -_Defn_ExtensionGroup_tparams = (Core.Name "tparams") - -_Defn_ExtensionGroup_parmss = (Core.Name "parmss") - -_Defn_ExtensionGroup_body = (Core.Name "body") - -data Defn_Def = - Defn_Def { - defn_DefMods :: [Mod], - defn_DefName :: Data_Name, - defn_DefTparams :: [Type_Param], - defn_DefParamss :: [[Data_Param]], - defn_DefDecltpe :: (Maybe Type), - defn_DefBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Defn_Def = (Core.Name "hydra/langs/scala/meta.Defn.Def") - -_Defn_Def_mods = (Core.Name "mods") - -_Defn_Def_name = (Core.Name "name") - -_Defn_Def_tparams = (Core.Name "tparams") - -_Defn_Def_paramss = (Core.Name "paramss") - -_Defn_Def_decltpe = (Core.Name "decltpe") - -_Defn_Def_body = (Core.Name "body") - -data Defn_Macro = - Defn_Macro { - defn_MacroMods :: [Mod], - defn_MacroName :: Data_Name, - defn_MacroTparams :: [Type_Param], - defn_MacroParamss :: [[Data_Param]], - defn_MacroDecltpe :: (Maybe Type), - defn_MacroBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Defn_Macro = (Core.Name "hydra/langs/scala/meta.Defn.Macro") - -_Defn_Macro_mods = (Core.Name "mods") - -_Defn_Macro_name = (Core.Name "name") - -_Defn_Macro_tparams = (Core.Name "tparams") - -_Defn_Macro_paramss = (Core.Name "paramss") - -_Defn_Macro_decltpe = (Core.Name "decltpe") - -_Defn_Macro_body = (Core.Name "body") - -data Defn_Type = - Defn_Type { - defn_TypeMods :: [Mod], - defn_TypeName :: Type_Name, - defn_TypeTparams :: [Type_Param], - defn_TypeBody :: Type} - deriving (Eq, Ord, Read, Show) - -_Defn_Type = (Core.Name "hydra/langs/scala/meta.Defn.Type") - -_Defn_Type_mods = (Core.Name "mods") - -_Defn_Type_name = (Core.Name "name") - -_Defn_Type_tparams = (Core.Name "tparams") - -_Defn_Type_body = (Core.Name "body") - -data Defn_Class = - Defn_Class { - defn_ClassMods :: [Mod], - defn_ClassName :: Type_Name, - defn_ClassTparams :: [Type_Param], - defn_ClassCtor :: Ctor_Primary, - defn_ClassTemplate :: Template} - deriving (Eq, Ord, Read, Show) - -_Defn_Class = (Core.Name "hydra/langs/scala/meta.Defn.Class") - -_Defn_Class_mods = (Core.Name "mods") - -_Defn_Class_name = (Core.Name "name") - -_Defn_Class_tparams = (Core.Name "tparams") - -_Defn_Class_ctor = (Core.Name "ctor") - -_Defn_Class_template = (Core.Name "template") - -data Defn_Trait = - Defn_Trait { - defn_TraitMods :: [Mod], - defn_TraitName :: Type_Name, - defn_TraitTparams :: [Type_Param], - defn_TraitCtor :: Ctor_Primary, - defn_TraitTemplate :: Template} - deriving (Eq, Ord, Read, Show) - -_Defn_Trait = (Core.Name "hydra/langs/scala/meta.Defn.Trait") - -_Defn_Trait_mods = (Core.Name "mods") - -_Defn_Trait_name = (Core.Name "name") - -_Defn_Trait_tparams = (Core.Name "tparams") - -_Defn_Trait_ctor = (Core.Name "ctor") - -_Defn_Trait_template = (Core.Name "template") - -data Defn_Object = - Defn_Object { - defn_ObjectName :: Data_Name} - deriving (Eq, Ord, Read, Show) - -_Defn_Object = (Core.Name "hydra/langs/scala/meta.Defn.Object") - -_Defn_Object_name = (Core.Name "name") - -data Pkg = - Pkg { - pkgName :: Data_Name, - pkgRef :: Data_Ref, - pkgStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Pkg = (Core.Name "hydra/langs/scala/meta.Pkg") - -_Pkg_name = (Core.Name "name") - -_Pkg_ref = (Core.Name "ref") - -_Pkg_stats = (Core.Name "stats") - -data Pkg_Object = - Pkg_Object { - pkg_ObjectMods :: [Mod], - pkg_ObjectName :: Data_Name, - pkg_ObjectTemplate :: Template} - deriving (Eq, Ord, Read, Show) - -_Pkg_Object = (Core.Name "hydra/langs/scala/meta.Pkg.Object") - -_Pkg_Object_mods = (Core.Name "mods") - -_Pkg_Object_name = (Core.Name "name") - -_Pkg_Object_template = (Core.Name "template") - -data Ctor = - CtorPrimary Ctor_Primary | - CtorSecondary Ctor_Secondary - deriving (Eq, Ord, Read, Show) - -_Ctor = (Core.Name "hydra/langs/scala/meta.Ctor") - -_Ctor_primary = (Core.Name "primary") - -_Ctor_secondary = (Core.Name "secondary") - -data Ctor_Primary = - Ctor_Primary { - ctor_PrimaryMods :: [Mod], - ctor_PrimaryName :: Name, - ctor_PrimaryParamss :: [[Data_Param]]} - deriving (Eq, Ord, Read, Show) - -_Ctor_Primary = (Core.Name "hydra/langs/scala/meta.Ctor.Primary") - -_Ctor_Primary_mods = (Core.Name "mods") - -_Ctor_Primary_name = (Core.Name "name") - -_Ctor_Primary_paramss = (Core.Name "paramss") - -data Ctor_Secondary = - Ctor_Secondary { - ctor_SecondaryMods :: [Mod], - ctor_SecondaryName :: Name, - ctor_SecondaryParamss :: [[Data_Param]], - ctor_SecondaryInit :: Init, - ctor_SecondaryStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Ctor_Secondary = (Core.Name "hydra/langs/scala/meta.Ctor.Secondary") - -_Ctor_Secondary_mods = (Core.Name "mods") - -_Ctor_Secondary_name = (Core.Name "name") - -_Ctor_Secondary_paramss = (Core.Name "paramss") - -_Ctor_Secondary_init = (Core.Name "init") - -_Ctor_Secondary_stats = (Core.Name "stats") - -data Init = - Init { - initTpe :: Type, - initName :: Name, - initArgss :: [[Data]]} - deriving (Eq, Ord, Read, Show) - -_Init = (Core.Name "hydra/langs/scala/meta.Init") - -_Init_tpe = (Core.Name "tpe") - -_Init_name = (Core.Name "name") - -_Init_argss = (Core.Name "argss") - -data Self = - Self {} - deriving (Eq, Ord, Read, Show) - -_Self = (Core.Name "hydra/langs/scala/meta.Self") - -data Template = - Template { - templateEarly :: [Stat], - templateInits :: [Init], - templateSelf :: Self, - templateStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Template = (Core.Name "hydra/langs/scala/meta.Template") - -_Template_early = (Core.Name "early") - -_Template_inits = (Core.Name "inits") - -_Template_self = (Core.Name "self") - -_Template_stats = (Core.Name "stats") - -data Mod = - ModAnnot Mod_Annot | - ModPrivate Mod_Private | - ModProtected Mod_Protected | - ModImplicit | - ModFinal | - ModSealed | - ModOpen | - ModSuper | - ModOverride | - ModCase | - ModAbstract | - ModCovariant | - ModContravariant | - ModLazy | - ModValParam | - ModVarParam | - ModInfix | - ModInline | - ModUsing | - ModOpaque | - ModTransparent - deriving (Eq, Ord, Read, Show) - -_Mod = (Core.Name "hydra/langs/scala/meta.Mod") - -_Mod_annot = (Core.Name "annot") - -_Mod_private = (Core.Name "private") - -_Mod_protected = (Core.Name "protected") - -_Mod_implicit = (Core.Name "implicit") - -_Mod_final = (Core.Name "final") - -_Mod_sealed = (Core.Name "sealed") - -_Mod_open = (Core.Name "open") - -_Mod_super = (Core.Name "super") - -_Mod_override = (Core.Name "override") - -_Mod_case = (Core.Name "case") - -_Mod_abstract = (Core.Name "abstract") - -_Mod_covariant = (Core.Name "covariant") - -_Mod_contravariant = (Core.Name "contravariant") - -_Mod_lazy = (Core.Name "lazy") - -_Mod_valParam = (Core.Name "valParam") - -_Mod_varParam = (Core.Name "varParam") - -_Mod_infix = (Core.Name "infix") - -_Mod_inline = (Core.Name "inline") - -_Mod_using = (Core.Name "using") - -_Mod_opaque = (Core.Name "opaque") - -_Mod_transparent = (Core.Name "transparent") - -data Mod_Annot = - Mod_Annot { - mod_AnnotInit :: Init} - deriving (Eq, Ord, Read, Show) - -_Mod_Annot = (Core.Name "hydra/langs/scala/meta.Mod.Annot") - -_Mod_Annot_init = (Core.Name "init") - -data Mod_Private = - Mod_Private { - mod_PrivateWithin :: Ref} - deriving (Eq, Ord, Read, Show) - -_Mod_Private = (Core.Name "hydra/langs/scala/meta.Mod.Private") - -_Mod_Private_within = (Core.Name "within") - -data Mod_Protected = - Mod_Protected { - mod_ProtectedWithin :: Ref} - deriving (Eq, Ord, Read, Show) - -_Mod_Protected = (Core.Name "hydra/langs/scala/meta.Mod.Protected") - -_Mod_Protected_within = (Core.Name "within") - -data Enumerator = - EnumeratorGenerator Enumerator_Generator | - EnumeratorCaseGenerator Enumerator_CaseGenerator | - EnumeratorVal Enumerator_Val | - EnumeratorGuard Enumerator_Guard - deriving (Eq, Ord, Read, Show) - -_Enumerator = (Core.Name "hydra/langs/scala/meta.Enumerator") - -_Enumerator_generator = (Core.Name "generator") - -_Enumerator_caseGenerator = (Core.Name "caseGenerator") - -_Enumerator_val = (Core.Name "val") - -_Enumerator_guard = (Core.Name "guard") - -data Enumerator_Generator = - Enumerator_Generator { - enumerator_GeneratorPat :: Pat, - enumerator_GeneratorRhs :: Data} - deriving (Eq, Ord, Read, Show) - -_Enumerator_Generator = (Core.Name "hydra/langs/scala/meta.Enumerator.Generator") - -_Enumerator_Generator_pat = (Core.Name "pat") - -_Enumerator_Generator_rhs = (Core.Name "rhs") - -data Enumerator_CaseGenerator = - Enumerator_CaseGenerator { - enumerator_CaseGeneratorPat :: Pat, - enumerator_CaseGeneratorRhs :: Data} - deriving (Eq, Ord, Read, Show) - -_Enumerator_CaseGenerator = (Core.Name "hydra/langs/scala/meta.Enumerator.CaseGenerator") - -_Enumerator_CaseGenerator_pat = (Core.Name "pat") - -_Enumerator_CaseGenerator_rhs = (Core.Name "rhs") - -data Enumerator_Val = - Enumerator_Val { - enumerator_ValPat :: Pat, - enumerator_ValRhs :: Data} - deriving (Eq, Ord, Read, Show) - -_Enumerator_Val = (Core.Name "hydra/langs/scala/meta.Enumerator.Val") - -_Enumerator_Val_pat = (Core.Name "pat") - -_Enumerator_Val_rhs = (Core.Name "rhs") - -data Enumerator_Guard = - Enumerator_Guard { - enumerator_GuardCond :: Data} - deriving (Eq, Ord, Read, Show) - -_Enumerator_Guard = (Core.Name "hydra/langs/scala/meta.Enumerator.Guard") - -_Enumerator_Guard_cond = (Core.Name "cond") - -data ImportExportStat = - ImportExportStatImport Import | - ImportExportStatExport Export - deriving (Eq, Ord, Read, Show) - -_ImportExportStat = (Core.Name "hydra/langs/scala/meta.ImportExportStat") - -_ImportExportStat_import = (Core.Name "import") - -_ImportExportStat_export = (Core.Name "export") - -data Import = - Import { - importImporters :: [Importer]} - deriving (Eq, Ord, Read, Show) - -_Import = (Core.Name "hydra/langs/scala/meta.Import") - -_Import_importers = (Core.Name "importers") - -data Export = - Export { - exportImporters :: [Importer]} - deriving (Eq, Ord, Read, Show) - -_Export = (Core.Name "hydra/langs/scala/meta.Export") - -_Export_importers = (Core.Name "importers") - -data Importer = - Importer { - importerRef :: Data_Ref, - importerImportees :: [Importee]} - deriving (Eq, Ord, Read, Show) - -_Importer = (Core.Name "hydra/langs/scala/meta.Importer") - -_Importer_ref = (Core.Name "ref") - -_Importer_importees = (Core.Name "importees") - -data Importee = - ImporteeWildcard | - ImporteeGiven Importee_Given | - ImporteeGivenAll | - ImporteeName Importee_Name | - ImporteeRename Importee_Rename | - ImporteeUnimport Importee_Unimport - deriving (Eq, Ord, Read, Show) - -_Importee = (Core.Name "hydra/langs/scala/meta.Importee") - -_Importee_wildcard = (Core.Name "wildcard") - -_Importee_given = (Core.Name "given") - -_Importee_givenAll = (Core.Name "givenAll") - -_Importee_name = (Core.Name "name") - -_Importee_rename = (Core.Name "rename") - -_Importee_unimport = (Core.Name "unimport") - -data Importee_Given = - Importee_Given { - importee_GivenTpe :: Type} - deriving (Eq, Ord, Read, Show) - -_Importee_Given = (Core.Name "hydra/langs/scala/meta.Importee.Given") - -_Importee_Given_tpe = (Core.Name "tpe") - -data Importee_Name = - Importee_Name { - importee_NameName :: Name} - deriving (Eq, Ord, Read, Show) - -_Importee_Name = (Core.Name "hydra/langs/scala/meta.Importee.Name") - -_Importee_Name_name = (Core.Name "name") - -data Importee_Rename = - Importee_Rename { - importee_RenameName :: Name, - importee_RenameRename :: Name} - deriving (Eq, Ord, Read, Show) - -_Importee_Rename = (Core.Name "hydra/langs/scala/meta.Importee.Rename") - -_Importee_Rename_name = (Core.Name "name") - -_Importee_Rename_rename = (Core.Name "rename") - -data Importee_Unimport = - Importee_Unimport { - importee_UnimportName :: Name} - deriving (Eq, Ord, Read, Show) - -_Importee_Unimport = (Core.Name "hydra/langs/scala/meta.Importee.Unimport") - -_Importee_Unimport_name = (Core.Name "name") - -data CaseTree = - CaseTreeCase Case | - CaseTreeTypeCase TypeCase - deriving (Eq, Ord, Read, Show) - -_CaseTree = (Core.Name "hydra/langs/scala/meta.CaseTree") - -_CaseTree_case = (Core.Name "case") - -_CaseTree_typeCase = (Core.Name "typeCase") - -data Case = - Case { - casePat :: Pat, - caseCond :: (Maybe Data), - caseBody :: Data} - deriving (Eq, Ord, Read, Show) - -_Case = (Core.Name "hydra/langs/scala/meta.Case") - -_Case_pat = (Core.Name "pat") - -_Case_cond = (Core.Name "cond") - -_Case_body = (Core.Name "body") - -data TypeCase = - TypeCase { - typeCasePat :: Type, - typeCaseBody :: Type} - deriving (Eq, Ord, Read, Show) - -_TypeCase = (Core.Name "hydra/langs/scala/meta.TypeCase") - -_TypeCase_pat = (Core.Name "pat") - -_TypeCase_body = (Core.Name "body") - -data Source = - Source { - sourceStats :: [Stat]} - deriving (Eq, Ord, Read, Show) - -_Source = (Core.Name "hydra/langs/scala/meta.Source") - -_Source_stats = (Core.Name "stats") - -data Quasi = - Quasi {} - deriving (Eq, Ord, Read, Show) - -_Quasi = (Core.Name "hydra/langs/scala/meta.Quasi") diff --git a/src/gen-main/haskell/Hydra/Langs/Shacl/Model.hs b/src/gen-main/haskell/Hydra/Langs/Shacl/Model.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Shacl/Model.hs +++ /dev/null @@ -1,357 +0,0 @@ --- | A SHACL syntax model. See https://www.w3.org/TR/shacl - -module Hydra.Langs.Shacl.Model where - -import qualified Hydra.Core as Core -import qualified Hydra.Langs.Rdf.Syntax as Syntax -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | See https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent -data Closed = - Closed { - closedIsClosed :: Bool, - closedIgnoredProperties :: (Maybe (Set Syntax.Property))} - deriving (Eq, Ord, Read, Show) - -_Closed = (Core.Name "hydra/langs/shacl/model.Closed") - -_Closed_isClosed = (Core.Name "isClosed") - -_Closed_ignoredProperties = (Core.Name "ignoredProperties") - --- | Any of a number of constraint parameters which can be applied either to node or property shapes -data CommonConstraint = - -- | See https://www.w3.org/TR/shacl/#AndConstraintComponent - CommonConstraintAnd (Set (Reference Shape)) | - -- | See https://www.w3.org/TR/shacl/#ClosedConstraintComponent - CommonConstraintClosed Closed | - -- | See https://www.w3.org/TR/shacl/#ClassConstraintComponent - CommonConstraintClass (Set Syntax.RdfsClass) | - -- | See https://www.w3.org/TR/shacl/#DatatypeConstraintComponent - CommonConstraintDatatype Syntax.Iri | - -- | See https://www.w3.org/TR/shacl/#DisjointConstraintComponent - CommonConstraintDisjoint (Set Syntax.Property) | - -- | See https://www.w3.org/TR/shacl/#EqualsConstraintComponent - CommonConstraintEquals (Set Syntax.Property) | - -- | Specifies the condition that at least one value node is equal to the given RDF term. See https://www.w3.org/TR/shacl/#HasValueConstraintComponent - CommonConstraintHasValue (Set Syntax.Node) | - -- | Specifies the condition that each value node is a member of a provided SHACL list. See https://www.w3.org/TR/shacl/#InConstraintComponent - CommonConstraintIn [Syntax.Node] | - -- | See https://www.w3.org/TR/shacl/#LanguageInConstraintComponent - CommonConstraintLanguageIn (Set Syntax.LanguageTag) | - -- | See https://www.w3.org/TR/shacl/#NodeKindConstraintComponent - CommonConstraintNodeKind NodeKind | - -- | See https://www.w3.org/TR/shacl/#NodeConstraintComponent - CommonConstraintNode (Set (Reference NodeShape)) | - -- | See https://www.w3.org/TR/shacl/#NotConstraintComponent - CommonConstraintNot (Set (Reference Shape)) | - -- | See https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent - CommonConstraintMaxExclusive Syntax.Literal | - -- | See https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent - CommonConstraintMaxInclusive Syntax.Literal | - -- | See https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent - CommonConstraintMaxLength Integer | - -- | See https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent - CommonConstraintMinExclusive Syntax.Literal | - -- | See https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent - CommonConstraintMinInclusive Syntax.Literal | - -- | See https://www.w3.org/TR/shacl/#MinLengthConstraintComponent - CommonConstraintMinLength Integer | - -- | See https://www.w3.org/TR/shacl/#PatternConstraintComponent - CommonConstraintPattern Pattern | - -- | See https://www.w3.org/TR/shacl/#PropertyConstraintComponent - CommonConstraintProperty (Set (Reference PropertyShape)) | - -- | See https://www.w3.org/TR/shacl/#OrConstraintComponent - CommonConstraintOr (Set (Reference Shape)) | - -- | See https://www.w3.org/TR/shacl/#XoneConstraintComponent - CommonConstraintXone (Set (Reference Shape)) - deriving (Eq, Ord, Read, Show) - -_CommonConstraint = (Core.Name "hydra/langs/shacl/model.CommonConstraint") - -_CommonConstraint_and = (Core.Name "and") - -_CommonConstraint_closed = (Core.Name "closed") - -_CommonConstraint_class = (Core.Name "class") - -_CommonConstraint_datatype = (Core.Name "datatype") - -_CommonConstraint_disjoint = (Core.Name "disjoint") - -_CommonConstraint_equals = (Core.Name "equals") - -_CommonConstraint_hasValue = (Core.Name "hasValue") - -_CommonConstraint_in = (Core.Name "in") - -_CommonConstraint_languageIn = (Core.Name "languageIn") - -_CommonConstraint_nodeKind = (Core.Name "nodeKind") - -_CommonConstraint_node = (Core.Name "node") - -_CommonConstraint_not = (Core.Name "not") - -_CommonConstraint_maxExclusive = (Core.Name "maxExclusive") - -_CommonConstraint_maxInclusive = (Core.Name "maxInclusive") - -_CommonConstraint_maxLength = (Core.Name "maxLength") - -_CommonConstraint_minExclusive = (Core.Name "minExclusive") - -_CommonConstraint_minInclusive = (Core.Name "minInclusive") - -_CommonConstraint_minLength = (Core.Name "minLength") - -_CommonConstraint_pattern = (Core.Name "pattern") - -_CommonConstraint_property = (Core.Name "property") - -_CommonConstraint_or = (Core.Name "or") - -_CommonConstraint_xone = (Core.Name "xone") - --- | Common constraint parameters and other properties for SHACL shapes -data CommonProperties = - CommonProperties { - -- | Common constraint parameters attached to this shape - commonPropertiesConstraints :: (Set CommonConstraint), - -- | See https://www.w3.org/TR/shacl/#deactivated - commonPropertiesDeactivated :: (Maybe Bool), - -- | See https://www.w3.org/TR/shacl/#message - commonPropertiesMessage :: Syntax.LangStrings, - -- | See https://www.w3.org/TR/shacl/#severity - commonPropertiesSeverity :: Severity, - -- | See https://www.w3.org/TR/shacl/#targetClass - commonPropertiesTargetClass :: (Set Syntax.RdfsClass), - -- | See https://www.w3.org/TR/shacl/#targetNode - commonPropertiesTargetNode :: (Set Syntax.IriOrLiteral), - -- | See https://www.w3.org/TR/shacl/#targetObjectsOf - commonPropertiesTargetObjectsOf :: (Set Syntax.Property), - -- | See https://www.w3.org/TR/shacl/#targetSubjectsOf - commonPropertiesTargetSubjectsOf :: (Set Syntax.Property)} - deriving (Eq, Ord, Read, Show) - -_CommonProperties = (Core.Name "hydra/langs/shacl/model.CommonProperties") - -_CommonProperties_constraints = (Core.Name "constraints") - -_CommonProperties_deactivated = (Core.Name "deactivated") - -_CommonProperties_message = (Core.Name "message") - -_CommonProperties_severity = (Core.Name "severity") - -_CommonProperties_targetClass = (Core.Name "targetClass") - -_CommonProperties_targetNode = (Core.Name "targetNode") - -_CommonProperties_targetObjectsOf = (Core.Name "targetObjectsOf") - -_CommonProperties_targetSubjectsOf = (Core.Name "targetSubjectsOf") - --- | An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance -data Definition a = - Definition { - definitionIri :: Syntax.Iri, - definitionTarget :: a} - deriving (Eq, Ord, Read, Show) - -_Definition = (Core.Name "hydra/langs/shacl/model.Definition") - -_Definition_iri = (Core.Name "iri") - -_Definition_target = (Core.Name "target") - -data NodeKind = - -- | A blank node - NodeKindBlankNode | - -- | An IRI - NodeKindIri | - -- | A literal - NodeKindLiteral | - -- | A blank node or an IRI - NodeKindBlankNodeOrIri | - -- | A blank node or a literal - NodeKindBlankNodeOrLiteral | - -- | An IRI or a literal - NodeKindIriOrLiteral - deriving (Eq, Ord, Read, Show) - -_NodeKind = (Core.Name "hydra/langs/shacl/model.NodeKind") - -_NodeKind_blankNode = (Core.Name "blankNode") - -_NodeKind_iri = (Core.Name "iri") - -_NodeKind_literal = (Core.Name "literal") - -_NodeKind_blankNodeOrIri = (Core.Name "blankNodeOrIri") - -_NodeKind_blankNodeOrLiteral = (Core.Name "blankNodeOrLiteral") - -_NodeKind_iriOrLiteral = (Core.Name "iriOrLiteral") - --- | A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes -data NodeShape = - NodeShape { - nodeShapeCommon :: CommonProperties} - deriving (Eq, Ord, Read, Show) - -_NodeShape = (Core.Name "hydra/langs/shacl/model.NodeShape") - -_NodeShape_common = (Core.Name "common") - --- | A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent -data Pattern = - Pattern { - patternRegex :: String, - patternFlags :: (Maybe String)} - deriving (Eq, Ord, Read, Show) - -_Pattern = (Core.Name "hydra/langs/shacl/model.Pattern") - -_Pattern_regex = (Core.Name "regex") - -_Pattern_flags = (Core.Name "flags") - --- | A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes -data PropertyShape = - PropertyShape { - propertyShapeCommon :: CommonProperties, - -- | Any property shape -specific constraint parameters - propertyShapeConstraints :: (Set PropertyShapeConstraint), - -- | See https://www.w3.org/TR/shacl/#defaultValue - propertyShapeDefaultValue :: (Maybe Syntax.Node), - -- | See https://www.w3.org/TR/shacl/#name - propertyShapeDescription :: Syntax.LangStrings, - -- | See https://www.w3.org/TR/shacl/#name - propertyShapeName :: Syntax.LangStrings, - -- | See https://www.w3.org/TR/shacl/#order - propertyShapeOrder :: (Maybe Integer), - propertyShapePath :: Syntax.Iri} - deriving (Eq, Ord, Read, Show) - -_PropertyShape = (Core.Name "hydra/langs/shacl/model.PropertyShape") - -_PropertyShape_common = (Core.Name "common") - -_PropertyShape_constraints = (Core.Name "constraints") - -_PropertyShape_defaultValue = (Core.Name "defaultValue") - -_PropertyShape_description = (Core.Name "description") - -_PropertyShape_name = (Core.Name "name") - -_PropertyShape_order = (Core.Name "order") - -_PropertyShape_path = (Core.Name "path") - --- | A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes -data PropertyShapeConstraint = - -- | See https://www.w3.org/TR/shacl/#LessThanConstraintComponent - PropertyShapeConstraintLessThan (Set Syntax.Property) | - -- | See https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent - PropertyShapeConstraintLessThanOrEquals (Set Syntax.Property) | - -- | The maximum cardinality. Node shapes cannot have any value for sh:maxCount. See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent - PropertyShapeConstraintMaxCount Integer | - -- | The minimum cardinality. Node shapes cannot have any value for sh:minCount. See https://www.w3.org/TR/shacl/#MinCountConstraintComponent - PropertyShapeConstraintMinCount Integer | - -- | See https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent - PropertyShapeConstraintUniqueLang Bool | - -- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent - PropertyShapeConstraintQualifiedValueShape QualifiedValueShape - deriving (Eq, Ord, Read, Show) - -_PropertyShapeConstraint = (Core.Name "hydra/langs/shacl/model.PropertyShapeConstraint") - -_PropertyShapeConstraint_lessThan = (Core.Name "lessThan") - -_PropertyShapeConstraint_lessThanOrEquals = (Core.Name "lessThanOrEquals") - -_PropertyShapeConstraint_maxCount = (Core.Name "maxCount") - -_PropertyShapeConstraint_minCount = (Core.Name "minCount") - -_PropertyShapeConstraint_uniqueLang = (Core.Name "uniqueLang") - -_PropertyShapeConstraint_qualifiedValueShape = (Core.Name "qualifiedValueShape") - --- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent -data QualifiedValueShape = - QualifiedValueShape { - qualifiedValueShapeQualifiedValueShape :: (Reference Shape), - qualifiedValueShapeQualifiedMaxCount :: Integer, - qualifiedValueShapeQualifiedMinCount :: Integer, - qualifiedValueShapeQualifiedValueShapesDisjoint :: (Maybe Bool)} - deriving (Eq, Ord, Read, Show) - -_QualifiedValueShape = (Core.Name "hydra/langs/shacl/model.QualifiedValueShape") - -_QualifiedValueShape_qualifiedValueShape = (Core.Name "qualifiedValueShape") - -_QualifiedValueShape_qualifiedMaxCount = (Core.Name "qualifiedMaxCount") - -_QualifiedValueShape_qualifiedMinCount = (Core.Name "qualifiedMinCount") - -_QualifiedValueShape_qualifiedValueShapesDisjoint = (Core.Name "qualifiedValueShapesDisjoint") - --- | Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type -data Reference a = - ReferenceNamed Syntax.Iri | - -- | An anonymous instance - ReferenceAnonymous a | - -- | An inline definition - ReferenceDefinition (Definition a) - deriving (Eq, Ord, Read, Show) - -_Reference = (Core.Name "hydra/langs/shacl/model.Reference") - -_Reference_named = (Core.Name "named") - -_Reference_anonymous = (Core.Name "anonymous") - -_Reference_definition = (Core.Name "definition") - -data Severity = - -- | A non-critical constraint violation indicating an informative message - SeverityInfo | - -- | A non-critical constraint violation indicating a warning - SeverityWarning | - -- | A constraint violation - SeverityViolation - deriving (Eq, Ord, Read, Show) - -_Severity = (Core.Name "hydra/langs/shacl/model.Severity") - -_Severity_info = (Core.Name "info") - -_Severity_warning = (Core.Name "warning") - -_Severity_violation = (Core.Name "violation") - --- | A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes -data Shape = - ShapeNode NodeShape | - ShapeProperty PropertyShape - deriving (Eq, Ord, Read, Show) - -_Shape = (Core.Name "hydra/langs/shacl/model.Shape") - -_Shape_node = (Core.Name "node") - -_Shape_property = (Core.Name "property") - --- | An RDF graph containing zero or more shapes that is passed into a SHACL validation process so that a data graph can be validated against the shapes -newtype ShapesGraph = - ShapesGraph { - unShapesGraph :: (Set (Definition Shape))} - deriving (Eq, Ord, Read, Show) - -_ShapesGraph = (Core.Name "hydra/langs/shacl/model.ShapesGraph") diff --git a/src/gen-main/haskell/Hydra/Langs/Shex/Syntax.hs b/src/gen-main/haskell/Hydra/Langs/Shex/Syntax.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Shex/Syntax.hs +++ /dev/null @@ -1,1607 +0,0 @@ --- | A Shex model. Based on the BNF at: --- | https://github.com/shexSpec/grammar/blob/master/bnf - -module Hydra.Langs.Shex.Syntax where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data ShexDoc = - ShexDoc { - shexDocListOfDirective :: [Directive], - shexDocSequence :: (Maybe ShexDoc_Sequence_Option), - shexDocPrefixDecl :: PrefixDecl} - deriving (Eq, Ord, Read, Show) - -_ShexDoc = (Core.Name "hydra/langs/shex/syntax.ShexDoc") - -_ShexDoc_listOfDirective = (Core.Name "listOfDirective") - -_ShexDoc_sequence = (Core.Name "sequence") - -_ShexDoc_prefixDecl = (Core.Name "prefixDecl") - -data ShexDoc_Sequence_Option = - ShexDoc_Sequence_Option { - shexDoc_Sequence_OptionAlts :: ShexDoc_Sequence_Option_Alts, - shexDoc_Sequence_OptionListOfStatement :: [Statement]} - deriving (Eq, Ord, Read, Show) - -_ShexDoc_Sequence_Option = (Core.Name "hydra/langs/shex/syntax.ShexDoc.Sequence.Option") - -_ShexDoc_Sequence_Option_alts = (Core.Name "alts") - -_ShexDoc_Sequence_Option_listOfStatement = (Core.Name "listOfStatement") - -data ShexDoc_Sequence_Option_Alts = - ShexDoc_Sequence_Option_AltsNotStartAction NotStartAction | - ShexDoc_Sequence_Option_AltsStartActions StartActions - deriving (Eq, Ord, Read, Show) - -_ShexDoc_Sequence_Option_Alts = (Core.Name "hydra/langs/shex/syntax.ShexDoc.Sequence.Option.Alts") - -_ShexDoc_Sequence_Option_Alts_notStartAction = (Core.Name "notStartAction") - -_ShexDoc_Sequence_Option_Alts_startActions = (Core.Name "startActions") - -data Directive = - DirectiveBaseDecl BaseDecl | - DirectivePrefixDecl PrefixDecl - deriving (Eq, Ord, Read, Show) - -_Directive = (Core.Name "hydra/langs/shex/syntax.Directive") - -_Directive_baseDecl = (Core.Name "baseDecl") - -_Directive_prefixDecl = (Core.Name "prefixDecl") - -newtype BaseDecl = - BaseDecl { - unBaseDecl :: IriRef} - deriving (Eq, Ord, Read, Show) - -_BaseDecl = (Core.Name "hydra/langs/shex/syntax.BaseDecl") - -data PrefixDecl = - PrefixDecl { - prefixDeclPnameNs :: PnameNs, - prefixDeclIriRef :: IriRef} - deriving (Eq, Ord, Read, Show) - -_PrefixDecl = (Core.Name "hydra/langs/shex/syntax.PrefixDecl") - -_PrefixDecl_pnameNs = (Core.Name "pnameNs") - -_PrefixDecl_iriRef = (Core.Name "iriRef") - -data NotStartAction = - NotStartActionStart ShapeExpression | - NotStartActionShapeExprDecl NotStartAction_ShapeExprDecl - deriving (Eq, Ord, Read, Show) - -_NotStartAction = (Core.Name "hydra/langs/shex/syntax.NotStartAction") - -_NotStartAction_start = (Core.Name "start") - -_NotStartAction_shapeExprDecl = (Core.Name "shapeExprDecl") - -data NotStartAction_ShapeExprDecl = - NotStartAction_ShapeExprDecl { - notStartAction_ShapeExprDeclShapeExprLabel :: ShapeExprLabel, - notStartAction_ShapeExprDeclAlts :: NotStartAction_ShapeExprDecl_Alts} - deriving (Eq, Ord, Read, Show) - -_NotStartAction_ShapeExprDecl = (Core.Name "hydra/langs/shex/syntax.NotStartAction.ShapeExprDecl") - -_NotStartAction_ShapeExprDecl_shapeExprLabel = (Core.Name "shapeExprLabel") - -_NotStartAction_ShapeExprDecl_alts = (Core.Name "alts") - -data NotStartAction_ShapeExprDecl_Alts = - NotStartAction_ShapeExprDecl_AltsShapeExpression ShapeExpression | - NotStartAction_ShapeExprDecl_AltsEXTERNAL - deriving (Eq, Ord, Read, Show) - -_NotStartAction_ShapeExprDecl_Alts = (Core.Name "hydra/langs/shex/syntax.NotStartAction.ShapeExprDecl.Alts") - -_NotStartAction_ShapeExprDecl_Alts_shapeExpression = (Core.Name "shapeExpression") - -_NotStartAction_ShapeExprDecl_Alts_eXTERNAL = (Core.Name "eXTERNAL") - -newtype StartActions = - StartActions { - unStartActions :: [CodeDecl]} - deriving (Eq, Ord, Read, Show) - -_StartActions = (Core.Name "hydra/langs/shex/syntax.StartActions") - -data Statement = - StatementDirective Directive | - StatementNotStartAction NotStartAction - deriving (Eq, Ord, Read, Show) - -_Statement = (Core.Name "hydra/langs/shex/syntax.Statement") - -_Statement_directive = (Core.Name "directive") - -_Statement_notStartAction = (Core.Name "notStartAction") - -newtype ShapeExpression = - ShapeExpression { - unShapeExpression :: ShapeOr} - deriving (Eq, Ord, Read, Show) - -_ShapeExpression = (Core.Name "hydra/langs/shex/syntax.ShapeExpression") - -newtype InlineShapeExpression = - InlineShapeExpression { - unInlineShapeExpression :: InlineShapeOr} - deriving (Eq, Ord, Read, Show) - -_InlineShapeExpression = (Core.Name "hydra/langs/shex/syntax.InlineShapeExpression") - -data ShapeOr = - ShapeOr { - shapeOrShapeAnd :: ShapeAnd, - shapeOrListOfSequence :: [ShapeAnd]} - deriving (Eq, Ord, Read, Show) - -_ShapeOr = (Core.Name "hydra/langs/shex/syntax.ShapeOr") - -_ShapeOr_shapeAnd = (Core.Name "shapeAnd") - -_ShapeOr_listOfSequence = (Core.Name "listOfSequence") - -data InlineShapeOr = - InlineShapeOr { - inlineShapeOrShapeAnd :: ShapeAnd, - inlineShapeOrListOfSequence :: [InlineShapeAnd]} - deriving (Eq, Ord, Read, Show) - -_InlineShapeOr = (Core.Name "hydra/langs/shex/syntax.InlineShapeOr") - -_InlineShapeOr_shapeAnd = (Core.Name "shapeAnd") - -_InlineShapeOr_listOfSequence = (Core.Name "listOfSequence") - -data ShapeAnd = - ShapeAnd { - shapeAndShapeNot :: ShapeNot, - shapeAndListOfSequence :: [ShapeNot]} - deriving (Eq, Ord, Read, Show) - -_ShapeAnd = (Core.Name "hydra/langs/shex/syntax.ShapeAnd") - -_ShapeAnd_shapeNot = (Core.Name "shapeNot") - -_ShapeAnd_listOfSequence = (Core.Name "listOfSequence") - -data InlineShapeAnd = - InlineShapeAnd { - inlineShapeAndInlineShapeNot :: InlineShapeNot, - inlineShapeAndListOfSequence :: [InlineShapeNot]} - deriving (Eq, Ord, Read, Show) - -_InlineShapeAnd = (Core.Name "hydra/langs/shex/syntax.InlineShapeAnd") - -_InlineShapeAnd_inlineShapeNot = (Core.Name "inlineShapeNot") - -_InlineShapeAnd_listOfSequence = (Core.Name "listOfSequence") - -data ShapeNot = - ShapeNot { - shapeNotNOT :: (Maybe ()), - shapeNotShapeAtom :: ShapeAtom} - deriving (Eq, Ord, Read, Show) - -_ShapeNot = (Core.Name "hydra/langs/shex/syntax.ShapeNot") - -_ShapeNot_nOT = (Core.Name "nOT") - -_ShapeNot_shapeAtom = (Core.Name "shapeAtom") - -data InlineShapeNot = - InlineShapeNot { - inlineShapeNotNOT :: (Maybe ()), - inlineShapeNotInlineShapeAtom :: InlineShapeAtom} - deriving (Eq, Ord, Read, Show) - -_InlineShapeNot = (Core.Name "hydra/langs/shex/syntax.InlineShapeNot") - -_InlineShapeNot_nOT = (Core.Name "nOT") - -_InlineShapeNot_inlineShapeAtom = (Core.Name "inlineShapeAtom") - -data ShapeAtom = - ShapeAtomSequence ShapeAtom_Sequence | - ShapeAtomShapeOrRef ShapeOrRef | - ShapeAtomSequence2 ShapeExpression | - ShapeAtomPeriod - deriving (Eq, Ord, Read, Show) - -_ShapeAtom = (Core.Name "hydra/langs/shex/syntax.ShapeAtom") - -_ShapeAtom_sequence = (Core.Name "sequence") - -_ShapeAtom_shapeOrRef = (Core.Name "shapeOrRef") - -_ShapeAtom_sequence2 = (Core.Name "sequence2") - -_ShapeAtom_period = (Core.Name "period") - -data ShapeAtom_Sequence = - ShapeAtom_Sequence { - shapeAtom_SequenceNodeConstraint :: NodeConstraint, - shapeAtom_SequenceShapeOrRef :: (Maybe ShapeOrRef)} - deriving (Eq, Ord, Read, Show) - -_ShapeAtom_Sequence = (Core.Name "hydra/langs/shex/syntax.ShapeAtom.Sequence") - -_ShapeAtom_Sequence_nodeConstraint = (Core.Name "nodeConstraint") - -_ShapeAtom_Sequence_shapeOrRef = (Core.Name "shapeOrRef") - -data InlineShapeAtom = - InlineShapeAtomSequence InlineShapeAtom_Sequence | - InlineShapeAtomSequence2 InlineShapeAtom_Sequence2 | - InlineShapeAtomSequence3 ShapeExpression | - InlineShapeAtomPeriod - deriving (Eq, Ord, Read, Show) - -_InlineShapeAtom = (Core.Name "hydra/langs/shex/syntax.InlineShapeAtom") - -_InlineShapeAtom_sequence = (Core.Name "sequence") - -_InlineShapeAtom_sequence2 = (Core.Name "sequence2") - -_InlineShapeAtom_sequence3 = (Core.Name "sequence3") - -_InlineShapeAtom_period = (Core.Name "period") - -data InlineShapeAtom_Sequence = - InlineShapeAtom_Sequence { - inlineShapeAtom_SequenceNodeConstraint :: NodeConstraint, - inlineShapeAtom_SequenceInlineShapeOrRef :: (Maybe InlineShapeOrRef)} - deriving (Eq, Ord, Read, Show) - -_InlineShapeAtom_Sequence = (Core.Name "hydra/langs/shex/syntax.InlineShapeAtom.Sequence") - -_InlineShapeAtom_Sequence_nodeConstraint = (Core.Name "nodeConstraint") - -_InlineShapeAtom_Sequence_inlineShapeOrRef = (Core.Name "inlineShapeOrRef") - -data InlineShapeAtom_Sequence2 = - InlineShapeAtom_Sequence2 { - inlineShapeAtom_Sequence2InlineShapeOrRef :: InlineShapeOrRef, - inlineShapeAtom_Sequence2NodeConstraint :: (Maybe NodeConstraint)} - deriving (Eq, Ord, Read, Show) - -_InlineShapeAtom_Sequence2 = (Core.Name "hydra/langs/shex/syntax.InlineShapeAtom.Sequence2") - -_InlineShapeAtom_Sequence2_inlineShapeOrRef = (Core.Name "inlineShapeOrRef") - -_InlineShapeAtom_Sequence2_nodeConstraint = (Core.Name "nodeConstraint") - -data ShapeOrRef = - ShapeOrRefShapeDefinition ShapeDefinition | - ShapeOrRefAtpNameLn AtpNameLn | - ShapeOrRefAtpNameNs AtpNameNs | - ShapeOrRefSequence ShapeExprLabel - deriving (Eq, Ord, Read, Show) - -_ShapeOrRef = (Core.Name "hydra/langs/shex/syntax.ShapeOrRef") - -_ShapeOrRef_shapeDefinition = (Core.Name "shapeDefinition") - -_ShapeOrRef_atpNameLn = (Core.Name "atpNameLn") - -_ShapeOrRef_atpNameNs = (Core.Name "atpNameNs") - -_ShapeOrRef_sequence = (Core.Name "sequence") - -data InlineShapeOrRef = - InlineShapeOrRefInlineShapeDefinition InlineShapeDefinition | - InlineShapeOrRefAtpNameLn AtpNameLn | - InlineShapeOrRefAtpNameNs AtpNameNs | - InlineShapeOrRefSequence ShapeExprLabel - deriving (Eq, Ord, Read, Show) - -_InlineShapeOrRef = (Core.Name "hydra/langs/shex/syntax.InlineShapeOrRef") - -_InlineShapeOrRef_inlineShapeDefinition = (Core.Name "inlineShapeDefinition") - -_InlineShapeOrRef_atpNameLn = (Core.Name "atpNameLn") - -_InlineShapeOrRef_atpNameNs = (Core.Name "atpNameNs") - -_InlineShapeOrRef_sequence = (Core.Name "sequence") - -data NodeConstraint = - NodeConstraintSequence [XsFacet] | - NodeConstraintSequence2 NodeConstraint_Sequence2 | - NodeConstraintSequence3 NodeConstraint_Sequence3 | - NodeConstraintSequence4 NodeConstraint_Sequence4 | - NodeConstraintSequence5 NodeConstraint_Sequence5 | - NodeConstraintListOfXsFacet [XsFacet] - deriving (Eq, Ord, Read, Show) - -_NodeConstraint = (Core.Name "hydra/langs/shex/syntax.NodeConstraint") - -_NodeConstraint_sequence = (Core.Name "sequence") - -_NodeConstraint_sequence2 = (Core.Name "sequence2") - -_NodeConstraint_sequence3 = (Core.Name "sequence3") - -_NodeConstraint_sequence4 = (Core.Name "sequence4") - -_NodeConstraint_sequence5 = (Core.Name "sequence5") - -_NodeConstraint_listOfXsFacet = (Core.Name "listOfXsFacet") - -data NodeConstraint_Sequence2 = - NodeConstraint_Sequence2 { - nodeConstraint_Sequence2NonLiteralKind :: NonLiteralKind, - nodeConstraint_Sequence2ListOfStringFacet :: [StringFacet]} - deriving (Eq, Ord, Read, Show) - -_NodeConstraint_Sequence2 = (Core.Name "hydra/langs/shex/syntax.NodeConstraint.Sequence2") - -_NodeConstraint_Sequence2_nonLiteralKind = (Core.Name "nonLiteralKind") - -_NodeConstraint_Sequence2_listOfStringFacet = (Core.Name "listOfStringFacet") - -data NodeConstraint_Sequence3 = - NodeConstraint_Sequence3 { - nodeConstraint_Sequence3Datatype :: Datatype, - nodeConstraint_Sequence3ListOfXsFacet :: [XsFacet]} - deriving (Eq, Ord, Read, Show) - -_NodeConstraint_Sequence3 = (Core.Name "hydra/langs/shex/syntax.NodeConstraint.Sequence3") - -_NodeConstraint_Sequence3_datatype = (Core.Name "datatype") - -_NodeConstraint_Sequence3_listOfXsFacet = (Core.Name "listOfXsFacet") - -data NodeConstraint_Sequence4 = - NodeConstraint_Sequence4 { - nodeConstraint_Sequence4ValueSet :: ValueSet, - nodeConstraint_Sequence4ListOfXsFacet :: [XsFacet]} - deriving (Eq, Ord, Read, Show) - -_NodeConstraint_Sequence4 = (Core.Name "hydra/langs/shex/syntax.NodeConstraint.Sequence4") - -_NodeConstraint_Sequence4_valueSet = (Core.Name "valueSet") - -_NodeConstraint_Sequence4_listOfXsFacet = (Core.Name "listOfXsFacet") - -data NodeConstraint_Sequence5 = - NodeConstraint_Sequence5 { - nodeConstraint_Sequence5ValueSet :: ValueSet, - nodeConstraint_Sequence5ListOfXsFacet :: [XsFacet]} - deriving (Eq, Ord, Read, Show) - -_NodeConstraint_Sequence5 = (Core.Name "hydra/langs/shex/syntax.NodeConstraint.Sequence5") - -_NodeConstraint_Sequence5_valueSet = (Core.Name "valueSet") - -_NodeConstraint_Sequence5_listOfXsFacet = (Core.Name "listOfXsFacet") - -data NonLiteralKind = - NonLiteralKindIRI | - NonLiteralKindBNODE | - NonLiteralKindNONLITERAL - deriving (Eq, Ord, Read, Show) - -_NonLiteralKind = (Core.Name "hydra/langs/shex/syntax.NonLiteralKind") - -_NonLiteralKind_iRI = (Core.Name "iRI") - -_NonLiteralKind_bNODE = (Core.Name "bNODE") - -_NonLiteralKind_nONLITERAL = (Core.Name "nONLITERAL") - -data XsFacet = - XsFacetStringFacet StringFacet | - XsFacetNumericFacet NumericFacet - deriving (Eq, Ord, Read, Show) - -_XsFacet = (Core.Name "hydra/langs/shex/syntax.XsFacet") - -_XsFacet_stringFacet = (Core.Name "stringFacet") - -_XsFacet_numericFacet = (Core.Name "numericFacet") - -data StringFacet = - StringFacetSequence StringFacet_Sequence | - StringFacetRegexp Regexp - deriving (Eq, Ord, Read, Show) - -_StringFacet = (Core.Name "hydra/langs/shex/syntax.StringFacet") - -_StringFacet_sequence = (Core.Name "sequence") - -_StringFacet_regexp = (Core.Name "regexp") - -data StringFacet_Sequence = - StringFacet_Sequence { - stringFacet_SequenceStringLength :: StringLength, - stringFacet_SequenceInteger :: Integer_} - deriving (Eq, Ord, Read, Show) - -_StringFacet_Sequence = (Core.Name "hydra/langs/shex/syntax.StringFacet.Sequence") - -_StringFacet_Sequence_stringLength = (Core.Name "stringLength") - -_StringFacet_Sequence_integer = (Core.Name "integer") - -data StringLength = - StringLengthLENGTH | - StringLengthMINLENGTH | - StringLengthMAXLENGTH - deriving (Eq, Ord, Read, Show) - -_StringLength = (Core.Name "hydra/langs/shex/syntax.StringLength") - -_StringLength_lENGTH = (Core.Name "lENGTH") - -_StringLength_mINLENGTH = (Core.Name "mINLENGTH") - -_StringLength_mAXLENGTH = (Core.Name "mAXLENGTH") - -data NumericFacet = - NumericFacetSequence NumericFacet_Sequence | - NumericFacetSequence2 NumericFacet_Sequence2 - deriving (Eq, Ord, Read, Show) - -_NumericFacet = (Core.Name "hydra/langs/shex/syntax.NumericFacet") - -_NumericFacet_sequence = (Core.Name "sequence") - -_NumericFacet_sequence2 = (Core.Name "sequence2") - -data NumericFacet_Sequence = - NumericFacet_Sequence { - numericFacet_SequenceNumericRange :: NumericRange, - numericFacet_SequenceNumericLiteral :: NumericLiteral} - deriving (Eq, Ord, Read, Show) - -_NumericFacet_Sequence = (Core.Name "hydra/langs/shex/syntax.NumericFacet.Sequence") - -_NumericFacet_Sequence_numericRange = (Core.Name "numericRange") - -_NumericFacet_Sequence_numericLiteral = (Core.Name "numericLiteral") - -data NumericFacet_Sequence2 = - NumericFacet_Sequence2 { - numericFacet_Sequence2NumericLength :: NumericLength, - numericFacet_Sequence2Integer :: Integer_} - deriving (Eq, Ord, Read, Show) - -_NumericFacet_Sequence2 = (Core.Name "hydra/langs/shex/syntax.NumericFacet.Sequence2") - -_NumericFacet_Sequence2_numericLength = (Core.Name "numericLength") - -_NumericFacet_Sequence2_integer = (Core.Name "integer") - -data NumericRange = - NumericRangeMININCLUSIVE | - NumericRangeMINEXCLUSIVE | - NumericRangeMAXINCLUSIVE | - NumericRangeMAXEXCLUSIVE - deriving (Eq, Ord, Read, Show) - -_NumericRange = (Core.Name "hydra/langs/shex/syntax.NumericRange") - -_NumericRange_mININCLUSIVE = (Core.Name "mININCLUSIVE") - -_NumericRange_mINEXCLUSIVE = (Core.Name "mINEXCLUSIVE") - -_NumericRange_mAXINCLUSIVE = (Core.Name "mAXINCLUSIVE") - -_NumericRange_mAXEXCLUSIVE = (Core.Name "mAXEXCLUSIVE") - -data NumericLength = - NumericLengthTOTALDIGITS | - NumericLengthFRACTIONDIGITS - deriving (Eq, Ord, Read, Show) - -_NumericLength = (Core.Name "hydra/langs/shex/syntax.NumericLength") - -_NumericLength_tOTALDIGITS = (Core.Name "tOTALDIGITS") - -_NumericLength_fRACTIONDIGITS = (Core.Name "fRACTIONDIGITS") - -data ShapeDefinition = - ShapeDefinition { - shapeDefinitionListOfAlts :: [ShapeDefinition_ListOfAlts_Elmt], - shapeDefinitionTripleExpression :: (Maybe TripleExpression), - shapeDefinitionListOfAnnotation :: [Annotation], - shapeDefinitionSemanticActions :: SemanticActions} - deriving (Eq, Ord, Read, Show) - -_ShapeDefinition = (Core.Name "hydra/langs/shex/syntax.ShapeDefinition") - -_ShapeDefinition_listOfAlts = (Core.Name "listOfAlts") - -_ShapeDefinition_tripleExpression = (Core.Name "tripleExpression") - -_ShapeDefinition_listOfAnnotation = (Core.Name "listOfAnnotation") - -_ShapeDefinition_semanticActions = (Core.Name "semanticActions") - -data ShapeDefinition_ListOfAlts_Elmt = - ShapeDefinition_ListOfAlts_ElmtIncludeSet IncludeSet | - ShapeDefinition_ListOfAlts_ElmtExtraPropertySet ExtraPropertySet | - ShapeDefinition_ListOfAlts_ElmtCLOSED - deriving (Eq, Ord, Read, Show) - -_ShapeDefinition_ListOfAlts_Elmt = (Core.Name "hydra/langs/shex/syntax.ShapeDefinition.ListOfAlts.Elmt") - -_ShapeDefinition_ListOfAlts_Elmt_includeSet = (Core.Name "includeSet") - -_ShapeDefinition_ListOfAlts_Elmt_extraPropertySet = (Core.Name "extraPropertySet") - -_ShapeDefinition_ListOfAlts_Elmt_cLOSED = (Core.Name "cLOSED") - -data InlineShapeDefinition = - InlineShapeDefinition { - inlineShapeDefinitionListOfAlts :: [InlineShapeDefinition_ListOfAlts_Elmt], - inlineShapeDefinitionTripleExpression :: (Maybe TripleExpression)} - deriving (Eq, Ord, Read, Show) - -_InlineShapeDefinition = (Core.Name "hydra/langs/shex/syntax.InlineShapeDefinition") - -_InlineShapeDefinition_listOfAlts = (Core.Name "listOfAlts") - -_InlineShapeDefinition_tripleExpression = (Core.Name "tripleExpression") - -data InlineShapeDefinition_ListOfAlts_Elmt = - InlineShapeDefinition_ListOfAlts_ElmtIncludeSet IncludeSet | - InlineShapeDefinition_ListOfAlts_ElmtExtraPropertySet ExtraPropertySet | - InlineShapeDefinition_ListOfAlts_ElmtCLOSED - deriving (Eq, Ord, Read, Show) - -_InlineShapeDefinition_ListOfAlts_Elmt = (Core.Name "hydra/langs/shex/syntax.InlineShapeDefinition.ListOfAlts.Elmt") - -_InlineShapeDefinition_ListOfAlts_Elmt_includeSet = (Core.Name "includeSet") - -_InlineShapeDefinition_ListOfAlts_Elmt_extraPropertySet = (Core.Name "extraPropertySet") - -_InlineShapeDefinition_ListOfAlts_Elmt_cLOSED = (Core.Name "cLOSED") - -newtype ExtraPropertySet = - ExtraPropertySet { - unExtraPropertySet :: [Predicate]} - deriving (Eq, Ord, Read, Show) - -_ExtraPropertySet = (Core.Name "hydra/langs/shex/syntax.ExtraPropertySet") - -newtype TripleExpression = - TripleExpression { - unTripleExpression :: OneOfTripleExpr} - deriving (Eq, Ord, Read, Show) - -_TripleExpression = (Core.Name "hydra/langs/shex/syntax.TripleExpression") - -data OneOfTripleExpr = - OneOfTripleExprGroupTripleExpr GroupTripleExpr | - OneOfTripleExprMultiElementOneOf MultiElementOneOf - deriving (Eq, Ord, Read, Show) - -_OneOfTripleExpr = (Core.Name "hydra/langs/shex/syntax.OneOfTripleExpr") - -_OneOfTripleExpr_groupTripleExpr = (Core.Name "groupTripleExpr") - -_OneOfTripleExpr_multiElementOneOf = (Core.Name "multiElementOneOf") - -data MultiElementOneOf = - MultiElementOneOf { - multiElementOneOfGroupTripleExpr :: GroupTripleExpr, - multiElementOneOfListOfSequence :: [GroupTripleExpr]} - deriving (Eq, Ord, Read, Show) - -_MultiElementOneOf = (Core.Name "hydra/langs/shex/syntax.MultiElementOneOf") - -_MultiElementOneOf_groupTripleExpr = (Core.Name "groupTripleExpr") - -_MultiElementOneOf_listOfSequence = (Core.Name "listOfSequence") - -data InnerTripleExpr = - InnerTripleExprMultiElementGroup MultiElementGroup | - InnerTripleExprMultiElementOneOf MultiElementOneOf - deriving (Eq, Ord, Read, Show) - -_InnerTripleExpr = (Core.Name "hydra/langs/shex/syntax.InnerTripleExpr") - -_InnerTripleExpr_multiElementGroup = (Core.Name "multiElementGroup") - -_InnerTripleExpr_multiElementOneOf = (Core.Name "multiElementOneOf") - -data GroupTripleExpr = - GroupTripleExprSingleElementGroup SingleElementGroup | - GroupTripleExprMultiElementGroup MultiElementGroup - deriving (Eq, Ord, Read, Show) - -_GroupTripleExpr = (Core.Name "hydra/langs/shex/syntax.GroupTripleExpr") - -_GroupTripleExpr_singleElementGroup = (Core.Name "singleElementGroup") - -_GroupTripleExpr_multiElementGroup = (Core.Name "multiElementGroup") - -data SingleElementGroup = - SingleElementGroup { - singleElementGroupUnaryTripleExpr :: UnaryTripleExpr, - singleElementGroupSemi :: (Maybe ())} - deriving (Eq, Ord, Read, Show) - -_SingleElementGroup = (Core.Name "hydra/langs/shex/syntax.SingleElementGroup") - -_SingleElementGroup_unaryTripleExpr = (Core.Name "unaryTripleExpr") - -_SingleElementGroup_semi = (Core.Name "semi") - -data MultiElementGroup = - MultiElementGroup { - multiElementGroupUnaryTripleExpr :: UnaryTripleExpr, - multiElementGroupListOfSequence :: [UnaryTripleExpr], - multiElementGroupSemi :: (Maybe ())} - deriving (Eq, Ord, Read, Show) - -_MultiElementGroup = (Core.Name "hydra/langs/shex/syntax.MultiElementGroup") - -_MultiElementGroup_unaryTripleExpr = (Core.Name "unaryTripleExpr") - -_MultiElementGroup_listOfSequence = (Core.Name "listOfSequence") - -_MultiElementGroup_semi = (Core.Name "semi") - -data UnaryTripleExpr = - UnaryTripleExprSequence UnaryTripleExpr_Sequence | - UnaryTripleExprInclude Include - deriving (Eq, Ord, Read, Show) - -_UnaryTripleExpr = (Core.Name "hydra/langs/shex/syntax.UnaryTripleExpr") - -_UnaryTripleExpr_sequence = (Core.Name "sequence") - -_UnaryTripleExpr_include = (Core.Name "include") - -data UnaryTripleExpr_Sequence = - UnaryTripleExpr_Sequence { - unaryTripleExpr_SequenceSequence :: (Maybe TripleExprLabel), - unaryTripleExpr_SequenceAlts :: UnaryTripleExpr_Sequence_Alts} - deriving (Eq, Ord, Read, Show) - -_UnaryTripleExpr_Sequence = (Core.Name "hydra/langs/shex/syntax.UnaryTripleExpr.Sequence") - -_UnaryTripleExpr_Sequence_sequence = (Core.Name "sequence") - -_UnaryTripleExpr_Sequence_alts = (Core.Name "alts") - -data UnaryTripleExpr_Sequence_Alts = - UnaryTripleExpr_Sequence_AltsTripleConstraint TripleConstraint | - UnaryTripleExpr_Sequence_AltsBracketedTripleExpr BracketedTripleExpr - deriving (Eq, Ord, Read, Show) - -_UnaryTripleExpr_Sequence_Alts = (Core.Name "hydra/langs/shex/syntax.UnaryTripleExpr.Sequence.Alts") - -_UnaryTripleExpr_Sequence_Alts_tripleConstraint = (Core.Name "tripleConstraint") - -_UnaryTripleExpr_Sequence_Alts_bracketedTripleExpr = (Core.Name "bracketedTripleExpr") - -data BracketedTripleExpr = - BracketedTripleExpr { - bracketedTripleExprInnerTripleExpr :: InnerTripleExpr, - bracketedTripleExprCardinality :: (Maybe Cardinality), - bracketedTripleExprListOfAnnotation :: [Annotation], - bracketedTripleExprSemanticActions :: SemanticActions} - deriving (Eq, Ord, Read, Show) - -_BracketedTripleExpr = (Core.Name "hydra/langs/shex/syntax.BracketedTripleExpr") - -_BracketedTripleExpr_innerTripleExpr = (Core.Name "innerTripleExpr") - -_BracketedTripleExpr_cardinality = (Core.Name "cardinality") - -_BracketedTripleExpr_listOfAnnotation = (Core.Name "listOfAnnotation") - -_BracketedTripleExpr_semanticActions = (Core.Name "semanticActions") - -data TripleConstraint = - TripleConstraint { - tripleConstraintSenseFlags :: (Maybe SenseFlags), - tripleConstraintPredicate :: Predicate, - tripleConstraintInlineShapeExpression :: InlineShapeExpression, - tripleConstraintCardinality :: (Maybe Cardinality), - tripleConstraintListOfAnnotation :: [Annotation], - tripleConstraintSemanticActions :: SemanticActions} - deriving (Eq, Ord, Read, Show) - -_TripleConstraint = (Core.Name "hydra/langs/shex/syntax.TripleConstraint") - -_TripleConstraint_senseFlags = (Core.Name "senseFlags") - -_TripleConstraint_predicate = (Core.Name "predicate") - -_TripleConstraint_inlineShapeExpression = (Core.Name "inlineShapeExpression") - -_TripleConstraint_cardinality = (Core.Name "cardinality") - -_TripleConstraint_listOfAnnotation = (Core.Name "listOfAnnotation") - -_TripleConstraint_semanticActions = (Core.Name "semanticActions") - -data Cardinality = - CardinalityAst | - CardinalityPlus | - CardinalityQuest | - CardinalityRepeatRange RepeatRange - deriving (Eq, Ord, Read, Show) - -_Cardinality = (Core.Name "hydra/langs/shex/syntax.Cardinality") - -_Cardinality_ast = (Core.Name "ast") - -_Cardinality_plus = (Core.Name "plus") - -_Cardinality_quest = (Core.Name "quest") - -_Cardinality_repeatRange = (Core.Name "repeatRange") - -data SenseFlags = - SenseFlags {} - deriving (Eq, Ord, Read, Show) - -_SenseFlags = (Core.Name "hydra/langs/shex/syntax.SenseFlags") - -newtype ValueSet = - ValueSet { - unValueSet :: [ValueSetValue]} - deriving (Eq, Ord, Read, Show) - -_ValueSet = (Core.Name "hydra/langs/shex/syntax.ValueSet") - -data ValueSetValue = - ValueSetValueIriRange IriRange | - ValueSetValueLiteral Literal - deriving (Eq, Ord, Read, Show) - -_ValueSetValue = (Core.Name "hydra/langs/shex/syntax.ValueSetValue") - -_ValueSetValue_iriRange = (Core.Name "iriRange") - -_ValueSetValue_literal = (Core.Name "literal") - -data IriRange = - IriRangeSequence IriRange_Sequence | - IriRangeSequence2 [Exclusion] - deriving (Eq, Ord, Read, Show) - -_IriRange = (Core.Name "hydra/langs/shex/syntax.IriRange") - -_IriRange_sequence = (Core.Name "sequence") - -_IriRange_sequence2 = (Core.Name "sequence2") - -data IriRange_Sequence = - IriRange_Sequence { - iriRange_SequenceIri :: Iri, - iriRange_SequenceSequence :: (Maybe [Exclusion])} - deriving (Eq, Ord, Read, Show) - -_IriRange_Sequence = (Core.Name "hydra/langs/shex/syntax.IriRange.Sequence") - -_IriRange_Sequence_iri = (Core.Name "iri") - -_IriRange_Sequence_sequence = (Core.Name "sequence") - -newtype Exclusion = - Exclusion { - unExclusion :: Iri} - deriving (Eq, Ord, Read, Show) - -_Exclusion = (Core.Name "hydra/langs/shex/syntax.Exclusion") - -newtype Include = - Include { - unInclude :: TripleExprLabel} - deriving (Eq, Ord, Read, Show) - -_Include = (Core.Name "hydra/langs/shex/syntax.Include") - -data Annotation = - Annotation { - annotationPredicate :: Predicate, - annotationAlts :: Annotation_Alts} - deriving (Eq, Ord, Read, Show) - -_Annotation = (Core.Name "hydra/langs/shex/syntax.Annotation") - -_Annotation_predicate = (Core.Name "predicate") - -_Annotation_alts = (Core.Name "alts") - -data Annotation_Alts = - Annotation_AltsIri Iri | - Annotation_AltsLiteral Literal - deriving (Eq, Ord, Read, Show) - -_Annotation_Alts = (Core.Name "hydra/langs/shex/syntax.Annotation.Alts") - -_Annotation_Alts_iri = (Core.Name "iri") - -_Annotation_Alts_literal = (Core.Name "literal") - -newtype SemanticActions = - SemanticActions { - unSemanticActions :: [CodeDecl]} - deriving (Eq, Ord, Read, Show) - -_SemanticActions = (Core.Name "hydra/langs/shex/syntax.SemanticActions") - -data CodeDecl = - CodeDecl { - codeDeclIri :: Iri, - codeDeclAlts :: CodeDecl_Alts} - deriving (Eq, Ord, Read, Show) - -_CodeDecl = (Core.Name "hydra/langs/shex/syntax.CodeDecl") - -_CodeDecl_iri = (Core.Name "iri") - -_CodeDecl_alts = (Core.Name "alts") - -data CodeDecl_Alts = - CodeDecl_AltsCode Code | - CodeDecl_AltsPercnt - deriving (Eq, Ord, Read, Show) - -_CodeDecl_Alts = (Core.Name "hydra/langs/shex/syntax.CodeDecl.Alts") - -_CodeDecl_Alts_code = (Core.Name "code") - -_CodeDecl_Alts_percnt = (Core.Name "percnt") - -data Literal = - LiteralRdfLiteral RdfLiteral | - LiteralNumericLiteral NumericLiteral | - LiteralBooleanLiteral BooleanLiteral - deriving (Eq, Ord, Read, Show) - -_Literal = (Core.Name "hydra/langs/shex/syntax.Literal") - -_Literal_rdfLiteral = (Core.Name "rdfLiteral") - -_Literal_numericLiteral = (Core.Name "numericLiteral") - -_Literal_booleanLiteral = (Core.Name "booleanLiteral") - -data Predicate = - PredicateIri Iri | - PredicateRdfType RdfType - deriving (Eq, Ord, Read, Show) - -_Predicate = (Core.Name "hydra/langs/shex/syntax.Predicate") - -_Predicate_iri = (Core.Name "iri") - -_Predicate_rdfType = (Core.Name "rdfType") - -newtype Datatype = - Datatype { - unDatatype :: Iri} - deriving (Eq, Ord, Read, Show) - -_Datatype = (Core.Name "hydra/langs/shex/syntax.Datatype") - -data ShapeExprLabel = - ShapeExprLabelIri Iri | - ShapeExprLabelBlankNode BlankNode - deriving (Eq, Ord, Read, Show) - -_ShapeExprLabel = (Core.Name "hydra/langs/shex/syntax.ShapeExprLabel") - -_ShapeExprLabel_iri = (Core.Name "iri") - -_ShapeExprLabel_blankNode = (Core.Name "blankNode") - -data TripleExprLabel = - TripleExprLabelIri Iri | - TripleExprLabelBlankNode BlankNode - deriving (Eq, Ord, Read, Show) - -_TripleExprLabel = (Core.Name "hydra/langs/shex/syntax.TripleExprLabel") - -_TripleExprLabel_iri = (Core.Name "iri") - -_TripleExprLabel_blankNode = (Core.Name "blankNode") - -data NumericLiteral = - NumericLiteralInteger Integer_ | - NumericLiteralDecimal Decimal | - NumericLiteralDouble Double_ - deriving (Eq, Ord, Read, Show) - -_NumericLiteral = (Core.Name "hydra/langs/shex/syntax.NumericLiteral") - -_NumericLiteral_integer = (Core.Name "integer") - -_NumericLiteral_decimal = (Core.Name "decimal") - -_NumericLiteral_double = (Core.Name "double") - -data RdfLiteral = - RdfLiteral { - rdfLiteralString :: String_, - rdfLiteralAlts :: (Maybe RdfLiteral_Alts_Option)} - deriving (Eq, Ord, Read, Show) - -_RdfLiteral = (Core.Name "hydra/langs/shex/syntax.RdfLiteral") - -_RdfLiteral_string = (Core.Name "string") - -_RdfLiteral_alts = (Core.Name "alts") - -data RdfLiteral_Alts_Option = - RdfLiteral_Alts_OptionLangTag LangTag | - RdfLiteral_Alts_OptionSequence Datatype - deriving (Eq, Ord, Read, Show) - -_RdfLiteral_Alts_Option = (Core.Name "hydra/langs/shex/syntax.RdfLiteral.Alts.Option") - -_RdfLiteral_Alts_Option_langTag = (Core.Name "langTag") - -_RdfLiteral_Alts_Option_sequence = (Core.Name "sequence") - -data BooleanLiteral = - BooleanLiteralTrue | - BooleanLiteralFalse - deriving (Eq, Ord, Read, Show) - -_BooleanLiteral = (Core.Name "hydra/langs/shex/syntax.BooleanLiteral") - -_BooleanLiteral_true = (Core.Name "true") - -_BooleanLiteral_false = (Core.Name "false") - -data String_ = - StringStringLiteral1 StringLiteral1 | - StringStringLiteralLong1 StringLiteralLong1 | - StringStringLiteral2 StringLiteral2 | - StringStringLiteralLong2 StringLiteralLong2 - deriving (Eq, Ord, Read, Show) - -_String = (Core.Name "hydra/langs/shex/syntax.String") - -_String_stringLiteral1 = (Core.Name "stringLiteral1") - -_String_stringLiteralLong1 = (Core.Name "stringLiteralLong1") - -_String_stringLiteral2 = (Core.Name "stringLiteral2") - -_String_stringLiteralLong2 = (Core.Name "stringLiteralLong2") - -data Iri = - IriIriRef IriRef | - IriPrefixedName PrefixedName - deriving (Eq, Ord, Read, Show) - -_Iri = (Core.Name "hydra/langs/shex/syntax.Iri") - -_Iri_iriRef = (Core.Name "iriRef") - -_Iri_prefixedName = (Core.Name "prefixedName") - -data PrefixedName = - PrefixedNamePnameLn PnameLn | - PrefixedNamePnameNs PnameNs - deriving (Eq, Ord, Read, Show) - -_PrefixedName = (Core.Name "hydra/langs/shex/syntax.PrefixedName") - -_PrefixedName_pnameLn = (Core.Name "pnameLn") - -_PrefixedName_pnameNs = (Core.Name "pnameNs") - -newtype BlankNode = - BlankNode { - unBlankNode :: BlankNodeLabel} - deriving (Eq, Ord, Read, Show) - -_BlankNode = (Core.Name "hydra/langs/shex/syntax.BlankNode") - -newtype IncludeSet = - IncludeSet { - unIncludeSet :: [ShapeExprLabel]} - deriving (Eq, Ord, Read, Show) - -_IncludeSet = (Core.Name "hydra/langs/shex/syntax.IncludeSet") - -newtype Code = - Code { - unCode :: [Code_Elmt]} - deriving (Eq, Ord, Read, Show) - -_Code = (Core.Name "hydra/langs/shex/syntax.Code") - -data Code_Elmt = - Code_ElmtRegex String | - Code_ElmtSequence String | - Code_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_Code_Elmt = (Core.Name "hydra/langs/shex/syntax.Code.Elmt") - -_Code_Elmt_regex = (Core.Name "regex") - -_Code_Elmt_sequence = (Core.Name "sequence") - -_Code_Elmt_uchar = (Core.Name "uchar") - -data RepeatRange = - RepeatRange { - repeatRangeInteger :: Integer_, - repeatRangeSequence :: (Maybe (Maybe (Maybe RepeatRange_Sequence_Option_Option_Option)))} - deriving (Eq, Ord, Read, Show) - -_RepeatRange = (Core.Name "hydra/langs/shex/syntax.RepeatRange") - -_RepeatRange_integer = (Core.Name "integer") - -_RepeatRange_sequence = (Core.Name "sequence") - -data RepeatRange_Sequence_Option_Option_Option = - RepeatRange_Sequence_Option_Option_OptionInteger Integer_ | - RepeatRange_Sequence_Option_Option_OptionAst - deriving (Eq, Ord, Read, Show) - -_RepeatRange_Sequence_Option_Option_Option = (Core.Name "hydra/langs/shex/syntax.RepeatRange.Sequence.Option.Option.Option") - -_RepeatRange_Sequence_Option_Option_Option_integer = (Core.Name "integer") - -_RepeatRange_Sequence_Option_Option_Option_ast = (Core.Name "ast") - -data RdfType = - RdfType {} - deriving (Eq, Ord, Read, Show) - -_RdfType = (Core.Name "hydra/langs/shex/syntax.RdfType") - -newtype IriRef = - IriRef { - unIriRef :: [IriRef_Elmt]} - deriving (Eq, Ord, Read, Show) - -_IriRef = (Core.Name "hydra/langs/shex/syntax.IriRef") - -data IriRef_Elmt = - IriRef_ElmtRegex String | - IriRef_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_IriRef_Elmt = (Core.Name "hydra/langs/shex/syntax.IriRef.Elmt") - -_IriRef_Elmt_regex = (Core.Name "regex") - -_IriRef_Elmt_uchar = (Core.Name "uchar") - -newtype PnameNs = - PnameNs { - unPnameNs :: (Maybe PnPrefix)} - deriving (Eq, Ord, Read, Show) - -_PnameNs = (Core.Name "hydra/langs/shex/syntax.PnameNs") - -data PnameLn = - PnameLn { - pnameLnPnameNs :: PnameNs, - pnameLnPnLocal :: PnLocal} - deriving (Eq, Ord, Read, Show) - -_PnameLn = (Core.Name "hydra/langs/shex/syntax.PnameLn") - -_PnameLn_pnameNs = (Core.Name "pnameNs") - -_PnameLn_pnLocal = (Core.Name "pnLocal") - -newtype AtpNameNs = - AtpNameNs { - unAtpNameNs :: (Maybe PnPrefix)} - deriving (Eq, Ord, Read, Show) - -_AtpNameNs = (Core.Name "hydra/langs/shex/syntax.AtpNameNs") - -data AtpNameLn = - AtpNameLn { - atpNameLnPnameNs :: PnameNs, - atpNameLnPnLocal :: PnLocal} - deriving (Eq, Ord, Read, Show) - -_AtpNameLn = (Core.Name "hydra/langs/shex/syntax.AtpNameLn") - -_AtpNameLn_pnameNs = (Core.Name "pnameNs") - -_AtpNameLn_pnLocal = (Core.Name "pnLocal") - -data Regexp = - Regexp { - regexpListOfAlts :: [Regexp_ListOfAlts_Elmt], - regexpListOfRegex :: [String]} - deriving (Eq, Ord, Read, Show) - -_Regexp = (Core.Name "hydra/langs/shex/syntax.Regexp") - -_Regexp_listOfAlts = (Core.Name "listOfAlts") - -_Regexp_listOfRegex = (Core.Name "listOfRegex") - -data Regexp_ListOfAlts_Elmt = - Regexp_ListOfAlts_ElmtRegex String | - Regexp_ListOfAlts_ElmtSequence String | - Regexp_ListOfAlts_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_Regexp_ListOfAlts_Elmt = (Core.Name "hydra/langs/shex/syntax.Regexp.ListOfAlts.Elmt") - -_Regexp_ListOfAlts_Elmt_regex = (Core.Name "regex") - -_Regexp_ListOfAlts_Elmt_sequence = (Core.Name "sequence") - -_Regexp_ListOfAlts_Elmt_uchar = (Core.Name "uchar") - -data BlankNodeLabel = - BlankNodeLabel { - blankNodeLabelAlts :: BlankNodeLabel_Alts, - blankNodeLabelListOfAlts :: (Maybe [BlankNodeLabel_ListOfAlts_Option_Elmt]), - blankNodeLabelPnChars :: PnChars} - deriving (Eq, Ord, Read, Show) - -_BlankNodeLabel = (Core.Name "hydra/langs/shex/syntax.BlankNodeLabel") - -_BlankNodeLabel_alts = (Core.Name "alts") - -_BlankNodeLabel_listOfAlts = (Core.Name "listOfAlts") - -_BlankNodeLabel_pnChars = (Core.Name "pnChars") - -data BlankNodeLabel_Alts = - BlankNodeLabel_AltsPnCharsU PnCharsU | - BlankNodeLabel_AltsRegex String - deriving (Eq, Ord, Read, Show) - -_BlankNodeLabel_Alts = (Core.Name "hydra/langs/shex/syntax.BlankNodeLabel.Alts") - -_BlankNodeLabel_Alts_pnCharsU = (Core.Name "pnCharsU") - -_BlankNodeLabel_Alts_regex = (Core.Name "regex") - -data BlankNodeLabel_ListOfAlts_Option_Elmt = - BlankNodeLabel_ListOfAlts_Option_ElmtPnChars PnChars | - BlankNodeLabel_ListOfAlts_Option_ElmtPeriod - deriving (Eq, Ord, Read, Show) - -_BlankNodeLabel_ListOfAlts_Option_Elmt = (Core.Name "hydra/langs/shex/syntax.BlankNodeLabel.ListOfAlts.Option.Elmt") - -_BlankNodeLabel_ListOfAlts_Option_Elmt_pnChars = (Core.Name "pnChars") - -_BlankNodeLabel_ListOfAlts_Option_Elmt_period = (Core.Name "period") - -newtype LangTag = - LangTag { - unLangTag :: String} - deriving (Eq, Ord, Read, Show) - -_LangTag = (Core.Name "hydra/langs/shex/syntax.LangTag") - -newtype Integer_ = - Integer_ { - unInteger :: String} - deriving (Eq, Ord, Read, Show) - -_Integer = (Core.Name "hydra/langs/shex/syntax.Integer") - -newtype Decimal = - Decimal { - unDecimal :: String} - deriving (Eq, Ord, Read, Show) - -_Decimal = (Core.Name "hydra/langs/shex/syntax.Decimal") - -newtype Double_ = - Double_ { - unDouble :: String} - deriving (Eq, Ord, Read, Show) - -_Double = (Core.Name "hydra/langs/shex/syntax.Double") - -newtype StringLiteral1 = - StringLiteral1 { - unStringLiteral1 :: [StringLiteral1_Elmt]} - deriving (Eq, Ord, Read, Show) - -_StringLiteral1 = (Core.Name "hydra/langs/shex/syntax.StringLiteral1") - -data StringLiteral1_Elmt = - StringLiteral1_ElmtRegex String | - StringLiteral1_ElmtEchar Echar | - StringLiteral1_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_StringLiteral1_Elmt = (Core.Name "hydra/langs/shex/syntax.StringLiteral1.Elmt") - -_StringLiteral1_Elmt_regex = (Core.Name "regex") - -_StringLiteral1_Elmt_echar = (Core.Name "echar") - -_StringLiteral1_Elmt_uchar = (Core.Name "uchar") - -newtype StringLiteral2 = - StringLiteral2 { - unStringLiteral2 :: [StringLiteral2_Elmt]} - deriving (Eq, Ord, Read, Show) - -_StringLiteral2 = (Core.Name "hydra/langs/shex/syntax.StringLiteral2") - -data StringLiteral2_Elmt = - StringLiteral2_ElmtRegex String | - StringLiteral2_ElmtEchar Echar | - StringLiteral2_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_StringLiteral2_Elmt = (Core.Name "hydra/langs/shex/syntax.StringLiteral2.Elmt") - -_StringLiteral2_Elmt_regex = (Core.Name "regex") - -_StringLiteral2_Elmt_echar = (Core.Name "echar") - -_StringLiteral2_Elmt_uchar = (Core.Name "uchar") - -newtype StringLiteralLong1 = - StringLiteralLong1 { - unStringLiteralLong1 :: [StringLiteralLong1_Elmt]} - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong1 = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong1") - -data StringLiteralLong1_Elmt = - StringLiteralLong1_ElmtSequence StringLiteralLong1_Elmt_Sequence | - StringLiteralLong1_ElmtEchar Echar | - StringLiteralLong1_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong1_Elmt = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong1.Elmt") - -_StringLiteralLong1_Elmt_sequence = (Core.Name "sequence") - -_StringLiteralLong1_Elmt_echar = (Core.Name "echar") - -_StringLiteralLong1_Elmt_uchar = (Core.Name "uchar") - -data StringLiteralLong1_Elmt_Sequence = - StringLiteralLong1_Elmt_Sequence { - stringLiteralLong1_Elmt_SequenceAlts :: (Maybe StringLiteralLong1_Elmt_Sequence_Alts_Option), - stringLiteralLong1_Elmt_SequenceRegex :: String} - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong1_Elmt_Sequence = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong1.Elmt.Sequence") - -_StringLiteralLong1_Elmt_Sequence_alts = (Core.Name "alts") - -_StringLiteralLong1_Elmt_Sequence_regex = (Core.Name "regex") - -data StringLiteralLong1_Elmt_Sequence_Alts_Option = - StringLiteralLong1_Elmt_Sequence_Alts_OptionApos | - StringLiteralLong1_Elmt_Sequence_Alts_OptionSequence StringLiteralLong1_Elmt_Sequence_Alts_Option_Sequence - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong1_Elmt_Sequence_Alts_Option = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong1.Elmt.Sequence.Alts.Option") - -_StringLiteralLong1_Elmt_Sequence_Alts_Option_apos = (Core.Name "apos") - -_StringLiteralLong1_Elmt_Sequence_Alts_Option_sequence = (Core.Name "sequence") - -data StringLiteralLong1_Elmt_Sequence_Alts_Option_Sequence = - StringLiteralLong1_Elmt_Sequence_Alts_Option_Sequence {} - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong1_Elmt_Sequence_Alts_Option_Sequence = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong1.Elmt.Sequence.Alts.Option.Sequence") - -newtype StringLiteralLong2 = - StringLiteralLong2 { - unStringLiteralLong2 :: [StringLiteralLong2_Elmt]} - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong2 = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong2") - -data StringLiteralLong2_Elmt = - StringLiteralLong2_ElmtSequence StringLiteralLong2_Elmt_Sequence | - StringLiteralLong2_ElmtEchar Echar | - StringLiteralLong2_ElmtUchar Uchar - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong2_Elmt = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong2.Elmt") - -_StringLiteralLong2_Elmt_sequence = (Core.Name "sequence") - -_StringLiteralLong2_Elmt_echar = (Core.Name "echar") - -_StringLiteralLong2_Elmt_uchar = (Core.Name "uchar") - -data StringLiteralLong2_Elmt_Sequence = - StringLiteralLong2_Elmt_Sequence { - stringLiteralLong2_Elmt_SequenceAlts :: (Maybe StringLiteralLong2_Elmt_Sequence_Alts_Option), - stringLiteralLong2_Elmt_SequenceRegex :: String} - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong2_Elmt_Sequence = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong2.Elmt.Sequence") - -_StringLiteralLong2_Elmt_Sequence_alts = (Core.Name "alts") - -_StringLiteralLong2_Elmt_Sequence_regex = (Core.Name "regex") - -data StringLiteralLong2_Elmt_Sequence_Alts_Option = - StringLiteralLong2_Elmt_Sequence_Alts_OptionQuot | - StringLiteralLong2_Elmt_Sequence_Alts_OptionSequence StringLiteralLong2_Elmt_Sequence_Alts_Option_Sequence - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong2_Elmt_Sequence_Alts_Option = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong2.Elmt.Sequence.Alts.Option") - -_StringLiteralLong2_Elmt_Sequence_Alts_Option_quot = (Core.Name "quot") - -_StringLiteralLong2_Elmt_Sequence_Alts_Option_sequence = (Core.Name "sequence") - -data StringLiteralLong2_Elmt_Sequence_Alts_Option_Sequence = - StringLiteralLong2_Elmt_Sequence_Alts_Option_Sequence {} - deriving (Eq, Ord, Read, Show) - -_StringLiteralLong2_Elmt_Sequence_Alts_Option_Sequence = (Core.Name "hydra/langs/shex/syntax.StringLiteralLong2.Elmt.Sequence.Alts.Option.Sequence") - -data Uchar = - UcharSequence Uchar_Sequence | - UcharSequence2 Uchar_Sequence2 - deriving (Eq, Ord, Read, Show) - -_Uchar = (Core.Name "hydra/langs/shex/syntax.Uchar") - -_Uchar_sequence = (Core.Name "sequence") - -_Uchar_sequence2 = (Core.Name "sequence2") - -data Uchar_Sequence = - Uchar_Sequence { - uchar_SequenceHex :: Hex, - uchar_SequenceHex2 :: Hex, - uchar_SequenceHex3 :: Hex, - uchar_SequenceHex4 :: Hex} - deriving (Eq, Ord, Read, Show) - -_Uchar_Sequence = (Core.Name "hydra/langs/shex/syntax.Uchar.Sequence") - -_Uchar_Sequence_hex = (Core.Name "hex") - -_Uchar_Sequence_hex2 = (Core.Name "hex2") - -_Uchar_Sequence_hex3 = (Core.Name "hex3") - -_Uchar_Sequence_hex4 = (Core.Name "hex4") - -data Uchar_Sequence2 = - Uchar_Sequence2 { - uchar_Sequence2Hex :: Hex, - uchar_Sequence2Hex2 :: Hex, - uchar_Sequence2Hex3 :: Hex, - uchar_Sequence2Hex4 :: Hex, - uchar_Sequence2Hex5 :: Hex, - uchar_Sequence2Hex6 :: Hex, - uchar_Sequence2Hex7 :: Hex, - uchar_Sequence2Hex8 :: Hex} - deriving (Eq, Ord, Read, Show) - -_Uchar_Sequence2 = (Core.Name "hydra/langs/shex/syntax.Uchar.Sequence2") - -_Uchar_Sequence2_hex = (Core.Name "hex") - -_Uchar_Sequence2_hex2 = (Core.Name "hex2") - -_Uchar_Sequence2_hex3 = (Core.Name "hex3") - -_Uchar_Sequence2_hex4 = (Core.Name "hex4") - -_Uchar_Sequence2_hex5 = (Core.Name "hex5") - -_Uchar_Sequence2_hex6 = (Core.Name "hex6") - -_Uchar_Sequence2_hex7 = (Core.Name "hex7") - -_Uchar_Sequence2_hex8 = (Core.Name "hex8") - -newtype Echar = - Echar { - unEchar :: String} - deriving (Eq, Ord, Read, Show) - -_Echar = (Core.Name "hydra/langs/shex/syntax.Echar") - -data PnCharsBase = - PnCharsBaseRegex String | - PnCharsBaseRegex2 String - deriving (Eq, Ord, Read, Show) - -_PnCharsBase = (Core.Name "hydra/langs/shex/syntax.PnCharsBase") - -_PnCharsBase_regex = (Core.Name "regex") - -_PnCharsBase_regex2 = (Core.Name "regex2") - -data PnCharsU = - PnCharsUPnCharsBase PnCharsBase | - PnCharsULowbar - deriving (Eq, Ord, Read, Show) - -_PnCharsU = (Core.Name "hydra/langs/shex/syntax.PnCharsU") - -_PnCharsU_pnCharsBase = (Core.Name "pnCharsBase") - -_PnCharsU_lowbar = (Core.Name "lowbar") - -data PnChars = - PnCharsPnCharsU PnCharsU | - PnCharsMinus | - PnCharsRegex String - deriving (Eq, Ord, Read, Show) - -_PnChars = (Core.Name "hydra/langs/shex/syntax.PnChars") - -_PnChars_pnCharsU = (Core.Name "pnCharsU") - -_PnChars_minus = (Core.Name "minus") - -_PnChars_regex = (Core.Name "regex") - -data PnPrefix = - PnPrefix { - pnPrefixPnCharsBase :: PnCharsBase, - pnPrefixSequence :: (Maybe PnPrefix_Sequence_Option)} - deriving (Eq, Ord, Read, Show) - -_PnPrefix = (Core.Name "hydra/langs/shex/syntax.PnPrefix") - -_PnPrefix_pnCharsBase = (Core.Name "pnCharsBase") - -_PnPrefix_sequence = (Core.Name "sequence") - -data PnPrefix_Sequence_Option = - PnPrefix_Sequence_Option { - pnPrefix_Sequence_OptionAlts :: PnPrefix_Sequence_Option_Alts, - pnPrefix_Sequence_OptionPnChars :: PnChars} - deriving (Eq, Ord, Read, Show) - -_PnPrefix_Sequence_Option = (Core.Name "hydra/langs/shex/syntax.PnPrefix.Sequence.Option") - -_PnPrefix_Sequence_Option_alts = (Core.Name "alts") - -_PnPrefix_Sequence_Option_pnChars = (Core.Name "pnChars") - -data PnPrefix_Sequence_Option_Alts = - PnPrefix_Sequence_Option_AltsPnChars PnChars | - PnPrefix_Sequence_Option_AltsPeriod - deriving (Eq, Ord, Read, Show) - -_PnPrefix_Sequence_Option_Alts = (Core.Name "hydra/langs/shex/syntax.PnPrefix.Sequence.Option.Alts") - -_PnPrefix_Sequence_Option_Alts_pnChars = (Core.Name "pnChars") - -_PnPrefix_Sequence_Option_Alts_period = (Core.Name "period") - -data PnLocal = - PnLocal { - pnLocalAlts :: PnLocal_Alts, - pnLocalSequence :: (Maybe PnLocal_Sequence_Option)} - deriving (Eq, Ord, Read, Show) - -_PnLocal = (Core.Name "hydra/langs/shex/syntax.PnLocal") - -_PnLocal_alts = (Core.Name "alts") - -_PnLocal_sequence = (Core.Name "sequence") - -data PnLocal_Alts = - PnLocal_AltsPnCharsU PnCharsU | - PnLocal_AltsColon | - PnLocal_AltsRegex String | - PnLocal_AltsPlx Plx - deriving (Eq, Ord, Read, Show) - -_PnLocal_Alts = (Core.Name "hydra/langs/shex/syntax.PnLocal.Alts") - -_PnLocal_Alts_pnCharsU = (Core.Name "pnCharsU") - -_PnLocal_Alts_colon = (Core.Name "colon") - -_PnLocal_Alts_regex = (Core.Name "regex") - -_PnLocal_Alts_plx = (Core.Name "plx") - -data PnLocal_Sequence_Option = - PnLocal_Sequence_Option { - pnLocal_Sequence_OptionListOfAlts :: [PnLocal_Sequence_Option_ListOfAlts_Elmt], - pnLocal_Sequence_OptionAlts :: PnLocal_Sequence_Option_Alts} - deriving (Eq, Ord, Read, Show) - -_PnLocal_Sequence_Option = (Core.Name "hydra/langs/shex/syntax.PnLocal.Sequence.Option") - -_PnLocal_Sequence_Option_listOfAlts = (Core.Name "listOfAlts") - -_PnLocal_Sequence_Option_alts = (Core.Name "alts") - -data PnLocal_Sequence_Option_ListOfAlts_Elmt = - PnLocal_Sequence_Option_ListOfAlts_ElmtPnChars PnChars | - PnLocal_Sequence_Option_ListOfAlts_ElmtPeriod | - PnLocal_Sequence_Option_ListOfAlts_ElmtColon | - PnLocal_Sequence_Option_ListOfAlts_ElmtPlx Plx - deriving (Eq, Ord, Read, Show) - -_PnLocal_Sequence_Option_ListOfAlts_Elmt = (Core.Name "hydra/langs/shex/syntax.PnLocal.Sequence.Option.ListOfAlts.Elmt") - -_PnLocal_Sequence_Option_ListOfAlts_Elmt_pnChars = (Core.Name "pnChars") - -_PnLocal_Sequence_Option_ListOfAlts_Elmt_period = (Core.Name "period") - -_PnLocal_Sequence_Option_ListOfAlts_Elmt_colon = (Core.Name "colon") - -_PnLocal_Sequence_Option_ListOfAlts_Elmt_plx = (Core.Name "plx") - -data PnLocal_Sequence_Option_Alts = - PnLocal_Sequence_Option_AltsPnChars PnChars | - PnLocal_Sequence_Option_AltsColon | - PnLocal_Sequence_Option_AltsPlx Plx - deriving (Eq, Ord, Read, Show) - -_PnLocal_Sequence_Option_Alts = (Core.Name "hydra/langs/shex/syntax.PnLocal.Sequence.Option.Alts") - -_PnLocal_Sequence_Option_Alts_pnChars = (Core.Name "pnChars") - -_PnLocal_Sequence_Option_Alts_colon = (Core.Name "colon") - -_PnLocal_Sequence_Option_Alts_plx = (Core.Name "plx") - -data Plx = - PlxPercent Percent | - PlxPnLocalEsc PnLocalEsc - deriving (Eq, Ord, Read, Show) - -_Plx = (Core.Name "hydra/langs/shex/syntax.Plx") - -_Plx_percent = (Core.Name "percent") - -_Plx_pnLocalEsc = (Core.Name "pnLocalEsc") - -data Percent = - Percent { - percentHex :: Hex, - percentHex2 :: Hex} - deriving (Eq, Ord, Read, Show) - -_Percent = (Core.Name "hydra/langs/shex/syntax.Percent") - -_Percent_hex = (Core.Name "hex") - -_Percent_hex2 = (Core.Name "hex2") - -newtype Hex = - Hex { - unHex :: String} - deriving (Eq, Ord, Read, Show) - -_Hex = (Core.Name "hydra/langs/shex/syntax.Hex") - -newtype PnLocalEsc = - PnLocalEsc { - unPnLocalEsc :: String} - deriving (Eq, Ord, Read, Show) - -_PnLocalEsc = (Core.Name "hydra/langs/shex/syntax.PnLocalEsc") diff --git a/src/gen-main/haskell/Hydra/Langs/Sql/Ansi.hs b/src/gen-main/haskell/Hydra/Langs/Sql/Ansi.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Sql/Ansi.hs +++ /dev/null @@ -1,1373 +0,0 @@ --- | A subset of ANSI SQL:2003, capturing selected productions of the BNF grammar provided at https://ronsavage.github.io/SQL/sql-2003-2.bnf.html, which is based on the Final Committee Draft (FCD) of ISO/IEC 9075-2:2003 - -module Hydra.Langs.Sql.Ansi where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype ApproximateNumericLiteral = - ApproximateNumericLiteral { - unApproximateNumericLiteral :: String} - deriving (Eq, Ord, Read, Show) - -_ApproximateNumericLiteral = (Core.Name "hydra/langs/sql/ansi.ApproximateNumericLiteral") - -data BinaryStringLiteral = - BinaryStringLiteral {} - deriving (Eq, Ord, Read, Show) - -_BinaryStringLiteral = (Core.Name "hydra/langs/sql/ansi.BinaryStringLiteral") - -newtype CharacterStringLiteral = - CharacterStringLiteral { - unCharacterStringLiteral :: String} - deriving (Eq, Ord, Read, Show) - -_CharacterStringLiteral = (Core.Name "hydra/langs/sql/ansi.CharacterStringLiteral") - -newtype ColumnName = - ColumnName { - unColumnName :: String} - deriving (Eq, Ord, Read, Show) - -_ColumnName = (Core.Name "hydra/langs/sql/ansi.ColumnName") - -data DateString = - DateString {} - deriving (Eq, Ord, Read, Show) - -_DateString = (Core.Name "hydra/langs/sql/ansi.DateString") - -newtype DomainName = - DomainName { - unDomainName :: String} - deriving (Eq, Ord, Read, Show) - -_DomainName = (Core.Name "hydra/langs/sql/ansi.DomainName") - -newtype ExactNumericLiteral = - ExactNumericLiteral { - unExactNumericLiteral :: String} - deriving (Eq, Ord, Read, Show) - -_ExactNumericLiteral = (Core.Name "hydra/langs/sql/ansi.ExactNumericLiteral") - -newtype LeftBracketOrTrigraph = - LeftBracketOrTrigraph { - unLeftBracketOrTrigraph :: String} - deriving (Eq, Ord, Read, Show) - -_LeftBracketOrTrigraph = (Core.Name "hydra/langs/sql/ansi.LeftBracketOrTrigraph") - -newtype RightBracketOrTrigraph = - RightBracketOrTrigraph { - unRightBracketOrTrigraph :: String} - deriving (Eq, Ord, Read, Show) - -_RightBracketOrTrigraph = (Core.Name "hydra/langs/sql/ansi.RightBracketOrTrigraph") - -data NationalCharacterStringLiteral = - NationalCharacterStringLiteral {} - deriving (Eq, Ord, Read, Show) - -_NationalCharacterStringLiteral = (Core.Name "hydra/langs/sql/ansi.NationalCharacterStringLiteral") - -newtype PathResolvedUserDefinedTypeName = - PathResolvedUserDefinedTypeName { - unPathResolvedUserDefinedTypeName :: String} - deriving (Eq, Ord, Read, Show) - -_PathResolvedUserDefinedTypeName = (Core.Name "hydra/langs/sql/ansi.PathResolvedUserDefinedTypeName") - -newtype TableName = - TableName { - unTableName :: String} - deriving (Eq, Ord, Read, Show) - -_TableName = (Core.Name "hydra/langs/sql/ansi.TableName") - -data TimeString = - TimeString {} - deriving (Eq, Ord, Read, Show) - -_TimeString = (Core.Name "hydra/langs/sql/ansi.TimeString") - -data TimestampLiteral = - TimestampLiteral {} - deriving (Eq, Ord, Read, Show) - -_TimestampLiteral = (Core.Name "hydra/langs/sql/ansi.TimestampLiteral") - -data UnicodeCharacterStringLiteral = - UnicodeCharacterStringLiteral {} - deriving (Eq, Ord, Read, Show) - -_UnicodeCharacterStringLiteral = (Core.Name "hydra/langs/sql/ansi.UnicodeCharacterStringLiteral") - -newtype UnsignedInteger = - UnsignedInteger { - unUnsignedInteger :: String} - deriving (Eq, Ord, Read, Show) - -_UnsignedInteger = (Core.Name "hydra/langs/sql/ansi.UnsignedInteger") - -data ApproximateNumericType = - ApproximateNumericTypeFloat (Maybe Precision) | - ApproximateNumericTypeReal | - ApproximateNumericTypeDouble - deriving (Eq, Ord, Read, Show) - -_ApproximateNumericType = (Core.Name "hydra/langs/sql/ansi.ApproximateNumericType") - -_ApproximateNumericType_float = (Core.Name "float") - -_ApproximateNumericType_real = (Core.Name "real") - -_ApproximateNumericType_double = (Core.Name "double") - -newtype ArrayElement = - ArrayElement { - unArrayElement :: ValueExpression} - deriving (Eq, Ord, Read, Show) - -_ArrayElement = (Core.Name "hydra/langs/sql/ansi.ArrayElement") - -data ArrayElementList = - ArrayElementList { - arrayElementListFirst :: ArrayElement, - arrayElementListRest :: [ArrayElement]} - deriving (Eq, Ord, Read, Show) - -_ArrayElementList = (Core.Name "hydra/langs/sql/ansi.ArrayElementList") - -_ArrayElementList_first = (Core.Name "first") - -_ArrayElementList_rest = (Core.Name "rest") - -data ArrayElementReference = - ArrayElementReference {} - deriving (Eq, Ord, Read, Show) - -_ArrayElementReference = (Core.Name "hydra/langs/sql/ansi.ArrayElementReference") - -data ArrayType = - ArrayType {} - deriving (Eq, Ord, Read, Show) - -_ArrayType = (Core.Name "hydra/langs/sql/ansi.ArrayType") - -data ArrayValueConstructor = - ArrayValueConstructorEnumeration ArrayValueConstructorByEnumeration | - ArrayValueConstructorQuery ArrayValueConstructorByQuery - deriving (Eq, Ord, Read, Show) - -_ArrayValueConstructor = (Core.Name "hydra/langs/sql/ansi.ArrayValueConstructor") - -_ArrayValueConstructor_enumeration = (Core.Name "enumeration") - -_ArrayValueConstructor_query = (Core.Name "query") - -data ArrayValueConstructorByQuery = - ArrayValueConstructorByQuery {} - deriving (Eq, Ord, Read, Show) - -_ArrayValueConstructorByQuery = (Core.Name "hydra/langs/sql/ansi.ArrayValueConstructorByQuery") - -data ArrayValueConstructorByEnumeration = - ArrayValueConstructorByEnumeration { - arrayValueConstructorByEnumerationLeftBracketOrTrigraph :: LeftBracketOrTrigraph, - arrayValueConstructorByEnumerationArrayElementList :: ArrayElementList, - arrayValueConstructorByEnumerationRightBracketOrTrigraph :: RightBracketOrTrigraph} - deriving (Eq, Ord, Read, Show) - -_ArrayValueConstructorByEnumeration = (Core.Name "hydra/langs/sql/ansi.ArrayValueConstructorByEnumeration") - -_ArrayValueConstructorByEnumeration_leftBracketOrTrigraph = (Core.Name "leftBracketOrTrigraph") - -_ArrayValueConstructorByEnumeration_arrayElementList = (Core.Name "arrayElementList") - -_ArrayValueConstructorByEnumeration_rightBracketOrTrigraph = (Core.Name "rightBracketOrTrigraph") - -data ArrayValueExpression = - ArrayValueExpression {} - deriving (Eq, Ord, Read, Show) - -_ArrayValueExpression = (Core.Name "hydra/langs/sql/ansi.ArrayValueExpression") - -data AsSubqueryClause = - AsSubqueryClause {} - deriving (Eq, Ord, Read, Show) - -_AsSubqueryClause = (Core.Name "hydra/langs/sql/ansi.AsSubqueryClause") - -data AttributeOrMethodReference = - AttributeOrMethodReference {} - deriving (Eq, Ord, Read, Show) - -_AttributeOrMethodReference = (Core.Name "hydra/langs/sql/ansi.AttributeOrMethodReference") - -data BinaryLargeObjectStringType = - BinaryLargeObjectStringTypeBinary (Maybe LargeObjectLength) | - BinaryLargeObjectStringTypeBlob (Maybe LargeObjectLength) - deriving (Eq, Ord, Read, Show) - -_BinaryLargeObjectStringType = (Core.Name "hydra/langs/sql/ansi.BinaryLargeObjectStringType") - -_BinaryLargeObjectStringType_binary = (Core.Name "binary") - -_BinaryLargeObjectStringType_blob = (Core.Name "blob") - -data BooleanFactor = - BooleanFactor { - booleanFactorNOT :: (Maybe ()), - booleanFactorBooleanTest :: BooleanTest} - deriving (Eq, Ord, Read, Show) - -_BooleanFactor = (Core.Name "hydra/langs/sql/ansi.BooleanFactor") - -_BooleanFactor_nOT = (Core.Name "nOT") - -_BooleanFactor_booleanTest = (Core.Name "booleanTest") - -data BooleanLiteral = - BooleanLiteralTRUE | - BooleanLiteralFALSE | - BooleanLiteralUNKNOWN - deriving (Eq, Ord, Read, Show) - -_BooleanLiteral = (Core.Name "hydra/langs/sql/ansi.BooleanLiteral") - -_BooleanLiteral_tRUE = (Core.Name "tRUE") - -_BooleanLiteral_fALSE = (Core.Name "fALSE") - -_BooleanLiteral_uNKNOWN = (Core.Name "uNKNOWN") - -data BooleanPredicand = - BooleanPredicand {} - deriving (Eq, Ord, Read, Show) - -_BooleanPredicand = (Core.Name "hydra/langs/sql/ansi.BooleanPredicand") - -data BooleanPrimary = - BooleanPrimaryPredicate Predicate | - BooleanPrimaryPredicand BooleanPredicand - deriving (Eq, Ord, Read, Show) - -_BooleanPrimary = (Core.Name "hydra/langs/sql/ansi.BooleanPrimary") - -_BooleanPrimary_predicate = (Core.Name "predicate") - -_BooleanPrimary_predicand = (Core.Name "predicand") - -data BooleanTerm = - BooleanTermFactor BooleanFactor | - BooleanTermAnd BooleanTerm_And - deriving (Eq, Ord, Read, Show) - -_BooleanTerm = (Core.Name "hydra/langs/sql/ansi.BooleanTerm") - -_BooleanTerm_factor = (Core.Name "factor") - -_BooleanTerm_and = (Core.Name "and") - -data BooleanTerm_And = - BooleanTerm_And { - booleanTerm_AndLhs :: BooleanTerm, - booleanTerm_AndRhs :: BooleanFactor} - deriving (Eq, Ord, Read, Show) - -_BooleanTerm_And = (Core.Name "hydra/langs/sql/ansi.BooleanTerm.And") - -_BooleanTerm_And_lhs = (Core.Name "lhs") - -_BooleanTerm_And_rhs = (Core.Name "rhs") - -data BooleanTest = - BooleanTest { - booleanTestBooleanPrimary :: BooleanPrimary, - booleanTestSequence :: (Maybe BooleanTest_Sequence_Option)} - deriving (Eq, Ord, Read, Show) - -_BooleanTest = (Core.Name "hydra/langs/sql/ansi.BooleanTest") - -_BooleanTest_booleanPrimary = (Core.Name "booleanPrimary") - -_BooleanTest_sequence = (Core.Name "sequence") - -data BooleanTest_Sequence_Option = - BooleanTest_Sequence_Option { - booleanTest_Sequence_OptionNOT :: (Maybe ()), - booleanTest_Sequence_OptionTruthValue :: TruthValue} - deriving (Eq, Ord, Read, Show) - -_BooleanTest_Sequence_Option = (Core.Name "hydra/langs/sql/ansi.BooleanTest.Sequence.Option") - -_BooleanTest_Sequence_Option_nOT = (Core.Name "nOT") - -_BooleanTest_Sequence_Option_truthValue = (Core.Name "truthValue") - -data BooleanType = - BooleanType {} - deriving (Eq, Ord, Read, Show) - -_BooleanType = (Core.Name "hydra/langs/sql/ansi.BooleanType") - -data BooleanValueExpression = - BooleanValueExpressionTerm BooleanTerm | - BooleanValueExpressionOr BooleanValueExpression_Or - deriving (Eq, Ord, Read, Show) - -_BooleanValueExpression = (Core.Name "hydra/langs/sql/ansi.BooleanValueExpression") - -_BooleanValueExpression_term = (Core.Name "term") - -_BooleanValueExpression_or = (Core.Name "or") - -data BooleanValueExpression_Or = - BooleanValueExpression_Or { - booleanValueExpression_OrLhs :: BooleanValueExpression, - booleanValueExpression_OrRhs :: BooleanTerm} - deriving (Eq, Ord, Read, Show) - -_BooleanValueExpression_Or = (Core.Name "hydra/langs/sql/ansi.BooleanValueExpression.Or") - -_BooleanValueExpression_Or_lhs = (Core.Name "lhs") - -_BooleanValueExpression_Or_rhs = (Core.Name "rhs") - -data CaseExpression = - CaseExpression {} - deriving (Eq, Ord, Read, Show) - -_CaseExpression = (Core.Name "hydra/langs/sql/ansi.CaseExpression") - -data CastSpecification = - CastSpecification {} - deriving (Eq, Ord, Read, Show) - -_CastSpecification = (Core.Name "hydra/langs/sql/ansi.CastSpecification") - -data CharacterSetSpecification = - CharacterSetSpecification {} - deriving (Eq, Ord, Read, Show) - -_CharacterSetSpecification = (Core.Name "hydra/langs/sql/ansi.CharacterSetSpecification") - -data CharacterStringType = - CharacterStringTypeCharacter (Maybe Length) | - CharacterStringTypeChar (Maybe Length) | - CharacterStringTypeCharacterVarying Length | - CharacterStringTypeCharVarying Length | - CharacterStringTypeVarchar Length | - CharacterStringTypeCharacterLargeObject (Maybe LargeObjectLength) | - CharacterStringTypeCharLargeObject (Maybe LargeObjectLength) | - CharacterStringTypeClob (Maybe LargeObjectLength) - deriving (Eq, Ord, Read, Show) - -_CharacterStringType = (Core.Name "hydra/langs/sql/ansi.CharacterStringType") - -_CharacterStringType_character = (Core.Name "character") - -_CharacterStringType_char = (Core.Name "char") - -_CharacterStringType_characterVarying = (Core.Name "characterVarying") - -_CharacterStringType_charVarying = (Core.Name "charVarying") - -_CharacterStringType_varchar = (Core.Name "varchar") - -_CharacterStringType_characterLargeObject = (Core.Name "characterLargeObject") - -_CharacterStringType_charLargeObject = (Core.Name "charLargeObject") - -_CharacterStringType_clob = (Core.Name "clob") - -data CollateClause = - CollateClause {} - deriving (Eq, Ord, Read, Show) - -_CollateClause = (Core.Name "hydra/langs/sql/ansi.CollateClause") - -data CollectionType = - CollectionTypeArray ArrayType | - CollectionTypeMultiset MultisetType - deriving (Eq, Ord, Read, Show) - -_CollectionType = (Core.Name "hydra/langs/sql/ansi.CollectionType") - -_CollectionType_array = (Core.Name "array") - -_CollectionType_multiset = (Core.Name "multiset") - -data CollectionValueConstructor = - CollectionValueConstructorArray ArrayValueConstructor | - CollectionValueConstructorMultiset MultisetValueConstructor - deriving (Eq, Ord, Read, Show) - -_CollectionValueConstructor = (Core.Name "hydra/langs/sql/ansi.CollectionValueConstructor") - -_CollectionValueConstructor_array = (Core.Name "array") - -_CollectionValueConstructor_multiset = (Core.Name "multiset") - -data CollectionValueExpression = - CollectionValueExpressionArray ArrayValueExpression | - CollectionValueExpressionMultiset MultisetValueExpression - deriving (Eq, Ord, Read, Show) - -_CollectionValueExpression = (Core.Name "hydra/langs/sql/ansi.CollectionValueExpression") - -_CollectionValueExpression_array = (Core.Name "array") - -_CollectionValueExpression_multiset = (Core.Name "multiset") - -data ColumnConstraintDefinition = - ColumnConstraintDefinition {} - deriving (Eq, Ord, Read, Show) - -_ColumnConstraintDefinition = (Core.Name "hydra/langs/sql/ansi.ColumnConstraintDefinition") - -data ColumnDefinition = - ColumnDefinition { - columnDefinitionName :: ColumnName, - columnDefinitionTypeOrDomain :: (Maybe ColumnDefinition_TypeOrDomain_Option), - columnDefinitionRefScope :: (Maybe ReferenceScopeCheck), - columnDefinitionDefaultOrIdentityOrGeneration :: (Maybe ColumnDefinition_DefaultOrIdentityOrGeneration_Option), - columnDefinitionConstraints :: [ColumnConstraintDefinition], - columnDefinitionCollate :: (Maybe CollateClause)} - deriving (Eq, Ord, Read, Show) - -_ColumnDefinition = (Core.Name "hydra/langs/sql/ansi.ColumnDefinition") - -_ColumnDefinition_name = (Core.Name "name") - -_ColumnDefinition_typeOrDomain = (Core.Name "typeOrDomain") - -_ColumnDefinition_refScope = (Core.Name "refScope") - -_ColumnDefinition_defaultOrIdentityOrGeneration = (Core.Name "defaultOrIdentityOrGeneration") - -_ColumnDefinition_constraints = (Core.Name "constraints") - -_ColumnDefinition_collate = (Core.Name "collate") - -data ColumnDefinition_TypeOrDomain_Option = - ColumnDefinition_TypeOrDomain_OptionDataType DataType | - ColumnDefinition_TypeOrDomain_OptionDomainName DomainName - deriving (Eq, Ord, Read, Show) - -_ColumnDefinition_TypeOrDomain_Option = (Core.Name "hydra/langs/sql/ansi.ColumnDefinition.TypeOrDomain.Option") - -_ColumnDefinition_TypeOrDomain_Option_dataType = (Core.Name "dataType") - -_ColumnDefinition_TypeOrDomain_Option_domainName = (Core.Name "domainName") - -data ColumnDefinition_DefaultOrIdentityOrGeneration_Option = - ColumnDefinition_DefaultOrIdentityOrGeneration_OptionDefaultClause DefaultClause | - ColumnDefinition_DefaultOrIdentityOrGeneration_OptionIdentityColumnSpecification IdentityColumnSpecification | - ColumnDefinition_DefaultOrIdentityOrGeneration_OptionGenerationClause GenerationClause - deriving (Eq, Ord, Read, Show) - -_ColumnDefinition_DefaultOrIdentityOrGeneration_Option = (Core.Name "hydra/langs/sql/ansi.ColumnDefinition.DefaultOrIdentityOrGeneration.Option") - -_ColumnDefinition_DefaultOrIdentityOrGeneration_Option_defaultClause = (Core.Name "defaultClause") - -_ColumnDefinition_DefaultOrIdentityOrGeneration_Option_identityColumnSpecification = (Core.Name "identityColumnSpecification") - -_ColumnDefinition_DefaultOrIdentityOrGeneration_Option_generationClause = (Core.Name "generationClause") - -data ColumnNameList = - ColumnNameList { - columnNameListFirst :: ColumnName, - columnNameListRest :: [ColumnName]} - deriving (Eq, Ord, Read, Show) - -_ColumnNameList = (Core.Name "hydra/langs/sql/ansi.ColumnNameList") - -_ColumnNameList_first = (Core.Name "first") - -_ColumnNameList_rest = (Core.Name "rest") - -data ColumnOptions = - ColumnOptions {} - deriving (Eq, Ord, Read, Show) - -_ColumnOptions = (Core.Name "hydra/langs/sql/ansi.ColumnOptions") - -data ColumnReference = - ColumnReference {} - deriving (Eq, Ord, Read, Show) - -_ColumnReference = (Core.Name "hydra/langs/sql/ansi.ColumnReference") - -data CommonValueExpression = - CommonValueExpressionNumeric NumericValueExpression | - CommonValueExpressionString StringValueExpression | - CommonValueExpressionDatetime DatetimeValueExpression | - CommonValueExpressionInterval IntervalValueExpression | - CommonValueExpressionUserDefined UserDefinedTypeValueExpression | - CommonValueExpressionReference ReferenceValueExpression | - CommonValueExpressionCollection CollectionValueExpression - deriving (Eq, Ord, Read, Show) - -_CommonValueExpression = (Core.Name "hydra/langs/sql/ansi.CommonValueExpression") - -_CommonValueExpression_numeric = (Core.Name "numeric") - -_CommonValueExpression_string = (Core.Name "string") - -_CommonValueExpression_datetime = (Core.Name "datetime") - -_CommonValueExpression_interval = (Core.Name "interval") - -_CommonValueExpression_userDefined = (Core.Name "userDefined") - -_CommonValueExpression_reference = (Core.Name "reference") - -_CommonValueExpression_collection = (Core.Name "collection") - -data ContextuallyTypedRowValueExpression = - ContextuallyTypedRowValueExpressionSpecialCase RowValueSpecialCase | - ContextuallyTypedRowValueExpressionConstructor ContextuallyTypedRowValueConstructor - deriving (Eq, Ord, Read, Show) - -_ContextuallyTypedRowValueExpression = (Core.Name "hydra/langs/sql/ansi.ContextuallyTypedRowValueExpression") - -_ContextuallyTypedRowValueExpression_specialCase = (Core.Name "specialCase") - -_ContextuallyTypedRowValueExpression_constructor = (Core.Name "constructor") - -data ContextuallyTypedRowValueConstructor = - ContextuallyTypedRowValueConstructor {} - deriving (Eq, Ord, Read, Show) - -_ContextuallyTypedRowValueConstructor = (Core.Name "hydra/langs/sql/ansi.ContextuallyTypedRowValueConstructor") - -data ContextuallyTypedRowValueExpressionList = - ContextuallyTypedRowValueExpressionList { - contextuallyTypedRowValueExpressionListFirst :: ContextuallyTypedRowValueExpression, - contextuallyTypedRowValueExpressionListRest :: [ContextuallyTypedRowValueExpression]} - deriving (Eq, Ord, Read, Show) - -_ContextuallyTypedRowValueExpressionList = (Core.Name "hydra/langs/sql/ansi.ContextuallyTypedRowValueExpressionList") - -_ContextuallyTypedRowValueExpressionList_first = (Core.Name "first") - -_ContextuallyTypedRowValueExpressionList_rest = (Core.Name "rest") - -newtype ContextuallyTypedTableValueConstructor = - ContextuallyTypedTableValueConstructor { - unContextuallyTypedTableValueConstructor :: ContextuallyTypedRowValueExpressionList} - deriving (Eq, Ord, Read, Show) - -_ContextuallyTypedTableValueConstructor = (Core.Name "hydra/langs/sql/ansi.ContextuallyTypedTableValueConstructor") - -data DataType = - DataTypePredefined PredefinedType | - DataTypeRow RowType | - DataTypeNamed PathResolvedUserDefinedTypeName | - DataTypeReference ReferenceType | - DataTypeCollection CollectionType - deriving (Eq, Ord, Read, Show) - -_DataType = (Core.Name "hydra/langs/sql/ansi.DataType") - -_DataType_predefined = (Core.Name "predefined") - -_DataType_row = (Core.Name "row") - -_DataType_named = (Core.Name "named") - -_DataType_reference = (Core.Name "reference") - -_DataType_collection = (Core.Name "collection") - -newtype DateLiteral = - DateLiteral { - unDateLiteral :: DateString} - deriving (Eq, Ord, Read, Show) - -_DateLiteral = (Core.Name "hydra/langs/sql/ansi.DateLiteral") - -data DatetimeLiteral = - DatetimeLiteralDate DateLiteral | - DatetimeLiteralTime TimeLiteral | - DatetimeLiteralTimestamp TimestampLiteral - deriving (Eq, Ord, Read, Show) - -_DatetimeLiteral = (Core.Name "hydra/langs/sql/ansi.DatetimeLiteral") - -_DatetimeLiteral_date = (Core.Name "date") - -_DatetimeLiteral_time = (Core.Name "time") - -_DatetimeLiteral_timestamp = (Core.Name "timestamp") - -data DatetimeType = - DatetimeType {} - deriving (Eq, Ord, Read, Show) - -_DatetimeType = (Core.Name "hydra/langs/sql/ansi.DatetimeType") - -data DatetimeValueExpression = - DatetimeValueExpression {} - deriving (Eq, Ord, Read, Show) - -_DatetimeValueExpression = (Core.Name "hydra/langs/sql/ansi.DatetimeValueExpression") - -data DefaultClause = - DefaultClause {} - deriving (Eq, Ord, Read, Show) - -_DefaultClause = (Core.Name "hydra/langs/sql/ansi.DefaultClause") - -data ExactNumericType = - ExactNumericTypeNumeric (Maybe ExactNumericType_Numeric_Option) | - ExactNumericTypeDecimal (Maybe ExactNumericType_Decimal_Option) | - ExactNumericTypeDec (Maybe ExactNumericType_Dec_Option) | - ExactNumericTypeSmallint | - ExactNumericTypeInteger | - ExactNumericTypeInt | - ExactNumericTypeBigint - deriving (Eq, Ord, Read, Show) - -_ExactNumericType = (Core.Name "hydra/langs/sql/ansi.ExactNumericType") - -_ExactNumericType_numeric = (Core.Name "numeric") - -_ExactNumericType_decimal = (Core.Name "decimal") - -_ExactNumericType_dec = (Core.Name "dec") - -_ExactNumericType_smallint = (Core.Name "smallint") - -_ExactNumericType_integer = (Core.Name "integer") - -_ExactNumericType_int = (Core.Name "int") - -_ExactNumericType_bigint = (Core.Name "bigint") - -data ExactNumericType_Numeric_Option = - ExactNumericType_Numeric_Option { - exactNumericType_Numeric_OptionPrecision :: Precision, - exactNumericType_Numeric_OptionSequence :: (Maybe Scale)} - deriving (Eq, Ord, Read, Show) - -_ExactNumericType_Numeric_Option = (Core.Name "hydra/langs/sql/ansi.ExactNumericType.Numeric.Option") - -_ExactNumericType_Numeric_Option_precision = (Core.Name "precision") - -_ExactNumericType_Numeric_Option_sequence = (Core.Name "sequence") - -data ExactNumericType_Decimal_Option = - ExactNumericType_Decimal_Option { - exactNumericType_Decimal_OptionPrecision :: Precision, - exactNumericType_Decimal_OptionSequence :: (Maybe Scale)} - deriving (Eq, Ord, Read, Show) - -_ExactNumericType_Decimal_Option = (Core.Name "hydra/langs/sql/ansi.ExactNumericType.Decimal.Option") - -_ExactNumericType_Decimal_Option_precision = (Core.Name "precision") - -_ExactNumericType_Decimal_Option_sequence = (Core.Name "sequence") - -data ExactNumericType_Dec_Option = - ExactNumericType_Dec_Option { - exactNumericType_Dec_OptionPrecision :: Precision, - exactNumericType_Dec_OptionSequence :: (Maybe Scale)} - deriving (Eq, Ord, Read, Show) - -_ExactNumericType_Dec_Option = (Core.Name "hydra/langs/sql/ansi.ExactNumericType.Dec.Option") - -_ExactNumericType_Dec_Option_precision = (Core.Name "precision") - -_ExactNumericType_Dec_Option_sequence = (Core.Name "sequence") - -data FieldReference = - FieldReference {} - deriving (Eq, Ord, Read, Show) - -_FieldReference = (Core.Name "hydra/langs/sql/ansi.FieldReference") - -data FromConstructor = - FromConstructor { - fromConstructorColumns :: (Maybe InsertColumnList), - fromConstructorOverride :: (Maybe OverrideClause), - fromConstructorValues :: ContextuallyTypedTableValueConstructor} - deriving (Eq, Ord, Read, Show) - -_FromConstructor = (Core.Name "hydra/langs/sql/ansi.FromConstructor") - -_FromConstructor_columns = (Core.Name "columns") - -_FromConstructor_override = (Core.Name "override") - -_FromConstructor_values = (Core.Name "values") - -data FromDefault = - FromDefault {} - deriving (Eq, Ord, Read, Show) - -_FromDefault = (Core.Name "hydra/langs/sql/ansi.FromDefault") - -data FromSubquery = - FromSubquery {} - deriving (Eq, Ord, Read, Show) - -_FromSubquery = (Core.Name "hydra/langs/sql/ansi.FromSubquery") - -data GeneralLiteral = - GeneralLiteralString CharacterStringLiteral | - GeneralLiteralNationalString NationalCharacterStringLiteral | - GeneralLiteralUnicode UnicodeCharacterStringLiteral | - GeneralLiteralBinary BinaryStringLiteral | - GeneralLiteralDateTime DatetimeLiteral | - GeneralLiteralInterval IntervalLiteral | - GeneralLiteralBoolean BooleanLiteral - deriving (Eq, Ord, Read, Show) - -_GeneralLiteral = (Core.Name "hydra/langs/sql/ansi.GeneralLiteral") - -_GeneralLiteral_string = (Core.Name "string") - -_GeneralLiteral_nationalString = (Core.Name "nationalString") - -_GeneralLiteral_unicode = (Core.Name "unicode") - -_GeneralLiteral_binary = (Core.Name "binary") - -_GeneralLiteral_dateTime = (Core.Name "dateTime") - -_GeneralLiteral_interval = (Core.Name "interval") - -_GeneralLiteral_boolean = (Core.Name "boolean") - -data GeneralValueSpecification = - GeneralValueSpecification {} - deriving (Eq, Ord, Read, Show) - -_GeneralValueSpecification = (Core.Name "hydra/langs/sql/ansi.GeneralValueSpecification") - -data GenerationClause = - GenerationClause {} - deriving (Eq, Ord, Read, Show) - -_GenerationClause = (Core.Name "hydra/langs/sql/ansi.GenerationClause") - -data GlobalOrLocal = - GlobalOrLocalGlobal | - GlobalOrLocalLocal - deriving (Eq, Ord, Read, Show) - -_GlobalOrLocal = (Core.Name "hydra/langs/sql/ansi.GlobalOrLocal") - -_GlobalOrLocal_global = (Core.Name "global") - -_GlobalOrLocal_local = (Core.Name "local") - -data IdentityColumnSpecification = - IdentityColumnSpecification {} - deriving (Eq, Ord, Read, Show) - -_IdentityColumnSpecification = (Core.Name "hydra/langs/sql/ansi.IdentityColumnSpecification") - -newtype InsertColumnList = - InsertColumnList { - unInsertColumnList :: ColumnNameList} - deriving (Eq, Ord, Read, Show) - -_InsertColumnList = (Core.Name "hydra/langs/sql/ansi.InsertColumnList") - -data InsertColumnsAndSource = - InsertColumnsAndSourceSubquery FromSubquery | - InsertColumnsAndSourceConstructor FromConstructor | - InsertColumnsAndSourceDefault FromDefault - deriving (Eq, Ord, Read, Show) - -_InsertColumnsAndSource = (Core.Name "hydra/langs/sql/ansi.InsertColumnsAndSource") - -_InsertColumnsAndSource_subquery = (Core.Name "subquery") - -_InsertColumnsAndSource_constructor = (Core.Name "constructor") - -_InsertColumnsAndSource_default = (Core.Name "default") - -data InsertStatement = - InsertStatement { - insertStatementTarget :: InsertionTarget, - insertStatementColumnsAndSource :: InsertColumnsAndSource} - deriving (Eq, Ord, Read, Show) - -_InsertStatement = (Core.Name "hydra/langs/sql/ansi.InsertStatement") - -_InsertStatement_target = (Core.Name "target") - -_InsertStatement_columnsAndSource = (Core.Name "columnsAndSource") - -newtype InsertionTarget = - InsertionTarget { - unInsertionTarget :: TableName} - deriving (Eq, Ord, Read, Show) - -_InsertionTarget = (Core.Name "hydra/langs/sql/ansi.InsertionTarget") - -data IntervalLiteral = - IntervalLiteral {} - deriving (Eq, Ord, Read, Show) - -_IntervalLiteral = (Core.Name "hydra/langs/sql/ansi.IntervalLiteral") - -data IntervalType = - IntervalType {} - deriving (Eq, Ord, Read, Show) - -_IntervalType = (Core.Name "hydra/langs/sql/ansi.IntervalType") - -data IntervalValueExpression = - IntervalValueExpression {} - deriving (Eq, Ord, Read, Show) - -_IntervalValueExpression = (Core.Name "hydra/langs/sql/ansi.IntervalValueExpression") - -data LargeObjectLength = - LargeObjectLength {} - deriving (Eq, Ord, Read, Show) - -_LargeObjectLength = (Core.Name "hydra/langs/sql/ansi.LargeObjectLength") - -newtype Length = - Length { - unLength :: UnsignedInteger} - deriving (Eq, Ord, Read, Show) - -_Length = (Core.Name "hydra/langs/sql/ansi.Length") - -data LikeClause = - LikeClause {} - deriving (Eq, Ord, Read, Show) - -_LikeClause = (Core.Name "hydra/langs/sql/ansi.LikeClause") - -data MethodInvocation = - MethodInvocation {} - deriving (Eq, Ord, Read, Show) - -_MethodInvocation = (Core.Name "hydra/langs/sql/ansi.MethodInvocation") - -data MultisetElementReference = - MultisetElementReference {} - deriving (Eq, Ord, Read, Show) - -_MultisetElementReference = (Core.Name "hydra/langs/sql/ansi.MultisetElementReference") - -newtype MultisetType = - MultisetType { - unMultisetType :: DataType} - deriving (Eq, Ord, Read, Show) - -_MultisetType = (Core.Name "hydra/langs/sql/ansi.MultisetType") - -data MultisetValueConstructor = - MultisetValueConstructor {} - deriving (Eq, Ord, Read, Show) - -_MultisetValueConstructor = (Core.Name "hydra/langs/sql/ansi.MultisetValueConstructor") - -data MultisetValueExpression = - MultisetValueExpression {} - deriving (Eq, Ord, Read, Show) - -_MultisetValueExpression = (Core.Name "hydra/langs/sql/ansi.MultisetValueExpression") - -data NationalCharacterStringType = - NationalCharacterStringType {} - deriving (Eq, Ord, Read, Show) - -_NationalCharacterStringType = (Core.Name "hydra/langs/sql/ansi.NationalCharacterStringType") - -data NewSpecification = - NewSpecification {} - deriving (Eq, Ord, Read, Show) - -_NewSpecification = (Core.Name "hydra/langs/sql/ansi.NewSpecification") - -data NextValueExpression = - NextValueExpression {} - deriving (Eq, Ord, Read, Show) - -_NextValueExpression = (Core.Name "hydra/langs/sql/ansi.NextValueExpression") - -data NumericType = - NumericTypeExact ExactNumericType | - NumericTypeApproximate ApproximateNumericType - deriving (Eq, Ord, Read, Show) - -_NumericType = (Core.Name "hydra/langs/sql/ansi.NumericType") - -_NumericType_exact = (Core.Name "exact") - -_NumericType_approximate = (Core.Name "approximate") - -data NumericValueExpression = - NumericValueExpression {} - deriving (Eq, Ord, Read, Show) - -_NumericValueExpression = (Core.Name "hydra/langs/sql/ansi.NumericValueExpression") - -data OverrideClause = - OverrideClauseOVERRIDINGSpUSERSpVALUE | - OverrideClauseOVERRIDINGSpSYSTEMSpVALUE - deriving (Eq, Ord, Read, Show) - -_OverrideClause = (Core.Name "hydra/langs/sql/ansi.OverrideClause") - -_OverrideClause_oVERRIDINGSpUSERSpVALUE = (Core.Name "oVERRIDINGSpUSERSpVALUE") - -_OverrideClause_oVERRIDINGSpSYSTEMSpVALUE = (Core.Name "oVERRIDINGSpSYSTEMSpVALUE") - -newtype ParenthesizedValueExpression = - ParenthesizedValueExpression { - unParenthesizedValueExpression :: ValueExpression} - deriving (Eq, Ord, Read, Show) - -_ParenthesizedValueExpression = (Core.Name "hydra/langs/sql/ansi.ParenthesizedValueExpression") - -newtype Precision = - Precision { - unPrecision :: UnsignedInteger} - deriving (Eq, Ord, Read, Show) - -_Precision = (Core.Name "hydra/langs/sql/ansi.Precision") - -data PredefinedType = - PredefinedTypeString PredefinedType_String | - PredefinedTypeNationalString PredefinedType_NationalString | - PredefinedTypeBlob BinaryLargeObjectStringType | - PredefinedTypeNumeric NumericType | - PredefinedTypeBoolean BooleanType | - PredefinedTypeDatetime DatetimeType | - PredefinedTypeInterval IntervalType - deriving (Eq, Ord, Read, Show) - -_PredefinedType = (Core.Name "hydra/langs/sql/ansi.PredefinedType") - -_PredefinedType_string = (Core.Name "string") - -_PredefinedType_nationalString = (Core.Name "nationalString") - -_PredefinedType_blob = (Core.Name "blob") - -_PredefinedType_numeric = (Core.Name "numeric") - -_PredefinedType_boolean = (Core.Name "boolean") - -_PredefinedType_datetime = (Core.Name "datetime") - -_PredefinedType_interval = (Core.Name "interval") - -data PredefinedType_String = - PredefinedType_String { - predefinedType_StringType :: CharacterStringType, - predefinedType_StringCharacters :: (Maybe CharacterSetSpecification), - predefinedType_StringCollate :: (Maybe CollateClause)} - deriving (Eq, Ord, Read, Show) - -_PredefinedType_String = (Core.Name "hydra/langs/sql/ansi.PredefinedType.String") - -_PredefinedType_String_type = (Core.Name "type") - -_PredefinedType_String_characters = (Core.Name "characters") - -_PredefinedType_String_collate = (Core.Name "collate") - -data PredefinedType_NationalString = - PredefinedType_NationalString { - predefinedType_NationalStringType :: NationalCharacterStringType, - predefinedType_NationalStringCollate :: (Maybe CollateClause)} - deriving (Eq, Ord, Read, Show) - -_PredefinedType_NationalString = (Core.Name "hydra/langs/sql/ansi.PredefinedType.NationalString") - -_PredefinedType_NationalString_type = (Core.Name "type") - -_PredefinedType_NationalString_collate = (Core.Name "collate") - -data Predicate = - Predicate {} - deriving (Eq, Ord, Read, Show) - -_Predicate = (Core.Name "hydra/langs/sql/ansi.Predicate") - -data QueryExpression = - QueryExpression {} - deriving (Eq, Ord, Read, Show) - -_QueryExpression = (Core.Name "hydra/langs/sql/ansi.QueryExpression") - -data ReferenceScopeCheck = - ReferenceScopeCheck {} - deriving (Eq, Ord, Read, Show) - -_ReferenceScopeCheck = (Core.Name "hydra/langs/sql/ansi.ReferenceScopeCheck") - -data ReferenceType = - ReferenceType {} - deriving (Eq, Ord, Read, Show) - -_ReferenceType = (Core.Name "hydra/langs/sql/ansi.ReferenceType") - -data RowType = - RowType {} - deriving (Eq, Ord, Read, Show) - -_RowType = (Core.Name "hydra/langs/sql/ansi.RowType") - -newtype RowValueSpecialCase = - RowValueSpecialCase { - unRowValueSpecialCase :: NonparenthesizedValueExpressionPrimary} - deriving (Eq, Ord, Read, Show) - -_RowValueSpecialCase = (Core.Name "hydra/langs/sql/ansi.RowValueSpecialCase") - -data NonparenthesizedValueExpressionPrimary = - NonparenthesizedValueExpressionPrimaryUnsigned UnsignedValueSpecification | - NonparenthesizedValueExpressionPrimaryColumn ColumnReference | - NonparenthesizedValueExpressionPrimarySetFunction SetFunctionSpecification | - NonparenthesizedValueExpressionPrimaryWindowFunction WindowFunction | - NonparenthesizedValueExpressionPrimaryScalarSubquery ScalarSubquery | - NonparenthesizedValueExpressionPrimaryCases CaseExpression | - NonparenthesizedValueExpressionPrimaryCast CastSpecification | - NonparenthesizedValueExpressionPrimaryField FieldReference | - NonparenthesizedValueExpressionPrimarySubtype SubtypeTreatment | - NonparenthesizedValueExpressionPrimaryMethod MethodInvocation | - NonparenthesizedValueExpressionPrimaryStaticMethod StaticMethodInvocation | - NonparenthesizedValueExpressionPrimaryNew NewSpecification | - NonparenthesizedValueExpressionPrimaryAttributeOrMethod AttributeOrMethodReference | - NonparenthesizedValueExpressionPrimaryReference ReferenceResolution | - NonparenthesizedValueExpressionPrimaryCollection CollectionValueConstructor | - NonparenthesizedValueExpressionPrimaryArrayElement ArrayElementReference | - NonparenthesizedValueExpressionPrimaryMultisetElement MultisetElementReference | - NonparenthesizedValueExpressionPrimaryRoutine RoutineInvocation | - NonparenthesizedValueExpressionPrimaryNext NextValueExpression - deriving (Eq, Ord, Read, Show) - -_NonparenthesizedValueExpressionPrimary = (Core.Name "hydra/langs/sql/ansi.NonparenthesizedValueExpressionPrimary") - -_NonparenthesizedValueExpressionPrimary_unsigned = (Core.Name "unsigned") - -_NonparenthesizedValueExpressionPrimary_column = (Core.Name "column") - -_NonparenthesizedValueExpressionPrimary_setFunction = (Core.Name "setFunction") - -_NonparenthesizedValueExpressionPrimary_windowFunction = (Core.Name "windowFunction") - -_NonparenthesizedValueExpressionPrimary_scalarSubquery = (Core.Name "scalarSubquery") - -_NonparenthesizedValueExpressionPrimary_cases = (Core.Name "cases") - -_NonparenthesizedValueExpressionPrimary_cast = (Core.Name "cast") - -_NonparenthesizedValueExpressionPrimary_field = (Core.Name "field") - -_NonparenthesizedValueExpressionPrimary_subtype = (Core.Name "subtype") - -_NonparenthesizedValueExpressionPrimary_method = (Core.Name "method") - -_NonparenthesizedValueExpressionPrimary_staticMethod = (Core.Name "staticMethod") - -_NonparenthesizedValueExpressionPrimary_new = (Core.Name "new") - -_NonparenthesizedValueExpressionPrimary_attributeOrMethod = (Core.Name "attributeOrMethod") - -_NonparenthesizedValueExpressionPrimary_reference = (Core.Name "reference") - -_NonparenthesizedValueExpressionPrimary_collection = (Core.Name "collection") - -_NonparenthesizedValueExpressionPrimary_arrayElement = (Core.Name "arrayElement") - -_NonparenthesizedValueExpressionPrimary_multisetElement = (Core.Name "multisetElement") - -_NonparenthesizedValueExpressionPrimary_routine = (Core.Name "routine") - -_NonparenthesizedValueExpressionPrimary_next = (Core.Name "next") - -data ReferenceResolution = - ReferenceResolution {} - deriving (Eq, Ord, Read, Show) - -_ReferenceResolution = (Core.Name "hydra/langs/sql/ansi.ReferenceResolution") - -newtype ReferenceValueExpression = - ReferenceValueExpression { - unReferenceValueExpression :: ValueExpressionPrimary} - deriving (Eq, Ord, Read, Show) - -_ReferenceValueExpression = (Core.Name "hydra/langs/sql/ansi.ReferenceValueExpression") - -data RowValueExpression = - RowValueExpression {} - deriving (Eq, Ord, Read, Show) - -_RowValueExpression = (Core.Name "hydra/langs/sql/ansi.RowValueExpression") - -data RoutineInvocation = - RoutineInvocation {} - deriving (Eq, Ord, Read, Show) - -_RoutineInvocation = (Core.Name "hydra/langs/sql/ansi.RoutineInvocation") - -newtype ScalarSubquery = - ScalarSubquery { - unScalarSubquery :: Subquery} - deriving (Eq, Ord, Read, Show) - -_ScalarSubquery = (Core.Name "hydra/langs/sql/ansi.ScalarSubquery") - -newtype Scale = - Scale { - unScale :: UnsignedInteger} - deriving (Eq, Ord, Read, Show) - -_Scale = (Core.Name "hydra/langs/sql/ansi.Scale") - -data SelfReferencingColumnSpecification = - SelfReferencingColumnSpecification {} - deriving (Eq, Ord, Read, Show) - -_SelfReferencingColumnSpecification = (Core.Name "hydra/langs/sql/ansi.SelfReferencingColumnSpecification") - -data SetFunctionSpecification = - SetFunctionSpecification {} - deriving (Eq, Ord, Read, Show) - -_SetFunctionSpecification = (Core.Name "hydra/langs/sql/ansi.SetFunctionSpecification") - -data StaticMethodInvocation = - StaticMethodInvocation {} - deriving (Eq, Ord, Read, Show) - -_StaticMethodInvocation = (Core.Name "hydra/langs/sql/ansi.StaticMethodInvocation") - -data StringValueExpression = - StringValueExpression {} - deriving (Eq, Ord, Read, Show) - -_StringValueExpression = (Core.Name "hydra/langs/sql/ansi.StringValueExpression") - -newtype Subquery = - Subquery { - unSubquery :: QueryExpression} - deriving (Eq, Ord, Read, Show) - -_Subquery = (Core.Name "hydra/langs/sql/ansi.Subquery") - -data SubtableClause = - SubtableClause {} - deriving (Eq, Ord, Read, Show) - -_SubtableClause = (Core.Name "hydra/langs/sql/ansi.SubtableClause") - -data SubtypeTreatment = - SubtypeTreatment {} - deriving (Eq, Ord, Read, Show) - -_SubtypeTreatment = (Core.Name "hydra/langs/sql/ansi.SubtypeTreatment") - -data TableCommitAction = - TableCommitActionPreserve | - TableCommitActionDelete - deriving (Eq, Ord, Read, Show) - -_TableCommitAction = (Core.Name "hydra/langs/sql/ansi.TableCommitAction") - -_TableCommitAction_preserve = (Core.Name "preserve") - -_TableCommitAction_delete = (Core.Name "delete") - -data TableConstraintDefinition = - TableConstraintDefinition {} - deriving (Eq, Ord, Read, Show) - -_TableConstraintDefinition = (Core.Name "hydra/langs/sql/ansi.TableConstraintDefinition") - -data TableContentsSource = - TableContentsSourceList TableElementList | - TableContentsSourceSubtable TableContentsSource_Subtable | - TableContentsSourceSubquery AsSubqueryClause - deriving (Eq, Ord, Read, Show) - -_TableContentsSource = (Core.Name "hydra/langs/sql/ansi.TableContentsSource") - -_TableContentsSource_list = (Core.Name "list") - -_TableContentsSource_subtable = (Core.Name "subtable") - -_TableContentsSource_subquery = (Core.Name "subquery") - -data TableContentsSource_Subtable = - TableContentsSource_Subtable { - tableContentsSource_SubtableType :: PathResolvedUserDefinedTypeName, - tableContentsSource_SubtableSubtable :: (Maybe SubtableClause), - tableContentsSource_SubtableElements :: (Maybe TableElementList)} - deriving (Eq, Ord, Read, Show) - -_TableContentsSource_Subtable = (Core.Name "hydra/langs/sql/ansi.TableContentsSource.Subtable") - -_TableContentsSource_Subtable_type = (Core.Name "type") - -_TableContentsSource_Subtable_subtable = (Core.Name "subtable") - -_TableContentsSource_Subtable_elements = (Core.Name "elements") - -data TableDefinition = - TableDefinition { - tableDefinitionScope :: (Maybe TableScope), - tableDefinitionName :: TableName, - tableDefinitionSource :: TableContentsSource, - tableDefinitionCommitActions :: (Maybe TableCommitAction)} - deriving (Eq, Ord, Read, Show) - -_TableDefinition = (Core.Name "hydra/langs/sql/ansi.TableDefinition") - -_TableDefinition_scope = (Core.Name "scope") - -_TableDefinition_name = (Core.Name "name") - -_TableDefinition_source = (Core.Name "source") - -_TableDefinition_commitActions = (Core.Name "commitActions") - -data TableElement = - TableElementColumn ColumnDefinition | - TableElementTableConstraint TableConstraintDefinition | - TableElementLike LikeClause | - TableElementSelfReferencingColumn SelfReferencingColumnSpecification | - TableElementColumOptions ColumnOptions - deriving (Eq, Ord, Read, Show) - -_TableElement = (Core.Name "hydra/langs/sql/ansi.TableElement") - -_TableElement_column = (Core.Name "column") - -_TableElement_tableConstraint = (Core.Name "tableConstraint") - -_TableElement_like = (Core.Name "like") - -_TableElement_selfReferencingColumn = (Core.Name "selfReferencingColumn") - -_TableElement_columOptions = (Core.Name "columOptions") - -data TableElementList = - TableElementList { - tableElementListFirst :: TableElement, - tableElementListRest :: [TableElement]} - deriving (Eq, Ord, Read, Show) - -_TableElementList = (Core.Name "hydra/langs/sql/ansi.TableElementList") - -_TableElementList_first = (Core.Name "first") - -_TableElementList_rest = (Core.Name "rest") - -newtype TableScope = - TableScope { - unTableScope :: GlobalOrLocal} - deriving (Eq, Ord, Read, Show) - -_TableScope = (Core.Name "hydra/langs/sql/ansi.TableScope") - -newtype TimeLiteral = - TimeLiteral { - unTimeLiteral :: TimeString} - deriving (Eq, Ord, Read, Show) - -_TimeLiteral = (Core.Name "hydra/langs/sql/ansi.TimeLiteral") - -data TruthValue = - TruthValueTRUE | - TruthValueFALSE | - TruthValueUNKNOWN - deriving (Eq, Ord, Read, Show) - -_TruthValue = (Core.Name "hydra/langs/sql/ansi.TruthValue") - -_TruthValue_tRUE = (Core.Name "tRUE") - -_TruthValue_fALSE = (Core.Name "fALSE") - -_TruthValue_uNKNOWN = (Core.Name "uNKNOWN") - -data UnsignedLiteral = - UnsignedLiteralNumeric UnsignedNumericLiteral | - UnsignedLiteralGeneral GeneralLiteral - deriving (Eq, Ord, Read, Show) - -_UnsignedLiteral = (Core.Name "hydra/langs/sql/ansi.UnsignedLiteral") - -_UnsignedLiteral_numeric = (Core.Name "numeric") - -_UnsignedLiteral_general = (Core.Name "general") - -data UnsignedNumericLiteral = - UnsignedNumericLiteralExact ExactNumericLiteral | - UnsignedNumericLiteralApproximate ApproximateNumericLiteral - deriving (Eq, Ord, Read, Show) - -_UnsignedNumericLiteral = (Core.Name "hydra/langs/sql/ansi.UnsignedNumericLiteral") - -_UnsignedNumericLiteral_exact = (Core.Name "exact") - -_UnsignedNumericLiteral_approximate = (Core.Name "approximate") - -data UnsignedValueSpecification = - UnsignedValueSpecificationLiteral UnsignedLiteral | - UnsignedValueSpecificationGeneral GeneralValueSpecification - deriving (Eq, Ord, Read, Show) - -_UnsignedValueSpecification = (Core.Name "hydra/langs/sql/ansi.UnsignedValueSpecification") - -_UnsignedValueSpecification_literal = (Core.Name "literal") - -_UnsignedValueSpecification_general = (Core.Name "general") - -newtype UserDefinedTypeValueExpression = - UserDefinedTypeValueExpression { - unUserDefinedTypeValueExpression :: ValueExpressionPrimary} - deriving (Eq, Ord, Read, Show) - -_UserDefinedTypeValueExpression = (Core.Name "hydra/langs/sql/ansi.UserDefinedTypeValueExpression") - -data ValueExpression = - ValueExpressionCommon CommonValueExpression | - ValueExpressionBoolean BooleanValueExpression | - ValueExpressionRow RowValueExpression - deriving (Eq, Ord, Read, Show) - -_ValueExpression = (Core.Name "hydra/langs/sql/ansi.ValueExpression") - -_ValueExpression_common = (Core.Name "common") - -_ValueExpression_boolean = (Core.Name "boolean") - -_ValueExpression_row = (Core.Name "row") - -data ValueExpressionPrimary = - ValueExpressionPrimaryParens ParenthesizedValueExpression | - ValueExpressionPrimaryNoparens NonparenthesizedValueExpressionPrimary - deriving (Eq, Ord, Read, Show) - -_ValueExpressionPrimary = (Core.Name "hydra/langs/sql/ansi.ValueExpressionPrimary") - -_ValueExpressionPrimary_parens = (Core.Name "parens") - -_ValueExpressionPrimary_noparens = (Core.Name "noparens") - -data WindowFunction = - WindowFunction {} - deriving (Eq, Ord, Read, Show) - -_WindowFunction = (Core.Name "hydra/langs/sql/ansi.WindowFunction") diff --git a/src/gen-main/haskell/Hydra/Langs/Tabular.hs b/src/gen-main/haskell/Hydra/Langs/Tabular.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tabular.hs +++ /dev/null @@ -1,40 +0,0 @@ --- | A simple, untyped tabular data model, suitable for CSVs and TSVs - -module Hydra.Langs.Tabular where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | A data row, containing optional-valued cells; one per column -newtype DataRow v = - DataRow { - unDataRow :: [Maybe v]} - deriving (Eq, Ord, Read, Show) - -_DataRow = (Core.Name "hydra/langs/tabular.DataRow") - --- | A header row, containing column names (but no types or data) -newtype HeaderRow = - HeaderRow { - unHeaderRow :: [String]} - deriving (Eq, Ord, Read, Show) - -_HeaderRow = (Core.Name "hydra/langs/tabular.HeaderRow") - --- | A simple table as in a CSV file, having an optional header row and any number of data rows -data Table v = - Table { - -- | The optional header row of the table. If present, the header must have the same number of cells as each data row. - tableHeader :: (Maybe HeaderRow), - -- | The data rows of the table. Each row must have the same number of cells. - tableData :: [DataRow v]} - deriving (Eq, Ord, Read, Show) - -_Table = (Core.Name "hydra/langs/tabular.Table") - -_Table_header = (Core.Name "header") - -_Table_data = (Core.Name "data") diff --git a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Features.hs b/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Features.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Features.hs +++ /dev/null @@ -1,322 +0,0 @@ --- | A model derived from TinkerPop's Graph.Features. See --- | https://tinkerpop.apache.org/javadocs/current/core/org/apache/tinkerpop/gremlin/structure/Graph.Features.html --- | --- | An interface that represents the capabilities of a Graph implementation. --- | By default all methods of features return true and it is up to implementers to disable feature they don't support. --- | Users should check features prior to using various functions of TinkerPop to help ensure code portability across implementations. --- | For example, a common usage would be to check if a graph supports transactions prior to calling the commit method on Graph.tx(). - -module Hydra.Langs.Tinkerpop.Features where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | Base interface for features that relate to supporting different data types. -data DataTypeFeatures = - DataTypeFeatures { - -- | Supports setting of an array of boolean values. - dataTypeFeaturesSupportsBooleanArrayValues :: Bool, - -- | Supports setting of a boolean value. - dataTypeFeaturesSupportsBooleanValues :: Bool, - -- | Supports setting of an array of byte values. - dataTypeFeaturesSupportsByteArrayValues :: Bool, - -- | Supports setting of a byte value. - dataTypeFeaturesSupportsByteValues :: Bool, - -- | Supports setting of an array of double values. - dataTypeFeaturesSupportsDoubleArrayValues :: Bool, - -- | Supports setting of a double value. - dataTypeFeaturesSupportsDoubleValues :: Bool, - -- | Supports setting of an array of float values. - dataTypeFeaturesSupportsFloatArrayValues :: Bool, - -- | Supports setting of a float value. - dataTypeFeaturesSupportsFloatValues :: Bool, - -- | Supports setting of an array of integer values. - dataTypeFeaturesSupportsIntegerArrayValues :: Bool, - -- | Supports setting of a integer value. - dataTypeFeaturesSupportsIntegerValues :: Bool, - -- | Supports setting of an array of long values. - dataTypeFeaturesSupportsLongArrayValues :: Bool, - -- | Supports setting of a long value. - dataTypeFeaturesSupportsLongValues :: Bool, - -- | Supports setting of a Map value. - dataTypeFeaturesSupportsMapValues :: Bool, - -- | Supports setting of a List value. - dataTypeFeaturesSupportsMixedListValues :: Bool, - -- | Supports setting of a Java serializable value. - dataTypeFeaturesSupportsSerializableValues :: Bool, - -- | Supports setting of an array of string values. - dataTypeFeaturesSupportsStringArrayValues :: Bool, - -- | Supports setting of a string value. - dataTypeFeaturesSupportsStringValues :: Bool, - -- | Supports setting of a List value. - dataTypeFeaturesSupportsUniformListValues :: Bool} - deriving (Eq, Ord, Read, Show) - -_DataTypeFeatures = (Core.Name "hydra/langs/tinkerpop/features.DataTypeFeatures") - -_DataTypeFeatures_supportsBooleanArrayValues = (Core.Name "supportsBooleanArrayValues") - -_DataTypeFeatures_supportsBooleanValues = (Core.Name "supportsBooleanValues") - -_DataTypeFeatures_supportsByteArrayValues = (Core.Name "supportsByteArrayValues") - -_DataTypeFeatures_supportsByteValues = (Core.Name "supportsByteValues") - -_DataTypeFeatures_supportsDoubleArrayValues = (Core.Name "supportsDoubleArrayValues") - -_DataTypeFeatures_supportsDoubleValues = (Core.Name "supportsDoubleValues") - -_DataTypeFeatures_supportsFloatArrayValues = (Core.Name "supportsFloatArrayValues") - -_DataTypeFeatures_supportsFloatValues = (Core.Name "supportsFloatValues") - -_DataTypeFeatures_supportsIntegerArrayValues = (Core.Name "supportsIntegerArrayValues") - -_DataTypeFeatures_supportsIntegerValues = (Core.Name "supportsIntegerValues") - -_DataTypeFeatures_supportsLongArrayValues = (Core.Name "supportsLongArrayValues") - -_DataTypeFeatures_supportsLongValues = (Core.Name "supportsLongValues") - -_DataTypeFeatures_supportsMapValues = (Core.Name "supportsMapValues") - -_DataTypeFeatures_supportsMixedListValues = (Core.Name "supportsMixedListValues") - -_DataTypeFeatures_supportsSerializableValues = (Core.Name "supportsSerializableValues") - -_DataTypeFeatures_supportsStringArrayValues = (Core.Name "supportsStringArrayValues") - -_DataTypeFeatures_supportsStringValues = (Core.Name "supportsStringValues") - -_DataTypeFeatures_supportsUniformListValues = (Core.Name "supportsUniformListValues") - --- | Features that are related to Edge operations. -data EdgeFeatures = - EdgeFeatures { - edgeFeaturesElementFeatures :: ElementFeatures, - edgeFeaturesProperties :: EdgePropertyFeatures, - -- | Determines if an Edge can be added to a Vertex. - edgeFeaturesSupportsAddEdges :: Bool, - -- | Determines if an Edge can be removed from a Vertex. - edgeFeaturesSupportsRemoveEdges :: Bool, - -- | Determines if the Graph implementation uses upsert functionality as opposed to insert functionality for Vertex.addEdge(String, Vertex, Object...). - edgeFeaturesSupportsUpsert :: Bool} - deriving (Eq, Ord, Read, Show) - -_EdgeFeatures = (Core.Name "hydra/langs/tinkerpop/features.EdgeFeatures") - -_EdgeFeatures_elementFeatures = (Core.Name "elementFeatures") - -_EdgeFeatures_properties = (Core.Name "properties") - -_EdgeFeatures_supportsAddEdges = (Core.Name "supportsAddEdges") - -_EdgeFeatures_supportsRemoveEdges = (Core.Name "supportsRemoveEdges") - -_EdgeFeatures_supportsUpsert = (Core.Name "supportsUpsert") - --- | Features that are related to Edge Property objects. -data EdgePropertyFeatures = - EdgePropertyFeatures { - edgePropertyFeaturesPropertyFeatures :: PropertyFeatures} - deriving (Eq, Ord, Read, Show) - -_EdgePropertyFeatures = (Core.Name "hydra/langs/tinkerpop/features.EdgePropertyFeatures") - -_EdgePropertyFeatures_propertyFeatures = (Core.Name "propertyFeatures") - --- | Features that are related to Element objects. -data ElementFeatures = - ElementFeatures { - -- | Determines if an Element allows properties to be added. - elementFeaturesSupportsAddProperty :: Bool, - -- | Determines if an Element any Java object is a suitable identifier. - elementFeaturesSupportsAnyIds :: Bool, - -- | Determines if an Element has a specific custom object as their internal representation. - elementFeaturesSupportsCustomIds :: Bool, - -- | Determines if an Element has numeric identifiers as their internal representation. - elementFeaturesSupportsNumericIds :: Bool, - -- | Determines if an Element allows properties to be removed. - elementFeaturesSupportsRemoveProperty :: Bool, - -- | Determines if an Element has string identifiers as their internal representation. - elementFeaturesSupportsStringIds :: Bool, - -- | Determines if an Element can have a user defined identifier. - elementFeaturesSupportsUserSuppliedIds :: Bool, - -- | Determines if an Element has UUID identifiers as their internal representation. - elementFeaturesSupportsUuidIds :: Bool} - deriving (Eq, Ord, Read, Show) - -_ElementFeatures = (Core.Name "hydra/langs/tinkerpop/features.ElementFeatures") - -_ElementFeatures_supportsAddProperty = (Core.Name "supportsAddProperty") - -_ElementFeatures_supportsAnyIds = (Core.Name "supportsAnyIds") - -_ElementFeatures_supportsCustomIds = (Core.Name "supportsCustomIds") - -_ElementFeatures_supportsNumericIds = (Core.Name "supportsNumericIds") - -_ElementFeatures_supportsRemoveProperty = (Core.Name "supportsRemoveProperty") - -_ElementFeatures_supportsStringIds = (Core.Name "supportsStringIds") - -_ElementFeatures_supportsUserSuppliedIds = (Core.Name "supportsUserSuppliedIds") - -_ElementFeatures_supportsUuidIds = (Core.Name "supportsUuidIds") - --- | Additional features which are needed for the complete specification of language constraints in Hydra, above and beyond TinkerPop Graph.Features -data ExtraFeatures a = - ExtraFeatures { - extraFeaturesSupportsMapKey :: (Core.Type -> Bool)} - -_ExtraFeatures = (Core.Name "hydra/langs/tinkerpop/features.ExtraFeatures") - -_ExtraFeatures_supportsMapKey = (Core.Name "supportsMapKey") - --- | An interface that represents the capabilities of a Graph implementation. By default all methods of features return true and it is up to implementers to disable feature they don't support. Users should check features prior to using various functions of TinkerPop to help ensure code portability across implementations. For example, a common usage would be to check if a graph supports transactions prior to calling the commit method on Graph.tx(). --- | --- | As an additional notice to Graph Providers, feature methods will be used by the test suite to determine which tests will be ignored and which will be executed, therefore proper setting of these features is essential to maximizing the amount of testing performed by the suite. Further note, that these methods may be called by the TinkerPop core code to determine what operations may be appropriately executed which will have impact on features utilized by users. -data Features = - Features { - -- | Gets the features related to edge operation. - featuresEdge :: EdgeFeatures, - -- | Gets the features related to graph operation. - featuresGraph :: GraphFeatures, - -- | Gets the features related to vertex operation. - featuresVertex :: VertexFeatures} - deriving (Eq, Ord, Read, Show) - -_Features = (Core.Name "hydra/langs/tinkerpop/features.Features") - -_Features_edge = (Core.Name "edge") - -_Features_graph = (Core.Name "graph") - -_Features_vertex = (Core.Name "vertex") - --- | Features specific to a operations of a graph. -data GraphFeatures = - GraphFeatures { - -- | Determines if the Graph implementation supports GraphComputer based processing. - graphFeaturesSupportsComputer :: Bool, - -- | Determines if the Graph implementation supports more than one connection to the same instance at the same time. - graphFeaturesSupportsConcurrentAccess :: Bool, - -- | Determines if the Graph implementations supports read operations as executed with the GraphTraversalSource.io(String) step. - graphFeaturesSupportsIoRead :: Bool, - -- | Determines if the Graph implementations supports write operations as executed with the GraphTraversalSource.io(String) step. - graphFeaturesSupportsIoWrite :: Bool, - -- | Determines if the Graph implementation supports persisting it's contents natively to disk. - graphFeaturesSupportsPersistence :: Bool, - -- | Determines if the Graph implementation supports threaded transactions which allow a transaction to be executed across multiple threads via Transaction.createThreadedTx(). - graphFeaturesSupportsThreadedTransactions :: Bool, - -- | Determines if the Graph implementations supports transactions. - graphFeaturesSupportsTransactions :: Bool, - -- | Gets the features related to graph sideEffects operation. - graphFeaturesVariables :: VariableFeatures} - deriving (Eq, Ord, Read, Show) - -_GraphFeatures = (Core.Name "hydra/langs/tinkerpop/features.GraphFeatures") - -_GraphFeatures_supportsComputer = (Core.Name "supportsComputer") - -_GraphFeatures_supportsConcurrentAccess = (Core.Name "supportsConcurrentAccess") - -_GraphFeatures_supportsIoRead = (Core.Name "supportsIoRead") - -_GraphFeatures_supportsIoWrite = (Core.Name "supportsIoWrite") - -_GraphFeatures_supportsPersistence = (Core.Name "supportsPersistence") - -_GraphFeatures_supportsThreadedTransactions = (Core.Name "supportsThreadedTransactions") - -_GraphFeatures_supportsTransactions = (Core.Name "supportsTransactions") - -_GraphFeatures_variables = (Core.Name "variables") - --- | A base interface for Edge or Vertex Property features. -data PropertyFeatures = - PropertyFeatures { - propertyFeaturesDataTypeFeatures :: DataTypeFeatures, - -- | Determines if an Element allows for the processing of at least one data type defined by the features. - propertyFeaturesSupportsProperties :: Bool} - deriving (Eq, Ord, Read, Show) - -_PropertyFeatures = (Core.Name "hydra/langs/tinkerpop/features.PropertyFeatures") - -_PropertyFeatures_dataTypeFeatures = (Core.Name "dataTypeFeatures") - -_PropertyFeatures_supportsProperties = (Core.Name "supportsProperties") - --- | Features for Graph.Variables. -data VariableFeatures = - VariableFeatures { - variableFeaturesDataTypeFeatures :: DataTypeFeatures, - -- | If any of the features on Graph.Features.VariableFeatures is true then this value must be true. - variableFeaturesSupportsVariables :: Bool} - deriving (Eq, Ord, Read, Show) - -_VariableFeatures = (Core.Name "hydra/langs/tinkerpop/features.VariableFeatures") - -_VariableFeatures_dataTypeFeatures = (Core.Name "dataTypeFeatures") - -_VariableFeatures_supportsVariables = (Core.Name "supportsVariables") - --- | Features that are related to Vertex operations. -data VertexFeatures = - VertexFeatures { - vertexFeaturesElementFeatures :: ElementFeatures, - vertexFeaturesProperties :: VertexPropertyFeatures, - -- | Determines if a Vertex can be added to the Graph. - vertexFeaturesSupportsAddVertices :: Bool, - -- | Determines if a Vertex can support non-unique values on the same key. - vertexFeaturesSupportsDuplicateMultiProperties :: Bool, - -- | Determines if a Vertex can support properties on vertex properties. - vertexFeaturesSupportsMetaProperties :: Bool, - -- | Determines if a Vertex can support multiple properties with the same key. - vertexFeaturesSupportsMultiProperties :: Bool, - -- | Determines if a Vertex can be removed from the Graph. - vertexFeaturesSupportsRemoveVertices :: Bool, - -- | Determines if the Graph implementation uses upsert functionality as opposed to insert functionality for Graph.addVertex(String). - vertexFeaturesSupportsUpsert :: Bool} - deriving (Eq, Ord, Read, Show) - -_VertexFeatures = (Core.Name "hydra/langs/tinkerpop/features.VertexFeatures") - -_VertexFeatures_elementFeatures = (Core.Name "elementFeatures") - -_VertexFeatures_properties = (Core.Name "properties") - -_VertexFeatures_supportsAddVertices = (Core.Name "supportsAddVertices") - -_VertexFeatures_supportsDuplicateMultiProperties = (Core.Name "supportsDuplicateMultiProperties") - -_VertexFeatures_supportsMetaProperties = (Core.Name "supportsMetaProperties") - -_VertexFeatures_supportsMultiProperties = (Core.Name "supportsMultiProperties") - -_VertexFeatures_supportsRemoveVertices = (Core.Name "supportsRemoveVertices") - -_VertexFeatures_supportsUpsert = (Core.Name "supportsUpsert") - --- | Features that are related to Vertex Property objects. -data VertexPropertyFeatures = - VertexPropertyFeatures { - vertexPropertyFeaturesDataTypeFeatures :: DataTypeFeatures, - vertexPropertyFeaturesPropertyFeatures :: PropertyFeatures, - vertexPropertyFeaturesElementFeatures :: ElementFeatures, - -- | Determines if a VertexProperty allows properties to be removed. - vertexPropertyFeaturesSupportsRemove :: Bool} - deriving (Eq, Ord, Read, Show) - -_VertexPropertyFeatures = (Core.Name "hydra/langs/tinkerpop/features.VertexPropertyFeatures") - -_VertexPropertyFeatures_dataTypeFeatures = (Core.Name "dataTypeFeatures") - -_VertexPropertyFeatures_propertyFeatures = (Core.Name "propertyFeatures") - -_VertexPropertyFeatures_elementFeatures = (Core.Name "elementFeatures") - -_VertexPropertyFeatures_supportsRemove = (Core.Name "supportsRemove") diff --git a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Gremlin.hs b/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Gremlin.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Gremlin.hs +++ /dev/null @@ -1,2409 +0,0 @@ --- | A Gremlin model, based on the Gremlin ANTLR grammar (master branch, as of 2024-06-30). - -module Hydra.Langs.Tinkerpop.Gremlin where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype QueryList = - QueryList { - unQueryList :: [Query]} - deriving (Eq, Ord, Read, Show) - -_QueryList = (Core.Name "hydra/langs/tinkerpop/gremlin.QueryList") - -data Query = - QueryTraversalSource TraversalSourceQuery | - QueryRootTraversal RootTraversalQuery | - QueryToString | - QueryEmpty - deriving (Eq, Ord, Read, Show) - -_Query = (Core.Name "hydra/langs/tinkerpop/gremlin.Query") - -_Query_traversalSource = (Core.Name "traversalSource") - -_Query_rootTraversal = (Core.Name "rootTraversal") - -_Query_toString = (Core.Name "toString") - -_Query_empty = (Core.Name "empty") - -data TraversalSourceQuery = - TraversalSourceQuery { - traversalSourceQuerySource :: TraversalSource, - traversalSourceQueryTransactionPart :: (Maybe TransactionPart)} - deriving (Eq, Ord, Read, Show) - -_TraversalSourceQuery = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSourceQuery") - -_TraversalSourceQuery_source = (Core.Name "source") - -_TraversalSourceQuery_transactionPart = (Core.Name "transactionPart") - -data RootTraversalQuery = - RootTraversalQuery { - rootTraversalQueryRoot :: RootTraversal, - rootTraversalQueryTerminalMethod :: (Maybe TraversalTerminalMethod)} - deriving (Eq, Ord, Read, Show) - -_RootTraversalQuery = (Core.Name "hydra/langs/tinkerpop/gremlin.RootTraversalQuery") - -_RootTraversalQuery_root = (Core.Name "root") - -_RootTraversalQuery_terminalMethod = (Core.Name "terminalMethod") - -newtype TraversalSource = - TraversalSource { - unTraversalSource :: [TraversalSourceSelfMethod]} - deriving (Eq, Ord, Read, Show) - -_TraversalSource = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSource") - -data TransactionPart = - TransactionPartBegin | - TransactionPartCommit | - TransactionPartRollback - deriving (Eq, Ord, Read, Show) - -_TransactionPart = (Core.Name "hydra/langs/tinkerpop/gremlin.TransactionPart") - -_TransactionPart_begin = (Core.Name "begin") - -_TransactionPart_commit = (Core.Name "commit") - -_TransactionPart_rollback = (Core.Name "rollback") - -data RootTraversal = - RootTraversal { - rootTraversalSource :: TraversalSource, - rootTraversalSpawnMethod :: TraversalSourceSpawnMethod, - rootTraversalChained :: [ChainedTraversalElement]} - deriving (Eq, Ord, Read, Show) - -_RootTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.RootTraversal") - -_RootTraversal_source = (Core.Name "source") - -_RootTraversal_spawnMethod = (Core.Name "spawnMethod") - -_RootTraversal_chained = (Core.Name "chained") - -data TraversalSourceSelfMethod = - TraversalSourceSelfMethodWithBulk Bool | - TraversalSourceSelfMethodWithPath | - TraversalSourceSelfMethodWithSack GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument | - TraversalSourceSelfMethodWithSideEffect StringArgumentAndGenericLiteralArgument | - TraversalSourceSelfMethodWithStrategies [TraversalStrategy] | - TraversalSourceSelfMethodWithoutStrategies [Identifier] | - TraversalSourceSelfMethodWith StringArgumentAndOptionalGenericLiteralArgument - deriving (Eq, Ord, Read, Show) - -_TraversalSourceSelfMethod = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSourceSelfMethod") - -_TraversalSourceSelfMethod_withBulk = (Core.Name "withBulk") - -_TraversalSourceSelfMethod_withPath = (Core.Name "withPath") - -_TraversalSourceSelfMethod_withSack = (Core.Name "withSack") - -_TraversalSourceSelfMethod_withSideEffect = (Core.Name "withSideEffect") - -_TraversalSourceSelfMethod_withStrategies = (Core.Name "withStrategies") - -_TraversalSourceSelfMethod_withoutStrategies = (Core.Name "withoutStrategies") - -_TraversalSourceSelfMethod_with = (Core.Name "with") - -data GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument = - GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument { - genericLiteralArgumentAndOptionalTraversalBiFunctionArgumentLiteral :: GenericLiteralArgument, - genericLiteralArgumentAndOptionalTraversalBiFunctionArgumentBiFunction :: (Maybe TraversalBiFunctionArgument)} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument") - -_GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument_literal = (Core.Name "literal") - -_GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument_biFunction = (Core.Name "biFunction") - -data StringArgumentAndGenericLiteralArgument = - StringArgumentAndGenericLiteralArgument { - stringArgumentAndGenericLiteralArgumentString :: StringArgument, - stringArgumentAndGenericLiteralArgumentLiteral :: GenericLiteralArgument} - deriving (Eq, Ord, Read, Show) - -_StringArgumentAndGenericLiteralArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.StringArgumentAndGenericLiteralArgument") - -_StringArgumentAndGenericLiteralArgument_string = (Core.Name "string") - -_StringArgumentAndGenericLiteralArgument_literal = (Core.Name "literal") - -data StringArgumentAndOptionalGenericLiteralArgument = - StringArgumentAndOptionalGenericLiteralArgument { - stringArgumentAndOptionalGenericLiteralArgumentString :: StringArgument, - stringArgumentAndOptionalGenericLiteralArgumentLiteral :: (Maybe GenericLiteralArgument)} - deriving (Eq, Ord, Read, Show) - -_StringArgumentAndOptionalGenericLiteralArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.StringArgumentAndOptionalGenericLiteralArgument") - -_StringArgumentAndOptionalGenericLiteralArgument_string = (Core.Name "string") - -_StringArgumentAndOptionalGenericLiteralArgument_literal = (Core.Name "literal") - -data TraversalSourceSpawnMethod = - TraversalSourceSpawnMethodAddE StringArgumentOrNestedTraversal | - TraversalSourceSpawnMethodAddV (Maybe StringArgumentOrNestedTraversal) | - TraversalSourceSpawnMethodE [GenericLiteralArgument] | - TraversalSourceSpawnMethodV [GenericLiteralArgument] | - TraversalSourceSpawnMethodMergeV GenericLiteralMapNullableArgumentOrNestedTraversal | - TraversalSourceSpawnMethodMergeE GenericLiteralMapNullableArgumentOrNestedTraversal | - TraversalSourceSpawnMethodInject [GenericLiteralArgument] | - TraversalSourceSpawnMethodIo StringArgument | - TraversalSourceSpawnMethodCall (Maybe ServiceCall) | - TraversalSourceSpawnMethodUnion [NestedTraversal] - deriving (Eq, Ord, Read, Show) - -_TraversalSourceSpawnMethod = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSourceSpawnMethod") - -_TraversalSourceSpawnMethod_addE = (Core.Name "addE") - -_TraversalSourceSpawnMethod_addV = (Core.Name "addV") - -_TraversalSourceSpawnMethod_e = (Core.Name "e") - -_TraversalSourceSpawnMethod_v = (Core.Name "v") - -_TraversalSourceSpawnMethod_mergeV = (Core.Name "mergeV") - -_TraversalSourceSpawnMethod_mergeE = (Core.Name "mergeE") - -_TraversalSourceSpawnMethod_inject = (Core.Name "inject") - -_TraversalSourceSpawnMethod_io = (Core.Name "io") - -_TraversalSourceSpawnMethod_call = (Core.Name "call") - -_TraversalSourceSpawnMethod_union = (Core.Name "union") - -data GenericLiteralMapNullableArgumentOrNestedTraversal = - GenericLiteralMapNullableArgumentOrNestedTraversalMap GenericLiteralMapNullableArgument | - GenericLiteralMapNullableArgumentOrNestedTraversalTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_GenericLiteralMapNullableArgumentOrNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralMapNullableArgumentOrNestedTraversal") - -_GenericLiteralMapNullableArgumentOrNestedTraversal_map = (Core.Name "map") - -_GenericLiteralMapNullableArgumentOrNestedTraversal_traversal = (Core.Name "traversal") - -data ServiceCall = - ServiceCall { - serviceCallService :: StringArgument, - serviceCallArguments :: ServiceArguments} - deriving (Eq, Ord, Read, Show) - -_ServiceCall = (Core.Name "hydra/langs/tinkerpop/gremlin.ServiceCall") - -_ServiceCall_service = (Core.Name "service") - -_ServiceCall_arguments = (Core.Name "arguments") - -data ServiceArguments = - ServiceArgumentsMap (Maybe GenericLiteralMapArgument) | - ServiceArgumentsTraversal (Maybe NestedTraversal) - deriving (Eq, Ord, Read, Show) - -_ServiceArguments = (Core.Name "hydra/langs/tinkerpop/gremlin.ServiceArguments") - -_ServiceArguments_map = (Core.Name "map") - -_ServiceArguments_traversal = (Core.Name "traversal") - -data ChainedTraversal = - ChainedTraversal { - chainedTraversalFirst :: TraversalMethod, - chainedTraversalRest :: ChainedTraversalElement} - deriving (Eq, Ord, Read, Show) - -_ChainedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.ChainedTraversal") - -_ChainedTraversal_first = (Core.Name "first") - -_ChainedTraversal_rest = (Core.Name "rest") - -data ChainedTraversalElement = - ChainedTraversalElementMethod TraversalMethod | - ChainedTraversalElementSelf TraversalSelfMethod - deriving (Eq, Ord, Read, Show) - -_ChainedTraversalElement = (Core.Name "hydra/langs/tinkerpop/gremlin.ChainedTraversalElement") - -_ChainedTraversalElement_method = (Core.Name "method") - -_ChainedTraversalElement_self = (Core.Name "self") - -data NestedTraversal = - NestedTraversalRoot RootTraversal | - NestedTraversalChained ChainedTraversal | - NestedTraversalAnonymous ChainedTraversal - deriving (Eq, Ord, Read, Show) - -_NestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.NestedTraversal") - -_NestedTraversal_root = (Core.Name "root") - -_NestedTraversal_chained = (Core.Name "chained") - -_NestedTraversal_anonymous = (Core.Name "anonymous") - -data TerminatedTraversal = - TerminatedTraversal { - terminatedTraversalRoot :: RootTraversal, - terminatedTraversalTerminal :: TraversalTerminalMethod} - deriving (Eq, Ord, Read, Show) - -_TerminatedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.TerminatedTraversal") - -_TerminatedTraversal_root = (Core.Name "root") - -_TerminatedTraversal_terminal = (Core.Name "terminal") - -data TraversalMethod = - TraversalMethodV [GenericLiteralArgument] | - TraversalMethodE [GenericLiteralArgument] | - TraversalMethodAddE StringArgumentOrNestedTraversal | - TraversalMethodAddV (Maybe StringArgumentOrNestedTraversal) | - TraversalMethodMergeE (Maybe GenericLiteralMapNullableArgumentOrNestedTraversal) | - TraversalMethodMergeV (Maybe GenericLiteralMapNullableArgumentOrNestedTraversal) | - TraversalMethodAggregate OptionalTraversalScopeArgumentAndStringArgument | - TraversalMethodAll TraversalPredicate | - TraversalMethodAnd [NestedTraversal] | - TraversalMethodAny TraversalPredicate | - TraversalMethodAs StringArgumentAndOptionalStringLiteralVarargs | - TraversalMethodBarrier (Maybe TraversalSackMethodArgumentOrIntegerArgument) | - TraversalMethodBoth [StringNullableArgument] | - TraversalMethodBothE [StringNullableArgument] | - TraversalMethodBothV | - TraversalMethodBranch NestedTraversal | - TraversalMethodBy ByArgs | - TraversalMethodCap StringArgumentAndOptionalStringLiteralVarargs | - TraversalMethodChoose ChooseArgs | - TraversalMethodCoalesce [NestedTraversal] | - TraversalMethodCoin FloatArgument | - TraversalMethodConjoin StringArgument | - TraversalMethodConnectedComponent | - TraversalMethodConstant GenericLiteralArgument | - TraversalMethodCount (Maybe TraversalScopeArgument) | - TraversalMethodCyclicPath | - TraversalMethodDedup DedupArgs | - TraversalMethodDifference GenericLiteralArgument | - TraversalMethodDisjunct GenericLiteralArgument | - TraversalMethodDrop | - TraversalMethodElementMap [StringNullableArgument] | - TraversalMethodEmit (Maybe PredicateOrTraversal) | - TraversalMethodFilter PredicateOrTraversal | - TraversalMethodFlatMap NestedTraversal | - TraversalMethodFold (Maybe GenericLiteralArgumentAndTraversalBiFunctionArgument) | - TraversalMethodFrom FromArgs | - TraversalMethodGroup (Maybe StringArgument) | - TraversalMethodGroupCount (Maybe StringArgument) | - TraversalMethodHas HasArgs | - TraversalMethodHasId GenericLiteralArgumentAndTraversalPredicate | - TraversalMethodHasKey TraversalPredicateOrStringLiteralVarargs | - TraversalMethodHasLabel TraversalPredicateOrStringLiteralVarargs | - TraversalMethodHasNot StringNullableArgument | - TraversalMethodHasValue TraversalPredicateOrGenericLiteralArgument | - TraversalMethodId | - TraversalMethodIdentity | - TraversalMethodIn [StringNullableArgument] | - TraversalMethodInE [StringNullableArgument] | - TraversalMethodIntersect GenericLiteralArgument | - TraversalMethodInV | - TraversalMethodIndex | - TraversalMethodInject [GenericLiteralArgument] | - TraversalMethodIs TraversalPredicateOrGenericLiteralArgument | - TraversalMethodKey | - TraversalMethodLabel | - TraversalMethodLimit OptionalTraversalScopeArgumentAndIntegerArgument | - TraversalMethodLocal NestedTraversal | - TraversalMethodLoops (Maybe StringArgument) | - TraversalMethodMap NestedTraversal | - TraversalMethodMatch [NestedTraversal] | - TraversalMethodMath StringArgument | - TraversalMethodMax (Maybe TraversalScopeArgument) | - TraversalMethodMean (Maybe TraversalScopeArgument) | - TraversalMethodMin (Maybe TraversalScopeArgument) | - TraversalMethodNone TraversalPredicate | - TraversalMethodNot NestedTraversal | - TraversalMethodOption OptionArgs | - TraversalMethodOptional NestedTraversal | - TraversalMethodOr [NestedTraversal] | - TraversalMethodOrder (Maybe TraversalScopeArgument) | - TraversalMethodOtherV | - TraversalMethodOut [StringNullableArgument] | - TraversalMethodOutE [StringNullableArgument] | - TraversalMethodOutV | - TraversalMethodPageRank (Maybe FloatArgument) | - TraversalMethodPath | - TraversalMethodPeerPressure | - TraversalMethodProfile (Maybe StringArgument) | - TraversalMethodProject StringArgumentAndOptionalStringLiteralVarargs | - TraversalMethodProperties [StringNullableArgument] | - TraversalMethodProperty PropertyArgs | - TraversalMethodPropertyMap [StringNullableArgument] | - TraversalMethodRange RangeArgs | - TraversalMethodRead | - TraversalMethodRepeat OptionalStringArgumentAndNestedTraversal | - TraversalMethodSack (Maybe TraversalBiFunctionArgument) | - TraversalMethodSample OptionalTraversalScopeArgumentAndIntegerArgument | - TraversalMethodSelect SelectArgs | - TraversalMethodCombine GenericLiteralArgument | - TraversalMethodProduct GenericLiteralArgument | - TraversalMethodMerge GenericLiteralArgument | - TraversalMethodShortestPath | - TraversalMethodSideEffect NestedTraversal | - TraversalMethodSimplePath | - TraversalMethodSkip OptionalTraversalScopeArgumentAndIntegerArgument | - TraversalMethodStore StringArgument | - TraversalMethodSubgraph StringArgument | - TraversalMethodSum (Maybe TraversalScopeArgument) | - TraversalMethodTail (Maybe TailArgs) | - TraversalMethodFail (Maybe StringArgument) | - TraversalMethodTimes IntegerArgument | - TraversalMethodTo ToArgs | - TraversalMethodToE DirectionAndVarargs | - TraversalMethodToV TraversalDirectionArgument | - TraversalMethodTree (Maybe StringArgument) | - TraversalMethodUnfold | - TraversalMethodUnion [NestedTraversal] | - TraversalMethodUntil PredicateOrTraversal | - TraversalMethodValue | - TraversalMethodValueMap ValueMapArgs | - TraversalMethodValues [StringNullableArgument] | - TraversalMethodWhere WhereArgs | - TraversalMethodWith WithArgs | - TraversalMethodWrite | - TraversalMethodElement [StringNullableArgument] | - TraversalMethodCall ServiceCall | - TraversalMethodConcat ConcatArgs | - TraversalMethodAsString (Maybe TraversalScopeArgument) | - TraversalMethodFormat StringArgument | - TraversalMethodToUpper (Maybe TraversalScopeArgument) | - TraversalMethodToLower (Maybe TraversalScopeArgument) | - TraversalMethodLength (Maybe TraversalScopeArgument) | - TraversalMethodTrim (Maybe TraversalScopeArgument) | - TraversalMethodLTrim (Maybe TraversalScopeArgument) | - TraversalMethodRTrim (Maybe TraversalScopeArgument) | - TraversalMethodReverse | - TraversalMethodReplace ReplaceArgs | - TraversalMethodSplit SplitArgs | - TraversalMethodSubstring SubstringArgs | - TraversalMethodAsDate | - TraversalMethodDateAdd DateAddArgs | - TraversalMethodDateDiff DateDiffArgs - deriving (Eq, Ord, Read, Show) - -_TraversalMethod = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalMethod") - -_TraversalMethod_v = (Core.Name "v") - -_TraversalMethod_e = (Core.Name "e") - -_TraversalMethod_addE = (Core.Name "addE") - -_TraversalMethod_addV = (Core.Name "addV") - -_TraversalMethod_mergeE = (Core.Name "mergeE") - -_TraversalMethod_mergeV = (Core.Name "mergeV") - -_TraversalMethod_aggregate = (Core.Name "aggregate") - -_TraversalMethod_all = (Core.Name "all") - -_TraversalMethod_and = (Core.Name "and") - -_TraversalMethod_any = (Core.Name "any") - -_TraversalMethod_as = (Core.Name "as") - -_TraversalMethod_barrier = (Core.Name "barrier") - -_TraversalMethod_both = (Core.Name "both") - -_TraversalMethod_bothE = (Core.Name "bothE") - -_TraversalMethod_bothV = (Core.Name "bothV") - -_TraversalMethod_branch = (Core.Name "branch") - -_TraversalMethod_by = (Core.Name "by") - -_TraversalMethod_cap = (Core.Name "cap") - -_TraversalMethod_choose = (Core.Name "choose") - -_TraversalMethod_coalesce = (Core.Name "coalesce") - -_TraversalMethod_coin = (Core.Name "coin") - -_TraversalMethod_conjoin = (Core.Name "conjoin") - -_TraversalMethod_connectedComponent = (Core.Name "connectedComponent") - -_TraversalMethod_constant = (Core.Name "constant") - -_TraversalMethod_count = (Core.Name "count") - -_TraversalMethod_cyclicPath = (Core.Name "cyclicPath") - -_TraversalMethod_dedup = (Core.Name "dedup") - -_TraversalMethod_difference = (Core.Name "difference") - -_TraversalMethod_disjunct = (Core.Name "disjunct") - -_TraversalMethod_drop = (Core.Name "drop") - -_TraversalMethod_elementMap = (Core.Name "elementMap") - -_TraversalMethod_emit = (Core.Name "emit") - -_TraversalMethod_filter = (Core.Name "filter") - -_TraversalMethod_flatMap = (Core.Name "flatMap") - -_TraversalMethod_fold = (Core.Name "fold") - -_TraversalMethod_from = (Core.Name "from") - -_TraversalMethod_group = (Core.Name "group") - -_TraversalMethod_groupCount = (Core.Name "groupCount") - -_TraversalMethod_has = (Core.Name "has") - -_TraversalMethod_hasId = (Core.Name "hasId") - -_TraversalMethod_hasKey = (Core.Name "hasKey") - -_TraversalMethod_hasLabel = (Core.Name "hasLabel") - -_TraversalMethod_hasNot = (Core.Name "hasNot") - -_TraversalMethod_hasValue = (Core.Name "hasValue") - -_TraversalMethod_id = (Core.Name "id") - -_TraversalMethod_identity = (Core.Name "identity") - -_TraversalMethod_in = (Core.Name "in") - -_TraversalMethod_inE = (Core.Name "inE") - -_TraversalMethod_intersect = (Core.Name "intersect") - -_TraversalMethod_inV = (Core.Name "inV") - -_TraversalMethod_index = (Core.Name "index") - -_TraversalMethod_inject = (Core.Name "inject") - -_TraversalMethod_is = (Core.Name "is") - -_TraversalMethod_key = (Core.Name "key") - -_TraversalMethod_label = (Core.Name "label") - -_TraversalMethod_limit = (Core.Name "limit") - -_TraversalMethod_local = (Core.Name "local") - -_TraversalMethod_loops = (Core.Name "loops") - -_TraversalMethod_map = (Core.Name "map") - -_TraversalMethod_match = (Core.Name "match") - -_TraversalMethod_math = (Core.Name "math") - -_TraversalMethod_max = (Core.Name "max") - -_TraversalMethod_mean = (Core.Name "mean") - -_TraversalMethod_min = (Core.Name "min") - -_TraversalMethod_none = (Core.Name "none") - -_TraversalMethod_not = (Core.Name "not") - -_TraversalMethod_option = (Core.Name "option") - -_TraversalMethod_optional = (Core.Name "optional") - -_TraversalMethod_or = (Core.Name "or") - -_TraversalMethod_order = (Core.Name "order") - -_TraversalMethod_otherV = (Core.Name "otherV") - -_TraversalMethod_out = (Core.Name "out") - -_TraversalMethod_outE = (Core.Name "outE") - -_TraversalMethod_outV = (Core.Name "outV") - -_TraversalMethod_pageRank = (Core.Name "pageRank") - -_TraversalMethod_path = (Core.Name "path") - -_TraversalMethod_peerPressure = (Core.Name "peerPressure") - -_TraversalMethod_profile = (Core.Name "profile") - -_TraversalMethod_project = (Core.Name "project") - -_TraversalMethod_properties = (Core.Name "properties") - -_TraversalMethod_property = (Core.Name "property") - -_TraversalMethod_propertyMap = (Core.Name "propertyMap") - -_TraversalMethod_range = (Core.Name "range") - -_TraversalMethod_read = (Core.Name "read") - -_TraversalMethod_repeat = (Core.Name "repeat") - -_TraversalMethod_sack = (Core.Name "sack") - -_TraversalMethod_sample = (Core.Name "sample") - -_TraversalMethod_select = (Core.Name "select") - -_TraversalMethod_combine = (Core.Name "combine") - -_TraversalMethod_product = (Core.Name "product") - -_TraversalMethod_merge = (Core.Name "merge") - -_TraversalMethod_shortestPath = (Core.Name "shortestPath") - -_TraversalMethod_sideEffect = (Core.Name "sideEffect") - -_TraversalMethod_simplePath = (Core.Name "simplePath") - -_TraversalMethod_skip = (Core.Name "skip") - -_TraversalMethod_store = (Core.Name "store") - -_TraversalMethod_subgraph = (Core.Name "subgraph") - -_TraversalMethod_sum = (Core.Name "sum") - -_TraversalMethod_tail = (Core.Name "tail") - -_TraversalMethod_fail = (Core.Name "fail") - -_TraversalMethod_times = (Core.Name "times") - -_TraversalMethod_to = (Core.Name "to") - -_TraversalMethod_toE = (Core.Name "toE") - -_TraversalMethod_toV = (Core.Name "toV") - -_TraversalMethod_tree = (Core.Name "tree") - -_TraversalMethod_unfold = (Core.Name "unfold") - -_TraversalMethod_union = (Core.Name "union") - -_TraversalMethod_until = (Core.Name "until") - -_TraversalMethod_value = (Core.Name "value") - -_TraversalMethod_valueMap = (Core.Name "valueMap") - -_TraversalMethod_values = (Core.Name "values") - -_TraversalMethod_where = (Core.Name "where") - -_TraversalMethod_with = (Core.Name "with") - -_TraversalMethod_write = (Core.Name "write") - -_TraversalMethod_element = (Core.Name "element") - -_TraversalMethod_call = (Core.Name "call") - -_TraversalMethod_concat = (Core.Name "concat") - -_TraversalMethod_asString = (Core.Name "asString") - -_TraversalMethod_format = (Core.Name "format") - -_TraversalMethod_toUpper = (Core.Name "toUpper") - -_TraversalMethod_toLower = (Core.Name "toLower") - -_TraversalMethod_length = (Core.Name "length") - -_TraversalMethod_trim = (Core.Name "trim") - -_TraversalMethod_lTrim = (Core.Name "lTrim") - -_TraversalMethod_rTrim = (Core.Name "rTrim") - -_TraversalMethod_reverse = (Core.Name "reverse") - -_TraversalMethod_replace = (Core.Name "replace") - -_TraversalMethod_split = (Core.Name "split") - -_TraversalMethod_substring = (Core.Name "substring") - -_TraversalMethod_asDate = (Core.Name "asDate") - -_TraversalMethod_dateAdd = (Core.Name "dateAdd") - -_TraversalMethod_dateDiff = (Core.Name "dateDiff") - -data StringArgumentOrNestedTraversal = - StringArgumentOrNestedTraversalString StringArgument | - StringArgumentOrNestedTraversalTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_StringArgumentOrNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.StringArgumentOrNestedTraversal") - -_StringArgumentOrNestedTraversal_string = (Core.Name "string") - -_StringArgumentOrNestedTraversal_traversal = (Core.Name "traversal") - -data OptionalTraversalScopeArgumentAndStringArgument = - OptionalTraversalScopeArgumentAndStringArgument { - optionalTraversalScopeArgumentAndStringArgumentScope :: (Maybe TraversalScopeArgument), - optionalTraversalScopeArgumentAndStringArgumentString :: StringArgument} - deriving (Eq, Ord, Read, Show) - -_OptionalTraversalScopeArgumentAndStringArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.OptionalTraversalScopeArgumentAndStringArgument") - -_OptionalTraversalScopeArgumentAndStringArgument_scope = (Core.Name "scope") - -_OptionalTraversalScopeArgumentAndStringArgument_string = (Core.Name "string") - -data StringArgumentAndOptionalStringLiteralVarargs = - StringArgumentAndOptionalStringLiteralVarargs { - stringArgumentAndOptionalStringLiteralVarargsFirst :: StringArgument, - stringArgumentAndOptionalStringLiteralVarargsRest :: [StringNullableArgument]} - deriving (Eq, Ord, Read, Show) - -_StringArgumentAndOptionalStringLiteralVarargs = (Core.Name "hydra/langs/tinkerpop/gremlin.StringArgumentAndOptionalStringLiteralVarargs") - -_StringArgumentAndOptionalStringLiteralVarargs_first = (Core.Name "first") - -_StringArgumentAndOptionalStringLiteralVarargs_rest = (Core.Name "rest") - -data TraversalSackMethodArgumentOrIntegerArgument = - TraversalSackMethodArgumentOrIntegerArgumentConsumer TraversalSackMethodArgument | - TraversalSackMethodArgumentOrIntegerArgumentInt IntegerArgument - deriving (Eq, Ord, Read, Show) - -_TraversalSackMethodArgumentOrIntegerArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSackMethodArgumentOrIntegerArgument") - -_TraversalSackMethodArgumentOrIntegerArgument_consumer = (Core.Name "consumer") - -_TraversalSackMethodArgumentOrIntegerArgument_int = (Core.Name "int") - -data ByArgs = - ByArgsOrder TraversalOrderArgument | - ByArgsToken TraversalTokenArgument | - ByArgsOther ByOtherArgs - deriving (Eq, Ord, Read, Show) - -_ByArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ByArgs") - -_ByArgs_order = (Core.Name "order") - -_ByArgs_token = (Core.Name "token") - -_ByArgs_other = (Core.Name "other") - -data ByOtherArgs = - ByOtherArgsComparator (Maybe TraversalComparatorArgument) | - ByOtherArgsOther (Maybe TraversalFunctionArgumentOrStringArgumentOrNestedTraversal) - deriving (Eq, Ord, Read, Show) - -_ByOtherArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ByOtherArgs") - -_ByOtherArgs_comparator = (Core.Name "comparator") - -_ByOtherArgs_other = (Core.Name "other") - -data TraversalFunctionArgumentOrStringArgumentOrNestedTraversal = - TraversalFunctionArgumentOrStringArgumentOrNestedTraversalFunction TraversalFunctionArgument | - TraversalFunctionArgumentOrStringArgumentOrNestedTraversalString StringArgument | - TraversalFunctionArgumentOrStringArgumentOrNestedTraversalTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_TraversalFunctionArgumentOrStringArgumentOrNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalFunctionArgumentOrStringArgumentOrNestedTraversal") - -_TraversalFunctionArgumentOrStringArgumentOrNestedTraversal_function = (Core.Name "function") - -_TraversalFunctionArgumentOrStringArgumentOrNestedTraversal_string = (Core.Name "string") - -_TraversalFunctionArgumentOrStringArgumentOrNestedTraversal_traversal = (Core.Name "traversal") - -data ChooseArgs = - ChooseArgsFunction TraversalFunctionArgument | - ChooseArgsPredicateTraversal PredicateTraversalArgument | - ChooseArgsTraversal NestedTraversalArgument - deriving (Eq, Ord, Read, Show) - -_ChooseArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ChooseArgs") - -_ChooseArgs_function = (Core.Name "function") - -_ChooseArgs_predicateTraversal = (Core.Name "predicateTraversal") - -_ChooseArgs_traversal = (Core.Name "traversal") - -data PredicateTraversalArgument = - PredicateTraversalArgument { - predicateTraversalArgumentPredicate :: TraversalPredicate, - predicateTraversalArgumentTraversal1 :: NestedTraversal, - predicateTraversalArgumentTraversal2 :: (Maybe NestedTraversal)} - deriving (Eq, Ord, Read, Show) - -_PredicateTraversalArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.PredicateTraversalArgument") - -_PredicateTraversalArgument_predicate = (Core.Name "predicate") - -_PredicateTraversalArgument_traversal1 = (Core.Name "traversal1") - -_PredicateTraversalArgument_traversal2 = (Core.Name "traversal2") - -data NestedTraversalArgument = - NestedTraversalArgument { - nestedTraversalArgumentTraversal1 :: NestedTraversal, - nestedTraversalArgumentTraversal2 :: (Maybe NestedTraversal), - nestedTraversalArgumentTraversal3 :: (Maybe NestedTraversal)} - deriving (Eq, Ord, Read, Show) - -_NestedTraversalArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.NestedTraversalArgument") - -_NestedTraversalArgument_traversal1 = (Core.Name "traversal1") - -_NestedTraversalArgument_traversal2 = (Core.Name "traversal2") - -_NestedTraversalArgument_traversal3 = (Core.Name "traversal3") - -data DedupArgs = - DedupArgsScopeString ScopeStringArgument | - DedupArgsString [StringNullableArgument] - deriving (Eq, Ord, Read, Show) - -_DedupArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.DedupArgs") - -_DedupArgs_scopeString = (Core.Name "scopeString") - -_DedupArgs_string = (Core.Name "string") - -data ScopeStringArgument = - ScopeStringArgument { - scopeStringArgumentScope :: TraversalScopeArgument, - scopeStringArgumentStrings :: [StringNullableArgument]} - deriving (Eq, Ord, Read, Show) - -_ScopeStringArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.ScopeStringArgument") - -_ScopeStringArgument_scope = (Core.Name "scope") - -_ScopeStringArgument_strings = (Core.Name "strings") - -data PredicateOrTraversal = - PredicateOrTraversalPredicate TraversalPredicate | - PredicateOrTraversalTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_PredicateOrTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.PredicateOrTraversal") - -_PredicateOrTraversal_predicate = (Core.Name "predicate") - -_PredicateOrTraversal_traversal = (Core.Name "traversal") - -data GenericLiteralArgumentAndTraversalBiFunctionArgument = - GenericLiteralArgumentAndTraversalBiFunctionArgument { - genericLiteralArgumentAndTraversalBiFunctionArgumentLiteral :: GenericLiteralArgument, - genericLiteralArgumentAndTraversalBiFunctionArgumentBiFunction :: TraversalBiFunctionArgument} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralArgumentAndTraversalBiFunctionArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralArgumentAndTraversalBiFunctionArgument") - -_GenericLiteralArgumentAndTraversalBiFunctionArgument_literal = (Core.Name "literal") - -_GenericLiteralArgumentAndTraversalBiFunctionArgument_biFunction = (Core.Name "biFunction") - -data FromArgs = - FromArgsString StringArgument | - FromArgsVertex StructureVertexArgument | - FromArgsTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_FromArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.FromArgs") - -_FromArgs_string = (Core.Name "string") - -_FromArgs_vertex = (Core.Name "vertex") - -_FromArgs_traversal = (Core.Name "traversal") - -data HasArgs = - HasArgsString HasStringArgumentAndOptionalStringLiteralVarargs | - HasArgsTraversalToken HasTraversalTokenArgs - deriving (Eq, Ord, Read, Show) - -_HasArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.HasArgs") - -_HasArgs_string = (Core.Name "string") - -_HasArgs_traversalToken = (Core.Name "traversalToken") - -data HasStringArgumentAndOptionalStringLiteralVarargs = - HasStringArgumentAndOptionalStringLiteralVarargs { - hasStringArgumentAndOptionalStringLiteralVarargsString :: StringNullableArgument, - hasStringArgumentAndOptionalStringLiteralVarargsRest :: (Maybe HasStringArgumentAndOptionalStringLiteralVarargsRest)} - deriving (Eq, Ord, Read, Show) - -_HasStringArgumentAndOptionalStringLiteralVarargs = (Core.Name "hydra/langs/tinkerpop/gremlin.HasStringArgumentAndOptionalStringLiteralVarargs") - -_HasStringArgumentAndOptionalStringLiteralVarargs_string = (Core.Name "string") - -_HasStringArgumentAndOptionalStringLiteralVarargs_rest = (Core.Name "rest") - -data HasStringArgumentAndOptionalStringLiteralVarargsRest = - HasStringArgumentAndOptionalStringLiteralVarargsRestObject GenericLiteralArgument | - HasStringArgumentAndOptionalStringLiteralVarargsRestPredicate TraversalPredicate | - HasStringArgumentAndOptionalStringLiteralVarargsRestStringObject StringNullableArgumentAndGenericLiteralArgument | - HasStringArgumentAndOptionalStringLiteralVarargsRestStringPredicate StringNullableArgumentAndTraversalPredicate | - HasStringArgumentAndOptionalStringLiteralVarargsRestTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_HasStringArgumentAndOptionalStringLiteralVarargsRest = (Core.Name "hydra/langs/tinkerpop/gremlin.HasStringArgumentAndOptionalStringLiteralVarargsRest") - -_HasStringArgumentAndOptionalStringLiteralVarargsRest_object = (Core.Name "object") - -_HasStringArgumentAndOptionalStringLiteralVarargsRest_predicate = (Core.Name "predicate") - -_HasStringArgumentAndOptionalStringLiteralVarargsRest_stringObject = (Core.Name "stringObject") - -_HasStringArgumentAndOptionalStringLiteralVarargsRest_stringPredicate = (Core.Name "stringPredicate") - -_HasStringArgumentAndOptionalStringLiteralVarargsRest_traversal = (Core.Name "traversal") - -data StringNullableArgumentAndGenericLiteralArgument = - StringNullableArgumentAndGenericLiteralArgument { - stringNullableArgumentAndGenericLiteralArgumentString :: StringNullableArgument, - stringNullableArgumentAndGenericLiteralArgumentLiteral :: GenericLiteralArgument} - deriving (Eq, Ord, Read, Show) - -_StringNullableArgumentAndGenericLiteralArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.StringNullableArgumentAndGenericLiteralArgument") - -_StringNullableArgumentAndGenericLiteralArgument_string = (Core.Name "string") - -_StringNullableArgumentAndGenericLiteralArgument_literal = (Core.Name "literal") - -data StringNullableArgumentAndTraversalPredicate = - StringNullableArgumentAndTraversalPredicate { - stringNullableArgumentAndTraversalPredicateString :: StringNullableArgument, - stringNullableArgumentAndTraversalPredicatePredicate :: TraversalPredicate} - deriving (Eq, Ord, Read, Show) - -_StringNullableArgumentAndTraversalPredicate = (Core.Name "hydra/langs/tinkerpop/gremlin.StringNullableArgumentAndTraversalPredicate") - -_StringNullableArgumentAndTraversalPredicate_string = (Core.Name "string") - -_StringNullableArgumentAndTraversalPredicate_predicate = (Core.Name "predicate") - -data HasTraversalTokenArgs = - HasTraversalTokenArgs { - hasTraversalTokenArgsTraversalToken :: TraversalTokenArgument, - hasTraversalTokenArgsRest :: HasTraversalTokenArgsRest} - deriving (Eq, Ord, Read, Show) - -_HasTraversalTokenArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.HasTraversalTokenArgs") - -_HasTraversalTokenArgs_traversalToken = (Core.Name "traversalToken") - -_HasTraversalTokenArgs_rest = (Core.Name "rest") - -data HasTraversalTokenArgsRest = - HasTraversalTokenArgsRestLiteral GenericLiteralArgument | - HasTraversalTokenArgsRestPredicate TraversalPredicate | - HasTraversalTokenArgsRestTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_HasTraversalTokenArgsRest = (Core.Name "hydra/langs/tinkerpop/gremlin.HasTraversalTokenArgsRest") - -_HasTraversalTokenArgsRest_literal = (Core.Name "literal") - -_HasTraversalTokenArgsRest_predicate = (Core.Name "predicate") - -_HasTraversalTokenArgsRest_traversal = (Core.Name "traversal") - -data GenericLiteralArgumentAndTraversalPredicate = - GenericLiteralArgumentAndTraversalPredicateLiteral GenericLiteralArgument | - GenericLiteralArgumentAndTraversalPredicatePredicate TraversalPredicate - deriving (Eq, Ord, Read, Show) - -_GenericLiteralArgumentAndTraversalPredicate = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralArgumentAndTraversalPredicate") - -_GenericLiteralArgumentAndTraversalPredicate_literal = (Core.Name "literal") - -_GenericLiteralArgumentAndTraversalPredicate_predicate = (Core.Name "predicate") - -data TraversalPredicateOrStringLiteralVarargs = - TraversalPredicateOrStringLiteralVarargsPredicate TraversalPredicate | - TraversalPredicateOrStringLiteralVarargsString [StringNullableArgument] - deriving (Eq, Ord, Read, Show) - -_TraversalPredicateOrStringLiteralVarargs = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPredicateOrStringLiteralVarargs") - -_TraversalPredicateOrStringLiteralVarargs_predicate = (Core.Name "predicate") - -_TraversalPredicateOrStringLiteralVarargs_string = (Core.Name "string") - -data TraversalPredicateOrGenericLiteralArgument = - TraversalPredicateOrGenericLiteralArgumentPredicate TraversalPredicate | - TraversalPredicateOrGenericLiteralArgumentLiteral [GenericLiteralArgument] - deriving (Eq, Ord, Read, Show) - -_TraversalPredicateOrGenericLiteralArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPredicateOrGenericLiteralArgument") - -_TraversalPredicateOrGenericLiteralArgument_predicate = (Core.Name "predicate") - -_TraversalPredicateOrGenericLiteralArgument_literal = (Core.Name "literal") - -data OptionArgs = - OptionArgsPredicateTraversal TraversalPredicateAndNestedTraversal | - OptionArgsMergeMap TraversalMergeArgumentAndGenericLiteralMapNullableArgument | - OptionArgsMergeTraversal TraversalMergeArgumentAndNestedTraversal | - OptionArgsObjectTraversal GenericLiteralArgumentAndNestedTraversal | - OptionArgsTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_OptionArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.OptionArgs") - -_OptionArgs_predicateTraversal = (Core.Name "predicateTraversal") - -_OptionArgs_mergeMap = (Core.Name "mergeMap") - -_OptionArgs_mergeTraversal = (Core.Name "mergeTraversal") - -_OptionArgs_objectTraversal = (Core.Name "objectTraversal") - -_OptionArgs_traversal = (Core.Name "traversal") - -data TraversalPredicateAndNestedTraversal = - TraversalPredicateAndNestedTraversal { - traversalPredicateAndNestedTraversalPredicate :: TraversalPredicate, - traversalPredicateAndNestedTraversalTraversal :: NestedTraversal} - deriving (Eq, Ord, Read, Show) - -_TraversalPredicateAndNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPredicateAndNestedTraversal") - -_TraversalPredicateAndNestedTraversal_predicate = (Core.Name "predicate") - -_TraversalPredicateAndNestedTraversal_traversal = (Core.Name "traversal") - -data TraversalMergeArgumentAndGenericLiteralMapNullableArgument = - TraversalMergeArgumentAndGenericLiteralMapNullableArgument { - traversalMergeArgumentAndGenericLiteralMapNullableArgumentMerge :: TraversalMergeArgument, - traversalMergeArgumentAndGenericLiteralMapNullableArgumentMap :: GenericLiteralMapNullableArgument, - traversalMergeArgumentAndGenericLiteralMapNullableArgumentCardinality :: (Maybe TraversalCardinality)} - deriving (Eq, Ord, Read, Show) - -_TraversalMergeArgumentAndGenericLiteralMapNullableArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalMergeArgumentAndGenericLiteralMapNullableArgument") - -_TraversalMergeArgumentAndGenericLiteralMapNullableArgument_merge = (Core.Name "merge") - -_TraversalMergeArgumentAndGenericLiteralMapNullableArgument_map = (Core.Name "map") - -_TraversalMergeArgumentAndGenericLiteralMapNullableArgument_cardinality = (Core.Name "cardinality") - -data TraversalMergeArgumentAndNestedTraversal = - TraversalMergeArgumentAndNestedTraversal { - traversalMergeArgumentAndNestedTraversalMerge :: TraversalMergeArgument, - traversalMergeArgumentAndNestedTraversalTraversal :: NestedTraversal} - deriving (Eq, Ord, Read, Show) - -_TraversalMergeArgumentAndNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalMergeArgumentAndNestedTraversal") - -_TraversalMergeArgumentAndNestedTraversal_merge = (Core.Name "merge") - -_TraversalMergeArgumentAndNestedTraversal_traversal = (Core.Name "traversal") - -data GenericLiteralArgumentAndNestedTraversal = - GenericLiteralArgumentAndNestedTraversal { - genericLiteralArgumentAndNestedTraversalObject :: GenericLiteralArgument, - genericLiteralArgumentAndNestedTraversalTraversal :: NestedTraversal} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralArgumentAndNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralArgumentAndNestedTraversal") - -_GenericLiteralArgumentAndNestedTraversal_object = (Core.Name "object") - -_GenericLiteralArgumentAndNestedTraversal_traversal = (Core.Name "traversal") - -data PropertyArgs = - PropertyArgsCardinalityObjects TraversalCardinalityArgumentAndObjects | - PropertyArgsObjects [GenericLiteralArgument] | - PropertyArgsObject GenericLiteralMapNullableArgument | - PropertyArgsCardinalityObject GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument - deriving (Eq, Ord, Read, Show) - -_PropertyArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.PropertyArgs") - -_PropertyArgs_cardinalityObjects = (Core.Name "cardinalityObjects") - -_PropertyArgs_objects = (Core.Name "objects") - -_PropertyArgs_object = (Core.Name "object") - -_PropertyArgs_cardinalityObject = (Core.Name "cardinalityObject") - -data TraversalCardinalityArgumentAndObjects = - TraversalCardinalityArgumentAndObjects { - traversalCardinalityArgumentAndObjectsCardinality :: TraversalCardinalityArgument, - traversalCardinalityArgumentAndObjectsObjects :: [GenericLiteralArgument]} - deriving (Eq, Ord, Read, Show) - -_TraversalCardinalityArgumentAndObjects = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalCardinalityArgumentAndObjects") - -_TraversalCardinalityArgumentAndObjects_cardinality = (Core.Name "cardinality") - -_TraversalCardinalityArgumentAndObjects_objects = (Core.Name "objects") - -data GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument = - GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument { - genericLiteralMapNullableArgumentAndTraversalCardinalityArgumentCardinality :: TraversalCardinalityArgument, - genericLiteralMapNullableArgumentAndTraversalCardinalityArgumentObject :: GenericLiteralMapNullableArgument} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument") - -_GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument_cardinality = (Core.Name "cardinality") - -_GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument_object = (Core.Name "object") - -data RangeArgs = - RangeArgs { - rangeArgsScope :: (Maybe TraversalScopeArgument), - rangeArgsMin :: IntegerArgument, - rangeArgsMax :: IntegerArgument} - deriving (Eq, Ord, Read, Show) - -_RangeArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.RangeArgs") - -_RangeArgs_scope = (Core.Name "scope") - -_RangeArgs_min = (Core.Name "min") - -_RangeArgs_max = (Core.Name "max") - -data OptionalStringArgumentAndNestedTraversal = - OptionalStringArgumentAndNestedTraversal { - optionalStringArgumentAndNestedTraversalString :: (Maybe StringArgument), - optionalStringArgumentAndNestedTraversalTraversal :: NestedTraversal} - deriving (Eq, Ord, Read, Show) - -_OptionalStringArgumentAndNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.OptionalStringArgumentAndNestedTraversal") - -_OptionalStringArgumentAndNestedTraversal_string = (Core.Name "string") - -_OptionalStringArgumentAndNestedTraversal_traversal = (Core.Name "traversal") - -data SelectArgs = - SelectArgsColumn TraversalColumnArgument | - SelectArgsPopStrings PopStringsArgument | - SelectArgsPopTraversal TraversalPopArgumentAndNestedTraversal | - SelectArgsStrings [StringArgument] | - SelectArgsTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_SelectArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.SelectArgs") - -_SelectArgs_column = (Core.Name "column") - -_SelectArgs_popStrings = (Core.Name "popStrings") - -_SelectArgs_popTraversal = (Core.Name "popTraversal") - -_SelectArgs_strings = (Core.Name "strings") - -_SelectArgs_traversal = (Core.Name "traversal") - -data PopStringsArgument = - PopStringsArgument { - popStringsArgumentPop :: TraversalPopArgument, - popStringsArgumentString :: [StringArgument]} - deriving (Eq, Ord, Read, Show) - -_PopStringsArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.PopStringsArgument") - -_PopStringsArgument_pop = (Core.Name "pop") - -_PopStringsArgument_string = (Core.Name "string") - -data TraversalPopArgumentAndNestedTraversal = - TraversalPopArgumentAndNestedTraversal { - traversalPopArgumentAndNestedTraversalPop :: TraversalPopArgument, - traversalPopArgumentAndNestedTraversalTraversal :: NestedTraversal} - deriving (Eq, Ord, Read, Show) - -_TraversalPopArgumentAndNestedTraversal = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPopArgumentAndNestedTraversal") - -_TraversalPopArgumentAndNestedTraversal_pop = (Core.Name "pop") - -_TraversalPopArgumentAndNestedTraversal_traversal = (Core.Name "traversal") - -data OptionalTraversalScopeArgumentAndIntegerArgument = - OptionalTraversalScopeArgumentAndIntegerArgument { - optionalTraversalScopeArgumentAndIntegerArgumentScope :: (Maybe TraversalScopeArgument), - optionalTraversalScopeArgumentAndIntegerArgumentLong :: IntegerArgument} - deriving (Eq, Ord, Read, Show) - -_OptionalTraversalScopeArgumentAndIntegerArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.OptionalTraversalScopeArgumentAndIntegerArgument") - -_OptionalTraversalScopeArgumentAndIntegerArgument_scope = (Core.Name "scope") - -_OptionalTraversalScopeArgumentAndIntegerArgument_long = (Core.Name "long") - -data TailArgs = - TailArgs { - tailArgsScope :: (Maybe TraversalScopeArgument), - tailArgsInteger :: (Maybe IntegerArgument)} - deriving (Eq, Ord, Read, Show) - -_TailArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.TailArgs") - -_TailArgs_scope = (Core.Name "scope") - -_TailArgs_integer = (Core.Name "integer") - -data ToArgs = - ToArgsDirection DirectionAndVarargs | - ToArgsString StringArgument | - ToArgsVertex StructureVertexArgument | - ToArgsTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_ToArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ToArgs") - -_ToArgs_direction = (Core.Name "direction") - -_ToArgs_string = (Core.Name "string") - -_ToArgs_vertex = (Core.Name "vertex") - -_ToArgs_traversal = (Core.Name "traversal") - -data DirectionAndVarargs = - DirectionAndVarargs { - directionAndVarargsDirection :: TraversalDirectionArgument, - directionAndVarargsVarargs :: [StringNullableArgument]} - deriving (Eq, Ord, Read, Show) - -_DirectionAndVarargs = (Core.Name "hydra/langs/tinkerpop/gremlin.DirectionAndVarargs") - -_DirectionAndVarargs_direction = (Core.Name "direction") - -_DirectionAndVarargs_varargs = (Core.Name "varargs") - -data ValueMapArgs = - ValueMapArgsString [StringNullableArgument] | - ValueMapArgsBoolean ValueMapBooleanArgs - deriving (Eq, Ord, Read, Show) - -_ValueMapArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ValueMapArgs") - -_ValueMapArgs_string = (Core.Name "string") - -_ValueMapArgs_boolean = (Core.Name "boolean") - -data ValueMapBooleanArgs = - ValueMapBooleanArgs { - valueMapBooleanArgsValue :: BooleanArgument, - valueMapBooleanArgsKeys :: (Maybe [StringNullableArgument])} - deriving (Eq, Ord, Read, Show) - -_ValueMapBooleanArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ValueMapBooleanArgs") - -_ValueMapBooleanArgs_value = (Core.Name "value") - -_ValueMapBooleanArgs_keys = (Core.Name "keys") - -data WhereArgs = - WhereArgsPredicate WhereWithPredicateArgs | - WhereArgsString StringArgument | - WhereArgsTraversal NestedTraversal - deriving (Eq, Ord, Read, Show) - -_WhereArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.WhereArgs") - -_WhereArgs_predicate = (Core.Name "predicate") - -_WhereArgs_string = (Core.Name "string") - -_WhereArgs_traversal = (Core.Name "traversal") - -data WhereWithPredicateArgs = - WhereWithPredicateArgs { - whereWithPredicateArgsLeftArg :: (Maybe StringArgument), - whereWithPredicateArgsPredicate :: TraversalPredicate} - deriving (Eq, Ord, Read, Show) - -_WhereWithPredicateArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.WhereWithPredicateArgs") - -_WhereWithPredicateArgs_leftArg = (Core.Name "leftArg") - -_WhereWithPredicateArgs_predicate = (Core.Name "predicate") - -data WithArgs = - WithArgs { - withArgsKeys :: WithArgsKeys, - withArgsValues :: (Maybe WithArgsValues)} - deriving (Eq, Ord, Read, Show) - -_WithArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.WithArgs") - -_WithArgs_keys = (Core.Name "keys") - -_WithArgs_values = (Core.Name "values") - -data WithArgsKeys = - WithArgsKeysWithOption WithOptionKeys | - WithArgsKeysString StringArgument - deriving (Eq, Ord, Read, Show) - -_WithArgsKeys = (Core.Name "hydra/langs/tinkerpop/gremlin.WithArgsKeys") - -_WithArgsKeys_withOption = (Core.Name "withOption") - -_WithArgsKeys_string = (Core.Name "string") - -data WithArgsValues = - WithArgsValuesWithOptions WithOptionsValues | - WithArgsValuesIo IoOptionsValues | - WithArgsValuesObject GenericLiteralArgument - deriving (Eq, Ord, Read, Show) - -_WithArgsValues = (Core.Name "hydra/langs/tinkerpop/gremlin.WithArgsValues") - -_WithArgsValues_withOptions = (Core.Name "withOptions") - -_WithArgsValues_io = (Core.Name "io") - -_WithArgsValues_object = (Core.Name "object") - -data ConcatArgs = - ConcatArgsTraversal [NestedTraversal] | - ConcatArgsString [StringNullableArgument] - deriving (Eq, Ord, Read, Show) - -_ConcatArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ConcatArgs") - -_ConcatArgs_traversal = (Core.Name "traversal") - -_ConcatArgs_string = (Core.Name "string") - -data ReplaceArgs = - ReplaceArgs { - replaceArgsScope :: (Maybe TraversalScopeArgument), - replaceArgsFrom :: StringNullableArgument, - replaceArgsTo :: StringNullableArgument} - deriving (Eq, Ord, Read, Show) - -_ReplaceArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.ReplaceArgs") - -_ReplaceArgs_scope = (Core.Name "scope") - -_ReplaceArgs_from = (Core.Name "from") - -_ReplaceArgs_to = (Core.Name "to") - -data SplitArgs = - SplitArgs { - splitArgsScope :: (Maybe TraversalScopeArgument), - splitArgsDelimiter :: StringNullableArgument} - deriving (Eq, Ord, Read, Show) - -_SplitArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.SplitArgs") - -_SplitArgs_scope = (Core.Name "scope") - -_SplitArgs_delimiter = (Core.Name "delimiter") - -data SubstringArgs = - SubstringArgs { - substringArgsScope :: (Maybe TraversalScopeArgument), - substringArgsStart :: IntegerArgument, - substringArgsEnd :: (Maybe IntegerArgument)} - deriving (Eq, Ord, Read, Show) - -_SubstringArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.SubstringArgs") - -_SubstringArgs_scope = (Core.Name "scope") - -_SubstringArgs_start = (Core.Name "start") - -_SubstringArgs_end = (Core.Name "end") - -data DateAddArgs = - DateAddArgs { - dateAddArgsUnit :: TraversalDTArgument, - dateAddArgsDuration :: IntegerArgument} - deriving (Eq, Ord, Read, Show) - -_DateAddArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.DateAddArgs") - -_DateAddArgs_unit = (Core.Name "unit") - -_DateAddArgs_duration = (Core.Name "duration") - -data DateDiffArgs = - DateDiffArgsTraversal NestedTraversal | - DateDiffArgsDate DateArgument - deriving (Eq, Ord, Read, Show) - -_DateDiffArgs = (Core.Name "hydra/langs/tinkerpop/gremlin.DateDiffArgs") - -_DateDiffArgs_traversal = (Core.Name "traversal") - -_DateDiffArgs_date = (Core.Name "date") - -data StructureVertex = - StructureVertex { - structureVertexNew :: Bool, - structureVertexId :: GenericLiteralArgument, - structureVertexLabel :: StringArgument} - deriving (Eq, Ord, Read, Show) - -_StructureVertex = (Core.Name "hydra/langs/tinkerpop/gremlin.StructureVertex") - -_StructureVertex_new = (Core.Name "new") - -_StructureVertex_id = (Core.Name "id") - -_StructureVertex_label = (Core.Name "label") - -data TraversalStrategy = - TraversalStrategy { - traversalStrategyNew :: Bool, - traversalStrategyClass :: Identifier, - traversalStrategyConfigurations :: [Configuration]} - deriving (Eq, Ord, Read, Show) - -_TraversalStrategy = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalStrategy") - -_TraversalStrategy_new = (Core.Name "new") - -_TraversalStrategy_class = (Core.Name "class") - -_TraversalStrategy_configurations = (Core.Name "configurations") - -data Configuration = - Configuration { - configurationKey :: KeywordOrIdentifier, - configurationValue :: GenericLiteralArgument} - deriving (Eq, Ord, Read, Show) - -_Configuration = (Core.Name "hydra/langs/tinkerpop/gremlin.Configuration") - -_Configuration_key = (Core.Name "key") - -_Configuration_value = (Core.Name "value") - -data KeywordOrIdentifier = - KeywordOrIdentifierKeyword Keyword | - KeywordOrIdentifierIdentifier Identifier - deriving (Eq, Ord, Read, Show) - -_KeywordOrIdentifier = (Core.Name "hydra/langs/tinkerpop/gremlin.KeywordOrIdentifier") - -_KeywordOrIdentifier_keyword = (Core.Name "keyword") - -_KeywordOrIdentifier_identifier = (Core.Name "identifier") - -data TraversalScope = - TraversalScopeLocal | - TraversalScopeGlobal - deriving (Eq, Ord, Read, Show) - -_TraversalScope = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalScope") - -_TraversalScope_local = (Core.Name "local") - -_TraversalScope_global = (Core.Name "global") - -data TraversalToken = - TraversalTokenId | - TraversalTokenLabel | - TraversalTokenKey | - TraversalTokenValue - deriving (Eq, Ord, Read, Show) - -_TraversalToken = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalToken") - -_TraversalToken_id = (Core.Name "id") - -_TraversalToken_label = (Core.Name "label") - -_TraversalToken_key = (Core.Name "key") - -_TraversalToken_value = (Core.Name "value") - -data TraversalMerge = - TraversalMergeOnCreate | - TraversalMergeOnMatch | - TraversalMergeOutV | - TraversalMergeInV - deriving (Eq, Ord, Read, Show) - -_TraversalMerge = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalMerge") - -_TraversalMerge_onCreate = (Core.Name "onCreate") - -_TraversalMerge_onMatch = (Core.Name "onMatch") - -_TraversalMerge_outV = (Core.Name "outV") - -_TraversalMerge_inV = (Core.Name "inV") - -data TraversalOrder = - TraversalOrderIncr | - TraversalOrderDecr | - TraversalOrderAsc | - TraversalOrderDesc | - TraversalOrderShuffle - deriving (Eq, Ord, Read, Show) - -_TraversalOrder = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalOrder") - -_TraversalOrder_incr = (Core.Name "incr") - -_TraversalOrder_decr = (Core.Name "decr") - -_TraversalOrder_asc = (Core.Name "asc") - -_TraversalOrder_desc = (Core.Name "desc") - -_TraversalOrder_shuffle = (Core.Name "shuffle") - -data TraversalDirection = - TraversalDirectionIn | - TraversalDirectionOut | - TraversalDirectionBoth - deriving (Eq, Ord, Read, Show) - -_TraversalDirection = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalDirection") - -_TraversalDirection_in = (Core.Name "in") - -_TraversalDirection_out = (Core.Name "out") - -_TraversalDirection_both = (Core.Name "both") - -data TraversalCardinality = - TraversalCardinalitySingle GenericLiteral | - TraversalCardinalitySet GenericLiteral | - TraversalCardinalityList GenericLiteral - deriving (Eq, Ord, Read, Show) - -_TraversalCardinality = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalCardinality") - -_TraversalCardinality_single = (Core.Name "single") - -_TraversalCardinality_set = (Core.Name "set") - -_TraversalCardinality_list = (Core.Name "list") - -data TraversalColumn = - TraversalColumnKeys | - TraversalColumnValues - deriving (Eq, Ord, Read, Show) - -_TraversalColumn = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalColumn") - -_TraversalColumn_keys = (Core.Name "keys") - -_TraversalColumn_values = (Core.Name "values") - -data TraversalPop = - TraversalPopFirst | - TraversalPopLast | - TraversalPopAll | - TraversalPopMixed - deriving (Eq, Ord, Read, Show) - -_TraversalPop = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPop") - -_TraversalPop_first = (Core.Name "first") - -_TraversalPop_last = (Core.Name "last") - -_TraversalPop_all = (Core.Name "all") - -_TraversalPop_mixed = (Core.Name "mixed") - -data TraversalOperator = - TraversalOperatorAddAll | - TraversalOperatorAnd | - TraversalOperatorAssign | - TraversalOperatorDiv | - TraversalOperatorMax | - TraversalOperatorMin | - TraversalOperatorMinus | - TraversalOperatorMult | - TraversalOperatorOr | - TraversalOperatorSum | - TraversalOperatorSumLong - deriving (Eq, Ord, Read, Show) - -_TraversalOperator = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalOperator") - -_TraversalOperator_addAll = (Core.Name "addAll") - -_TraversalOperator_and = (Core.Name "and") - -_TraversalOperator_assign = (Core.Name "assign") - -_TraversalOperator_div = (Core.Name "div") - -_TraversalOperator_max = (Core.Name "max") - -_TraversalOperator_min = (Core.Name "min") - -_TraversalOperator_minus = (Core.Name "minus") - -_TraversalOperator_mult = (Core.Name "mult") - -_TraversalOperator_or = (Core.Name "or") - -_TraversalOperator_sum = (Core.Name "sum") - -_TraversalOperator_sumLong = (Core.Name "sumLong") - -data TraversalPick = - TraversalPickAny | - TraversalPickNone - deriving (Eq, Ord, Read, Show) - -_TraversalPick = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPick") - -_TraversalPick_any = (Core.Name "any") - -_TraversalPick_none = (Core.Name "none") - -data TraversalDT = - TraversalDTSecond | - TraversalDTMinute | - TraversalDTHour | - TraversalDTDay - deriving (Eq, Ord, Read, Show) - -_TraversalDT = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalDT") - -_TraversalDT_second = (Core.Name "second") - -_TraversalDT_minute = (Core.Name "minute") - -_TraversalDT_hour = (Core.Name "hour") - -_TraversalDT_day = (Core.Name "day") - -data TraversalPredicate = - TraversalPredicateEq GenericLiteralArgument | - TraversalPredicateNeq GenericLiteralArgument | - TraversalPredicateLt GenericLiteralArgument | - TraversalPredicateLte GenericLiteralArgument | - TraversalPredicateGt GenericLiteralArgument | - TraversalPredicateGte GenericLiteralArgument | - TraversalPredicateInside RangeArgument | - TraversalPredicateOutside RangeArgument | - TraversalPredicateBetween RangeArgument | - TraversalPredicateWithin (Maybe GenericLiteralArgument) | - TraversalPredicateWithout (Maybe GenericLiteralArgument) | - TraversalPredicateNot TraversalPredicate | - TraversalPredicateStartingWith StringArgument | - TraversalPredicateNotStartingWith StringArgument | - TraversalPredicateEndingWith StringArgument | - TraversalPredicateNotEndingWith StringArgument | - TraversalPredicateContaining StringArgument | - TraversalPredicateNotContaining StringArgument | - TraversalPredicateRegex StringArgument | - TraversalPredicateNotRegex StringArgument | - TraversalPredicateAnd TwoTraversalPredicates | - TraversalPredicateOr TwoTraversalPredicates | - TraversalPredicateNegate TraversalPredicate - deriving (Eq, Ord, Read, Show) - -_TraversalPredicate = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPredicate") - -_TraversalPredicate_eq = (Core.Name "eq") - -_TraversalPredicate_neq = (Core.Name "neq") - -_TraversalPredicate_lt = (Core.Name "lt") - -_TraversalPredicate_lte = (Core.Name "lte") - -_TraversalPredicate_gt = (Core.Name "gt") - -_TraversalPredicate_gte = (Core.Name "gte") - -_TraversalPredicate_inside = (Core.Name "inside") - -_TraversalPredicate_outside = (Core.Name "outside") - -_TraversalPredicate_between = (Core.Name "between") - -_TraversalPredicate_within = (Core.Name "within") - -_TraversalPredicate_without = (Core.Name "without") - -_TraversalPredicate_not = (Core.Name "not") - -_TraversalPredicate_startingWith = (Core.Name "startingWith") - -_TraversalPredicate_notStartingWith = (Core.Name "notStartingWith") - -_TraversalPredicate_endingWith = (Core.Name "endingWith") - -_TraversalPredicate_notEndingWith = (Core.Name "notEndingWith") - -_TraversalPredicate_containing = (Core.Name "containing") - -_TraversalPredicate_notContaining = (Core.Name "notContaining") - -_TraversalPredicate_regex = (Core.Name "regex") - -_TraversalPredicate_notRegex = (Core.Name "notRegex") - -_TraversalPredicate_and = (Core.Name "and") - -_TraversalPredicate_or = (Core.Name "or") - -_TraversalPredicate_negate = (Core.Name "negate") - -data TwoTraversalPredicates = - TwoTraversalPredicates { - twoTraversalPredicatesLeft :: TraversalPredicate, - twoTraversalPredicatesRight :: TraversalPredicate} - deriving (Eq, Ord, Read, Show) - -_TwoTraversalPredicates = (Core.Name "hydra/langs/tinkerpop/gremlin.TwoTraversalPredicates") - -_TwoTraversalPredicates_left = (Core.Name "left") - -_TwoTraversalPredicates_right = (Core.Name "right") - -data TraversalTerminalMethod = - TraversalTerminalMethodExplain | - TraversalTerminalMethodIterate | - TraversalTerminalMethodHasNext | - TraversalTerminalMethodTryNext | - TraversalTerminalMethodNext (Maybe IntegerLiteral) | - TraversalTerminalMethodToList | - TraversalTerminalMethodToSet | - TraversalTerminalMethodToBulkSet - deriving (Eq, Ord, Read, Show) - -_TraversalTerminalMethod = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalTerminalMethod") - -_TraversalTerminalMethod_explain = (Core.Name "explain") - -_TraversalTerminalMethod_iterate = (Core.Name "iterate") - -_TraversalTerminalMethod_hasNext = (Core.Name "hasNext") - -_TraversalTerminalMethod_tryNext = (Core.Name "tryNext") - -_TraversalTerminalMethod_next = (Core.Name "next") - -_TraversalTerminalMethod_toList = (Core.Name "toList") - -_TraversalTerminalMethod_toSet = (Core.Name "toSet") - -_TraversalTerminalMethod_toBulkSet = (Core.Name "toBulkSet") - -data TraversalSelfMethod = - TraversalSelfMethodDiscard - deriving (Eq, Ord, Read, Show) - -_TraversalSelfMethod = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSelfMethod") - -_TraversalSelfMethod_discard = (Core.Name "discard") - -data TraversalFunction = - TraversalFunctionToken TraversalToken | - TraversalFunctionColumn TraversalColumn - deriving (Eq, Ord, Read, Show) - -_TraversalFunction = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalFunction") - -_TraversalFunction_token = (Core.Name "token") - -_TraversalFunction_column = (Core.Name "column") - -data RangeArgument = - RangeArgument { - rangeArgumentMin :: GenericLiteralArgument, - rangeArgumentMax :: GenericLiteralArgument} - deriving (Eq, Ord, Read, Show) - -_RangeArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.RangeArgument") - -_RangeArgument_min = (Core.Name "min") - -_RangeArgument_max = (Core.Name "max") - -data WithOptionKeys = - WithOptionKeysShortestPath ShortestPathConstants | - WithOptionKeysConnectedComponent ConnectedComponentConstants | - WithOptionKeysPageRank PageRankConstants | - WithOptionKeysPeerPressure PeerPressureConstants | - WithOptionKeysIo IoOptionsKeys | - WithOptionKeysWithOptionsTokens | - WithOptionKeysWithOptionsIndexer - deriving (Eq, Ord, Read, Show) - -_WithOptionKeys = (Core.Name "hydra/langs/tinkerpop/gremlin.WithOptionKeys") - -_WithOptionKeys_shortestPath = (Core.Name "shortestPath") - -_WithOptionKeys_connectedComponent = (Core.Name "connectedComponent") - -_WithOptionKeys_pageRank = (Core.Name "pageRank") - -_WithOptionKeys_peerPressure = (Core.Name "peerPressure") - -_WithOptionKeys_io = (Core.Name "io") - -_WithOptionKeys_withOptionsTokens = (Core.Name "withOptionsTokens") - -_WithOptionKeys_withOptionsIndexer = (Core.Name "withOptionsIndexer") - -data ConnectedComponentConstants = - ConnectedComponentConstantsComponent | - ConnectedComponentConstantsEdges | - ConnectedComponentConstantsPropertyName - deriving (Eq, Ord, Read, Show) - -_ConnectedComponentConstants = (Core.Name "hydra/langs/tinkerpop/gremlin.ConnectedComponentConstants") - -_ConnectedComponentConstants_component = (Core.Name "component") - -_ConnectedComponentConstants_edges = (Core.Name "edges") - -_ConnectedComponentConstants_propertyName = (Core.Name "propertyName") - -data PageRankConstants = - PageRankConstantsEdges | - PageRankConstantsTimes | - PageRankConstantsPropertyName - deriving (Eq, Ord, Read, Show) - -_PageRankConstants = (Core.Name "hydra/langs/tinkerpop/gremlin.PageRankConstants") - -_PageRankConstants_edges = (Core.Name "edges") - -_PageRankConstants_times = (Core.Name "times") - -_PageRankConstants_propertyName = (Core.Name "propertyName") - -data PeerPressureConstants = - PeerPressureConstantsEdges | - PeerPressureConstantsTimes | - PeerPressureConstantsPropertyName - deriving (Eq, Ord, Read, Show) - -_PeerPressureConstants = (Core.Name "hydra/langs/tinkerpop/gremlin.PeerPressureConstants") - -_PeerPressureConstants_edges = (Core.Name "edges") - -_PeerPressureConstants_times = (Core.Name "times") - -_PeerPressureConstants_propertyName = (Core.Name "propertyName") - -data ShortestPathConstants = - ShortestPathConstantsTarget | - ShortestPathConstantsEdges | - ShortestPathConstantsDistance | - ShortestPathConstantsMaxDistance | - ShortestPathConstantsIncludeEdges - deriving (Eq, Ord, Read, Show) - -_ShortestPathConstants = (Core.Name "hydra/langs/tinkerpop/gremlin.ShortestPathConstants") - -_ShortestPathConstants_target = (Core.Name "target") - -_ShortestPathConstants_edges = (Core.Name "edges") - -_ShortestPathConstants_distance = (Core.Name "distance") - -_ShortestPathConstants_maxDistance = (Core.Name "maxDistance") - -_ShortestPathConstants_includeEdges = (Core.Name "includeEdges") - -data WithOptionsValues = - WithOptionsValuesTokens | - WithOptionsValuesNone | - WithOptionsValuesIds | - WithOptionsValuesLabels | - WithOptionsValuesKeys | - WithOptionsValuesValues | - WithOptionsValuesAll | - WithOptionsValuesList | - WithOptionsValuesMap - deriving (Eq, Ord, Read, Show) - -_WithOptionsValues = (Core.Name "hydra/langs/tinkerpop/gremlin.WithOptionsValues") - -_WithOptionsValues_tokens = (Core.Name "tokens") - -_WithOptionsValues_none = (Core.Name "none") - -_WithOptionsValues_ids = (Core.Name "ids") - -_WithOptionsValues_labels = (Core.Name "labels") - -_WithOptionsValues_keys = (Core.Name "keys") - -_WithOptionsValues_values = (Core.Name "values") - -_WithOptionsValues_all = (Core.Name "all") - -_WithOptionsValues_list = (Core.Name "list") - -_WithOptionsValues_map = (Core.Name "map") - -data IoOptionsKeys = - IoOptionsKeysReader | - IoOptionsKeysWriter - deriving (Eq, Ord, Read, Show) - -_IoOptionsKeys = (Core.Name "hydra/langs/tinkerpop/gremlin.IoOptionsKeys") - -_IoOptionsKeys_reader = (Core.Name "reader") - -_IoOptionsKeys_writer = (Core.Name "writer") - -data IoOptionsValues = - IoOptionsValuesGryo | - IoOptionsValuesGraphson | - IoOptionsValuesGraphml - deriving (Eq, Ord, Read, Show) - -_IoOptionsValues = (Core.Name "hydra/langs/tinkerpop/gremlin.IoOptionsValues") - -_IoOptionsValues_gryo = (Core.Name "gryo") - -_IoOptionsValues_graphson = (Core.Name "graphson") - -_IoOptionsValues_graphml = (Core.Name "graphml") - -data BooleanArgument = - BooleanArgumentValue Bool | - BooleanArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_BooleanArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.BooleanArgument") - -_BooleanArgument_value = (Core.Name "value") - -_BooleanArgument_variable = (Core.Name "variable") - -data IntegerArgument = - IntegerArgumentValue IntegerLiteral | - IntegerArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_IntegerArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.IntegerArgument") - -_IntegerArgument_value = (Core.Name "value") - -_IntegerArgument_variable = (Core.Name "variable") - -data FloatArgument = - FloatArgumentValue FloatLiteral | - FloatArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_FloatArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.FloatArgument") - -_FloatArgument_value = (Core.Name "value") - -_FloatArgument_variable = (Core.Name "variable") - -data StringArgument = - StringArgumentValue String | - StringArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_StringArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.StringArgument") - -_StringArgument_value = (Core.Name "value") - -_StringArgument_variable = (Core.Name "variable") - -data StringNullableArgument = - StringNullableArgumentValue (Maybe String) | - StringNullableArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_StringNullableArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.StringNullableArgument") - -_StringNullableArgument_value = (Core.Name "value") - -_StringNullableArgument_variable = (Core.Name "variable") - -data DateArgument = - DateArgumentValue DateLiteral | - DateArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_DateArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.DateArgument") - -_DateArgument_value = (Core.Name "value") - -_DateArgument_variable = (Core.Name "variable") - -data GenericLiteralArgument = - GenericLiteralArgumentValue GenericLiteral | - GenericLiteralArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_GenericLiteralArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralArgument") - -_GenericLiteralArgument_value = (Core.Name "value") - -_GenericLiteralArgument_variable = (Core.Name "variable") - -data GenericLiteralListArgument = - GenericLiteralListArgumentValue GenericLiteralList | - GenericLiteralListArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_GenericLiteralListArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralListArgument") - -_GenericLiteralListArgument_value = (Core.Name "value") - -_GenericLiteralListArgument_variable = (Core.Name "variable") - -data GenericLiteralMapArgument = - GenericLiteralMapArgumentValue GenericLiteralMap | - GenericLiteralMapArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_GenericLiteralMapArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralMapArgument") - -_GenericLiteralMapArgument_value = (Core.Name "value") - -_GenericLiteralMapArgument_variable = (Core.Name "variable") - -data GenericLiteralMapNullableArgument = - GenericLiteralMapNullableArgumentValue (Maybe GenericLiteralMap) | - GenericLiteralMapNullableArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_GenericLiteralMapNullableArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralMapNullableArgument") - -_GenericLiteralMapNullableArgument_value = (Core.Name "value") - -_GenericLiteralMapNullableArgument_variable = (Core.Name "variable") - -data StructureVertexArgument = - StructureVertexArgumentValue StructureVertex | - StructureVertexArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_StructureVertexArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.StructureVertexArgument") - -_StructureVertexArgument_value = (Core.Name "value") - -_StructureVertexArgument_variable = (Core.Name "variable") - -data TraversalCardinalityArgument = - TraversalCardinalityArgumentValue TraversalCardinality | - TraversalCardinalityArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalCardinalityArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalCardinalityArgument") - -_TraversalCardinalityArgument_value = (Core.Name "value") - -_TraversalCardinalityArgument_variable = (Core.Name "variable") - -data TraversalColumnArgument = - TraversalColumnArgumentValue TraversalColumn | - TraversalColumnArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalColumnArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalColumnArgument") - -_TraversalColumnArgument_value = (Core.Name "value") - -_TraversalColumnArgument_variable = (Core.Name "variable") - -data TraversalDirectionArgument = - TraversalDirectionArgumentValue TraversalDirection | - TraversalDirectionArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalDirectionArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalDirectionArgument") - -_TraversalDirectionArgument_value = (Core.Name "value") - -_TraversalDirectionArgument_variable = (Core.Name "variable") - -data TraversalMergeArgument = - TraversalMergeArgumentValue TraversalMerge | - TraversalMergeArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalMergeArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalMergeArgument") - -_TraversalMergeArgument_value = (Core.Name "value") - -_TraversalMergeArgument_variable = (Core.Name "variable") - -data TraversalOrderArgument = - TraversalOrderArgumentValue TraversalOrder | - TraversalOrderArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalOrderArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalOrderArgument") - -_TraversalOrderArgument_value = (Core.Name "value") - -_TraversalOrderArgument_variable = (Core.Name "variable") - -data TraversalPopArgument = - TraversalPopArgumentValue TraversalPop | - TraversalPopArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalPopArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalPopArgument") - -_TraversalPopArgument_value = (Core.Name "value") - -_TraversalPopArgument_variable = (Core.Name "variable") - -data TraversalSackMethodArgument = - TraversalSackMethodArgumentValue | - TraversalSackMethodArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalSackMethodArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalSackMethodArgument") - -_TraversalSackMethodArgument_value = (Core.Name "value") - -_TraversalSackMethodArgument_variable = (Core.Name "variable") - -data TraversalScopeArgument = - TraversalScopeArgumentValue TraversalScope | - TraversalScopeArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalScopeArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalScopeArgument") - -_TraversalScopeArgument_value = (Core.Name "value") - -_TraversalScopeArgument_variable = (Core.Name "variable") - -data TraversalTokenArgument = - TraversalTokenArgumentValue TraversalToken | - TraversalTokenArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalTokenArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalTokenArgument") - -_TraversalTokenArgument_value = (Core.Name "value") - -_TraversalTokenArgument_variable = (Core.Name "variable") - -data TraversalComparatorArgument = - TraversalComparatorArgumentValue TraversalOrder | - TraversalComparatorArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalComparatorArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalComparatorArgument") - -_TraversalComparatorArgument_value = (Core.Name "value") - -_TraversalComparatorArgument_variable = (Core.Name "variable") - -data TraversalFunctionArgument = - TraversalFunctionArgumentValue TraversalFunction | - TraversalFunctionArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalFunctionArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalFunctionArgument") - -_TraversalFunctionArgument_value = (Core.Name "value") - -_TraversalFunctionArgument_variable = (Core.Name "variable") - -data TraversalBiFunctionArgument = - TraversalBiFunctionArgumentValue TraversalOperator | - TraversalBiFunctionArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalBiFunctionArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalBiFunctionArgument") - -_TraversalBiFunctionArgument_value = (Core.Name "value") - -_TraversalBiFunctionArgument_variable = (Core.Name "variable") - -data TraversalDTArgument = - TraversalDTArgumentValue TraversalDT | - TraversalDTArgumentVariable Identifier - deriving (Eq, Ord, Read, Show) - -_TraversalDTArgument = (Core.Name "hydra/langs/tinkerpop/gremlin.TraversalDTArgument") - -_TraversalDTArgument_value = (Core.Name "value") - -_TraversalDTArgument_variable = (Core.Name "variable") - -newtype GenericLiteralList = - GenericLiteralList { - unGenericLiteralList :: [GenericLiteral]} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralList = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralList") - -data GenericLiteralRange = - GenericLiteralRangeInteger IntegerRange | - GenericLiteralRangeString StringRange - deriving (Eq, Ord, Read, Show) - -_GenericLiteralRange = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralRange") - -_GenericLiteralRange_integer = (Core.Name "integer") - -_GenericLiteralRange_string = (Core.Name "string") - -data IntegerRange = - IntegerRange { - integerRangeLeft :: IntegerLiteral, - integerRangeRight :: IntegerLiteral} - deriving (Eq, Ord, Read, Show) - -_IntegerRange = (Core.Name "hydra/langs/tinkerpop/gremlin.IntegerRange") - -_IntegerRange_left = (Core.Name "left") - -_IntegerRange_right = (Core.Name "right") - -data StringRange = - StringRange { - stringRangeLeft :: String, - stringRangeRight :: String} - deriving (Eq, Ord, Read, Show) - -_StringRange = (Core.Name "hydra/langs/tinkerpop/gremlin.StringRange") - -_StringRange_left = (Core.Name "left") - -_StringRange_right = (Core.Name "right") - -newtype GenericLiteralSet = - GenericLiteralSet { - unGenericLiteralSet :: [GenericLiteral]} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralSet = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralSet") - -newtype GenericLiteralCollection = - GenericLiteralCollection { - unGenericLiteralCollection :: [GenericLiteral]} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralCollection = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralCollection") - -data GenericLiteral = - GenericLiteralNumeric NumericLiteral | - GenericLiteralBoolean Bool | - GenericLiteralString String | - GenericLiteralDate DateLiteral | - GenericLiteralNull | - GenericLiteralNan | - GenericLiteralInf | - GenericLiteralTraversalToken TraversalToken | - GenericLiteralTraversalCardinality TraversalCardinality | - GenericLiteralTraversalDirection TraversalDirection | - GenericLiteralTraversalMerge TraversalMerge | - GenericLiteralTraversalPick TraversalPick | - GenericLiteralTraversalDT TraversalDT | - GenericLiteralStructureVertex StructureVertex | - GenericLiteralGenericLiteralSet GenericLiteralSet | - GenericLiteralGenericLiteralCollection GenericLiteralCollection | - GenericLiteralGenericLiteralRange GenericLiteralRange | - GenericLiteralNestedTraversal NestedTraversal | - GenericLiteralTerminatedTraversal TerminatedTraversal | - GenericLiteralGenericLiteralMap GenericLiteralMap - deriving (Eq, Ord, Read, Show) - -_GenericLiteral = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteral") - -_GenericLiteral_numeric = (Core.Name "numeric") - -_GenericLiteral_boolean = (Core.Name "boolean") - -_GenericLiteral_string = (Core.Name "string") - -_GenericLiteral_date = (Core.Name "date") - -_GenericLiteral_null = (Core.Name "null") - -_GenericLiteral_nan = (Core.Name "nan") - -_GenericLiteral_inf = (Core.Name "inf") - -_GenericLiteral_traversalToken = (Core.Name "traversalToken") - -_GenericLiteral_traversalCardinality = (Core.Name "traversalCardinality") - -_GenericLiteral_traversalDirection = (Core.Name "traversalDirection") - -_GenericLiteral_traversalMerge = (Core.Name "traversalMerge") - -_GenericLiteral_traversalPick = (Core.Name "traversalPick") - -_GenericLiteral_traversalDT = (Core.Name "traversalDT") - -_GenericLiteral_structureVertex = (Core.Name "structureVertex") - -_GenericLiteral_genericLiteralSet = (Core.Name "genericLiteralSet") - -_GenericLiteral_genericLiteralCollection = (Core.Name "genericLiteralCollection") - -_GenericLiteral_genericLiteralRange = (Core.Name "genericLiteralRange") - -_GenericLiteral_nestedTraversal = (Core.Name "nestedTraversal") - -_GenericLiteral_terminatedTraversal = (Core.Name "terminatedTraversal") - -_GenericLiteral_genericLiteralMap = (Core.Name "genericLiteralMap") - -newtype GenericLiteralMap = - GenericLiteralMap { - unGenericLiteralMap :: [MapEntry]} - deriving (Eq, Ord, Read, Show) - -_GenericLiteralMap = (Core.Name "hydra/langs/tinkerpop/gremlin.GenericLiteralMap") - -data MapEntry = - MapEntryKey MapKey | - MapEntryValue GenericLiteral - deriving (Eq, Ord, Read, Show) - -_MapEntry = (Core.Name "hydra/langs/tinkerpop/gremlin.MapEntry") - -_MapEntry_key = (Core.Name "key") - -_MapEntry_value = (Core.Name "value") - -data MapKey = - MapKeyString String | - MapKeyNumeric NumericLiteral | - MapKeyTraversalToken TraversalToken | - MapKeyTraversalDirection TraversalDirection | - MapKeySet GenericLiteralSet | - MapKeyCollection GenericLiteralCollection | - MapKeyMap GenericLiteralMap | - MapKeyKeyword Keyword | - MapKeyIdentifier Identifier - deriving (Eq, Ord, Read, Show) - -_MapKey = (Core.Name "hydra/langs/tinkerpop/gremlin.MapKey") - -_MapKey_string = (Core.Name "string") - -_MapKey_numeric = (Core.Name "numeric") - -_MapKey_traversalToken = (Core.Name "traversalToken") - -_MapKey_traversalDirection = (Core.Name "traversalDirection") - -_MapKey_set = (Core.Name "set") - -_MapKey_collection = (Core.Name "collection") - -_MapKey_map = (Core.Name "map") - -_MapKey_keyword = (Core.Name "keyword") - -_MapKey_identifier = (Core.Name "identifier") - -newtype IntegerLiteral = - IntegerLiteral { - unIntegerLiteral :: Integer} - deriving (Eq, Ord, Read, Show) - -_IntegerLiteral = (Core.Name "hydra/langs/tinkerpop/gremlin.IntegerLiteral") - -newtype FloatLiteral = - FloatLiteral { - unFloatLiteral :: Double} - deriving (Eq, Ord, Read, Show) - -_FloatLiteral = (Core.Name "hydra/langs/tinkerpop/gremlin.FloatLiteral") - -data NumericLiteral = - NumericLiteralInteger IntegerLiteral | - NumericLiteralFloat FloatLiteral - deriving (Eq, Ord, Read, Show) - -_NumericLiteral = (Core.Name "hydra/langs/tinkerpop/gremlin.NumericLiteral") - -_NumericLiteral_integer = (Core.Name "integer") - -_NumericLiteral_float = (Core.Name "float") - -newtype DateLiteral = - DateLiteral { - unDateLiteral :: (Maybe StringArgument)} - deriving (Eq, Ord, Read, Show) - -_DateLiteral = (Core.Name "hydra/langs/tinkerpop/gremlin.DateLiteral") - -data Keyword = - KeywordEdges | - KeywordKeys | - KeywordNew | - KeywordValues - deriving (Eq, Ord, Read, Show) - -_Keyword = (Core.Name "hydra/langs/tinkerpop/gremlin.Keyword") - -_Keyword_edges = (Core.Name "edges") - -_Keyword_keys = (Core.Name "keys") - -_Keyword_new = (Core.Name "new") - -_Keyword_values = (Core.Name "values") - -newtype Identifier = - Identifier { - unIdentifier :: String} - deriving (Eq, Ord, Read, Show) - -_Identifier = (Core.Name "hydra/langs/tinkerpop/gremlin.Identifier") diff --git a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Mappings.hs b/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Mappings.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Mappings.hs +++ /dev/null @@ -1,183 +0,0 @@ --- | A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs - -module Hydra.Langs.Tinkerpop.Mappings where - -import qualified Hydra.Compute as Compute -import qualified Hydra.Core as Core -import qualified Hydra.Langs.Tinkerpop.PropertyGraph as PropertyGraph -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | Configurable annotation keys for property graph mapping specifications -data AnnotationSchema = - AnnotationSchema { - annotationSchemaVertexLabel :: String, - annotationSchemaEdgeLabel :: String, - annotationSchemaVertexId :: String, - annotationSchemaEdgeId :: String, - annotationSchemaPropertyKey :: String, - annotationSchemaPropertyValue :: String, - annotationSchemaOutVertex :: String, - annotationSchemaOutVertexLabel :: String, - annotationSchemaInVertex :: String, - annotationSchemaInVertexLabel :: String, - annotationSchemaOutEdge :: String, - annotationSchemaOutEdgeLabel :: String, - annotationSchemaInEdge :: String, - annotationSchemaInEdgeLabel :: String, - annotationSchemaIgnore :: String} - deriving (Eq, Ord, Read, Show) - -_AnnotationSchema = (Core.Name "hydra/langs/tinkerpop/mappings.AnnotationSchema") - -_AnnotationSchema_vertexLabel = (Core.Name "vertexLabel") - -_AnnotationSchema_edgeLabel = (Core.Name "edgeLabel") - -_AnnotationSchema_vertexId = (Core.Name "vertexId") - -_AnnotationSchema_edgeId = (Core.Name "edgeId") - -_AnnotationSchema_propertyKey = (Core.Name "propertyKey") - -_AnnotationSchema_propertyValue = (Core.Name "propertyValue") - -_AnnotationSchema_outVertex = (Core.Name "outVertex") - -_AnnotationSchema_outVertexLabel = (Core.Name "outVertexLabel") - -_AnnotationSchema_inVertex = (Core.Name "inVertex") - -_AnnotationSchema_inVertexLabel = (Core.Name "inVertexLabel") - -_AnnotationSchema_outEdge = (Core.Name "outEdge") - -_AnnotationSchema_outEdgeLabel = (Core.Name "outEdgeLabel") - -_AnnotationSchema_inEdge = (Core.Name "inEdge") - -_AnnotationSchema_inEdgeLabel = (Core.Name "inEdgeLabel") - -_AnnotationSchema_ignore = (Core.Name "ignore") - --- | A mapping specification producing edges of a specified label. -data EdgeSpec = - EdgeSpec { - -- | The label of the target edges, which must conform to the edge type associated with that label. - edgeSpecLabel :: PropertyGraph.EdgeLabel, - -- | A specification of the id of each target edge - edgeSpecId :: ValueSpec, - -- | A specification of the out-vertex reference of each target edge - edgeSpecOut :: ValueSpec, - -- | A specification of the in-vertex reference of each target edge - edgeSpecIn :: ValueSpec, - -- | Zero or more property specifications for each target edge - edgeSpecProperties :: [PropertySpec]} - deriving (Eq, Ord, Read, Show) - -_EdgeSpec = (Core.Name "hydra/langs/tinkerpop/mappings.EdgeSpec") - -_EdgeSpec_label = (Core.Name "label") - -_EdgeSpec_id = (Core.Name "id") - -_EdgeSpec_out = (Core.Name "out") - -_EdgeSpec_in = (Core.Name "in") - -_EdgeSpec_properties = (Core.Name "properties") - --- | Either a vertex specification or an edge specification -data ElementSpec = - ElementSpecVertex VertexSpec | - ElementSpecEdge EdgeSpec - deriving (Eq, Ord, Read, Show) - -_ElementSpec = (Core.Name "hydra/langs/tinkerpop/mappings.ElementSpec") - -_ElementSpec_vertex = (Core.Name "vertex") - -_ElementSpec_edge = (Core.Name "edge") - --- | A mapping specification producing properties of a specified key, and values of the appropriate type. -data PropertySpec = - PropertySpec { - -- | The key of the target properties - propertySpecKey :: PropertyGraph.PropertyKey, - -- | A specification of the value of each target property, which must conform to the type associated with the property key - propertySpecValue :: ValueSpec} - deriving (Eq, Ord, Read, Show) - -_PropertySpec = (Core.Name "hydra/langs/tinkerpop/mappings.PropertySpec") - -_PropertySpec_key = (Core.Name "key") - -_PropertySpec_value = (Core.Name "value") - --- | A set of mappings which translates between Hydra terms and annotations, and application-specific property graph types -data Schema s t v = - Schema { - schemaVertexIdTypes :: (Compute.Coder s s Core.Type t), - schemaVertexIds :: (Compute.Coder s s Core.Term v), - schemaEdgeIdTypes :: (Compute.Coder s s Core.Type t), - schemaEdgeIds :: (Compute.Coder s s Core.Term v), - schemaPropertyTypes :: (Compute.Coder s s Core.Type t), - schemaPropertyValues :: (Compute.Coder s s Core.Term v), - schemaAnnotations :: AnnotationSchema, - schemaDefaultVertexId :: v, - schemaDefaultEdgeId :: v} - -_Schema = (Core.Name "hydra/langs/tinkerpop/mappings.Schema") - -_Schema_vertexIdTypes = (Core.Name "vertexIdTypes") - -_Schema_vertexIds = (Core.Name "vertexIds") - -_Schema_edgeIdTypes = (Core.Name "edgeIdTypes") - -_Schema_edgeIds = (Core.Name "edgeIds") - -_Schema_propertyTypes = (Core.Name "propertyTypes") - -_Schema_propertyValues = (Core.Name "propertyValues") - -_Schema_annotations = (Core.Name "annotations") - -_Schema_defaultVertexId = (Core.Name "defaultVertexId") - -_Schema_defaultEdgeId = (Core.Name "defaultEdgeId") - --- | A mapping specification producing values (usually literal values) whose type is understood in context -data ValueSpec = - -- | A trivial no-op specification which passes the entire value - ValueSpecValue | - -- | A compact path representing the function, e.g. engine-${engineInfo/model/name} - ValueSpecPattern String - deriving (Eq, Ord, Read, Show) - -_ValueSpec = (Core.Name "hydra/langs/tinkerpop/mappings.ValueSpec") - -_ValueSpec_value = (Core.Name "value") - -_ValueSpec_pattern = (Core.Name "pattern") - --- | A mapping specification producing vertices of a specified label -data VertexSpec = - VertexSpec { - -- | The label of the target vertices, which must conform to the vertex type associated with that label. - vertexSpecLabel :: PropertyGraph.VertexLabel, - -- | A specification of the id of each target vertex - vertexSpecId :: ValueSpec, - -- | Zero or more property specifications for each target vertex - vertexSpecProperties :: [PropertySpec]} - deriving (Eq, Ord, Read, Show) - -_VertexSpec = (Core.Name "hydra/langs/tinkerpop/mappings.VertexSpec") - -_VertexSpec_label = (Core.Name "label") - -_VertexSpec_id = (Core.Name "id") - -_VertexSpec_properties = (Core.Name "properties") diff --git a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/PropertyGraph.hs b/src/gen-main/haskell/Hydra/Langs/Tinkerpop/PropertyGraph.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/PropertyGraph.hs +++ /dev/null @@ -1,279 +0,0 @@ --- | A typed property graph data model. Property graphs are parameterized a type for property and id values, while property graph schemas are parameterized by a type for property and id types - -module Hydra.Langs.Tinkerpop.PropertyGraph where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | The direction of an edge or edge pattern -data Direction = - DirectionOut | - DirectionIn | - DirectionBoth | - DirectionUndirected - deriving (Eq, Ord, Read, Show) - -_Direction = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Direction") - -_Direction_out = (Core.Name "out") - -_Direction_in = (Core.Name "in") - -_Direction_both = (Core.Name "both") - -_Direction_undirected = (Core.Name "undirected") - --- | An edge -data Edge v = - Edge { - -- | The label of the edge - edgeLabel :: EdgeLabel, - -- | The unique identifier of the edge - edgeId :: v, - -- | The id of the out-vertex (tail) of the edge - edgeOut :: v, - -- | The id of the in-vertex (head) of the edge - edgeIn :: v, - -- | A key/value map of edge properties - edgeProperties :: (Map PropertyKey v)} - deriving (Eq, Ord, Read, Show) - -_Edge = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Edge") - -_Edge_label = (Core.Name "label") - -_Edge_id = (Core.Name "id") - -_Edge_out = (Core.Name "out") - -_Edge_in = (Core.Name "in") - -_Edge_properties = (Core.Name "properties") - --- | The label of an edge -newtype EdgeLabel = - EdgeLabel { - unEdgeLabel :: String} - deriving (Eq, Ord, Read, Show) - -_EdgeLabel = (Core.Name "hydra/langs/tinkerpop/propertyGraph.EdgeLabel") - --- | The type of an edge -data EdgeType t = - EdgeType { - -- | The label of any edge of this edge type - edgeTypeLabel :: EdgeLabel, - -- | The type of the id of any edge of this edge type - edgeTypeId :: t, - -- | The label of the out-vertex (tail) of any edge of this edge type - edgeTypeOut :: VertexLabel, - -- | The label of the in-vertex (head) of any edge of this edge type - edgeTypeIn :: VertexLabel, - -- | A list of property types. The types are ordered for the sake of applications in which property order is significant. - edgeTypeProperties :: [PropertyType t]} - deriving (Eq, Ord, Read, Show) - -_EdgeType = (Core.Name "hydra/langs/tinkerpop/propertyGraph.EdgeType") - -_EdgeType_label = (Core.Name "label") - -_EdgeType_id = (Core.Name "id") - -_EdgeType_out = (Core.Name "out") - -_EdgeType_in = (Core.Name "in") - -_EdgeType_properties = (Core.Name "properties") - --- | Either a vertex or an edge -data Element v = - ElementVertex (Vertex v) | - ElementEdge (Edge v) - deriving (Eq, Ord, Read, Show) - -_Element = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Element") - -_Element_vertex = (Core.Name "vertex") - -_Element_edge = (Core.Name "edge") - --- | The kind of an element: vertex or edge -data ElementKind = - ElementKindVertex | - ElementKindEdge - deriving (Eq, Ord, Read, Show) - -_ElementKind = (Core.Name "hydra/langs/tinkerpop/propertyGraph.ElementKind") - -_ElementKind_vertex = (Core.Name "vertex") - -_ElementKind_edge = (Core.Name "edge") - --- | An element together with its dependencies in some context -data ElementTree v = - ElementTree { - elementTreeSelf :: (Element v), - elementTreeDependencies :: [ElementTree v]} - deriving (Eq, Ord, Read, Show) - -_ElementTree = (Core.Name "hydra/langs/tinkerpop/propertyGraph.ElementTree") - -_ElementTree_self = (Core.Name "self") - -_ElementTree_dependencies = (Core.Name "dependencies") - --- | The type of a vertex or edge -data ElementType t = - ElementTypeVertex (VertexType t) | - ElementTypeEdge (EdgeType t) - deriving (Eq, Ord, Read, Show) - -_ElementType = (Core.Name "hydra/langs/tinkerpop/propertyGraph.ElementType") - -_ElementType_vertex = (Core.Name "vertex") - -_ElementType_edge = (Core.Name "edge") - --- | An element type together with its dependencies in some context -data ElementTypeTree t = - ElementTypeTree { - elementTypeTreeSelf :: (ElementType t), - elementTypeTreeDependencies :: [ElementTypeTree t]} - deriving (Eq, Ord, Read, Show) - -_ElementTypeTree = (Core.Name "hydra/langs/tinkerpop/propertyGraph.ElementTypeTree") - -_ElementTypeTree_self = (Core.Name "self") - -_ElementTypeTree_dependencies = (Core.Name "dependencies") - --- | A graph; a self-contained collection of vertices and edges -data Graph v = - Graph { - graphVertices :: (Map v (Vertex v)), - graphEdges :: (Map v (Edge v))} - deriving (Eq, Ord, Read, Show) - -_Graph = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Graph") - -_Graph_vertices = (Core.Name "vertices") - -_Graph_edges = (Core.Name "edges") - --- | A graph schema; a vertex and edge types for the vertices and edges of a graph conforming to the schema -data GraphSchema t = - GraphSchema { - -- | A unique vertex type for each vertex label which may occur in a graph - graphSchemaVertices :: (Map VertexLabel (VertexType t)), - -- | A unique edge type for each edge label which may occur in a graph - graphSchemaEdges :: (Map EdgeLabel (EdgeType t))} - deriving (Eq, Ord, Read, Show) - -_GraphSchema = (Core.Name "hydra/langs/tinkerpop/propertyGraph.GraphSchema") - -_GraphSchema_vertices = (Core.Name "vertices") - -_GraphSchema_edges = (Core.Name "edges") - --- | Either a vertex or edge label -data Label = - LabelVertex VertexLabel | - LabelEdge EdgeLabel - deriving (Eq, Ord, Read, Show) - -_Label = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Label") - -_Label_vertex = (Core.Name "vertex") - -_Label_edge = (Core.Name "edge") - --- | A key/value property -data Property v = - Property { - -- | They key of the property - propertyKey :: PropertyKey, - -- | The value of the property - propertyValue :: v} - deriving (Eq, Ord, Read, Show) - -_Property = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Property") - -_Property_key = (Core.Name "key") - -_Property_value = (Core.Name "value") - --- | A property key -newtype PropertyKey = - PropertyKey { - unPropertyKey :: String} - deriving (Eq, Ord, Read, Show) - -_PropertyKey = (Core.Name "hydra/langs/tinkerpop/propertyGraph.PropertyKey") - --- | The type of a property -data PropertyType t = - PropertyType { - -- | A property's key - propertyTypeKey :: PropertyKey, - -- | The type of a property's value - propertyTypeValue :: t, - -- | Whether the property is required; values may be omitted from a property map otherwise - propertyTypeRequired :: Bool} - deriving (Eq, Ord, Read, Show) - -_PropertyType = (Core.Name "hydra/langs/tinkerpop/propertyGraph.PropertyType") - -_PropertyType_key = (Core.Name "key") - -_PropertyType_value = (Core.Name "value") - -_PropertyType_required = (Core.Name "required") - --- | A vertex -data Vertex v = - Vertex { - -- | The label of the vertex - vertexLabel :: VertexLabel, - -- | The unique identifier of the vertex - vertexId :: v, - -- | A key/value map of vertex properties - vertexProperties :: (Map PropertyKey v)} - deriving (Eq, Ord, Read, Show) - -_Vertex = (Core.Name "hydra/langs/tinkerpop/propertyGraph.Vertex") - -_Vertex_label = (Core.Name "label") - -_Vertex_id = (Core.Name "id") - -_Vertex_properties = (Core.Name "properties") - --- | The label of a vertex. The default (null) vertex is represented by the empty string -newtype VertexLabel = - VertexLabel { - unVertexLabel :: String} - deriving (Eq, Ord, Read, Show) - -_VertexLabel = (Core.Name "hydra/langs/tinkerpop/propertyGraph.VertexLabel") - --- | The type of a vertex -data VertexType t = - VertexType { - -- | The label of any vertex of this vertex type - vertexTypeLabel :: VertexLabel, - -- | The type of the id of any vertex of this vertex type - vertexTypeId :: t, - -- | A list of property types. The types are ordered for the sake of applications in which property order is significant. - vertexTypeProperties :: [PropertyType t]} - deriving (Eq, Ord, Read, Show) - -_VertexType = (Core.Name "hydra/langs/tinkerpop/propertyGraph.VertexType") - -_VertexType_label = (Core.Name "label") - -_VertexType_id = (Core.Name "id") - -_VertexType_properties = (Core.Name "properties") diff --git a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Queries.hs b/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Queries.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Queries.hs +++ /dev/null @@ -1,329 +0,0 @@ --- | A common model for pattern-matching queries over property graphs - -module Hydra.Langs.Tinkerpop.Queries where - -import qualified Hydra.Core as Core -import qualified Hydra.Langs.Tinkerpop.PropertyGraph as PropertyGraph -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -data AggregationQuery = - AggregationQueryCount - deriving (Eq, Ord, Read, Show) - -_AggregationQuery = (Core.Name "hydra/langs/tinkerpop/queries.AggregationQuery") - -_AggregationQuery_count = (Core.Name "count") - -newtype ApplicationQuery = - ApplicationQuery { - unApplicationQuery :: [Query]} - deriving (Eq, Ord, Read, Show) - -_ApplicationQuery = (Core.Name "hydra/langs/tinkerpop/queries.ApplicationQuery") - -data AssociativeExpression = - AssociativeExpression { - associativeExpressionOperator :: BinaryOperator, - associativeExpressionOperands :: [Expression]} - deriving (Eq, Ord, Read, Show) - -_AssociativeExpression = (Core.Name "hydra/langs/tinkerpop/queries.AssociativeExpression") - -_AssociativeExpression_operator = (Core.Name "operator") - -_AssociativeExpression_operands = (Core.Name "operands") - -data BinaryExpression = - BinaryExpression { - binaryExpressionLeft :: Expression, - binaryExpressionOperator :: BinaryOperator, - binaryExpressionRight :: Expression} - deriving (Eq, Ord, Read, Show) - -_BinaryExpression = (Core.Name "hydra/langs/tinkerpop/queries.BinaryExpression") - -_BinaryExpression_left = (Core.Name "left") - -_BinaryExpression_operator = (Core.Name "operator") - -_BinaryExpression_right = (Core.Name "right") - -data BinaryBooleanOperator = - BinaryBooleanOperatorAnd | - BinaryBooleanOperatorOr | - BinaryBooleanOperatorXor - deriving (Eq, Ord, Read, Show) - -_BinaryBooleanOperator = (Core.Name "hydra/langs/tinkerpop/queries.BinaryBooleanOperator") - -_BinaryBooleanOperator_and = (Core.Name "and") - -_BinaryBooleanOperator_or = (Core.Name "or") - -_BinaryBooleanOperator_xor = (Core.Name "xor") - -data BinaryOperator = - BinaryOperatorBoolean BinaryBooleanOperator | - BinaryOperatorComparison ComparisonOperator | - BinaryOperatorPower - deriving (Eq, Ord, Read, Show) - -_BinaryOperator = (Core.Name "hydra/langs/tinkerpop/queries.BinaryOperator") - -_BinaryOperator_boolean = (Core.Name "boolean") - -_BinaryOperator_comparison = (Core.Name "comparison") - -_BinaryOperator_power = (Core.Name "power") - -data Binding = - Binding { - bindingKey :: Variable, - bindingValue :: Query} - deriving (Eq, Ord, Read, Show) - -_Binding = (Core.Name "hydra/langs/tinkerpop/queries.Binding") - -_Binding_key = (Core.Name "key") - -_Binding_value = (Core.Name "value") - -data ComparisonOperator = - ComparisonOperatorEq | - ComparisonOperatorNeq | - ComparisonOperatorLt | - ComparisonOperatorLte | - ComparisonOperatorGt | - ComparisonOperatorGte - deriving (Eq, Ord, Read, Show) - -_ComparisonOperator = (Core.Name "hydra/langs/tinkerpop/queries.ComparisonOperator") - -_ComparisonOperator_eq = (Core.Name "eq") - -_ComparisonOperator_neq = (Core.Name "neq") - -_ComparisonOperator_lt = (Core.Name "lt") - -_ComparisonOperator_lte = (Core.Name "lte") - -_ComparisonOperator_gt = (Core.Name "gt") - -_ComparisonOperator_gte = (Core.Name "gte") - -data EdgeProjectionPattern = - EdgeProjectionPattern { - edgeProjectionPatternDirection :: PropertyGraph.Direction, - edgeProjectionPatternLabel :: (Maybe PropertyGraph.EdgeLabel), - edgeProjectionPatternProperties :: [PropertyPattern], - edgeProjectionPatternVertex :: (Maybe VertexPattern)} - deriving (Eq, Ord, Read, Show) - -_EdgeProjectionPattern = (Core.Name "hydra/langs/tinkerpop/queries.EdgeProjectionPattern") - -_EdgeProjectionPattern_direction = (Core.Name "direction") - -_EdgeProjectionPattern_label = (Core.Name "label") - -_EdgeProjectionPattern_properties = (Core.Name "properties") - -_EdgeProjectionPattern_vertex = (Core.Name "vertex") - -data Expression = - ExpressionAssociative AssociativeExpression | - ExpressionBinary BinaryExpression | - ExpressionProperty PropertyProjection | - ExpressionUnary UnaryExpression | - ExpressionVariable Variable | - ExpressionVertex VertexPattern - deriving (Eq, Ord, Read, Show) - -_Expression = (Core.Name "hydra/langs/tinkerpop/queries.Expression") - -_Expression_associative = (Core.Name "associative") - -_Expression_binary = (Core.Name "binary") - -_Expression_property = (Core.Name "property") - -_Expression_unary = (Core.Name "unary") - -_Expression_variable = (Core.Name "variable") - -_Expression_vertex = (Core.Name "vertex") - -data LetQuery = - LetQuery { - letQueryBindings :: [Binding], - letQueryEnvironment :: Query} - deriving (Eq, Ord, Read, Show) - -_LetQuery = (Core.Name "hydra/langs/tinkerpop/queries.LetQuery") - -_LetQuery_bindings = (Core.Name "bindings") - -_LetQuery_environment = (Core.Name "environment") - -data MatchQuery = - MatchQuery { - matchQueryOptional :: Bool, - matchQueryPattern :: [Projection], - matchQueryWhere :: (Maybe Expression)} - deriving (Eq, Ord, Read, Show) - -_MatchQuery = (Core.Name "hydra/langs/tinkerpop/queries.MatchQuery") - -_MatchQuery_optional = (Core.Name "optional") - -_MatchQuery_pattern = (Core.Name "pattern") - -_MatchQuery_where = (Core.Name "where") - -data Projection = - Projection { - projectionValue :: Expression, - projectionAs :: (Maybe Variable)} - deriving (Eq, Ord, Read, Show) - -_Projection = (Core.Name "hydra/langs/tinkerpop/queries.Projection") - -_Projection_value = (Core.Name "value") - -_Projection_as = (Core.Name "as") - -data Projections = - Projections { - projectionsAll :: Bool, - projectionsExplicit :: [Projection]} - deriving (Eq, Ord, Read, Show) - -_Projections = (Core.Name "hydra/langs/tinkerpop/queries.Projections") - -_Projections_all = (Core.Name "all") - -_Projections_explicit = (Core.Name "explicit") - -data PropertyPattern = - PropertyPattern { - propertyPatternKey :: PropertyGraph.PropertyKey, - propertyPatternValue :: PropertyValuePattern} - deriving (Eq, Ord, Read, Show) - -_PropertyPattern = (Core.Name "hydra/langs/tinkerpop/queries.PropertyPattern") - -_PropertyPattern_key = (Core.Name "key") - -_PropertyPattern_value = (Core.Name "value") - -data PropertyProjection = - PropertyProjection { - propertyProjectionBase :: Expression, - propertyProjectionKey :: PropertyGraph.PropertyKey} - deriving (Eq, Ord, Read, Show) - -_PropertyProjection = (Core.Name "hydra/langs/tinkerpop/queries.PropertyProjection") - -_PropertyProjection_base = (Core.Name "base") - -_PropertyProjection_key = (Core.Name "key") - -newtype PropertyValue = - PropertyValue { - unPropertyValue :: String} - deriving (Eq, Ord, Read, Show) - -_PropertyValue = (Core.Name "hydra/langs/tinkerpop/queries.PropertyValue") - -data PropertyValuePattern = - PropertyValuePatternVariable PropertyGraph.PropertyKey | - PropertyValuePatternValue String - deriving (Eq, Ord, Read, Show) - -_PropertyValuePattern = (Core.Name "hydra/langs/tinkerpop/queries.PropertyValuePattern") - -_PropertyValuePattern_variable = (Core.Name "variable") - -_PropertyValuePattern_value = (Core.Name "value") - -data Query = - QueryApplication ApplicationQuery | - QueryAggregate AggregationQuery | - QueryLetQuery LetQuery | - QueryMatch MatchQuery | - QuerySelect SelectQuery | - QueryValue String - deriving (Eq, Ord, Read, Show) - -_Query = (Core.Name "hydra/langs/tinkerpop/queries.Query") - -_Query_application = (Core.Name "application") - -_Query_aggregate = (Core.Name "aggregate") - -_Query_LetQuery = (Core.Name "LetQuery") - -_Query_match = (Core.Name "match") - -_Query_select = (Core.Name "select") - -_Query_value = (Core.Name "value") - -data SelectQuery = - SelectQuery { - selectQueryDistinct :: Bool, - selectQueryProjection :: Projections} - deriving (Eq, Ord, Read, Show) - -_SelectQuery = (Core.Name "hydra/langs/tinkerpop/queries.SelectQuery") - -_SelectQuery_distinct = (Core.Name "distinct") - -_SelectQuery_projection = (Core.Name "projection") - -data UnaryExpression = - UnaryExpression { - unaryExpressionOperator :: UnaryOperator, - unaryExpressionOperand :: Expression} - deriving (Eq, Ord, Read, Show) - -_UnaryExpression = (Core.Name "hydra/langs/tinkerpop/queries.UnaryExpression") - -_UnaryExpression_operator = (Core.Name "operator") - -_UnaryExpression_operand = (Core.Name "operand") - -data UnaryOperator = - UnaryOperatorNegate - deriving (Eq, Ord, Read, Show) - -_UnaryOperator = (Core.Name "hydra/langs/tinkerpop/queries.UnaryOperator") - -_UnaryOperator_negate = (Core.Name "negate") - -newtype Variable = - Variable { - unVariable :: String} - deriving (Eq, Ord, Read, Show) - -_Variable = (Core.Name "hydra/langs/tinkerpop/queries.Variable") - -data VertexPattern = - VertexPattern { - vertexPatternVariable :: (Maybe Variable), - vertexPatternLabel :: (Maybe PropertyGraph.VertexLabel), - vertexPatternProperties :: [PropertyPattern], - vertexPatternEdges :: [EdgeProjectionPattern]} - deriving (Eq, Ord, Read, Show) - -_VertexPattern = (Core.Name "hydra/langs/tinkerpop/queries.VertexPattern") - -_VertexPattern_variable = (Core.Name "variable") - -_VertexPattern_label = (Core.Name "label") - -_VertexPattern_properties = (Core.Name "properties") - -_VertexPattern_edges = (Core.Name "edges") diff --git a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Validate.hs b/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Validate.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Tinkerpop/Validate.hs +++ /dev/null @@ -1,143 +0,0 @@ --- | Utilities for validating property graphs against property graph schemas - -module Hydra.Langs.Tinkerpop.Validate where - -import qualified Hydra.Langs.Tinkerpop.PropertyGraph as PropertyGraph -import qualified Hydra.Lib.Equality as Equality -import qualified Hydra.Lib.Lists as Lists -import qualified Hydra.Lib.Logic as Logic -import qualified Hydra.Lib.Maps as Maps -import qualified Hydra.Lib.Optionals as Optionals -import qualified Hydra.Lib.Strings as Strings -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -validateEdge :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe PropertyGraph.VertexLabel) -> PropertyGraph.EdgeType t -> PropertyGraph.Edge v -> Maybe String) -validateEdge checkValue showValue labelForVertexId typ el = - let failWith = (edgeError showValue el) - checkLabel = - let expected = (PropertyGraph.edgeTypeLabel typ) - actual = (PropertyGraph.edgeLabel el) - in (verify (Equality.equalString (PropertyGraph.unEdgeLabel actual) (PropertyGraph.unEdgeLabel expected)) (failWith (prepend "Wrong label" (edgeLabelMismatch expected actual)))) - checkId = (Optionals.map (\x -> failWith (prepend "Invalid id" x)) (checkValue (PropertyGraph.edgeTypeId typ) (PropertyGraph.edgeId el))) - checkProperties = (Optionals.map (\x -> failWith (prepend "Invalid property" x)) (validateProperties checkValue (PropertyGraph.edgeTypeProperties typ) (PropertyGraph.edgeProperties el))) - checkOut = ((\x -> case x of - Nothing -> Nothing - Just v286 -> ((\x -> case x of - Nothing -> (Just (failWith (prepend "Out-vertex does not exist" (showValue (PropertyGraph.edgeOut el))))) - Just v287 -> (verify (Equality.equalString (PropertyGraph.unVertexLabel v287) (PropertyGraph.unVertexLabel (PropertyGraph.edgeTypeOut typ))) (failWith (prepend "Wrong out-vertex label" (vertexLabelMismatch (PropertyGraph.edgeTypeOut typ) v287))))) (v286 (PropertyGraph.edgeOut el)))) labelForVertexId) - checkIn = ((\x -> case x of - Nothing -> Nothing - Just v288 -> ((\x -> case x of - Nothing -> (Just (failWith (prepend "In-vertex does not exist" (showValue (PropertyGraph.edgeIn el))))) - Just v289 -> (verify (Equality.equalString (PropertyGraph.unVertexLabel v289) (PropertyGraph.unVertexLabel (PropertyGraph.edgeTypeIn typ))) (failWith (prepend "Wrong in-vertex label" (vertexLabelMismatch (PropertyGraph.edgeTypeIn typ) v289))))) (v288 (PropertyGraph.edgeIn el)))) labelForVertexId) - in (checkAll [ - checkLabel, - checkId, - checkProperties, - checkOut, - checkIn]) - -validateElement :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe PropertyGraph.VertexLabel) -> PropertyGraph.ElementType t -> PropertyGraph.Element v -> Maybe String) -validateElement checkValue showValue labelForVertexId typ el = ((\x -> case x of - PropertyGraph.ElementTypeVertex v290 -> ((\x -> case x of - PropertyGraph.ElementEdge v291 -> (Just (prepend "Edge instead of vertex" (showValue (PropertyGraph.edgeId v291)))) - PropertyGraph.ElementVertex v292 -> (validateVertex checkValue showValue v290 v292)) el) - PropertyGraph.ElementTypeEdge v293 -> ((\x -> case x of - PropertyGraph.ElementVertex v294 -> (Just (prepend "Vertex instead of edge" (showValue (PropertyGraph.vertexId v294)))) - PropertyGraph.ElementEdge v295 -> (validateEdge checkValue showValue labelForVertexId v293 v295)) el)) typ) - -validateGraph :: (Ord v) => ((t -> v -> Maybe String) -> (v -> String) -> PropertyGraph.GraphSchema t -> PropertyGraph.Graph v -> Maybe String) -validateGraph checkValue showValue schema graph = - let checkVertices = - let checkVertex = (\el -> (\x -> case x of - Nothing -> (Just (vertexError showValue el (prepend "Unexpected label" (PropertyGraph.unVertexLabel (PropertyGraph.vertexLabel el))))) - Just v296 -> (validateVertex checkValue showValue v296 el)) (Maps.lookup (PropertyGraph.vertexLabel el) (PropertyGraph.graphSchemaVertices schema))) - in (checkAll (Lists.map checkVertex (Maps.values (PropertyGraph.graphVertices graph)))) - checkEdges = - let checkEdge = (\el -> (\x -> case x of - Nothing -> (Just (edgeError showValue el (prepend "Unexpected label" (PropertyGraph.unEdgeLabel (PropertyGraph.edgeLabel el))))) - Just v297 -> (validateEdge checkValue showValue labelForVertexId v297 el)) (Maps.lookup (PropertyGraph.edgeLabel el) (PropertyGraph.graphSchemaEdges schema))) - labelForVertexId = (Just (\i -> Optionals.map PropertyGraph.vertexLabel (Maps.lookup i (PropertyGraph.graphVertices graph)))) - in (checkAll (Lists.map checkEdge (Maps.values (PropertyGraph.graphEdges graph)))) - in (checkAll [ - checkVertices, - checkEdges]) - -validateProperties :: ((t -> v -> Maybe String) -> [PropertyGraph.PropertyType t] -> Map PropertyGraph.PropertyKey v -> Maybe String) -validateProperties checkValue types props = - let checkTypes = (checkAll (Lists.map checkType types)) - checkType = (\t -> Logic.ifElse ((\x -> case x of - Nothing -> (Just (prepend "Missing value for " (PropertyGraph.unPropertyKey (PropertyGraph.propertyTypeKey t)))) - Just _ -> Nothing) (Maps.lookup (PropertyGraph.propertyTypeKey t) props)) Nothing (PropertyGraph.propertyTypeRequired t)) - checkValues = - let m = (Maps.fromList (Lists.map (\p -> (PropertyGraph.propertyTypeKey p, (PropertyGraph.propertyTypeValue p))) types)) - checkPair = (\pair -> - let key = (fst pair) - val = (snd pair) - in ((\x -> case x of - Nothing -> (Just (prepend "Unexpected key" (PropertyGraph.unPropertyKey key))) - Just v299 -> (Optionals.map (prepend "Invalid value") (checkValue v299 val))) (Maps.lookup key m))) - in (checkAll (Lists.map checkPair (Maps.toList props))) - in (checkAll [ - checkTypes, - checkValues]) - -validateVertex :: ((t -> v -> Maybe String) -> (v -> String) -> PropertyGraph.VertexType t -> PropertyGraph.Vertex v -> Maybe String) -validateVertex checkValue showValue typ el = - let failWith = (vertexError showValue el) - checkLabel = - let expected = (PropertyGraph.vertexTypeLabel typ) - actual = (PropertyGraph.vertexLabel el) - in (verify (Equality.equalString (PropertyGraph.unVertexLabel actual) (PropertyGraph.unVertexLabel expected)) (failWith (prepend "Wrong label" (vertexLabelMismatch expected actual)))) - checkId = (Optionals.map (\x -> failWith (prepend "Invalid id" x)) (checkValue (PropertyGraph.vertexTypeId typ) (PropertyGraph.vertexId el))) - checkProperties = (Optionals.map (\x -> failWith (prepend "Invalid property" x)) (validateProperties checkValue (PropertyGraph.vertexTypeProperties typ) (PropertyGraph.vertexProperties el))) - in (checkAll [ - checkLabel, - checkId, - checkProperties]) - -checkAll :: ([Maybe a] -> Maybe a) -checkAll checks = - let errors = (Optionals.cat checks) - in (Lists.safeHead errors) - -edgeError :: ((v -> String) -> PropertyGraph.Edge v -> String -> String) -edgeError showValue e = (prepend (Strings.cat [ - "Invalid edge with id ", - (showValue (PropertyGraph.edgeId e))])) - -edgeLabelMismatch :: (PropertyGraph.EdgeLabel -> PropertyGraph.EdgeLabel -> String) -edgeLabelMismatch expected actual = (Strings.cat [ - Strings.cat [ - Strings.cat [ - "expected ", - (PropertyGraph.unEdgeLabel expected)], - ", found "], - (PropertyGraph.unEdgeLabel actual)]) - -prepend :: (String -> String -> String) -prepend prefix msg = (Strings.cat [ - Strings.cat [ - prefix, - ": "], - msg]) - -verify :: (Bool -> String -> Maybe String) -verify b err = (Logic.ifElse Nothing (Just err) b) - -vertexError :: ((v -> String) -> PropertyGraph.Vertex v -> String -> String) -vertexError showValue v = (prepend (Strings.cat [ - "Invalid vertex with id ", - (showValue (PropertyGraph.vertexId v))])) - -vertexLabelMismatch :: (PropertyGraph.VertexLabel -> PropertyGraph.VertexLabel -> String) -vertexLabelMismatch expected actual = (Strings.cat [ - Strings.cat [ - Strings.cat [ - "expected ", - (PropertyGraph.unVertexLabel expected)], - ", found "], - (PropertyGraph.unVertexLabel actual)]) diff --git a/src/gen-main/haskell/Hydra/Langs/Xml/Schema.hs b/src/gen-main/haskell/Hydra/Langs/Xml/Schema.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Xml/Schema.hs +++ /dev/null @@ -1,465 +0,0 @@ --- | A partial XML Schema model, focusing on datatypes. All simple datatypes (i.e. xsd:anySimpleType and below) are included. --- | See: https://www.w3.org/TR/xmlschema-2 --- | Note: for most of the XML Schema datatype definitions included here, the associated Hydra type is simply --- | the string type. Exceptions are made for xsd:boolean and most of the numeric types, where there is a clearly --- | corresponding Hydra literal type. - -module Hydra.Langs.Xml.Schema where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - -newtype AnySimpleType = - AnySimpleType { - unAnySimpleType :: String} - deriving (Eq, Ord, Read, Show) - -_AnySimpleType = (Core.Name "hydra/langs/xml/schema.AnySimpleType") - -newtype AnyType = - AnyType { - unAnyType :: String} - deriving (Eq, Ord, Read, Show) - -_AnyType = (Core.Name "hydra/langs/xml/schema.AnyType") - -newtype AnyURI = - AnyURI { - unAnyURI :: String} - deriving (Eq, Ord, Read, Show) - -_AnyURI = (Core.Name "hydra/langs/xml/schema.AnyURI") - -newtype Base64Binary = - Base64Binary { - unBase64Binary :: String} - deriving (Eq, Ord, Read, Show) - -_Base64Binary = (Core.Name "hydra/langs/xml/schema.Base64Binary") - -newtype Boolean = - Boolean { - unBoolean :: Bool} - deriving (Eq, Ord, Read, Show) - -_Boolean = (Core.Name "hydra/langs/xml/schema.Boolean") - -newtype Byte = - Byte { - unByte :: Int8} - deriving (Eq, Ord, Read, Show) - -_Byte = (Core.Name "hydra/langs/xml/schema.Byte") - -newtype Date = - Date { - unDate :: String} - deriving (Eq, Ord, Read, Show) - -_Date = (Core.Name "hydra/langs/xml/schema.Date") - -newtype DateTime = - DateTime { - unDateTime :: String} - deriving (Eq, Ord, Read, Show) - -_DateTime = (Core.Name "hydra/langs/xml/schema.DateTime") - -newtype Decimal = - Decimal { - unDecimal :: String} - deriving (Eq, Ord, Read, Show) - -_Decimal = (Core.Name "hydra/langs/xml/schema.Decimal") - -newtype Double_ = - Double_ { - unDouble :: Double} - deriving (Eq, Ord, Read, Show) - -_Double = (Core.Name "hydra/langs/xml/schema.Double") - -newtype Duration = - Duration { - unDuration :: String} - deriving (Eq, Ord, Read, Show) - -_Duration = (Core.Name "hydra/langs/xml/schema.Duration") - -newtype ENTITIES = - ENTITIES { - unENTITIES :: String} - deriving (Eq, Ord, Read, Show) - -_ENTITIES = (Core.Name "hydra/langs/xml/schema.ENTITIES") - -newtype ENTITY = - ENTITY { - unENTITY :: String} - deriving (Eq, Ord, Read, Show) - -_ENTITY = (Core.Name "hydra/langs/xml/schema.ENTITY") - -newtype Float_ = - Float_ { - unFloat :: Float} - deriving (Eq, Ord, Read, Show) - -_Float = (Core.Name "hydra/langs/xml/schema.Float") - -newtype GDay = - GDay { - unGDay :: String} - deriving (Eq, Ord, Read, Show) - -_GDay = (Core.Name "hydra/langs/xml/schema.GDay") - -newtype GMonth = - GMonth { - unGMonth :: String} - deriving (Eq, Ord, Read, Show) - -_GMonth = (Core.Name "hydra/langs/xml/schema.GMonth") - -newtype GMonthDay = - GMonthDay { - unGMonthDay :: String} - deriving (Eq, Ord, Read, Show) - -_GMonthDay = (Core.Name "hydra/langs/xml/schema.GMonthDay") - -newtype GYear = - GYear { - unGYear :: String} - deriving (Eq, Ord, Read, Show) - -_GYear = (Core.Name "hydra/langs/xml/schema.GYear") - -newtype GYearMonth = - GYearMonth { - unGYearMonth :: String} - deriving (Eq, Ord, Read, Show) - -_GYearMonth = (Core.Name "hydra/langs/xml/schema.GYearMonth") - -newtype HexBinary = - HexBinary { - unHexBinary :: String} - deriving (Eq, Ord, Read, Show) - -_HexBinary = (Core.Name "hydra/langs/xml/schema.HexBinary") - -newtype ID = - ID { - unID :: String} - deriving (Eq, Ord, Read, Show) - -_ID = (Core.Name "hydra/langs/xml/schema.ID") - -newtype IDREF = - IDREF { - unIDREF :: String} - deriving (Eq, Ord, Read, Show) - -_IDREF = (Core.Name "hydra/langs/xml/schema.IDREF") - -newtype IDREFS = - IDREFS { - unIDREFS :: String} - deriving (Eq, Ord, Read, Show) - -_IDREFS = (Core.Name "hydra/langs/xml/schema.IDREFS") - -newtype Int_ = - Int_ { - unInt :: Int} - deriving (Eq, Ord, Read, Show) - -_Int = (Core.Name "hydra/langs/xml/schema.Int") - -newtype Integer_ = - Integer_ { - unInteger :: Integer} - deriving (Eq, Ord, Read, Show) - -_Integer = (Core.Name "hydra/langs/xml/schema.Integer") - -newtype Language = - Language { - unLanguage :: String} - deriving (Eq, Ord, Read, Show) - -_Language = (Core.Name "hydra/langs/xml/schema.Language") - -newtype Long = - Long { - unLong :: Int64} - deriving (Eq, Ord, Read, Show) - -_Long = (Core.Name "hydra/langs/xml/schema.Long") - -newtype NMTOKEN = - NMTOKEN { - unNMTOKEN :: String} - deriving (Eq, Ord, Read, Show) - -_NMTOKEN = (Core.Name "hydra/langs/xml/schema.NMTOKEN") - -newtype NOTATION = - NOTATION { - unNOTATION :: String} - deriving (Eq, Ord, Read, Show) - -_NOTATION = (Core.Name "hydra/langs/xml/schema.NOTATION") - -newtype Name = - Name { - unName :: String} - deriving (Eq, Ord, Read, Show) - -_Name = (Core.Name "hydra/langs/xml/schema.Name") - -newtype NegativeInteger = - NegativeInteger { - unNegativeInteger :: Integer} - deriving (Eq, Ord, Read, Show) - -_NegativeInteger = (Core.Name "hydra/langs/xml/schema.NegativeInteger") - -newtype NonNegativeInteger = - NonNegativeInteger { - unNonNegativeInteger :: Integer} - deriving (Eq, Ord, Read, Show) - -_NonNegativeInteger = (Core.Name "hydra/langs/xml/schema.NonNegativeInteger") - -newtype NonPositiveInteger = - NonPositiveInteger { - unNonPositiveInteger :: Integer} - deriving (Eq, Ord, Read, Show) - -_NonPositiveInteger = (Core.Name "hydra/langs/xml/schema.NonPositiveInteger") - -newtype NormalizedString = - NormalizedString { - unNormalizedString :: String} - deriving (Eq, Ord, Read, Show) - -_NormalizedString = (Core.Name "hydra/langs/xml/schema.NormalizedString") - -newtype PositiveInteger = - PositiveInteger { - unPositiveInteger :: Integer} - deriving (Eq, Ord, Read, Show) - -_PositiveInteger = (Core.Name "hydra/langs/xml/schema.PositiveInteger") - -newtype QName = - QName { - unQName :: String} - deriving (Eq, Ord, Read, Show) - -_QName = (Core.Name "hydra/langs/xml/schema.QName") - -newtype Short = - Short { - unShort :: Int16} - deriving (Eq, Ord, Read, Show) - -_Short = (Core.Name "hydra/langs/xml/schema.Short") - -newtype String_ = - String_ { - unString :: String} - deriving (Eq, Ord, Read, Show) - -_String = (Core.Name "hydra/langs/xml/schema.String") - -newtype Time = - Time { - unTime :: String} - deriving (Eq, Ord, Read, Show) - -_Time = (Core.Name "hydra/langs/xml/schema.Time") - -newtype Token = - Token { - unToken :: String} - deriving (Eq, Ord, Read, Show) - -_Token = (Core.Name "hydra/langs/xml/schema.Token") - -newtype UnsignedByte = - UnsignedByte { - unUnsignedByte :: Int16} - deriving (Eq, Ord, Read, Show) - -_UnsignedByte = (Core.Name "hydra/langs/xml/schema.UnsignedByte") - -newtype UnsignedInt = - UnsignedInt { - unUnsignedInt :: Int64} - deriving (Eq, Ord, Read, Show) - -_UnsignedInt = (Core.Name "hydra/langs/xml/schema.UnsignedInt") - -newtype UnsignedLong = - UnsignedLong { - unUnsignedLong :: Integer} - deriving (Eq, Ord, Read, Show) - -_UnsignedLong = (Core.Name "hydra/langs/xml/schema.UnsignedLong") - -newtype UnsignedShort = - UnsignedShort { - unUnsignedShort :: Int} - deriving (Eq, Ord, Read, Show) - -_UnsignedShort = (Core.Name "hydra/langs/xml/schema.UnsignedShort") - --- | See https://www.w3.org/TR/xmlschema-2/#non-fundamental -data ConstrainingFacet = - ConstrainingFacet {} - deriving (Eq, Ord, Read, Show) - -_ConstrainingFacet = (Core.Name "hydra/langs/xml/schema.ConstrainingFacet") - -data Datatype = - DatatypeAnySimpleType | - DatatypeAnyType | - DatatypeAnyURI | - DatatypeBase64Binary | - DatatypeBoolean | - DatatypeByte | - DatatypeDate | - DatatypeDateTime | - DatatypeDecimal | - DatatypeDouble | - DatatypeDuration | - DatatypeENTITIES | - DatatypeENTITY | - DatatypeFloat | - DatatypeGDay | - DatatypeGMonth | - DatatypeGMonthDay | - DatatypeGYear | - DatatypeGYearMonth | - DatatypeHexBinary | - DatatypeID | - DatatypeIDREF | - DatatypeIDREFS | - DatatypeInt | - DatatypeInteger | - DatatypeLanguage | - DatatypeLong | - DatatypeNMTOKEN | - DatatypeNOTATION | - DatatypeName | - DatatypeNegativeInteger | - DatatypeNonNegativeInteger | - DatatypeNonPositiveInteger | - DatatypeNormalizedString | - DatatypePositiveInteger | - DatatypeQName | - DatatypeShort | - DatatypeString | - DatatypeTime | - DatatypeToken | - DatatypeUnsignedByte | - DatatypeUnsignedInt | - DatatypeUnsignedLong | - DatatypeUnsignedShort - deriving (Eq, Ord, Read, Show) - -_Datatype = (Core.Name "hydra/langs/xml/schema.Datatype") - -_Datatype_anySimpleType = (Core.Name "anySimpleType") - -_Datatype_anyType = (Core.Name "anyType") - -_Datatype_anyURI = (Core.Name "anyURI") - -_Datatype_base64Binary = (Core.Name "base64Binary") - -_Datatype_boolean = (Core.Name "boolean") - -_Datatype_byte = (Core.Name "byte") - -_Datatype_date = (Core.Name "date") - -_Datatype_dateTime = (Core.Name "dateTime") - -_Datatype_decimal = (Core.Name "decimal") - -_Datatype_double = (Core.Name "double") - -_Datatype_duration = (Core.Name "duration") - -_Datatype_ENTITIES = (Core.Name "ENTITIES") - -_Datatype_ENTITY = (Core.Name "ENTITY") - -_Datatype_float = (Core.Name "float") - -_Datatype_gDay = (Core.Name "gDay") - -_Datatype_gMonth = (Core.Name "gMonth") - -_Datatype_gMonthDay = (Core.Name "gMonthDay") - -_Datatype_gYear = (Core.Name "gYear") - -_Datatype_gYearMonth = (Core.Name "gYearMonth") - -_Datatype_hexBinary = (Core.Name "hexBinary") - -_Datatype_ID = (Core.Name "ID") - -_Datatype_IDREF = (Core.Name "IDREF") - -_Datatype_IDREFS = (Core.Name "IDREFS") - -_Datatype_int = (Core.Name "int") - -_Datatype_integer = (Core.Name "integer") - -_Datatype_language = (Core.Name "language") - -_Datatype_long = (Core.Name "long") - -_Datatype_NMTOKEN = (Core.Name "NMTOKEN") - -_Datatype_NOTATION = (Core.Name "NOTATION") - -_Datatype_name = (Core.Name "name") - -_Datatype_negativeInteger = (Core.Name "negativeInteger") - -_Datatype_nonNegativeInteger = (Core.Name "nonNegativeInteger") - -_Datatype_nonPositiveInteger = (Core.Name "nonPositiveInteger") - -_Datatype_normalizedString = (Core.Name "normalizedString") - -_Datatype_positiveInteger = (Core.Name "positiveInteger") - -_Datatype_qName = (Core.Name "qName") - -_Datatype_short = (Core.Name "short") - -_Datatype_string = (Core.Name "string") - -_Datatype_time = (Core.Name "time") - -_Datatype_token = (Core.Name "token") - -_Datatype_unsignedByte = (Core.Name "unsignedByte") - -_Datatype_unsignedInt = (Core.Name "unsignedInt") - -_Datatype_unsignedLong = (Core.Name "unsignedLong") - -_Datatype_unsignedShort = (Core.Name "unsignedShort") diff --git a/src/gen-main/haskell/Hydra/Langs/Yaml/Model.hs b/src/gen-main/haskell/Hydra/Langs/Yaml/Model.hs deleted file mode 100644 --- a/src/gen-main/haskell/Hydra/Langs/Yaml/Model.hs +++ /dev/null @@ -1,54 +0,0 @@ --- | A basic YAML representation model. Based on: --- | https://yaml.org/spec/1.2/spec.html --- | The Serialization and Presentation properties of YAML, --- | including directives, comments, anchors, style, formatting, and aliases, are not supported by this model. --- | In addition, tags are omitted from this model, and non-standard scalars are unsupported. - -module Hydra.Langs.Yaml.Model where - -import qualified Hydra.Core as Core -import Data.Int -import Data.List as L -import Data.Map as M -import Data.Set as S - --- | A YAML node (value) -data Node = - NodeMapping (Map Node Node) | - NodeScalar Scalar | - NodeSequence [Node] - deriving (Eq, Ord, Read, Show) - -_Node = (Core.Name "hydra/langs/yaml/model.Node") - -_Node_mapping = (Core.Name "mapping") - -_Node_scalar = (Core.Name "scalar") - -_Node_sequence = (Core.Name "sequence") - --- | A union of scalars supported in the YAML failsafe and JSON schemas. Other scalars are not supported here -data Scalar = - -- | Represents a true/false value - ScalarBool Bool | - -- | Represents an approximation to real numbers - ScalarFloat Double | - -- | Represents arbitrary sized finite mathematical integers - ScalarInt Integer | - -- | Represents the lack of a value - ScalarNull | - -- | A string value - ScalarStr String - deriving (Eq, Ord, Read, Show) - -_Scalar = (Core.Name "hydra/langs/yaml/model.Scalar") - -_Scalar_bool = (Core.Name "bool") - -_Scalar_float = (Core.Name "float") - -_Scalar_int = (Core.Name "int") - -_Scalar_null = (Core.Name "null") - -_Scalar_str = (Core.Name "str") diff --git a/src/gen-main/haskell/Hydra/Mantle.hs b/src/gen-main/haskell/Hydra/Mantle.hs --- a/src/gen-main/haskell/Hydra/Mantle.hs +++ b/src/gen-main/haskell/Hydra/Mantle.hs @@ -1,4 +1,4 @@ --- | A set of types which supplement hydra/core with type variants, graphs, and elements +-- | A set of types which supplement hydra/core with variants and accessors module Hydra.Mantle where @@ -92,6 +92,84 @@ _Precision_bits = (Core.Name "bits") +-- | A function which maps from a term to a particular immediate subterm +data TermAccessor = + TermAccessorAnnotatedSubject | + TermAccessorApplicationFunction | + TermAccessorApplicationArgument | + TermAccessorLambdaBody | + TermAccessorListFold | + TermAccessorOptionalCasesNothing | + TermAccessorOptionalCasesJust | + TermAccessorUnionCasesDefault | + TermAccessorUnionCasesBranch Core.Name | + TermAccessorLetEnvironment | + TermAccessorLetBinding Core.Name | + TermAccessorListElement Int | + TermAccessorMapKey Int | + TermAccessorMapValue Int | + TermAccessorOptionalTerm | + TermAccessorProductTerm Int | + TermAccessorRecordField Core.Name | + TermAccessorSetElement Int | + TermAccessorSumTerm | + TermAccessorTypeAbstractionBody | + TermAccessorTypeApplicationTerm | + TermAccessorTypedTerm | + TermAccessorInjectionTerm | + TermAccessorWrappedTerm + deriving (Eq, Ord, Read, Show) + +_TermAccessor = (Core.Name "hydra/mantle.TermAccessor") + +_TermAccessor_annotatedSubject = (Core.Name "annotatedSubject") + +_TermAccessor_applicationFunction = (Core.Name "applicationFunction") + +_TermAccessor_applicationArgument = (Core.Name "applicationArgument") + +_TermAccessor_lambdaBody = (Core.Name "lambdaBody") + +_TermAccessor_listFold = (Core.Name "listFold") + +_TermAccessor_optionalCasesNothing = (Core.Name "optionalCasesNothing") + +_TermAccessor_optionalCasesJust = (Core.Name "optionalCasesJust") + +_TermAccessor_unionCasesDefault = (Core.Name "unionCasesDefault") + +_TermAccessor_unionCasesBranch = (Core.Name "unionCasesBranch") + +_TermAccessor_letEnvironment = (Core.Name "letEnvironment") + +_TermAccessor_letBinding = (Core.Name "letBinding") + +_TermAccessor_listElement = (Core.Name "listElement") + +_TermAccessor_mapKey = (Core.Name "mapKey") + +_TermAccessor_mapValue = (Core.Name "mapValue") + +_TermAccessor_optionalTerm = (Core.Name "optionalTerm") + +_TermAccessor_productTerm = (Core.Name "productTerm") + +_TermAccessor_recordField = (Core.Name "recordField") + +_TermAccessor_setElement = (Core.Name "setElement") + +_TermAccessor_sumTerm = (Core.Name "sumTerm") + +_TermAccessor_typeAbstractionBody = (Core.Name "typeAbstractionBody") + +_TermAccessor_typeApplicationTerm = (Core.Name "typeApplicationTerm") + +_TermAccessor_typedTerm = (Core.Name "typedTerm") + +_TermAccessor_injectionTerm = (Core.Name "injectionTerm") + +_TermAccessor_wrappedTerm = (Core.Name "wrappedTerm") + -- | The identifier of a term expression constructor data TermVariant = TermVariantAnnotated | @@ -106,6 +184,8 @@ TermVariantRecord | TermVariantSet | TermVariantSum | + TermVariantTypeAbstraction | + TermVariantTypeApplication | TermVariantTyped | TermVariantUnion | TermVariantVariable | @@ -138,6 +218,10 @@ _TermVariant_sum = (Core.Name "sum") +_TermVariant_typeAbstraction = (Core.Name "typeAbstraction") + +_TermVariant_typeApplication = (Core.Name "typeApplication") + _TermVariant_typed = (Core.Name "typed") _TermVariant_union = (Core.Name "union") @@ -145,6 +229,22 @@ _TermVariant_variable = (Core.Name "variable") _TermVariant_wrap = (Core.Name "wrap") + +-- | An assertion that two types can be unified into a single type +data TypeConstraint = + TypeConstraint { + typeConstraintLeft :: Core.Type, + typeConstraintRight :: Core.Type, + typeConstraintContext :: (Maybe String)} + deriving (Eq, Ord, Read, Show) + +_TypeConstraint = (Core.Name "hydra/mantle.TypeConstraint") + +_TypeConstraint_left = (Core.Name "left") + +_TypeConstraint_right = (Core.Name "right") + +_TypeConstraint_context = (Core.Name "context") -- | The identifier of a type constructor data TypeVariant = diff --git a/src/gen-main/haskell/Hydra/Module.hs b/src/gen-main/haskell/Hydra/Module.hs --- a/src/gen-main/haskell/Hydra/Module.hs +++ b/src/gen-main/haskell/Hydra/Module.hs @@ -16,6 +16,24 @@ _FileExtension = (Core.Name "hydra/module.FileExtension") +-- | A library of primitive functions +data Library = + Library { + -- | A common prefix for all primitive function names in the library + libraryNamespace :: Namespace, + -- | A preferred namespace prefix for function names in the library + libraryPrefix :: String, + -- | The primitives defined in this library + libraryPrimitives :: [Graph.Primitive]} + +_Library = (Core.Name "hydra/module.Library") + +_Library_namespace = (Core.Name "namespace") + +_Library_prefix = (Core.Name "prefix") + +_Library_primitives = (Core.Name "primitives") + -- | A logical collection of elements in the same namespace, having dependencies on zero or more other modules data Module = Module { diff --git a/src/gen-main/haskell/Hydra/Pg/Mapping.hs b/src/gen-main/haskell/Hydra/Pg/Mapping.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Pg/Mapping.hs @@ -0,0 +1,183 @@ +-- | A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs + +module Hydra.Pg.Mapping where + +import qualified Hydra.Compute as Compute +import qualified Hydra.Core as Core +import qualified Hydra.Pg.Model as Model +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | Configurable annotation keys for property graph mapping specifications +data AnnotationSchema = + AnnotationSchema { + annotationSchemaVertexLabel :: String, + annotationSchemaEdgeLabel :: String, + annotationSchemaVertexId :: String, + annotationSchemaEdgeId :: String, + annotationSchemaPropertyKey :: String, + annotationSchemaPropertyValue :: String, + annotationSchemaOutVertex :: String, + annotationSchemaOutVertexLabel :: String, + annotationSchemaInVertex :: String, + annotationSchemaInVertexLabel :: String, + annotationSchemaOutEdge :: String, + annotationSchemaOutEdgeLabel :: String, + annotationSchemaInEdge :: String, + annotationSchemaInEdgeLabel :: String, + annotationSchemaIgnore :: String} + deriving (Eq, Ord, Read, Show) + +_AnnotationSchema = (Core.Name "hydra/pg/mapping.AnnotationSchema") + +_AnnotationSchema_vertexLabel = (Core.Name "vertexLabel") + +_AnnotationSchema_edgeLabel = (Core.Name "edgeLabel") + +_AnnotationSchema_vertexId = (Core.Name "vertexId") + +_AnnotationSchema_edgeId = (Core.Name "edgeId") + +_AnnotationSchema_propertyKey = (Core.Name "propertyKey") + +_AnnotationSchema_propertyValue = (Core.Name "propertyValue") + +_AnnotationSchema_outVertex = (Core.Name "outVertex") + +_AnnotationSchema_outVertexLabel = (Core.Name "outVertexLabel") + +_AnnotationSchema_inVertex = (Core.Name "inVertex") + +_AnnotationSchema_inVertexLabel = (Core.Name "inVertexLabel") + +_AnnotationSchema_outEdge = (Core.Name "outEdge") + +_AnnotationSchema_outEdgeLabel = (Core.Name "outEdgeLabel") + +_AnnotationSchema_inEdge = (Core.Name "inEdge") + +_AnnotationSchema_inEdgeLabel = (Core.Name "inEdgeLabel") + +_AnnotationSchema_ignore = (Core.Name "ignore") + +-- | A mapping specification producing edges of a specified label. +data EdgeSpec = + EdgeSpec { + -- | The label of the target edges, which must conform to the edge type associated with that label. + edgeSpecLabel :: Model.EdgeLabel, + -- | A specification of the id of each target edge + edgeSpecId :: ValueSpec, + -- | A specification of the out-vertex reference of each target edge + edgeSpecOut :: ValueSpec, + -- | A specification of the in-vertex reference of each target edge + edgeSpecIn :: ValueSpec, + -- | Zero or more property specifications for each target edge + edgeSpecProperties :: [PropertySpec]} + deriving (Eq, Ord, Read, Show) + +_EdgeSpec = (Core.Name "hydra/pg/mapping.EdgeSpec") + +_EdgeSpec_label = (Core.Name "label") + +_EdgeSpec_id = (Core.Name "id") + +_EdgeSpec_out = (Core.Name "out") + +_EdgeSpec_in = (Core.Name "in") + +_EdgeSpec_properties = (Core.Name "properties") + +-- | Either a vertex specification or an edge specification +data ElementSpec = + ElementSpecVertex VertexSpec | + ElementSpecEdge EdgeSpec + deriving (Eq, Ord, Read, Show) + +_ElementSpec = (Core.Name "hydra/pg/mapping.ElementSpec") + +_ElementSpec_vertex = (Core.Name "vertex") + +_ElementSpec_edge = (Core.Name "edge") + +-- | A mapping specification producing properties of a specified key, and values of the appropriate type. +data PropertySpec = + PropertySpec { + -- | The key of the target properties + propertySpecKey :: Model.PropertyKey, + -- | A specification of the value of each target property, which must conform to the type associated with the property key + propertySpecValue :: ValueSpec} + deriving (Eq, Ord, Read, Show) + +_PropertySpec = (Core.Name "hydra/pg/mapping.PropertySpec") + +_PropertySpec_key = (Core.Name "key") + +_PropertySpec_value = (Core.Name "value") + +-- | A set of mappings which translates between Hydra terms and annotations, and application-specific property graph types +data Schema s t v = + Schema { + schemaVertexIdTypes :: (Compute.Coder s s Core.Type t), + schemaVertexIds :: (Compute.Coder s s Core.Term v), + schemaEdgeIdTypes :: (Compute.Coder s s Core.Type t), + schemaEdgeIds :: (Compute.Coder s s Core.Term v), + schemaPropertyTypes :: (Compute.Coder s s Core.Type t), + schemaPropertyValues :: (Compute.Coder s s Core.Term v), + schemaAnnotations :: AnnotationSchema, + schemaDefaultVertexId :: v, + schemaDefaultEdgeId :: v} + +_Schema = (Core.Name "hydra/pg/mapping.Schema") + +_Schema_vertexIdTypes = (Core.Name "vertexIdTypes") + +_Schema_vertexIds = (Core.Name "vertexIds") + +_Schema_edgeIdTypes = (Core.Name "edgeIdTypes") + +_Schema_edgeIds = (Core.Name "edgeIds") + +_Schema_propertyTypes = (Core.Name "propertyTypes") + +_Schema_propertyValues = (Core.Name "propertyValues") + +_Schema_annotations = (Core.Name "annotations") + +_Schema_defaultVertexId = (Core.Name "defaultVertexId") + +_Schema_defaultEdgeId = (Core.Name "defaultEdgeId") + +-- | A mapping specification producing values (usually literal values) whose type is understood in context +data ValueSpec = + -- | A trivial no-op specification which passes the entire value + ValueSpecValue | + -- | A compact path representing the function, e.g. engine-${engineInfo/model/name} + ValueSpecPattern String + deriving (Eq, Ord, Read, Show) + +_ValueSpec = (Core.Name "hydra/pg/mapping.ValueSpec") + +_ValueSpec_value = (Core.Name "value") + +_ValueSpec_pattern = (Core.Name "pattern") + +-- | A mapping specification producing vertices of a specified label +data VertexSpec = + VertexSpec { + -- | The label of the target vertices, which must conform to the vertex type associated with that label. + vertexSpecLabel :: Model.VertexLabel, + -- | A specification of the id of each target vertex + vertexSpecId :: ValueSpec, + -- | Zero or more property specifications for each target vertex + vertexSpecProperties :: [PropertySpec]} + deriving (Eq, Ord, Read, Show) + +_VertexSpec = (Core.Name "hydra/pg/mapping.VertexSpec") + +_VertexSpec_label = (Core.Name "label") + +_VertexSpec_id = (Core.Name "id") + +_VertexSpec_properties = (Core.Name "properties") diff --git a/src/gen-main/haskell/Hydra/Pg/Model.hs b/src/gen-main/haskell/Hydra/Pg/Model.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Pg/Model.hs @@ -0,0 +1,279 @@ +-- | A typed property graph data model. Property graphs are parameterized a type for property and id values, while property graph schemas are parameterized by a type for property and id types + +module Hydra.Pg.Model where + +import qualified Hydra.Core as Core +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +-- | The direction of an edge or edge pattern +data Direction = + DirectionOut | + DirectionIn | + DirectionBoth | + DirectionUndirected + deriving (Eq, Ord, Read, Show) + +_Direction = (Core.Name "hydra/pg/model.Direction") + +_Direction_out = (Core.Name "out") + +_Direction_in = (Core.Name "in") + +_Direction_both = (Core.Name "both") + +_Direction_undirected = (Core.Name "undirected") + +-- | An edge +data Edge v = + Edge { + -- | The label of the edge + edgeLabel :: EdgeLabel, + -- | The unique identifier of the edge + edgeId :: v, + -- | The id of the out-vertex (tail) of the edge + edgeOut :: v, + -- | The id of the in-vertex (head) of the edge + edgeIn :: v, + -- | A key/value map of edge properties + edgeProperties :: (Map PropertyKey v)} + deriving (Eq, Ord, Read, Show) + +_Edge = (Core.Name "hydra/pg/model.Edge") + +_Edge_label = (Core.Name "label") + +_Edge_id = (Core.Name "id") + +_Edge_out = (Core.Name "out") + +_Edge_in = (Core.Name "in") + +_Edge_properties = (Core.Name "properties") + +-- | The label of an edge +newtype EdgeLabel = + EdgeLabel { + unEdgeLabel :: String} + deriving (Eq, Ord, Read, Show) + +_EdgeLabel = (Core.Name "hydra/pg/model.EdgeLabel") + +-- | The type of an edge +data EdgeType t = + EdgeType { + -- | The label of any edge of this edge type + edgeTypeLabel :: EdgeLabel, + -- | The type of the id of any edge of this edge type + edgeTypeId :: t, + -- | The label of the out-vertex (tail) of any edge of this edge type + edgeTypeOut :: VertexLabel, + -- | The label of the in-vertex (head) of any edge of this edge type + edgeTypeIn :: VertexLabel, + -- | A list of property types. The types are ordered for the sake of applications in which property order is significant. + edgeTypeProperties :: [PropertyType t]} + deriving (Eq, Ord, Read, Show) + +_EdgeType = (Core.Name "hydra/pg/model.EdgeType") + +_EdgeType_label = (Core.Name "label") + +_EdgeType_id = (Core.Name "id") + +_EdgeType_out = (Core.Name "out") + +_EdgeType_in = (Core.Name "in") + +_EdgeType_properties = (Core.Name "properties") + +-- | Either a vertex or an edge +data Element v = + ElementVertex (Vertex v) | + ElementEdge (Edge v) + deriving (Eq, Ord, Read, Show) + +_Element = (Core.Name "hydra/pg/model.Element") + +_Element_vertex = (Core.Name "vertex") + +_Element_edge = (Core.Name "edge") + +-- | The kind of an element: vertex or edge +data ElementKind = + ElementKindVertex | + ElementKindEdge + deriving (Eq, Ord, Read, Show) + +_ElementKind = (Core.Name "hydra/pg/model.ElementKind") + +_ElementKind_vertex = (Core.Name "vertex") + +_ElementKind_edge = (Core.Name "edge") + +-- | An element together with its dependencies in some context +data ElementTree v = + ElementTree { + elementTreeSelf :: (Element v), + elementTreeDependencies :: [ElementTree v]} + deriving (Eq, Ord, Read, Show) + +_ElementTree = (Core.Name "hydra/pg/model.ElementTree") + +_ElementTree_self = (Core.Name "self") + +_ElementTree_dependencies = (Core.Name "dependencies") + +-- | The type of a vertex or edge +data ElementType t = + ElementTypeVertex (VertexType t) | + ElementTypeEdge (EdgeType t) + deriving (Eq, Ord, Read, Show) + +_ElementType = (Core.Name "hydra/pg/model.ElementType") + +_ElementType_vertex = (Core.Name "vertex") + +_ElementType_edge = (Core.Name "edge") + +-- | An element type together with its dependencies in some context +data ElementTypeTree t = + ElementTypeTree { + elementTypeTreeSelf :: (ElementType t), + elementTypeTreeDependencies :: [ElementTypeTree t]} + deriving (Eq, Ord, Read, Show) + +_ElementTypeTree = (Core.Name "hydra/pg/model.ElementTypeTree") + +_ElementTypeTree_self = (Core.Name "self") + +_ElementTypeTree_dependencies = (Core.Name "dependencies") + +-- | A graph; a self-contained collection of vertices and edges +data Graph v = + Graph { + graphVertices :: (Map v (Vertex v)), + graphEdges :: (Map v (Edge v))} + deriving (Eq, Ord, Read, Show) + +_Graph = (Core.Name "hydra/pg/model.Graph") + +_Graph_vertices = (Core.Name "vertices") + +_Graph_edges = (Core.Name "edges") + +-- | A graph schema; a vertex and edge types for the vertices and edges of a graph conforming to the schema +data GraphSchema t = + GraphSchema { + -- | A unique vertex type for each vertex label which may occur in a graph + graphSchemaVertices :: (Map VertexLabel (VertexType t)), + -- | A unique edge type for each edge label which may occur in a graph + graphSchemaEdges :: (Map EdgeLabel (EdgeType t))} + deriving (Eq, Ord, Read, Show) + +_GraphSchema = (Core.Name "hydra/pg/model.GraphSchema") + +_GraphSchema_vertices = (Core.Name "vertices") + +_GraphSchema_edges = (Core.Name "edges") + +-- | Either a vertex or edge label +data Label = + LabelVertex VertexLabel | + LabelEdge EdgeLabel + deriving (Eq, Ord, Read, Show) + +_Label = (Core.Name "hydra/pg/model.Label") + +_Label_vertex = (Core.Name "vertex") + +_Label_edge = (Core.Name "edge") + +-- | A key/value property +data Property v = + Property { + -- | They key of the property + propertyKey :: PropertyKey, + -- | The value of the property + propertyValue :: v} + deriving (Eq, Ord, Read, Show) + +_Property = (Core.Name "hydra/pg/model.Property") + +_Property_key = (Core.Name "key") + +_Property_value = (Core.Name "value") + +-- | A property key +newtype PropertyKey = + PropertyKey { + unPropertyKey :: String} + deriving (Eq, Ord, Read, Show) + +_PropertyKey = (Core.Name "hydra/pg/model.PropertyKey") + +-- | The type of a property +data PropertyType t = + PropertyType { + -- | A property's key + propertyTypeKey :: PropertyKey, + -- | The type of a property's value + propertyTypeValue :: t, + -- | Whether the property is required; values may be omitted from a property map otherwise + propertyTypeRequired :: Bool} + deriving (Eq, Ord, Read, Show) + +_PropertyType = (Core.Name "hydra/pg/model.PropertyType") + +_PropertyType_key = (Core.Name "key") + +_PropertyType_value = (Core.Name "value") + +_PropertyType_required = (Core.Name "required") + +-- | A vertex +data Vertex v = + Vertex { + -- | The label of the vertex + vertexLabel :: VertexLabel, + -- | The unique identifier of the vertex + vertexId :: v, + -- | A key/value map of vertex properties + vertexProperties :: (Map PropertyKey v)} + deriving (Eq, Ord, Read, Show) + +_Vertex = (Core.Name "hydra/pg/model.Vertex") + +_Vertex_label = (Core.Name "label") + +_Vertex_id = (Core.Name "id") + +_Vertex_properties = (Core.Name "properties") + +-- | The label of a vertex. The default (null) vertex is represented by the empty string +newtype VertexLabel = + VertexLabel { + unVertexLabel :: String} + deriving (Eq, Ord, Read, Show) + +_VertexLabel = (Core.Name "hydra/pg/model.VertexLabel") + +-- | The type of a vertex +data VertexType t = + VertexType { + -- | The label of any vertex of this vertex type + vertexTypeLabel :: VertexLabel, + -- | The type of the id of any vertex of this vertex type + vertexTypeId :: t, + -- | A list of property types. The types are ordered for the sake of applications in which property order is significant. + vertexTypeProperties :: [PropertyType t]} + deriving (Eq, Ord, Read, Show) + +_VertexType = (Core.Name "hydra/pg/model.VertexType") + +_VertexType_label = (Core.Name "label") + +_VertexType_id = (Core.Name "id") + +_VertexType_properties = (Core.Name "properties") diff --git a/src/gen-main/haskell/Hydra/Pg/Query.hs b/src/gen-main/haskell/Hydra/Pg/Query.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Pg/Query.hs @@ -0,0 +1,329 @@ +-- | A common model for pattern-matching queries over property graphs + +module Hydra.Pg.Query where + +import qualified Hydra.Core as Core +import qualified Hydra.Pg.Model as Model +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +data AggregationQuery = + AggregationQueryCount + deriving (Eq, Ord, Read, Show) + +_AggregationQuery = (Core.Name "hydra/pg/query.AggregationQuery") + +_AggregationQuery_count = (Core.Name "count") + +newtype ApplicationQuery = + ApplicationQuery { + unApplicationQuery :: [Query]} + deriving (Eq, Ord, Read, Show) + +_ApplicationQuery = (Core.Name "hydra/pg/query.ApplicationQuery") + +data AssociativeExpression = + AssociativeExpression { + associativeExpressionOperator :: BinaryOperator, + associativeExpressionOperands :: [Expression]} + deriving (Eq, Ord, Read, Show) + +_AssociativeExpression = (Core.Name "hydra/pg/query.AssociativeExpression") + +_AssociativeExpression_operator = (Core.Name "operator") + +_AssociativeExpression_operands = (Core.Name "operands") + +data BinaryExpression = + BinaryExpression { + binaryExpressionLeft :: Expression, + binaryExpressionOperator :: BinaryOperator, + binaryExpressionRight :: Expression} + deriving (Eq, Ord, Read, Show) + +_BinaryExpression = (Core.Name "hydra/pg/query.BinaryExpression") + +_BinaryExpression_left = (Core.Name "left") + +_BinaryExpression_operator = (Core.Name "operator") + +_BinaryExpression_right = (Core.Name "right") + +data BinaryBooleanOperator = + BinaryBooleanOperatorAnd | + BinaryBooleanOperatorOr | + BinaryBooleanOperatorXor + deriving (Eq, Ord, Read, Show) + +_BinaryBooleanOperator = (Core.Name "hydra/pg/query.BinaryBooleanOperator") + +_BinaryBooleanOperator_and = (Core.Name "and") + +_BinaryBooleanOperator_or = (Core.Name "or") + +_BinaryBooleanOperator_xor = (Core.Name "xor") + +data BinaryOperator = + BinaryOperatorBoolean BinaryBooleanOperator | + BinaryOperatorComparison ComparisonOperator | + BinaryOperatorPower + deriving (Eq, Ord, Read, Show) + +_BinaryOperator = (Core.Name "hydra/pg/query.BinaryOperator") + +_BinaryOperator_boolean = (Core.Name "boolean") + +_BinaryOperator_comparison = (Core.Name "comparison") + +_BinaryOperator_power = (Core.Name "power") + +data Binding = + Binding { + bindingKey :: Variable, + bindingValue :: Query} + deriving (Eq, Ord, Read, Show) + +_Binding = (Core.Name "hydra/pg/query.Binding") + +_Binding_key = (Core.Name "key") + +_Binding_value = (Core.Name "value") + +data ComparisonOperator = + ComparisonOperatorEq | + ComparisonOperatorNeq | + ComparisonOperatorLt | + ComparisonOperatorLte | + ComparisonOperatorGt | + ComparisonOperatorGte + deriving (Eq, Ord, Read, Show) + +_ComparisonOperator = (Core.Name "hydra/pg/query.ComparisonOperator") + +_ComparisonOperator_eq = (Core.Name "eq") + +_ComparisonOperator_neq = (Core.Name "neq") + +_ComparisonOperator_lt = (Core.Name "lt") + +_ComparisonOperator_lte = (Core.Name "lte") + +_ComparisonOperator_gt = (Core.Name "gt") + +_ComparisonOperator_gte = (Core.Name "gte") + +data EdgeProjectionPattern = + EdgeProjectionPattern { + edgeProjectionPatternDirection :: Model.Direction, + edgeProjectionPatternLabel :: (Maybe Model.EdgeLabel), + edgeProjectionPatternProperties :: [PropertyPattern], + edgeProjectionPatternVertex :: (Maybe VertexPattern)} + deriving (Eq, Ord, Read, Show) + +_EdgeProjectionPattern = (Core.Name "hydra/pg/query.EdgeProjectionPattern") + +_EdgeProjectionPattern_direction = (Core.Name "direction") + +_EdgeProjectionPattern_label = (Core.Name "label") + +_EdgeProjectionPattern_properties = (Core.Name "properties") + +_EdgeProjectionPattern_vertex = (Core.Name "vertex") + +data Expression = + ExpressionAssociative AssociativeExpression | + ExpressionBinary BinaryExpression | + ExpressionProperty PropertyProjection | + ExpressionUnary UnaryExpression | + ExpressionVariable Variable | + ExpressionVertex VertexPattern + deriving (Eq, Ord, Read, Show) + +_Expression = (Core.Name "hydra/pg/query.Expression") + +_Expression_associative = (Core.Name "associative") + +_Expression_binary = (Core.Name "binary") + +_Expression_property = (Core.Name "property") + +_Expression_unary = (Core.Name "unary") + +_Expression_variable = (Core.Name "variable") + +_Expression_vertex = (Core.Name "vertex") + +data LetQuery = + LetQuery { + letQueryBindings :: [Binding], + letQueryEnvironment :: Query} + deriving (Eq, Ord, Read, Show) + +_LetQuery = (Core.Name "hydra/pg/query.LetQuery") + +_LetQuery_bindings = (Core.Name "bindings") + +_LetQuery_environment = (Core.Name "environment") + +data MatchQuery = + MatchQuery { + matchQueryOptional :: Bool, + matchQueryPattern :: [Projection], + matchQueryWhere :: (Maybe Expression)} + deriving (Eq, Ord, Read, Show) + +_MatchQuery = (Core.Name "hydra/pg/query.MatchQuery") + +_MatchQuery_optional = (Core.Name "optional") + +_MatchQuery_pattern = (Core.Name "pattern") + +_MatchQuery_where = (Core.Name "where") + +data Projection = + Projection { + projectionValue :: Expression, + projectionAs :: (Maybe Variable)} + deriving (Eq, Ord, Read, Show) + +_Projection = (Core.Name "hydra/pg/query.Projection") + +_Projection_value = (Core.Name "value") + +_Projection_as = (Core.Name "as") + +data Projections = + Projections { + projectionsAll :: Bool, + projectionsExplicit :: [Projection]} + deriving (Eq, Ord, Read, Show) + +_Projections = (Core.Name "hydra/pg/query.Projections") + +_Projections_all = (Core.Name "all") + +_Projections_explicit = (Core.Name "explicit") + +data PropertyPattern = + PropertyPattern { + propertyPatternKey :: Model.PropertyKey, + propertyPatternValue :: PropertyValuePattern} + deriving (Eq, Ord, Read, Show) + +_PropertyPattern = (Core.Name "hydra/pg/query.PropertyPattern") + +_PropertyPattern_key = (Core.Name "key") + +_PropertyPattern_value = (Core.Name "value") + +data PropertyProjection = + PropertyProjection { + propertyProjectionBase :: Expression, + propertyProjectionKey :: Model.PropertyKey} + deriving (Eq, Ord, Read, Show) + +_PropertyProjection = (Core.Name "hydra/pg/query.PropertyProjection") + +_PropertyProjection_base = (Core.Name "base") + +_PropertyProjection_key = (Core.Name "key") + +newtype PropertyValue = + PropertyValue { + unPropertyValue :: String} + deriving (Eq, Ord, Read, Show) + +_PropertyValue = (Core.Name "hydra/pg/query.PropertyValue") + +data PropertyValuePattern = + PropertyValuePatternVariable Model.PropertyKey | + PropertyValuePatternValue String + deriving (Eq, Ord, Read, Show) + +_PropertyValuePattern = (Core.Name "hydra/pg/query.PropertyValuePattern") + +_PropertyValuePattern_variable = (Core.Name "variable") + +_PropertyValuePattern_value = (Core.Name "value") + +data Query = + QueryApplication ApplicationQuery | + QueryAggregate AggregationQuery | + QueryLetQuery LetQuery | + QueryMatch MatchQuery | + QuerySelect SelectQuery | + QueryValue String + deriving (Eq, Ord, Read, Show) + +_Query = (Core.Name "hydra/pg/query.Query") + +_Query_application = (Core.Name "application") + +_Query_aggregate = (Core.Name "aggregate") + +_Query_LetQuery = (Core.Name "LetQuery") + +_Query_match = (Core.Name "match") + +_Query_select = (Core.Name "select") + +_Query_value = (Core.Name "value") + +data SelectQuery = + SelectQuery { + selectQueryDistinct :: Bool, + selectQueryProjection :: Projections} + deriving (Eq, Ord, Read, Show) + +_SelectQuery = (Core.Name "hydra/pg/query.SelectQuery") + +_SelectQuery_distinct = (Core.Name "distinct") + +_SelectQuery_projection = (Core.Name "projection") + +data UnaryExpression = + UnaryExpression { + unaryExpressionOperator :: UnaryOperator, + unaryExpressionOperand :: Expression} + deriving (Eq, Ord, Read, Show) + +_UnaryExpression = (Core.Name "hydra/pg/query.UnaryExpression") + +_UnaryExpression_operator = (Core.Name "operator") + +_UnaryExpression_operand = (Core.Name "operand") + +data UnaryOperator = + UnaryOperatorNegate + deriving (Eq, Ord, Read, Show) + +_UnaryOperator = (Core.Name "hydra/pg/query.UnaryOperator") + +_UnaryOperator_negate = (Core.Name "negate") + +newtype Variable = + Variable { + unVariable :: String} + deriving (Eq, Ord, Read, Show) + +_Variable = (Core.Name "hydra/pg/query.Variable") + +data VertexPattern = + VertexPattern { + vertexPatternVariable :: (Maybe Variable), + vertexPatternLabel :: (Maybe Model.VertexLabel), + vertexPatternProperties :: [PropertyPattern], + vertexPatternEdges :: [EdgeProjectionPattern]} + deriving (Eq, Ord, Read, Show) + +_VertexPattern = (Core.Name "hydra/pg/query.VertexPattern") + +_VertexPattern_variable = (Core.Name "variable") + +_VertexPattern_label = (Core.Name "label") + +_VertexPattern_properties = (Core.Name "properties") + +_VertexPattern_edges = (Core.Name "edges") diff --git a/src/gen-main/haskell/Hydra/Pg/Validation.hs b/src/gen-main/haskell/Hydra/Pg/Validation.hs new file mode 100644 --- /dev/null +++ b/src/gen-main/haskell/Hydra/Pg/Validation.hs @@ -0,0 +1,143 @@ +-- | Utilities for validating property graphs against property graph schemas + +module Hydra.Pg.Validation where + +import qualified Hydra.Lib.Equality as Equality +import qualified Hydra.Lib.Lists as Lists +import qualified Hydra.Lib.Logic as Logic +import qualified Hydra.Lib.Maps as Maps +import qualified Hydra.Lib.Optionals as Optionals +import qualified Hydra.Lib.Strings as Strings +import qualified Hydra.Pg.Model as Model +import Data.Int +import Data.List as L +import Data.Map as M +import Data.Set as S + +validateEdge :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe Model.VertexLabel) -> Model.EdgeType t -> Model.Edge v -> Maybe String) +validateEdge checkValue showValue labelForVertexId typ el = + let failWith = (edgeError showValue el) + checkLabel = + let expected = (Model.edgeTypeLabel typ) + actual = (Model.edgeLabel el) + in (verify (Equality.equalString (Model.unEdgeLabel actual) (Model.unEdgeLabel expected)) (failWith (prepend "Wrong label" (edgeLabelMismatch expected actual)))) + checkId = (Optionals.map (\x -> failWith (prepend "Invalid id" x)) (checkValue (Model.edgeTypeId typ) (Model.edgeId el))) + checkProperties = (Optionals.map (\x -> failWith (prepend "Invalid property" x)) (validateProperties checkValue (Model.edgeTypeProperties typ) (Model.edgeProperties el))) + checkOut = ((\x -> case x of + Nothing -> Nothing + Just v329 -> ((\x -> case x of + Nothing -> (Just (failWith (prepend "Out-vertex does not exist" (showValue (Model.edgeOut el))))) + Just v330 -> (verify (Equality.equalString (Model.unVertexLabel v330) (Model.unVertexLabel (Model.edgeTypeOut typ))) (failWith (prepend "Wrong out-vertex label" (vertexLabelMismatch (Model.edgeTypeOut typ) v330))))) (v329 (Model.edgeOut el)))) labelForVertexId) + checkIn = ((\x -> case x of + Nothing -> Nothing + Just v331 -> ((\x -> case x of + Nothing -> (Just (failWith (prepend "In-vertex does not exist" (showValue (Model.edgeIn el))))) + Just v332 -> (verify (Equality.equalString (Model.unVertexLabel v332) (Model.unVertexLabel (Model.edgeTypeIn typ))) (failWith (prepend "Wrong in-vertex label" (vertexLabelMismatch (Model.edgeTypeIn typ) v332))))) (v331 (Model.edgeIn el)))) labelForVertexId) + in (checkAll [ + checkLabel, + checkId, + checkProperties, + checkOut, + checkIn]) + +validateElement :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe Model.VertexLabel) -> Model.ElementType t -> Model.Element v -> Maybe String) +validateElement checkValue showValue labelForVertexId typ el = ((\x -> case x of + Model.ElementTypeVertex v333 -> ((\x -> case x of + Model.ElementEdge v334 -> (Just (prepend "Edge instead of vertex" (showValue (Model.edgeId v334)))) + Model.ElementVertex v335 -> (validateVertex checkValue showValue v333 v335)) el) + Model.ElementTypeEdge v336 -> ((\x -> case x of + Model.ElementVertex v337 -> (Just (prepend "Vertex instead of edge" (showValue (Model.vertexId v337)))) + Model.ElementEdge v338 -> (validateEdge checkValue showValue labelForVertexId v336 v338)) el)) typ) + +validateGraph :: (Ord v) => ((t -> v -> Maybe String) -> (v -> String) -> Model.GraphSchema t -> Model.Graph v -> Maybe String) +validateGraph checkValue showValue schema graph = + let checkVertices = + let checkVertex = (\el -> (\x -> case x of + Nothing -> (Just (vertexError showValue el (prepend "Unexpected label" (Model.unVertexLabel (Model.vertexLabel el))))) + Just v339 -> (validateVertex checkValue showValue v339 el)) (Maps.lookup (Model.vertexLabel el) (Model.graphSchemaVertices schema))) + in (checkAll (Lists.map checkVertex (Maps.values (Model.graphVertices graph)))) + checkEdges = + let checkEdge = (\el -> (\x -> case x of + Nothing -> (Just (edgeError showValue el (prepend "Unexpected label" (Model.unEdgeLabel (Model.edgeLabel el))))) + Just v340 -> (validateEdge checkValue showValue labelForVertexId v340 el)) (Maps.lookup (Model.edgeLabel el) (Model.graphSchemaEdges schema))) + labelForVertexId = (Just (\i -> Optionals.map Model.vertexLabel (Maps.lookup i (Model.graphVertices graph)))) + in (checkAll (Lists.map checkEdge (Maps.values (Model.graphEdges graph)))) + in (checkAll [ + checkVertices, + checkEdges]) + +validateProperties :: ((t -> v -> Maybe String) -> [Model.PropertyType t] -> Map Model.PropertyKey v -> Maybe String) +validateProperties checkValue types props = + let checkTypes = (checkAll (Lists.map checkType types)) + checkType = (\t -> Logic.ifElse ((\x -> case x of + Nothing -> (Just (prepend "Missing value for " (Model.unPropertyKey (Model.propertyTypeKey t)))) + Just _ -> Nothing) (Maps.lookup (Model.propertyTypeKey t) props)) Nothing (Model.propertyTypeRequired t)) + checkValues = + let m = (Maps.fromList (Lists.map (\p -> (Model.propertyTypeKey p, (Model.propertyTypeValue p))) types)) + checkPair = (\pair -> + let key = (fst pair) + val = (snd pair) + in ((\x -> case x of + Nothing -> (Just (prepend "Unexpected key" (Model.unPropertyKey key))) + Just v342 -> (Optionals.map (prepend "Invalid value") (checkValue v342 val))) (Maps.lookup key m))) + in (checkAll (Lists.map checkPair (Maps.toList props))) + in (checkAll [ + checkTypes, + checkValues]) + +validateVertex :: ((t -> v -> Maybe String) -> (v -> String) -> Model.VertexType t -> Model.Vertex v -> Maybe String) +validateVertex checkValue showValue typ el = + let failWith = (vertexError showValue el) + checkLabel = + let expected = (Model.vertexTypeLabel typ) + actual = (Model.vertexLabel el) + in (verify (Equality.equalString (Model.unVertexLabel actual) (Model.unVertexLabel expected)) (failWith (prepend "Wrong label" (vertexLabelMismatch expected actual)))) + checkId = (Optionals.map (\x -> failWith (prepend "Invalid id" x)) (checkValue (Model.vertexTypeId typ) (Model.vertexId el))) + checkProperties = (Optionals.map (\x -> failWith (prepend "Invalid property" x)) (validateProperties checkValue (Model.vertexTypeProperties typ) (Model.vertexProperties el))) + in (checkAll [ + checkLabel, + checkId, + checkProperties]) + +checkAll :: ([Maybe a] -> Maybe a) +checkAll checks = + let errors = (Optionals.cat checks) + in (Lists.safeHead errors) + +edgeError :: ((v -> String) -> Model.Edge v -> String -> String) +edgeError showValue e = (prepend (Strings.cat [ + "Invalid edge with id ", + (showValue (Model.edgeId e))])) + +edgeLabelMismatch :: (Model.EdgeLabel -> Model.EdgeLabel -> String) +edgeLabelMismatch expected actual = (Strings.cat [ + Strings.cat [ + Strings.cat [ + "expected ", + (Model.unEdgeLabel expected)], + ", found "], + (Model.unEdgeLabel actual)]) + +prepend :: (String -> String -> String) +prepend prefix msg = (Strings.cat [ + Strings.cat [ + prefix, + ": "], + msg]) + +verify :: (Bool -> String -> Maybe String) +verify b err = (Logic.ifElse Nothing (Just err) b) + +vertexError :: ((v -> String) -> Model.Vertex v -> String -> String) +vertexError showValue v = (prepend (Strings.cat [ + "Invalid vertex with id ", + (showValue (Model.vertexId v))])) + +vertexLabelMismatch :: (Model.VertexLabel -> Model.VertexLabel -> String) +vertexLabelMismatch expected actual = (Strings.cat [ + Strings.cat [ + Strings.cat [ + "expected ", + (Model.unVertexLabel expected)], + ", found "], + (Model.unVertexLabel actual)]) diff --git a/src/gen-main/haskell/Hydra/Phantoms.hs b/src/gen-main/haskell/Hydra/Phantoms.hs --- a/src/gen-main/haskell/Hydra/Phantoms.hs +++ b/src/gen-main/haskell/Hydra/Phantoms.hs @@ -1,4 +1,4 @@ --- | Phantom types for use in model definitions +-- | Phantom types for use with Hydra DSLs module Hydra.Phantoms where @@ -9,45 +9,38 @@ import Data.Set as S -- | An association of a field name (as in a case statement) with a phantom type -newtype Case a = - Case { - unCase :: Core.Name} - deriving (Eq, Ord, Read, Show) - -_Case = (Core.Name "hydra/phantoms.Case") - --- | An association of a term with a phantom type -newtype Datum a = - Datum { - unDatum :: Core.Term} +newtype TCase a = + TCase { + unTCase :: Core.Name} deriving (Eq, Ord, Read, Show) -_Datum = (Core.Name "hydra/phantoms.Datum") +_TCase = (Core.Name "hydra/phantoms.TCase") --- | An association with a named term with a phantom type -data Definition a = - Definition { - definitionName :: Core.Name, - definitionDatum :: (Datum a)} +-- | An association with a named term (element) with a phantom type +data TElement a = + TElement { + tElementName :: Core.Name, + tElementTerm :: (TTerm a)} deriving (Eq, Ord, Read, Show) -_Definition = (Core.Name "hydra/phantoms.Definition") +_TElement = (Core.Name "hydra/phantoms.TElement") -_Definition_name = (Core.Name "name") +_TElement_name = (Core.Name "name") -_Definition_datum = (Core.Name "datum") +_TElement_term = (Core.Name "term") -- | An association with a term-level field with a phantom type -newtype Fld a = - Fld { - unFld :: Core.Field} +newtype TField a = + TField { + unTField :: Core.Field} deriving (Eq, Ord, Read, Show) -_Fld = (Core.Name "hydra/phantoms.Fld") +_TField = (Core.Name "hydra/phantoms.TField") --- | A pure association with a phantom type -data Reference a = - Reference {} +-- | An association of a term with a phantom type +newtype TTerm a = + TTerm { + unTTerm :: Core.Term} deriving (Eq, Ord, Read, Show) -_Reference = (Core.Name "hydra/phantoms.Reference") +_TTerm = (Core.Name "hydra/phantoms.TTerm") diff --git a/src/gen-main/haskell/Hydra/Printing.hs b/src/gen-main/haskell/Hydra/Printing.hs --- a/src/gen-main/haskell/Hydra/Printing.hs +++ b/src/gen-main/haskell/Hydra/Printing.hs @@ -29,55 +29,55 @@ describeLiteralType x = case x of Core.LiteralTypeBinary -> "binary strings" Core.LiteralTypeBoolean -> "boolean values" - Core.LiteralTypeFloat v246 -> (describeFloatType v246) - Core.LiteralTypeInteger v247 -> (describeIntegerType v247) + Core.LiteralTypeFloat v289 -> (describeFloatType v289) + Core.LiteralTypeInteger v290 -> (describeIntegerType v290) Core.LiteralTypeString -> "character strings" -- | Display numeric precision as a string describePrecision :: (Mantle.Precision -> String) describePrecision x = case x of Mantle.PrecisionArbitrary -> "arbitrary-precision" - Mantle.PrecisionBits v250 -> (Strings.cat [ - Literals.showInt32 v250, + Mantle.PrecisionBits v293 -> (Strings.cat [ + Literals.showInt32 v293, "-bit"]) -- | Display a type as a string describeType :: (Core.Type -> String) describeType x = case x of - Core.TypeAnnotated v251 -> (Strings.cat [ + Core.TypeAnnotated v294 -> (Strings.cat [ "annotated ", - (describeType (Core.annotatedTypeSubject v251))]) + (describeType (Core.annotatedTypeSubject v294))]) Core.TypeApplication _ -> "instances of an application type" - Core.TypeLiteral v253 -> (describeLiteralType v253) - Core.TypeFunction v254 -> (Strings.cat [ + Core.TypeLiteral v296 -> (describeLiteralType v296) + Core.TypeFunction v297 -> (Strings.cat [ Strings.cat [ Strings.cat [ "functions from ", - (describeType (Core.functionTypeDomain v254))], + (describeType (Core.functionTypeDomain v297))], " to "], - (describeType (Core.functionTypeCodomain v254))]) + (describeType (Core.functionTypeCodomain v297))]) Core.TypeLambda _ -> "polymorphic terms" - Core.TypeList v256 -> (Strings.cat [ + Core.TypeList v299 -> (Strings.cat [ "lists of ", - (describeType v256)]) - Core.TypeMap v257 -> (Strings.cat [ + (describeType v299)]) + Core.TypeMap v300 -> (Strings.cat [ Strings.cat [ Strings.cat [ "maps from ", - (describeType (Core.mapTypeKeys v257))], + (describeType (Core.mapTypeKeys v300))], " to "], - (describeType (Core.mapTypeValues v257))]) - Core.TypeOptional v258 -> (Strings.cat [ + (describeType (Core.mapTypeValues v300))]) + Core.TypeOptional v301 -> (Strings.cat [ "optional ", - (describeType v258)]) + (describeType v301)]) Core.TypeProduct _ -> "tuples" Core.TypeRecord _ -> "records" - Core.TypeSet v261 -> (Strings.cat [ + Core.TypeSet v304 -> (Strings.cat [ "sets of ", - (describeType v261)]) + (describeType v304)]) Core.TypeSum _ -> "variant tuples" Core.TypeUnion _ -> "unions" Core.TypeVariable _ -> "instances of a named type" - Core.TypeWrap v265 -> (Strings.cat [ + Core.TypeWrap v308 -> (Strings.cat [ "wrapper for ", - (describeType (Core.wrappedTypeObject v265))]) + (describeType (Core.wrappedTypeObject v308))]) diff --git a/src/gen-main/haskell/Hydra/Strip.hs b/src/gen-main/haskell/Hydra/Strip.hs --- a/src/gen-main/haskell/Hydra/Strip.hs +++ b/src/gen-main/haskell/Hydra/Strip.hs @@ -11,24 +11,24 @@ -- | Strip all annotations from a term, including first-class type annotations fullyStripTerm :: (Core.Term -> Core.Term) fullyStripTerm t = ((\x -> case x of - Core.TermAnnotated v266 -> (fullyStripTerm (Core.annotatedTermSubject v266)) - Core.TermTyped v267 -> (fullyStripTerm (Core.typedTermTerm v267)) + Core.TermAnnotated v309 -> (fullyStripTerm (Core.annotatedTermSubject v309)) + Core.TermTyped v310 -> (fullyStripTerm (Core.typedTermTerm v310)) _ -> t) t) -- | Strip all annotations from a term stripTerm :: (Core.Term -> Core.Term) stripTerm t = ((\x -> case x of - Core.TermAnnotated v268 -> (stripTerm (Core.annotatedTermSubject v268)) + Core.TermAnnotated v311 -> (stripTerm (Core.annotatedTermSubject v311)) _ -> t) t) -- | Strip all annotations from a term stripType :: (Core.Type -> Core.Type) stripType t = ((\x -> case x of - Core.TypeAnnotated v269 -> (stripType (Core.annotatedTypeSubject v269)) + Core.TypeAnnotated v312 -> (stripType (Core.annotatedTypeSubject v312)) _ -> t) t) -- | Strip any top-level type lambdas from a type, extracting the (possibly nested) type body stripTypeParameters :: (Core.Type -> Core.Type) stripTypeParameters t = ((\x -> case x of - Core.TypeLambda v270 -> (stripTypeParameters (Core.lambdaTypeBody v270)) + Core.TypeLambda v313 -> (stripTypeParameters (Core.lambdaTypeBody v313)) _ -> t) (stripType t)) diff --git a/src/gen-main/haskell/Hydra/Tier1.hs b/src/gen-main/haskell/Hydra/Tier1.hs --- a/src/gen-main/haskell/Hydra/Tier1.hs +++ b/src/gen-main/haskell/Hydra/Tier1.hs @@ -25,30 +25,30 @@ -- | Convert a floating-point value of any precision to a bigfloat floatValueToBigfloat :: (Core.FloatValue -> Double) floatValueToBigfloat x = case x of - Core.FloatValueBigfloat v77 -> (Equality.identity v77) - Core.FloatValueFloat32 v78 -> (Literals.float32ToBigfloat v78) - Core.FloatValueFloat64 v79 -> (Literals.float64ToBigfloat v79) + Core.FloatValueBigfloat v0 -> (Equality.identity v0) + Core.FloatValueFloat32 v1 -> (Literals.float32ToBigfloat v1) + Core.FloatValueFloat64 v2 -> (Literals.float64ToBigfloat v2) -- | Convert an integer value of any precision to a bigint integerValueToBigint :: (Core.IntegerValue -> Integer) integerValueToBigint x = case x of - Core.IntegerValueBigint v80 -> (Equality.identity v80) - Core.IntegerValueInt8 v81 -> (Literals.int8ToBigint v81) - Core.IntegerValueInt16 v82 -> (Literals.int16ToBigint v82) - Core.IntegerValueInt32 v83 -> (Literals.int32ToBigint v83) - Core.IntegerValueInt64 v84 -> (Literals.int64ToBigint v84) - Core.IntegerValueUint8 v85 -> (Literals.uint8ToBigint v85) - Core.IntegerValueUint16 v86 -> (Literals.uint16ToBigint v86) - Core.IntegerValueUint32 v87 -> (Literals.uint32ToBigint v87) - Core.IntegerValueUint64 v88 -> (Literals.uint64ToBigint v88) + Core.IntegerValueBigint v3 -> (Equality.identity v3) + Core.IntegerValueInt8 v4 -> (Literals.int8ToBigint v4) + Core.IntegerValueInt16 v5 -> (Literals.int16ToBigint v5) + Core.IntegerValueInt32 v6 -> (Literals.int32ToBigint v6) + Core.IntegerValueInt64 v7 -> (Literals.int64ToBigint v7) + Core.IntegerValueUint8 v8 -> (Literals.uint8ToBigint v8) + Core.IntegerValueUint16 v9 -> (Literals.uint16ToBigint v9) + Core.IntegerValueUint32 v10 -> (Literals.uint32ToBigint v10) + Core.IntegerValueUint64 v11 -> (Literals.uint64ToBigint v11) -- | Check whether a term is a lambda, possibly nested within let and/or annotation terms isLambda :: (Core.Term -> Bool) isLambda term = ((\x -> case x of - Core.TermFunction v89 -> ((\x -> case x of + Core.TermFunction v12 -> ((\x -> case x of Core.FunctionLambda _ -> True - _ -> False) v89) - Core.TermLet v91 -> (isLambda (Core.letEnvironment v91)) + _ -> False) v12) + Core.TermLet v14 -> (isLambda (Core.letEnvironment v14)) _ -> False) (Strip.fullyStripTerm term)) -- | Convert a qualified name to a dot-separated name @@ -56,8 +56,8 @@ unqualifyName qname = let prefix = ((\x -> case x of Nothing -> "" - Just v92 -> (Strings.cat [ - Module.unNamespace v92, + Just v15 -> (Strings.cat [ + Module.unNamespace v15, "."])) (Module.qualifiedNameNamespace qname)) in (Core.Name (Strings.cat [ prefix, @@ -80,10 +80,10 @@ freeVariablesInTerm term = let dfltVars = (Lists.foldl (\s -> \t -> Sets.union s (freeVariablesInTerm t)) Sets.empty (subterms term)) in ((\x -> case x of - Core.TermFunction v97 -> ((\x -> case x of - Core.FunctionLambda v98 -> (Sets.remove (Core.lambdaParameter v98) (freeVariablesInTerm (Core.lambdaBody v98))) - _ -> dfltVars) v97) - Core.TermVariable v99 -> (Sets.singleton v99) + Core.TermFunction v20 -> ((\x -> case x of + Core.FunctionLambda v21 -> (Sets.remove (Core.lambdaParameter v21) (freeVariablesInTerm (Core.lambdaBody v21))) + _ -> dfltVars) v20) + Core.TermVariable v22 -> (Sets.singleton v22) _ -> dfltVars) term) -- | Find the free variables (i.e. variables not bound by a lambda or let) in a type @@ -91,86 +91,140 @@ freeVariablesInType typ = let dfltVars = (Lists.foldl (\s -> \t -> Sets.union s (freeVariablesInType t)) Sets.empty (subtypes typ)) in ((\x -> case x of - Core.TypeLambda v100 -> (Sets.remove (Core.lambdaTypeParameter v100) (freeVariablesInType (Core.lambdaTypeBody v100))) - Core.TypeVariable v101 -> (Sets.singleton v101) + Core.TypeLambda v23 -> (Sets.remove (Core.lambdaTypeParameter v23) (freeVariablesInType (Core.lambdaTypeBody v23))) + Core.TypeVariable v24 -> (Sets.singleton v24) _ -> dfltVars) typ) -- | Find the children of a given term subterms :: (Core.Term -> [Core.Term]) subterms x = case x of - Core.TermAnnotated v102 -> [ - Core.annotatedTermSubject v102] - Core.TermApplication v103 -> [ - Core.applicationFunction v103, - (Core.applicationArgument v103)] - Core.TermFunction v104 -> ((\x -> case x of - Core.FunctionElimination v105 -> ((\x -> case x of - Core.EliminationList v106 -> [ - v106] - Core.EliminationOptional v107 -> [ - Core.optionalCasesNothing v107, - (Core.optionalCasesJust v107)] - Core.EliminationUnion v108 -> (Lists.concat2 ((\x -> case x of + Core.TermAnnotated v25 -> [ + Core.annotatedTermSubject v25] + Core.TermApplication v26 -> [ + Core.applicationFunction v26, + (Core.applicationArgument v26)] + Core.TermFunction v27 -> ((\x -> case x of + Core.FunctionElimination v28 -> ((\x -> case x of + Core.EliminationList v29 -> [ + v29] + Core.EliminationOptional v30 -> [ + Core.optionalCasesNothing v30, + (Core.optionalCasesJust v30)] + Core.EliminationUnion v31 -> (Lists.concat2 ((\x -> case x of Nothing -> [] - Just v109 -> [ - v109]) (Core.caseStatementDefault v108)) (Lists.map Core.fieldTerm (Core.caseStatementCases v108))) - _ -> []) v105) - Core.FunctionLambda v110 -> [ - Core.lambdaBody v110] - _ -> []) v104) - Core.TermLet v111 -> (Lists.cons (Core.letEnvironment v111) (Lists.map Core.letBindingTerm (Core.letBindings v111))) - Core.TermList v112 -> v112 + Just v32 -> [ + v32]) (Core.caseStatementDefault v31)) (Lists.map Core.fieldTerm (Core.caseStatementCases v31))) + _ -> []) v28) + Core.FunctionLambda v33 -> [ + Core.lambdaBody v33] + _ -> []) v27) + Core.TermLet v34 -> (Lists.cons (Core.letEnvironment v34) (Lists.map Core.letBindingTerm (Core.letBindings v34))) + Core.TermList v35 -> v35 Core.TermLiteral _ -> [] - Core.TermMap v114 -> (Lists.concat (Lists.map (\p -> [ + Core.TermMap v37 -> (Lists.concat (Lists.map (\p -> [ fst p, - (snd p)]) (Maps.toList v114))) - Core.TermOptional v115 -> ((\x -> case x of + (snd p)]) (Maps.toList v37))) + Core.TermOptional v38 -> ((\x -> case x of Nothing -> [] - Just v116 -> [ - v116]) v115) - Core.TermProduct v117 -> v117 - Core.TermRecord v118 -> (Lists.map Core.fieldTerm (Core.recordFields v118)) - Core.TermSet v119 -> (Sets.toList v119) - Core.TermSum v120 -> [ - Core.sumTerm v120] - Core.TermTyped v121 -> [ - Core.typedTermTerm v121] - Core.TermUnion v122 -> [ - Core.fieldTerm (Core.injectionField v122)] + Just v39 -> [ + v39]) v38) + Core.TermProduct v40 -> v40 + Core.TermRecord v41 -> (Lists.map Core.fieldTerm (Core.recordFields v41)) + Core.TermSet v42 -> (Sets.toList v42) + Core.TermSum v43 -> [ + Core.sumTerm v43] + Core.TermTypeAbstraction v44 -> [ + Core.typeAbstractionBody v44] + Core.TermTypeApplication v45 -> [ + Core.typedTermTerm v45] + Core.TermTyped v46 -> [ + Core.typedTermTerm v46] + Core.TermUnion v47 -> [ + Core.fieldTerm (Core.injectionField v47)] Core.TermVariable _ -> [] - Core.TermWrap v124 -> [ - Core.wrappedTermObject v124] + Core.TermWrap v49 -> [ + Core.wrappedTermObject v49] +-- | Find the children of a given term +subtermsWithAccessors :: (Core.Term -> [(Mantle.TermAccessor, Core.Term)]) +subtermsWithAccessors x = case x of + Core.TermAnnotated v50 -> [ + (Mantle.TermAccessorAnnotatedSubject, (Core.annotatedTermSubject v50))] + Core.TermApplication v51 -> [ + (Mantle.TermAccessorApplicationFunction, (Core.applicationFunction v51)), + (Mantle.TermAccessorApplicationArgument, (Core.applicationArgument v51))] + Core.TermFunction v52 -> ((\x -> case x of + Core.FunctionElimination v53 -> ((\x -> case x of + Core.EliminationList v54 -> [ + (Mantle.TermAccessorListFold, v54)] + Core.EliminationOptional v55 -> [ + (Mantle.TermAccessorOptionalCasesNothing, (Core.optionalCasesNothing v55)), + (Mantle.TermAccessorOptionalCasesJust, (Core.optionalCasesJust v55))] + Core.EliminationUnion v56 -> (Lists.concat2 ((\x -> case x of + Nothing -> [] + Just v57 -> [ + (Mantle.TermAccessorUnionCasesDefault, v57)]) (Core.caseStatementDefault v56)) (Lists.map (\f -> (Mantle.TermAccessorUnionCasesBranch (Core.fieldName f), (Core.fieldTerm f))) (Core.caseStatementCases v56))) + _ -> []) v53) + Core.FunctionLambda v58 -> [ + (Mantle.TermAccessorLambdaBody, (Core.lambdaBody v58))] + _ -> []) v52) + Core.TermLet v59 -> (Lists.cons (Mantle.TermAccessorLetEnvironment, (Core.letEnvironment v59)) (Lists.map (\b -> (Mantle.TermAccessorLetBinding (Core.letBindingName b), (Core.letBindingTerm b))) (Core.letBindings v59))) + Core.TermList v60 -> (Lists.map (\e -> (Mantle.TermAccessorListElement 0, e)) v60) + Core.TermLiteral _ -> [] + Core.TermMap v62 -> (Lists.concat (Lists.map (\p -> [ + (Mantle.TermAccessorMapKey 0, (fst p)), + (Mantle.TermAccessorMapValue 0, (snd p))]) (Maps.toList v62))) + Core.TermOptional v63 -> ((\x -> case x of + Nothing -> [] + Just v64 -> [ + (Mantle.TermAccessorOptionalTerm, v64)]) v63) + Core.TermProduct v65 -> (Lists.map (\e -> (Mantle.TermAccessorProductTerm 0, e)) v65) + Core.TermRecord v66 -> (Lists.map (\f -> (Mantle.TermAccessorRecordField (Core.fieldName f), (Core.fieldTerm f))) (Core.recordFields v66)) + Core.TermSet v67 -> (Lists.map (\e -> (Mantle.TermAccessorListElement 0, e)) (Sets.toList v67)) + Core.TermSum v68 -> [ + (Mantle.TermAccessorSumTerm, (Core.sumTerm v68))] + Core.TermTypeAbstraction v69 -> [ + (Mantle.TermAccessorTypeAbstractionBody, (Core.typeAbstractionBody v69))] + Core.TermTypeApplication v70 -> [ + (Mantle.TermAccessorTypeApplicationTerm, (Core.typedTermTerm v70))] + Core.TermTyped v71 -> [ + (Mantle.TermAccessorTypedTerm, (Core.typedTermTerm v71))] + Core.TermUnion v72 -> [ + (Mantle.TermAccessorInjectionTerm, (Core.fieldTerm (Core.injectionField v72)))] + Core.TermVariable _ -> [] + Core.TermWrap v74 -> [ + (Mantle.TermAccessorWrappedTerm, (Core.wrappedTermObject v74))] + -- | Find the children of a given type expression subtypes :: (Core.Type -> [Core.Type]) subtypes x = case x of - Core.TypeAnnotated v125 -> [ - Core.annotatedTypeSubject v125] - Core.TypeApplication v126 -> [ - Core.applicationTypeFunction v126, - (Core.applicationTypeArgument v126)] - Core.TypeFunction v127 -> [ - Core.functionTypeDomain v127, - (Core.functionTypeCodomain v127)] - Core.TypeLambda v128 -> [ - Core.lambdaTypeBody v128] - Core.TypeList v129 -> [ - v129] + Core.TypeAnnotated v75 -> [ + Core.annotatedTypeSubject v75] + Core.TypeApplication v76 -> [ + Core.applicationTypeFunction v76, + (Core.applicationTypeArgument v76)] + Core.TypeFunction v77 -> [ + Core.functionTypeDomain v77, + (Core.functionTypeCodomain v77)] + Core.TypeLambda v78 -> [ + Core.lambdaTypeBody v78] + Core.TypeList v79 -> [ + v79] Core.TypeLiteral _ -> [] - Core.TypeMap v131 -> [ - Core.mapTypeKeys v131, - (Core.mapTypeValues v131)] - Core.TypeOptional v132 -> [ - v132] - Core.TypeProduct v133 -> v133 - Core.TypeRecord v134 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v134)) - Core.TypeSet v135 -> [ - v135] - Core.TypeSum v136 -> v136 - Core.TypeUnion v137 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v137)) + Core.TypeMap v81 -> [ + Core.mapTypeKeys v81, + (Core.mapTypeValues v81)] + Core.TypeOptional v82 -> [ + v82] + Core.TypeProduct v83 -> v83 + Core.TypeRecord v84 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v84)) + Core.TypeSet v85 -> [ + v85] + Core.TypeSum v86 -> v86 + Core.TypeUnion v87 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v87)) Core.TypeVariable _ -> [] - Core.TypeWrap v139 -> [ - Core.wrappedTypeObject v139] + Core.TypeWrap v89 -> [ + Core.wrappedTypeObject v89] emptyTrace :: Compute.Trace emptyTrace = Compute.Trace { @@ -186,7 +240,7 @@ fromFlow :: (a -> s -> Compute.Flow s a -> a) fromFlow def cx f = ((\x -> case x of Nothing -> def - Just v140 -> v140) (Compute.flowStateValue (Compute.unFlow f cx emptyTrace))) + Just v90 -> v90) (Compute.flowStateValue (Compute.unFlow f cx emptyTrace))) mutateTrace :: ((Compute.Trace -> Mantle.Either_ String Compute.Trace) -> (Compute.Trace -> Compute.Trace -> Compute.Trace) -> Compute.Flow s a -> Compute.Flow s a) mutateTrace mutate restore f = (Compute.Flow (\s0 -> \t0 -> @@ -201,8 +255,8 @@ Compute.flowStateState = (Compute.flowStateState f2), Compute.flowStateTrace = (restore t0 (Compute.flowStateTrace f2))}) in ((\x -> case x of - Mantle.EitherLeft v141 -> (forLeft v141) - Mantle.EitherRight v142 -> (forRight v142)) (mutate t0)))) + Mantle.EitherLeft v91 -> (forLeft v91) + Mantle.EitherRight v92 -> (forRight v92)) (mutate t0)))) -- | Push an error message pushError :: (String -> Compute.Trace -> Compute.Trace) @@ -234,7 +288,7 @@ Compute.flowStateTrace = (addMessage (Compute.flowStateTrace f1))})) -- | Continue the current flow after setting a flag -withFlag :: (String -> Compute.Flow s a -> Compute.Flow s a) +withFlag :: (Core.Name -> Compute.Flow s a -> Compute.Flow s a) withFlag flag = let mutate = (\t -> Mantle.EitherRight (Compute.Trace { Compute.traceStack = (Compute.traceStack t), diff --git a/src/gen-main/haskell/Hydra/Tier2.hs b/src/gen-main/haskell/Hydra/Tier2.hs --- a/src/gen-main/haskell/Hydra/Tier2.hs +++ b/src/gen-main/haskell/Hydra/Tier2.hs @@ -29,8 +29,8 @@ -- | Get the annotated type of a given term, if any getTermType :: (Core.Term -> Maybe Core.Type) getTermType x = case x of - Core.TermAnnotated v272 -> (getTermType (Core.annotatedTermSubject v272)) - Core.TermTyped v273 -> (Just (Core.typedTermType v273)) + Core.TermAnnotated v315 -> (getTermType (Core.annotatedTermSubject v315)) + Core.TermTyped v316 -> (Just (Core.typedTermType v316)) _ -> Nothing -- | Set the state of a flow @@ -49,7 +49,7 @@ Nothing -> (Flows.fail (Strings.cat [ "missing type annotation for element ", (Core.unName (Graph.elementName el))])) - Just v274 -> (Flows.pure v274)) + Just v317 -> (Flows.pure v317)) in (withType (getTermType (Graph.elementData el))) -- | Get the annotated type of a given term, or fail if it is missing @@ -58,7 +58,7 @@ where withType = (\x -> case x of Nothing -> (Flows.fail "missing type annotation") - Just v275 -> (Flows.pure v275)) + Just v318 -> (Flows.pure v318)) -- | Fail if an actual value does not match an expected value unexpected :: (String -> String -> Compute.Flow s x) diff --git a/src/gen-main/haskell/Hydra/Tier3.hs b/src/gen-main/haskell/Hydra/Tier3.hs --- a/src/gen-main/haskell/Hydra/Tier3.hs +++ b/src/gen-main/haskell/Hydra/Tier3.hs @@ -3,6 +3,7 @@ module Hydra.Tier3 where import qualified Hydra.Compute as Compute +import qualified Hydra.Core as Core import qualified Hydra.Lib.Io as Io import qualified Hydra.Lib.Lists as Lists import qualified Hydra.Lib.Logic as Logic @@ -22,7 +23,7 @@ Strings.cat [ Strings.cat [ "\t", - (fst pair)], + (Core.unName (fst pair))], ": "], (Io.showTerm (snd pair))]) in (Strings.intercalate "\n" (Lists.concat2 messageLines keyvalLines)) diff --git a/src/gen-test/haskell/Hydra/Test/TestSuite.hs b/src/gen-test/haskell/Hydra/Test/TestSuite.hs --- a/src/gen-test/haskell/Hydra/Test/TestSuite.hs +++ b/src/gen-test/haskell/Hydra/Test/TestSuite.hs @@ -61,6 +61,7 @@ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})), Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda { Core.lambdaParameter = (Core.Name "x"), + Core.lambdaDomain = Nothing, Core.lambdaBody = (Core.TermApplication (Core.Application { Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.pure"))), Core.applicationArgument = (Core.TermApplication (Core.Application { diff --git a/src/main/haskell/Hydra/AdapterUtils.hs b/src/main/haskell/Hydra/AdapterUtils.hs --- a/src/main/haskell/Hydra/AdapterUtils.hs +++ b/src/main/haskell/Hydra/AdapterUtils.hs @@ -12,6 +12,7 @@ import Hydra.Module import Hydra.Printing import Hydra.Mantle +import Hydra.Strip import Hydra.Annotations import qualified Hydra.Lib.Strings as Strings import qualified Hydra.Dsl.Expect as Expect @@ -27,6 +28,8 @@ type TypeAdapter = Type -> Flow AdapterContext (SymmetricAdapter AdapterContext Type Term) +key_types = Name "types" + bidirectional :: (CoderDirection -> b -> Flow s b) -> Coder s s b b bidirectional f = Coder (f CoderDirectionEncode) (f CoderDirectionDecode) @@ -64,18 +67,18 @@ debugCheckType :: (Eq t, Ord t, Show t) => t -> Flow s () debugCheckType typ = do let s = show typ - types <- getAttrWithDefault "types" (Terms.set S.empty) >>= Expect.set Expect.string + types <- getAttrWithDefault key_types (Terms.set S.empty) >>= Expect.set Expect.string if S.member s types then fail $ "detected a cycle; type has already been encountered: " ++ show typ - else putAttr "types" $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types)) + else putAttr key_types $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types)) return () debugRemoveType :: (Eq t, Ord t, Show t) => t -> Flow s () debugRemoveType typ = do let s = show typ - types <- getAttrWithDefault "types" (Terms.set S.empty) >>= Expect.set Expect.string + types <- getAttrWithDefault key_types (Terms.set S.empty) >>= Expect.set Expect.string let types' = S.delete s types - putAttr "types" $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types')) + putAttr key_types $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types')) encodeDecode :: CoderDirection -> Coder s s x x -> x -> Flow s x encodeDecode dir = case dir of @@ -108,10 +111,9 @@ prefix = Y.maybe "" (\(Namespace gname) -> gname ++ "/") ns typeIsSupported :: LanguageConstraints -> Type -> Bool -typeIsSupported constraints t = languageConstraintsTypes constraints t -- these are *additional* type constraints - && isSupportedVariant (typeVariant t) - && case t of - TypeAnnotated (AnnotatedType at _) -> typeIsSupported constraints at +typeIsSupported constraints t = languageConstraintsTypes constraints base -- these are *additional* type constraints + && isSupportedVariant (typeVariant base) + && case base of TypeLiteral at -> literalTypeIsSupported constraints at TypeFunction (FunctionType dom cod) -> typeIsSupported constraints dom && typeIsSupported constraints cod TypeList lt -> typeIsSupported constraints lt @@ -124,6 +126,7 @@ _ -> True where isSupportedVariant v = v == TypeVariantVariable || S.member v (languageConstraintsTypeVariants constraints) + base = stripType t unidirectionalCoder :: (a -> Flow s b) -> Coder s s a b unidirectionalCoder m = Coder { diff --git a/src/main/haskell/Hydra/Adapters.hs b/src/main/haskell/Hydra/Adapters.hs --- a/src/main/haskell/Hydra/Adapters.hs +++ b/src/main/haskell/Hydra/Adapters.hs @@ -9,7 +9,7 @@ import Hydra.Coders import Hydra.Compute import Hydra.Core -import Hydra.CoreDecoding +import Hydra.Schemas import Hydra.CoreLanguage import Hydra.Graph import Hydra.Lexical diff --git a/src/main/haskell/Hydra/Annotations.hs b/src/main/haskell/Hydra/Annotations.hs --- a/src/main/haskell/Hydra/Annotations.hs +++ b/src/main/haskell/Hydra/Annotations.hs @@ -23,52 +23,52 @@ import qualified Data.Maybe as Y -key_classes = "classes" :: String -key_description = "description" -key_type = "type" +key_classes = Name "classes" +key_description = Name "description" +key_type = Name "type" -aggregateAnnotations :: (x -> Maybe y) -> (y -> x) -> (y -> M.Map String Term) -> x -> M.Map String Term +aggregateAnnotations :: (x -> Maybe y) -> (y -> x) -> (y -> M.Map Name Term) -> x -> M.Map Name Term aggregateAnnotations getValue getX getAnns t = M.fromList $ L.concat $ toPairs [] t where toPairs rest t = case getValue t of Nothing -> rest Just yy -> toPairs ((M.toList (getAnns yy)):rest) (getX yy) -failOnFlag :: String -> String -> Flow s () +failOnFlag :: Name -> String -> Flow s () failOnFlag flag msg = do val <- hasFlag flag if val then fail msg else pure () -getAttr :: String -> Flow s (Maybe Term) +getAttr :: Name -> Flow s (Maybe Term) getAttr key = Flow q where q s0 t0 = FlowState (Just $ M.lookup key $ traceOther t0) s0 t0 -getAttrWithDefault :: String -> Term -> Flow s Term +getAttrWithDefault :: Name -> Term -> Flow s Term getAttrWithDefault key def = Y.fromMaybe def <$> getAttr key -getDescription :: M.Map String Term -> Flow Graph (Y.Maybe String) +getDescription :: M.Map Name Term -> Flow Graph (Y.Maybe String) getDescription anns = case getAnnotation key_description anns of Nothing -> pure Nothing Just term -> case term of TermLiteral (LiteralString s) -> pure $ Just s _ -> fail $ "unexpected value for " ++ show key_description ++ ": " ++ show term -getTermAnnotation :: String -> Term -> Y.Maybe Term +getTermAnnotation :: Name -> Term -> Y.Maybe Term getTermAnnotation key = getAnnotation key . termAnnotationInternal getTermDescription :: Term -> Flow Graph (Y.Maybe String) getTermDescription = getDescription . termAnnotationInternal -getType :: M.Map String Term -> Flow Graph (Y.Maybe Type) +getType :: M.Map Name Term -> Flow Graph (Y.Maybe Type) getType anns = case getAnnotation key_type anns of Nothing -> pure Nothing Just dat -> Just <$> coreDecodeType dat -getTypeAnnotation :: String -> Type -> Y.Maybe Term +getTypeAnnotation :: Name -> Type -> Y.Maybe Term getTypeAnnotation key = getAnnotation key . typeAnnotationInternal getTypeClasses :: Type -> Flow Graph (M.Map Name (S.Set TypeClass)) @@ -83,17 +83,17 @@ getTypeDescription :: Type -> Flow Graph (Y.Maybe String) getTypeDescription = getDescription . typeAnnotationInternal -hasFlag :: String -> Flow s Bool +hasFlag :: Name -> Flow s Bool hasFlag flag = getAttrWithDefault flag (Terms.boolean False) >>= Expect.boolean -- | Return a zero-indexed counter for the given key: 0, 1, 2, ... -nextCount :: String -> Flow s Int +nextCount :: Name -> Flow s Int nextCount attrName = do count <- getAttrWithDefault attrName (Terms.int32 0) >>= Expect.int32 putAttr attrName (Terms.int32 $ count + 1) return count -resetCount :: String -> Flow s () +resetCount :: Name -> Flow s () resetCount attrName = do putAttr attrName (Terms.int32 0) return () @@ -114,18 +114,18 @@ anns = typeAnnotationInternal typ stripped = stripType typ -putAttr :: String -> Term -> Flow s () +putAttr :: Name -> Term -> Flow s () putAttr key val = Flow q where q s0 t0 = FlowState (Just ()) s0 (t0 {traceOther = M.insert key val $ traceOther t0}) -setAnnotation :: String -> Y.Maybe Term -> M.Map String Term -> M.Map String Term +setAnnotation :: Name -> Y.Maybe Term -> M.Map Name Term -> M.Map Name Term setAnnotation key val m = M.alter (const val) key m -setDescription :: Y.Maybe String -> M.Map String Term -> M.Map String Term +setDescription :: Y.Maybe String -> M.Map Name Term -> M.Map Name Term setDescription d = setAnnotation key_description (Terms.string <$> d) -setTermAnnotation :: String -> Y.Maybe Term -> Term -> Term +setTermAnnotation :: Name -> Y.Maybe Term -> Term -> Term setTermAnnotation key val term = if anns == M.empty then term' else TermAnnotated $ AnnotatedTerm term' anns @@ -149,7 +149,7 @@ setType mt = setAnnotation key_type (coreEncodeType <$> mt) -setTypeAnnotation :: String -> Y.Maybe Term -> Type -> Type +setTypeAnnotation :: Name -> Y.Maybe Term -> Type -> Type setTypeAnnotation key val typ = if anns == M.empty then typ' else TypeAnnotated $ AnnotatedType typ' anns @@ -171,7 +171,7 @@ setTypeDescription :: Y.Maybe String -> Type -> Type setTypeDescription d = setTypeAnnotation key_description (Terms.string <$> d) -termAnnotationInternal :: Term -> M.Map String Term +termAnnotationInternal :: Term -> M.Map Name Term termAnnotationInternal = aggregateAnnotations getAnn annotatedTermSubject annotatedTermAnnotation where getAnn t = case t of @@ -179,14 +179,14 @@ TermTyped (TypedTerm t1 _) -> getAnn t1 _ -> Nothing -typeAnnotationInternal :: Type -> M.Map String Term +typeAnnotationInternal :: Type -> M.Map Name Term typeAnnotationInternal = aggregateAnnotations getAnn annotatedTypeSubject annotatedTypeAnnotation where getAnn t = case t of TypeAnnotated a -> Just a _ -> Nothing -whenFlag :: String -> Flow s a -> Flow s a -> Flow s a +whenFlag :: Name -> Flow s a -> Flow s a -> Flow s a whenFlag flag fthen felse = do b <- hasFlag flag if b @@ -195,22 +195,22 @@ -- TODO: move out of Annotations and into Rewriting unshadowVariables :: Term -> Term -unshadowVariables term = Y.fromJust $ flowStateValue $ unFlow (rewriteTermM rewrite (pure . id) term) (S.empty, M.empty) emptyTrace +unshadowVariables term = Y.fromJust $ flowStateValue $ unFlow (rewriteTermM rewrite term) (S.empty, M.empty) emptyTrace where rewrite recurse term = do (reserved, subst) <- getState case term of TermVariable v -> pure $ TermVariable $ Y.fromMaybe v $ M.lookup v subst - TermFunction (FunctionLambda (Lambda v body)) -> if S.member v reserved + TermFunction (FunctionLambda (Lambda v d body)) -> if S.member v reserved then do v' <- freshName putState (S.insert v' reserved, M.insert v v' subst) body' <- recurse body putState (reserved, subst) - pure $ TermFunction $ FunctionLambda $ Lambda v' body' + pure $ TermFunction $ FunctionLambda $ Lambda v' d body' else do putState (S.insert v reserved, subst) body' <- recurse body - return $ TermFunction $ FunctionLambda $ Lambda v body' + return $ TermFunction $ FunctionLambda $ Lambda v d body' _ -> recurse term - freshName = (\n -> Name $ "s" ++ show n) <$> nextCount "unshadow" + freshName = (\n -> Name $ "s" ++ show n) <$> nextCount (Name "unshadow") diff --git a/src/main/haskell/Hydra/Codegen.hs b/src/main/haskell/Hydra/Codegen.hs --- a/src/main/haskell/Hydra/Codegen.hs +++ b/src/main/haskell/Hydra/Codegen.hs @@ -15,14 +15,14 @@ import Hydra.Kernel import Hydra.Dsl.Annotations import Hydra.Dsl.Bootstrap -import Hydra.Langs.Graphql.Coder -import Hydra.Langs.Haskell.Coder -import Hydra.Langs.Java.Coder -import Hydra.Langs.Json.Coder -import Hydra.Langs.Pegasus.Coder -import Hydra.Langs.Protobuf.Coder -import Hydra.Langs.Scala.Coder -import Hydra.Langs.Yaml.Modules +import Hydra.Ext.Graphql.Coder +import Hydra.Ext.Haskell.Coder +import Hydra.Ext.Java.Coder +import Hydra.Ext.Json.Coder +import Hydra.Ext.Pegasus.Coder +import Hydra.Ext.Protobuf.Coder +import Hydra.Ext.Scala.Coder +import Hydra.Ext.Yaml.Modules import Hydra.Sources.Libraries import Hydra.Sources.Tier4.All diff --git a/src/main/haskell/Hydra/CoreDecoding.hs b/src/main/haskell/Hydra/CoreDecoding.hs --- a/src/main/haskell/Hydra/CoreDecoding.hs +++ b/src/main/haskell/Hydra/CoreDecoding.hs @@ -13,19 +13,6 @@ coreDecodeRowType, coreDecodeString, coreDecodeType, - dereferenceType, - elementAsTypedTerm, - fieldTypes, - fullyStripTerm, - isSerializable, - moduleDependencyNamespaces, - requireRecordType, - requireType, - requireUnionType, - requireWrappedType, - resolveType, - typeDependencies, - typeDependencyNames, ) where import Hydra.Basics @@ -119,7 +106,6 @@ coreDecodeRowType :: Term -> Flow Graph (RowType) coreDecodeRowType = matchRecord $ \m -> RowType <$> getField m _RowType_typeName coreDecodeName - <*> getField m _RowType_extends (Expect.optional coreDecodeName) <*> getField m _RowType_fields coreDecodeFieldTypes coreDecodeString :: Term -> Flow Graph String @@ -128,6 +114,7 @@ coreDecodeType :: Term -> Flow Graph Type coreDecodeType dat = case dat of TermAnnotated (AnnotatedTerm term ann) -> (\t -> TypeAnnotated $ AnnotatedType t ann) <$> coreDecodeType term + TermTyped (TypedTerm term _) -> coreDecodeType term _ -> matchUnion _Type [ -- (_Type_annotated, fmap TypeAnnotated . coreDecodeAnnotated), (_Type_application, fmap TypeApplication . coreDecodeApplicationType), @@ -147,45 +134,11 @@ (_Type_variable, fmap TypeVariable . coreDecodeName), (_Type_wrap, fmap TypeWrap . (coreDecodeWrappedType))] dat -dereferenceType :: Name -> Flow Graph (Maybe Type) -dereferenceType name = do - mel <- dereferenceElement name - case mel of - Nothing -> return Nothing - Just el -> Just <$> coreDecodeType (elementData el) - -elementAsTypedTerm :: Element -> Flow Graph TypedTerm -elementAsTypedTerm el = do - typ <- requireTermType $ elementData el - return $ TypedTerm (elementData el) typ - -fieldTypes :: Type -> Flow Graph (M.Map Name Type) -fieldTypes t = case stripType t of - TypeLambda (LambdaType _ body) -> fieldTypes body - TypeRecord rt -> pure $ toMap $ rowTypeFields rt - TypeUnion rt -> pure $ toMap $ rowTypeFields rt - TypeVariable name -> do - withTrace ("field types of " ++ unName name) $ do - el <- requireElement name - coreDecodeType (elementData el) >>= fieldTypes - _ -> unexpected "record or union type" $ show t - where - toMap fields = M.fromList (toPair <$> fields) - toPair (FieldType fname ftype) = (fname, ftype) - getField :: M.Map Name (Term) -> Name -> (Term -> Flow Graph b) -> Flow Graph b getField m fname decode = case M.lookup fname m of Nothing -> fail $ "expected field " ++ show fname ++ " not found" Just val -> decode val -isSerializable :: Element -> Flow Graph Bool -isSerializable el = do - deps <- typeDependencies (elementName el) - let allVariants = S.fromList $ L.concat (variants <$> M.elems deps) - return $ not $ S.member TypeVariantFunction allVariants - where - variants typ = typeVariant <$> foldOverType TraversalOrderPre (\m t -> t:m) [] typ - matchEnum :: Name -> [(Name, b)] -> Term -> Flow Graph b matchEnum tname = matchUnion tname . fmap (uncurry matchUnitField) @@ -210,95 +163,3 @@ matchUnitField :: Name -> y -> (Name, x -> Flow Graph y) matchUnitField fname x = (fname, \_ -> pure x) - --- | Find dependency namespaces in various dimensions of a term: va -moduleDependencyNamespaces :: Bool -> Bool -> Bool -> Bool -> Module -> Flow Graph (S.Set Namespace) -moduleDependencyNamespaces withVars withPrims withNoms withSchema mod = do - allNames <- S.unions <$> (CM.mapM elNames $ moduleElements mod) - let namespaces = S.fromList $ Y.catMaybes (namespaceOfEager <$> S.toList allNames) - return $ S.delete (moduleNamespace mod) namespaces - where - elNames el = do - let term = elementData el - let dataNames = termDependencyNames withVars withPrims withNoms term - - schemaNames <- if withSchema - then typeDependencyNames <$> requireTermType term - else pure S.empty - - typeNames <- if isEncodedType (fullyStripTerm term) - then typeDependencyNames <$> coreDecodeType term - else pure S.empty - - return $ S.unions [dataNames, schemaNames, typeNames] - -requireRecordType :: Bool -> Name -> Flow Graph (RowType) -requireRecordType infer = requireRowType "record type" infer $ \t -> case t of - TypeRecord rt -> Just rt - _ -> Nothing - -requireRowType :: String -> Bool -> (Type -> Maybe (RowType)) -> Name -> Flow Graph (RowType) -requireRowType label infer getter name = do - t <- requireType name - case getter (rawType t) of - Just rt -> if infer - then case rowTypeExtends rt of - Nothing -> return rt - Just name' -> do - rt' <- requireRowType label True getter name' - return $ RowType name Nothing (rowTypeFields rt' ++ rowTypeFields rt) - else return rt - Nothing -> fail $ show name ++ " does not resolve to a " ++ label ++ " type: " ++ show t - where - rawType t = case t of - TypeAnnotated (AnnotatedType t' _) -> rawType t' - TypeLambda (LambdaType _ body) -> rawType body -- Note: throwing away quantification here - _ -> t - -requireType :: Name -> Flow Graph Type -requireType name = withTrace ("require type " ++ unName name) $ - (withSchemaContext $ requireElement name) >>= (coreDecodeType . elementData) - -requireUnionType :: Bool -> Name -> Flow Graph (RowType) -requireUnionType infer = requireRowType "union" infer $ \t -> case t of - TypeUnion rt -> Just rt - _ -> Nothing - -requireWrappedType :: Name -> Flow Graph Type -requireWrappedType name = do - typ <- requireType name - case stripType typ of - TypeWrap (WrappedType name t) -> return t - _ -> return typ -- TODO: stop allowing this "slop" once typedefs are clearly separated from newtypes --- _ -> fail $ "expected wrapped type for " ++ unName name ++ " but got " ++ show typ - -resolveType :: Type -> Flow Graph (Maybe Type) -resolveType typ = case stripType typ of - TypeVariable name -> withSchemaContext $ do - mterm <- resolveTerm name - case mterm of - Nothing -> pure Nothing - Just t -> Just <$> coreDecodeType t - _ -> pure $ Just typ - -typeDependencies :: Name -> Flow Graph (M.Map Name Type) -typeDependencies name = deps (S.fromList [name]) M.empty - where - deps seeds names = if S.null seeds - then return names - else do - pairs <- CM.mapM toPair $ S.toList seeds - let newNames = M.union names (M.fromList pairs) - let refs = L.foldl S.union S.empty (typeDependencyNames <$> (snd <$> pairs)) - let visited = S.fromList $ M.keys names - let newSeeds = S.difference refs visited - deps newSeeds newNames - where - toPair name = do - typ <- requireType name - return (name, typ) - - requireType name = do - withTrace ("type dependencies of " ++ unName name) $ do - el <- requireElement name - coreDecodeType (elementData el) diff --git a/src/main/haskell/Hydra/Dsl/Annotations.hs b/src/main/haskell/Hydra/Dsl/Annotations.hs --- a/src/main/haskell/Hydra/Dsl/Annotations.hs +++ b/src/main/haskell/Hydra/Dsl/Annotations.hs @@ -13,15 +13,15 @@ import qualified Data.Maybe as Y -key_deprecated = "_deprecated" -key_maxLength = "_maxLength" -key_minLength = "_minLength" -key_preserveFieldName = "_preserveFieldName" +key_deprecated = Name "_deprecated" +key_maxLength = Name "_maxLength" +key_minLength = Name "_minLength" +key_preserveFieldName = Name "_preserveFieldName" -annotateTerm :: String -> Y.Maybe (Term) -> Term -> Term +annotateTerm :: Name -> Y.Maybe Term -> Term -> Term annotateTerm = setTermAnnotation -annotateType :: String -> Y.Maybe (Term) -> Type -> Type +annotateType :: Name -> Y.Maybe Term -> Type -> Type annotateType = setTypeAnnotation bounded :: Maybe Int -> Maybe Int -> Type -> Type diff --git a/src/main/haskell/Hydra/Dsl/Base.hs b/src/main/haskell/Hydra/Dsl/Base.hs --- a/src/main/haskell/Hydra/Dsl/Base.hs +++ b/src/main/haskell/Hydra/Dsl/Base.hs @@ -30,195 +30,195 @@ import qualified Data.Set as S -instance IsString (Datum a) where fromString = Datum . Terms.string - -el :: Definition a -> Element -el (Definition name (Datum term)) = Element name term +instance IsString (TTerm a) where fromString = TTerm . Terms.string infixr 0 >: -(>:) :: String -> Datum a -> Field -n >: d = Field (Name n) (unDatum d) +(>:) :: String -> TTerm a -> Field +n >: d = Field (Name n) (unTTerm d) infixr 0 >>: -(>>:) :: Name -> Datum a -> Field -fname >>: d = Field fname (unDatum d) +(>>:) :: Name -> TTerm a -> Field +fname >>: d = Field fname (unTTerm d) -(<.>) :: Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c) +(<.>) :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c) f <.> g = compose f g -($$) :: Datum (a -> b) -> Datum a -> Datum b -f $$ x = apply f x - -(@@) :: Datum (a -> b) -> Datum a -> Datum b +-- Two alternative symbols for typed term application +(@@) :: TTerm (a -> b) -> TTerm a -> TTerm b f @@ x = apply f x +($$) :: TTerm (a -> b) -> TTerm a -> TTerm b +f $$ x = apply f x infixr 0 @-> (@->) :: a -> b -> (a, b) x @-> y = (x, y) infixr 0 --> -(-->) :: Case a -> Datum (a -> b) -> Field +(-->) :: TCase a -> TTerm (a -> b) -> Field c --> t = caseField c t -apply :: Datum (a -> b) -> Datum a -> Datum b -apply (Datum lhs) (Datum rhs) = Datum $ Terms.apply lhs rhs +apply :: TTerm (a -> b) -> TTerm a -> TTerm b +apply (TTerm lhs) (TTerm rhs) = TTerm $ Terms.apply lhs rhs -apply2 :: Datum (a -> b -> c) -> Datum a -> Datum b -> Datum c -apply2 (Datum f) (Datum a1) (Datum a2) = Datum $ Terms.apply (Terms.apply f a1) a2 +apply2 :: TTerm (a -> b -> c) -> TTerm a -> TTerm b -> TTerm c +apply2 (TTerm f) (TTerm a1) (TTerm a2) = TTerm $ Terms.apply (Terms.apply f a1) a2 -caseField :: Case a -> Datum (a -> b) -> Field -caseField (Case fname) (Datum f) = Field fname f +caseField :: TCase a -> TTerm (a -> b) -> Field +caseField (TCase fname) (TTerm f) = Field fname f -compose :: Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c) -compose (Datum f) (Datum g) = Datum $ Terms.compose f g +compose :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c) +compose (TTerm f) (TTerm g) = TTerm $ Terms.compose f g -constant :: Datum a -> Datum (b -> a) -constant (Datum term) = Datum $ Terms.constant term +constant :: TTerm a -> TTerm (b -> a) +constant (TTerm term) = TTerm $ Terms.constant term -definitionInModule :: Module -> String -> Datum a -> Definition a -definitionInModule mod lname = Definition $ Tier1.unqualifyName $ QualifiedName (Just $ moduleNamespace mod) lname +definitionInModule :: Module -> String -> TTerm a -> TElement a +definitionInModule mod lname = TElement $ Tier1.unqualifyName $ QualifiedName (Just $ moduleNamespace mod) lname -doc :: String -> Datum a -> Datum a -doc s (Datum term) = Datum $ setTermDescription (Just s) term +doc :: String -> TTerm a -> TTerm a +doc s (TTerm term) = TTerm $ setTermDescription (Just s) term -doc70 :: String -> Datum a -> Datum a +doc70 :: String -> TTerm a -> TTerm a doc70 = doc . wrapLine 70 -doc80 :: String -> Datum a -> Datum a +doc80 :: String -> TTerm a -> TTerm a doc80 = doc . wrapLine 80 -field :: Name -> Datum a -> Field -field fname (Datum val) = Field fname val +el :: TElement a -> Element +el (TElement name (TTerm term)) = Element name term -first :: Datum ((a, b) -> a) -first = Datum $ Terms.untuple 2 0 +field :: Name -> TTerm a -> Field +field fname (TTerm val) = Field fname val -fld :: Name -> Datum a -> Fld a -fld fname (Datum val) = Fld $ Field fname val +first :: TTerm ((a, b) -> a) +first = TTerm $ Terms.untuple 2 0 -fold :: Datum (b -> a -> b) -> Datum (b -> [a] -> b) +fld :: Name -> TTerm a -> TField a +fld fname (TTerm val) = TField $ Field fname val + +fold :: TTerm (b -> a -> b) -> TTerm (b -> [a] -> b) fold f = Lists.foldl @@ f -function :: Type -> Type -> Datum a -> Datum a +function :: Type -> Type -> TTerm a -> TTerm a function dom cod = typed (Types.function dom cod) -functionN :: [Type] -> Datum a -> Datum a +functionN :: [Type] -> TTerm a -> TTerm a functionN ts = typed $ Types.functionN ts -functionNWithClasses :: [Type] -> M.Map Name (S.Set TypeClass) -> Datum a -> Datum a +functionNWithClasses :: [Type] -> M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a functionNWithClasses ts classes = typed $ setTypeClasses classes (Types.functionN ts) -functionWithClasses :: Type -> Type -> M.Map Name (S.Set TypeClass) -> Datum a -> Datum a +functionWithClasses :: Type -> Type -> M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a functionWithClasses dom cod classes = typed $ setTypeClasses classes (Types.function dom cod) -- Note: Haskell has trouble type-checking this construction if the convenience functions from Base are used -ifElse :: Datum Bool -> Datum a -> Datum a -> Datum a -ifElse (Datum cond) (Datum ifTrue) (Datum ifFalse) = Datum $ +ifElse :: TTerm Bool -> TTerm a -> TTerm a -> TTerm a +ifElse (TTerm cond) (TTerm ifTrue) (TTerm ifFalse) = TTerm $ Terms.apply (Terms.apply (Terms.apply (Terms.primitive _logic_ifElse) ifTrue) ifFalse) cond -ifOpt :: Datum (Maybe a) -> Datum b -> Datum (a -> b) -> Datum b +ifOpt :: TTerm (Maybe a) -> TTerm b -> TTerm (a -> b) -> TTerm b ifOpt m n j = matchOpt n j @@ m -identity :: Datum (a -> a) -identity = Datum Terms.identity +identity :: TTerm (a -> a) +identity = TTerm Terms.identity -inject :: Name -> Name -> Datum a -> Datum b -inject name fname (Datum term) = Datum $ Terms.inject name (Field fname term) +inject :: Name -> Name -> TTerm a -> TTerm b +inject name fname (TTerm term) = TTerm $ Terms.inject name (Field fname term) -inject2 :: Name -> Name -> Datum (a -> b) +inject2 :: Name -> Name -> TTerm (a -> b) inject2 name fname = lambda "x2" $ inject name fname $ var "x2" -just :: Datum x -> Datum (Maybe x) -just (Datum term) = Datum $ Terms.just term +just :: TTerm x -> TTerm (Maybe x) +just (TTerm term) = TTerm $ Terms.just term -lambda :: String -> Datum x -> Datum (a -> b) -lambda v (Datum body) = Datum $ Terms.lambda v body +lambda :: String -> TTerm x -> TTerm (a -> b) +lambda v (TTerm body) = TTerm $ Terms.lambda v body ---letTerm :: Var a -> Datum a -> Datum b -> Datum b ---letTerm (Var k) (Datum v) (Datum env) = Datum $ Terms.letTerm (Name k) v env +--letTerm :: Var a -> TTerm a -> TTerm b -> TTerm b +--letTerm (Var k) (TTerm v) (TTerm env) = TTerm $ Terms.letTerm (Name k) v env -list :: [Datum a] -> Datum [a] -list els = Datum $ Terms.list (unDatum <$> els) +list :: [TTerm a] -> TTerm [a] +list els = TTerm $ Terms.list (unTTerm <$> els) -map :: M.Map (Datum a) (Datum b) -> Datum (M.Map a b) -map = Datum . Terms.map . M.fromList . fmap fromDatum . M.toList +map :: M.Map (TTerm a) (TTerm b) -> TTerm (M.Map a b) +map = TTerm . Terms.map . M.fromList . fmap fromTTerm . M.toList where - fromDatum (Datum k, Datum v) = (k, v) + fromTTerm (TTerm k, TTerm v) = (k, v) -match :: Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b) -match name dflt fields = Datum $ Terms.match name (unDatum <$> dflt) fields +match :: Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b) +match name dflt fields = TTerm $ Terms.match name (unTTerm <$> dflt) fields -matchData :: Name -> Maybe (Datum b) -> [(Name, Datum (x -> b))] -> Datum (a -> b) -matchData name dflt pairs = Datum $ Terms.match name (unDatum <$> dflt) (toField <$> pairs) +matchData :: Name -> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b) +matchData name dflt pairs = TTerm $ Terms.match name (unTTerm <$> dflt) (toField <$> pairs) where - toField (fname, Datum term) = Field fname term + toField (fname, TTerm term) = Field fname term -matchOpt :: Datum b -> Datum (a -> b) -> Datum (Maybe a -> b) -matchOpt (Datum n) (Datum j) = Datum $ Terms.matchOpt n j +matchOpt :: TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b) +matchOpt (TTerm n) (TTerm j) = TTerm $ Terms.matchOpt n j -matchToEnum :: Name -> Name -> Maybe (Datum b) -> [(Name, Name)] -> Datum (a -> b) +matchToEnum :: Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b) matchToEnum domName codName dflt pairs = matchData domName dflt (toCase <$> pairs) where toCase (fromName, toName) = (fromName, constant $ unitVariant codName toName) -matchToUnion :: Name -> Name -> Maybe (Datum b) -> [(Name, Field)] -> Datum (a -> b) +matchToUnion :: Name -> Name -> Maybe (TTerm b) -> [(Name, Field)] -> TTerm (a -> b) matchToUnion domName codName dflt pairs = matchData domName dflt (toCase <$> pairs) where - toCase (fromName, fld) = (fromName, constant $ Datum $ Terms.inject codName fld) + toCase (fromName, fld) = (fromName, constant $ TTerm $ Terms.inject codName fld) -- Note: the phantom types provide no guarantee of type safety in this case -nom :: Name -> Datum a -> Datum b -nom name (Datum term) = Datum $ Terms.wrap name term +nom :: Name -> TTerm a -> TTerm b +nom name (TTerm term) = TTerm $ Terms.wrap name term -nothing :: Datum x -nothing = Datum Terms.nothing +nothing :: TTerm a +nothing = TTerm Terms.nothing -opt :: Maybe (Datum a) -> Datum (Maybe a) -opt mc = Datum $ Terms.optional (unDatum <$> mc) +opt :: Maybe (TTerm a) -> TTerm (Maybe a) +opt mc = TTerm $ Terms.optional (unTTerm <$> mc) -pair :: (Datum a, Datum b) -> Datum (a, b) -pair (Datum l, Datum r) = Datum $ Terms.pair l r +pair :: (TTerm a) -> (TTerm b) -> TTerm (a, b) +pair (TTerm l) (TTerm r) = TTerm $ Terms.pair l r -primitive :: Name -> Datum a -primitive = Datum . Terms.primitive +primitive :: Name -> TTerm a +primitive = TTerm . Terms.primitive -project :: Name -> Name -> Datum (a -> b) -project name fname = Datum $ Terms.project name fname +project :: Name -> Name -> TTerm (a -> b) +project name fname = TTerm $ Terms.project name fname -record :: Name -> [Field] -> Datum a -record name fields = Datum $ Terms.record name fields +record :: Name -> [Field] -> TTerm a +record name fields = TTerm $ Terms.record name fields -ref :: Definition a -> Datum a -ref (Definition name _) = Datum (TermVariable name) +ref :: TElement a -> TTerm a +ref (TElement name _) = TTerm (TermVariable name) -second :: Datum ((a, b) -> b) -second = Datum $ Terms.untuple 2 1 +second :: TTerm ((a, b) -> b) +second = TTerm $ Terms.untuple 2 1 -set :: S.Set (Datum a) -> Datum (S.Set a) -set = Datum . Terms.set . S.fromList . fmap unDatum . S.toList +set :: S.Set (TTerm a) -> TTerm (S.Set a) +set = TTerm . Terms.set . S.fromList . fmap unTTerm . S.toList -typed :: Type -> Datum a -> Datum a -typed typ (Datum term) = Datum $ setTermType (Just typ) term +typed :: Type -> TTerm a -> TTerm a +typed typ (TTerm term) = TTerm $ setTermType (Just typ) term -unit :: Datum a -unit = Datum Terms.unit +unit :: TTerm a +unit = TTerm Terms.unit -unitVariant :: Name -> Name -> Datum a -unitVariant name fname = Datum $ Terms.inject name $ Field fname Terms.unit +unitVariant :: Name -> Name -> TTerm a +unitVariant name fname = TTerm $ Terms.inject name $ Field fname Terms.unit -unwrap :: Name -> Datum (a -> b) -unwrap = Datum . Terms.unwrap +unwrap :: Name -> TTerm (a -> b) +unwrap = TTerm . Terms.unwrap -var :: String -> Datum a -var v = Datum $ Terms.var v +var :: String -> TTerm a +var v = TTerm $ Terms.var v -variant :: Name -> Name -> Datum a -> Datum b -variant name fname (Datum term) = Datum $ Terms.inject name $ Field fname term +variant :: Name -> Name -> TTerm a -> TTerm b +variant name fname (TTerm term) = TTerm $ Terms.inject name $ Field fname term -with :: Datum a -> [Field] -> Datum a -(Datum env) `with` fields = Datum $ TermLet $ Let (toBinding <$> fields) env +with :: TTerm a -> [Field] -> TTerm a +(TTerm env) `with` fields = TTerm $ TermLet $ Let (toBinding <$> fields) env where toBinding (Field name value) = LetBinding name value Nothing -wrap :: Name -> Datum a -> Datum b -wrap name (Datum term) = Datum $ Terms.wrap name term +wrap :: Name -> TTerm a -> TTerm b +wrap name (TTerm term) = TTerm $ Terms.wrap name term diff --git a/src/main/haskell/Hydra/Dsl/Bootstrap.hs b/src/main/haskell/Hydra/Dsl/Bootstrap.hs --- a/src/main/haskell/Hydra/Dsl/Bootstrap.hs +++ b/src/main/haskell/Hydra/Dsl/Bootstrap.hs @@ -15,6 +15,7 @@ import qualified Hydra.Dsl.Types as Types import Hydra.Tools.Debug +import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S @@ -26,21 +27,21 @@ graphEnvironment = M.empty, graphTypes = M.empty, graphBody = Terms.list [], -- Note: the bootstrap body is arbitrary - graphPrimitives = M.fromList $ fmap (\p -> (primitiveName p, p)) standardPrimitives, + graphPrimitives = M.fromList $ fmap (\p -> (primitiveName p, p)) (L.concat (libraryPrimitives <$> standardLibraries)), graphSchema = Nothing} datatype :: Namespace -> String -> Type -> Element -datatype gname lname typ = typeElement elName $ rewriteType replacePlaceholders id typ +datatype gname lname typ = typeElement elName $ rewriteType replacePlaceholders typ where elName = qualify gname (Name lname) -- Note: placeholders are only expected at the top level, or beneath annotations and/or type lambdas replacePlaceholders rec t = case rect of - TypeRecord (RowType tname e fields) -> if tname == placeholderName - then TypeRecord (RowType elName e fields) + TypeRecord (RowType tname fields) -> if tname == placeholderName + then TypeRecord (RowType elName fields) else rect - TypeUnion (RowType tname e fields) -> if tname == placeholderName - then TypeUnion (RowType elName e fields) + TypeUnion (RowType tname fields) -> if tname == placeholderName + then TypeUnion (RowType elName fields) else rect TypeWrap (WrappedType tname t) -> if tname == placeholderName then TypeWrap (WrappedType elName t) diff --git a/src/main/haskell/Hydra/Dsl/Core.hs b/src/main/haskell/Hydra/Dsl/Core.hs --- a/src/main/haskell/Hydra/Dsl/Core.hs +++ b/src/main/haskell/Hydra/Dsl/Core.hs @@ -7,268 +7,282 @@ import qualified Data.Maybe as Y -annotatedTerm :: Datum Term -> Datum (M.Map String Term) -> Datum AnnotatedTerm +annotatedTerm :: TTerm Term -> TTerm (M.Map String Term) -> TTerm AnnotatedTerm annotatedTerm subject annotation = Base.record _AnnotatedTerm [ _AnnotatedTerm_subject>>: subject, _AnnotatedTerm_annotation>>: annotation] -annotatedTermSubject :: Datum (AnnotatedTerm -> Term) +annotatedTermSubject :: TTerm (AnnotatedTerm -> Term) annotatedTermSubject = project _AnnotatedTerm _AnnotatedTerm_subject -annotatedTermAnnotation :: Datum (AnnotatedTerm -> M.Map String Term) +annotatedTermAnnotation :: TTerm (AnnotatedTerm -> M.Map String Term) annotatedTermAnnotation = project _AnnotatedTerm _AnnotatedTerm_annotation -annotatedType :: Datum Type -> Datum (M.Map String Term) -> Datum AnnotatedType +annotatedType :: TTerm Type -> TTerm (M.Map String Term) -> TTerm AnnotatedType annotatedType subject annotation = Base.record _AnnotatedType [ _AnnotatedType_subject>>: subject, _AnnotatedType_annotation>>: annotation] -annotatedTypeSubject :: Datum (AnnotatedType -> Type) +annotatedTypeSubject :: TTerm (AnnotatedType -> Type) annotatedTypeSubject = project _AnnotatedType _AnnotatedType_subject -annotatedTypeAnnotation :: Datum (AnnotatedType -> M.Map String Term) +annotatedTypeAnnotation :: TTerm (AnnotatedType -> M.Map String Term) annotatedTypeAnnotation = project _AnnotatedType _AnnotatedType_annotation -application :: Datum Term -> Datum Term -> Datum (Application) +application :: TTerm Term -> TTerm Term -> TTerm (Application) application function argument = Base.record _Application [ _Application_function>>: function, _Application_argument>>: argument] -applicationFunction :: Datum (Application -> Term) +applicationFunction :: TTerm (Application -> Term) applicationFunction = project _Application _Application_function -applicationArgument :: Datum (Application -> Term) +applicationArgument :: TTerm (Application -> Term) applicationArgument = project _Application _Application_argument -applicationType :: Datum Type -> Datum Type -> Datum (ApplicationType) +applicationType :: TTerm Type -> TTerm Type -> TTerm (ApplicationType) applicationType function argument = Base.record _ApplicationType [ _ApplicationType_function>>: function, _ApplicationType_argument>>: argument] -applicationTypeFunction :: Datum (ApplicationType -> Type) +applicationTypeFunction :: TTerm (ApplicationType -> Type) applicationTypeFunction = project _ApplicationType _ApplicationType_function -applicationTypeArgument :: Datum (ApplicationType -> Type) +applicationTypeArgument :: TTerm (ApplicationType -> Type) applicationTypeArgument = project _ApplicationType _ApplicationType_argument -caseStatement :: Datum Name -> Datum (Maybe Term) -> Datum [Field] -> Datum (CaseStatement) +caseStatement :: TTerm Name -> TTerm (Maybe Term) -> TTerm [Field] -> TTerm (CaseStatement) caseStatement typeName defaultTerm cases = Base.record _CaseStatement [ _CaseStatement_typeName>>: typeName, _CaseStatement_default>>: defaultTerm, _CaseStatement_cases>>: cases] -caseStatementTypeName :: Datum (CaseStatement -> Name) +caseStatementTypeName :: TTerm (CaseStatement -> Name) caseStatementTypeName = project _CaseStatement _CaseStatement_typeName -caseStatementDefault :: Datum (CaseStatement -> Maybe Term) +caseStatementDefault :: TTerm (CaseStatement -> Maybe Term) caseStatementDefault = project _CaseStatement _CaseStatement_default -caseStatementCases :: Datum (CaseStatement -> [Field]) +caseStatementCases :: TTerm (CaseStatement -> [Field]) caseStatementCases = project _CaseStatement _CaseStatement_cases -field :: Datum Name -> Datum Term -> Datum Field +field :: TTerm Name -> TTerm Term -> TTerm Field field name term = Base.record _Field [ _Field_name>>: name, _Field_term>>: term] -fieldName :: Datum (Field -> Name) +fieldName :: TTerm (Field -> Name) fieldName = project _Field _Field_name -fieldTerm :: Datum (Field -> Term) +fieldTerm :: TTerm (Field -> Term) fieldTerm = project _Field _Field_term -fieldType :: Datum Name -> Datum Type -> Datum (FieldType) +fieldType :: TTerm Name -> TTerm Type -> TTerm (FieldType) fieldType name typ = Base.record _FieldType [ _FieldType_name>>: name, _FieldType_type>>: typ] -fieldTypeName :: Datum (FieldType -> Name) +fieldTypeName :: TTerm (FieldType -> Name) fieldTypeName = project _FieldType _FieldType_name -fieldTypeType :: Datum (FieldType -> Type) +fieldTypeType :: TTerm (FieldType -> Type) fieldTypeType = project _FieldType _FieldType_type -functionType :: Datum Type -> Datum Type -> Datum (FunctionType) +functionType :: TTerm Type -> TTerm Type -> TTerm (FunctionType) functionType domain codomain = Base.record _FunctionType [ _FunctionType_domain>>: domain, _FunctionType_codomain>>: codomain] -functionTypeDomain :: Datum (FunctionType -> Type) +functionTypeDomain :: TTerm (FunctionType -> Type) functionTypeDomain = project _FunctionType _FunctionType_domain -functionTypeCodomain :: Datum (FunctionType -> Type) +functionTypeCodomain :: TTerm (FunctionType -> Type) functionTypeCodomain = project _FunctionType _FunctionType_codomain -injection :: Datum Name -> Datum Field -> Datum Injection +injection :: TTerm Name -> TTerm Field -> TTerm Injection injection typeName field = Base.record _Injection [ _Injection_typeName>>: typeName, _Injection_field>>: field] -injectionTypeName :: Datum (Injection -> Name) +injectionTypeName :: TTerm (Injection -> Name) injectionTypeName = project _Injection _Injection_typeName -injectionField :: Datum (Injection -> Field) +injectionField :: TTerm (Injection -> Field) injectionField = project _Injection _Injection_field -lambda :: Datum Name -> Datum Term -> Datum Lambda +lambda :: TTerm Name -> TTerm Term -> TTerm Lambda lambda parameter body = Base.record _Lambda [ _Lambda_parameter>>: parameter, _Lambda_body>>: body] -lambdaParameter :: Datum (Lambda -> Name) +lambdaParameter :: TTerm (Lambda -> Name) lambdaParameter = project _Lambda _Lambda_parameter -lambdaBody :: Datum (Lambda -> Term) +lambdaBody :: TTerm (Lambda -> Term) lambdaBody = project _Lambda _Lambda_body -lambdaType :: Datum Name -> Datum Type -> Datum LambdaType +lambdaDomain :: TTerm (Lambda -> Maybe Type) +lambdaDomain = project _Lambda _Lambda_domain + +lambdaType :: TTerm Name -> TTerm Type -> TTerm LambdaType lambdaType parameter body = Base.record _LambdaType [ _LambdaType_parameter>>: parameter, _LambdaType_body>>: body] -lambdaTypeParameter :: Datum (LambdaType -> Name) +lambdaTypeParameter :: TTerm (LambdaType -> Name) lambdaTypeParameter = project _LambdaType _LambdaType_parameter -lambdaTypeBody :: Datum (LambdaType -> Type) +lambdaTypeBody :: TTerm (LambdaType -> Type) lambdaTypeBody = project _LambdaType _LambdaType_body -letExpression :: Datum [LetBinding] -> Datum Term -> Datum Let +letExpression :: TTerm [LetBinding] -> TTerm Term -> TTerm Let letExpression bindings environment = Base.record _Let [ _Let_bindings>>: bindings, _Let_environment>>: environment] -letBindings :: Datum (Let -> [LetBinding]) +letBindings :: TTerm (Let -> [LetBinding]) letBindings = project _Let _Let_bindings -letBindingName :: Datum (LetBinding -> Name) +letBindingName :: TTerm (LetBinding -> Name) letBindingName = project _LetBinding _LetBinding_name -letBindingTerm :: Datum (LetBinding -> Term) +letBindingTerm :: TTerm (LetBinding -> Term) letBindingTerm = project _LetBinding _LetBinding_term -letBindingType :: Datum (LetBinding -> Y.Maybe TypeScheme) +letBindingType :: TTerm (LetBinding -> Y.Maybe TypeScheme) letBindingType = project _LetBinding _LetBinding_type -letEnvironment :: Datum (Let -> Term) +letEnvironment :: TTerm (Let -> Term) letEnvironment = project _Let _Let_environment -literalBinary :: Datum String -> Datum Literal +literalBinary :: TTerm String -> TTerm Literal literalBinary = variant _Literal _Literal_binary -literalBoolean :: Datum Bool -> Datum Literal +literalBoolean :: TTerm Bool -> TTerm Literal literalBoolean = variant _Literal _Literal_boolean -literalFloat :: Datum FloatValue -> Datum Literal +literalFloat :: TTerm FloatValue -> TTerm Literal literalFloat = variant _Literal _Literal_float -literalInteger :: Datum IntegerValue -> Datum Literal +literalInteger :: TTerm IntegerValue -> TTerm Literal literalInteger = variant _Literal _Literal_integer -mapType :: Datum Type -> Datum Type -> Datum MapType +mapType :: TTerm Type -> TTerm Type -> TTerm MapType mapType keys values = Base.record _MapType [ _MapType_keys>>: keys, _MapType_values>>: values] -mapTypeKeys :: Datum (MapType -> Type) +mapTypeKeys :: TTerm (MapType -> Type) mapTypeKeys = project _MapType _MapType_keys -mapTypeValues :: Datum (MapType -> Type) +mapTypeValues :: TTerm (MapType -> Type) mapTypeValues = project _MapType _MapType_values -optionalCases :: Datum Term -> Datum Term -> Datum OptionalCases +name :: Name -> TTerm Name +name nm = TTerm $ coreEncodeName nm + +optionalCases :: TTerm Term -> TTerm Term -> TTerm OptionalCases optionalCases nothing just = Base.record _OptionalCases [ _OptionalCases_nothing>>: nothing, _OptionalCases_just>>: just] -optionalCasesNothing :: Datum (OptionalCases -> Term) +optionalCasesNothing :: TTerm (OptionalCases -> Term) optionalCasesNothing = project _OptionalCases _OptionalCases_nothing -optionalCasesJust :: Datum (OptionalCases -> Term) +optionalCasesJust :: TTerm (OptionalCases -> Term) optionalCasesJust = project _OptionalCases _OptionalCases_just -projectionTypeName :: Datum (Projection -> Name) +projectionTypeName :: TTerm (Projection -> Name) projectionTypeName = project _Projection _Projection_typeName -projectionField :: Datum (Projection -> Name) +projectionField :: TTerm (Projection -> Name) projectionField = project _Projection _Projection_field -record :: Datum Name -> Datum [Field] -> Datum Record +record :: TTerm Name -> TTerm [Field] -> TTerm Record record typeName fields = Base.record _Record [ _Record_typeName>>: typeName, _Record_fields>>: fields] -recordTypeName :: Datum (Record -> Name) +recordTypeName :: TTerm (Record -> Name) recordTypeName = project _Record _Record_typeName -recordFields :: Datum (Record -> [Field]) +recordFields :: TTerm (Record -> [Field]) recordFields = project _Record _Record_fields -rowType :: Datum Name -> Datum (Maybe Name) -> Datum [FieldType] -> Datum (RowType) -rowType typeName extends fields = Base.record _RowType [ +rowType :: TTerm Name -> TTerm [FieldType] -> TTerm (RowType) +rowType typeName fields = Base.record _RowType [ _RowType_typeName>>: typeName, - _RowType_extends>>: extends, _RowType_fields>>: fields] -rowTypeTypeName :: Datum (RowType -> Name) +rowTypeTypeName :: TTerm (RowType -> Name) rowTypeTypeName = project _RowType _RowType_typeName -rowTypeExtends :: Datum (RowType -> Maybe Name) -rowTypeExtends = project _RowType _RowType_extends - -rowTypeFields :: Datum (RowType -> [FieldType]) +rowTypeFields :: TTerm (RowType -> [FieldType]) rowTypeFields = project _RowType _RowType_fields -sum :: Datum Int -> Datum Int -> Datum Term -> Datum Sum +sum :: TTerm Int -> TTerm Int -> TTerm Term -> TTerm Sum sum index size term = Base.record _Sum [ _Sum_index>>: index, _Sum_size>>: size, _Sum_term>>: term] -sumIndex :: Datum (Sum -> Int) +sumIndex :: TTerm (Sum -> Int) sumIndex = project _Sum _Sum_index -sumSize :: Datum (Sum -> Int) +sumSize :: TTerm (Sum -> Int) sumSize = project _Sum _Sum_size -sumTerm :: Datum (Sum -> Term) +sumTerm :: TTerm (Sum -> Term) sumTerm = project _Sum _Sum_term -termAnnotated :: Datum AnnotatedTerm -> Datum Term +termAnnotated :: TTerm AnnotatedTerm -> TTerm Term termAnnotated = variant _Term _Term_annotated -tupleProjectionArity :: Datum (TupleProjection -> Int) +tupleProjectionArity :: TTerm (TupleProjection -> Int) tupleProjectionArity = project _TupleProjection _TupleProjection_arity -tupleProjectionIndex :: Datum (TupleProjection -> Int) +tupleProjectionIndex :: TTerm (TupleProjection -> Int) tupleProjectionIndex = project _TupleProjection _TupleProjection_index -typeSchemeVariables :: Datum (TypeScheme -> [Name]) +typeAbstractionParameter :: TTerm (TypeAbstraction -> Name) +typeAbstractionParameter = project _TypeAbstraction _TypeAbstraction_parameter + +typeAbstractionBody :: TTerm (TypeAbstraction -> Type) +typeAbstractionBody = project _TypeAbstraction _TypeAbstraction_body + +typeSchemeVariables :: TTerm (TypeScheme -> [Name]) typeSchemeVariables = project _TypeScheme _TypeScheme_variables -typeSchemeType :: Datum (TypeScheme -> Type) +typeSchemeType :: TTerm (TypeScheme -> Type) typeSchemeType = project _TypeScheme _TypeScheme_type -typedTermTerm :: Datum (TypedTerm -> Term) +typedTermTerm :: TTerm (TypedTerm -> Term) typedTermTerm = project _TypedTerm _TypedTerm_term -wrappedTerm :: Datum Name -> Datum Term -> Datum WrappedTerm +unName :: TTerm (Name -> String) +unName = unwrap _Name + +unNamespace :: TTerm (Namespace -> String) +unNamespace = unwrap _Namespace + +wrappedTerm :: TTerm Name -> TTerm Term -> TTerm WrappedTerm wrappedTerm typeName object = Base.record _WrappedTerm [ _WrappedTerm_typeName>>: typeName, _WrappedTerm_object>>: object] -wrappedTermTypeName :: Datum (WrappedTerm -> Name) +wrappedTermTypeName :: TTerm (WrappedTerm -> Name) wrappedTermTypeName = project _WrappedTerm _WrappedTerm_typeName -wrappedTermObject :: Datum (WrappedTerm -> Term) +wrappedTermObject :: TTerm (WrappedTerm -> Term) wrappedTermObject = project _WrappedTerm _WrappedTerm_object -wrappedType :: Datum Name -> Datum Type -> Datum WrappedType +wrappedType :: TTerm Name -> TTerm Type -> TTerm WrappedType wrappedType typeName object = Base.record _WrappedType [ _WrappedType_typeName>>: typeName, _WrappedType_object>>: object] -wrappedTypeTypeName :: Datum (WrappedType -> Name) +wrappedTypeTypeName :: TTerm (WrappedType -> Name) wrappedTypeTypeName = project _WrappedType _WrappedType_typeName -wrappedTypeObject :: Datum (WrappedType -> Type) +wrappedTypeObject :: TTerm (WrappedType -> Type) wrappedTypeObject = project _WrappedType _WrappedType_object diff --git a/src/main/haskell/Hydra/Dsl/Expect.hs b/src/main/haskell/Hydra/Dsl/Expect.hs --- a/src/main/haskell/Hydra/Dsl/Expect.hs +++ b/src/main/haskell/Hydra/Dsl/Expect.hs @@ -1,4 +1,4 @@ --- | A DSL for constructing Hydra terms +-- | A DSL for decoding Hydra terms module Hydra.Dsl.Expect where diff --git a/src/main/haskell/Hydra/Dsl/Graph.hs b/src/main/haskell/Hydra/Dsl/Graph.hs --- a/src/main/haskell/Hydra/Dsl/Graph.hs +++ b/src/main/haskell/Hydra/Dsl/Graph.hs @@ -6,13 +6,16 @@ import qualified Data.Map as M -graph :: Datum (M.Map Name Element) - -> Datum (M.Map Name (Maybe Term)) - -> Datum (M.Map Name Type) - -> Datum Term - -> Datum (M.Map Name Primitive) - -> Datum (Maybe Graph) - -> Datum Graph +elementName :: TTerm (Element -> Name) +elementName = project _Element _Element_name + +graph :: TTerm (M.Map Name Element) + -> TTerm (M.Map Name (Maybe Term)) + -> TTerm (M.Map Name TypeScheme) + -> TTerm Term + -> TTerm (M.Map Name Primitive) + -> TTerm (Maybe Graph) + -> TTerm Graph graph elements environment types body primitives schema = record _Graph [ _Graph_elements>>: elements, _Graph_environment>>: environment, @@ -21,20 +24,29 @@ _Graph_primitives>>: primitives, _Graph_schema>>: schema] -graphElements :: Datum (Graph -> M.Map Name Element) +graphElements :: TTerm (Graph -> M.Map Name Element) graphElements = project _Graph _Graph_elements -graphEnvironment :: Datum (Graph -> M.Map Name (Maybe Term)) +graphEnvironment :: TTerm (Graph -> M.Map Name (Maybe Term)) graphEnvironment = project _Graph _Graph_environment -graphTypes :: Datum (Graph -> M.Map Name Type) +graphTypes :: TTerm (Graph -> M.Map Name TypeScheme) graphTypes = project _Graph _Graph_types -graphBody :: Datum (Graph -> Term) +graphBody :: TTerm (Graph -> Term) graphBody = project _Graph _Graph_body -graphPrimitives :: Datum (Graph -> M.Map Name Primitive) +graphPrimitives :: TTerm (Graph -> M.Map Name Primitive) graphPrimitives = project _Graph _Graph_primitives -graphSchema :: Datum (Graph -> Maybe Graph) +graphSchema :: TTerm (Graph -> Maybe Graph) graphSchema = project _Graph _Graph_schema + +primitiveName :: TTerm (Primitive -> Name) +primitiveName = project _Primitive _Primitive_name + +primitiveType :: TTerm (Primitive -> TypeScheme) +primitiveType = project _Primitive _Primitive_type + +primitiveImplementation :: TTerm (Primitive -> ([Term] -> Flow Graph Term)) +primitiveImplementation = project _Primitive _Primitive_type diff --git a/src/main/haskell/Hydra/Dsl/Lib/Equality.hs b/src/main/haskell/Hydra/Dsl/Lib/Equality.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Equality.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Equality.hs @@ -8,68 +8,71 @@ import Data.Int -equalBinary :: Datum (String -> String -> Bool) -equalBinary = Datum $ Terms.primitive _equality_equalBinary +equal :: TTerm (a -> a -> Bool) +equal = TTerm $ Terms.primitive _equality_equal -equalBoolean :: Datum (Bool -> Bool -> Bool) -equalBoolean = Datum $ Terms.primitive _equality_equalBoolean +equalBinary :: TTerm (String -> String -> Bool) +equalBinary = TTerm $ Terms.primitive _equality_equalBinary -equalBigfloat :: Datum (Double -> Double -> Bool) -equalBigfloat = Datum $ Terms.primitive _equality_equalBigfloat +equalBoolean :: TTerm (Bool -> Bool -> Bool) +equalBoolean = TTerm $ Terms.primitive _equality_equalBoolean -equalFloat32 :: Datum (Float -> Float -> Bool) -equalFloat32 = Datum $ Terms.primitive _equality_equalFloat32 +equalBigfloat :: TTerm (Double -> Double -> Bool) +equalBigfloat = TTerm $ Terms.primitive _equality_equalBigfloat -equalFloat64 :: Datum (Double -> Double -> Bool) -equalFloat64 = Datum $ Terms.primitive _equality_equalFloat64 +equalFloat32 :: TTerm (Float -> Float -> Bool) +equalFloat32 = TTerm $ Terms.primitive _equality_equalFloat32 -equalBigint :: Datum (Integer -> Integer -> Bool) -equalBigint = Datum $ Terms.primitive _equality_equalBigint +equalFloat64 :: TTerm (Double -> Double -> Bool) +equalFloat64 = TTerm $ Terms.primitive _equality_equalFloat64 -equalInt8 :: Datum (Int8 -> Int8 -> Bool) -equalInt8 = Datum $ Terms.primitive _equality_equalInt8 +equalBigint :: TTerm (Integer -> Integer -> Bool) +equalBigint = TTerm $ Terms.primitive _equality_equalBigint -equalInt16 :: Datum (Int16 -> Int16 -> Bool) -equalInt16 = Datum $ Terms.primitive _equality_equalInt16 +equalInt8 :: TTerm (Int8 -> Int8 -> Bool) +equalInt8 = TTerm $ Terms.primitive _equality_equalInt8 -equalInt32 :: Datum (Int -> Int -> Bool) -equalInt32 = Datum $ Terms.primitive _equality_equalInt32 +equalInt16 :: TTerm (Int16 -> Int16 -> Bool) +equalInt16 = TTerm $ Terms.primitive _equality_equalInt16 -equalInt64 :: Datum (Int64 -> Int64 -> Bool) -equalInt64 = Datum $ Terms.primitive _equality_equalInt64 +equalInt32 :: TTerm (Int -> Int -> Bool) +equalInt32 = TTerm $ Terms.primitive _equality_equalInt32 -equalString :: Datum (String -> String -> Bool) -equalString = Datum $ Terms.primitive _equality_equalString +equalInt64 :: TTerm (Int64 -> Int64 -> Bool) +equalInt64 = TTerm $ Terms.primitive _equality_equalInt64 -equalTerm :: Datum (Term -> Term -> Bool) -equalTerm = Datum $ Terms.primitive _equality_equalTerm +equalString :: TTerm (String -> String -> Bool) +equalString = TTerm $ Terms.primitive _equality_equalString -equalType :: Datum (Type -> Type -> Bool) -equalType = Datum $ Terms.primitive _equality_equalType +equalTerm :: TTerm (Term -> Term -> Bool) +equalTerm = TTerm $ Terms.primitive _equality_equalTerm -equalUint8 :: Datum (Int16 -> Int16 -> Bool) -equalUint8 = Datum $ Terms.primitive _equality_equalUint8 +equalType :: TTerm (Type -> Type -> Bool) +equalType = TTerm $ Terms.primitive _equality_equalType -equalUint16 :: Datum (Int -> Int -> Bool) -equalUint16 = Datum $ Terms.primitive _equality_equalUint16 +equalUint8 :: TTerm (Int16 -> Int16 -> Bool) +equalUint8 = TTerm $ Terms.primitive _equality_equalUint8 -equalUint32 :: Datum (Int64 -> Int64 -> Bool) -equalUint32 = Datum $ Terms.primitive _equality_equalUint32 +equalUint16 :: TTerm (Int -> Int -> Bool) +equalUint16 = TTerm $ Terms.primitive _equality_equalUint16 -equalUint64 :: Datum (Integer -> Integer -> Bool) -equalUint64 = Datum $ Terms.primitive _equality_equalUint64 +equalUint32 :: TTerm (Int64 -> Int64 -> Bool) +equalUint32 = TTerm $ Terms.primitive _equality_equalUint32 -identity :: Datum (x -> x) -identity = Datum $ Terms.primitive _equality_identity +equalUint64 :: TTerm (Integer -> Integer -> Bool) +equalUint64 = TTerm $ Terms.primitive _equality_equalUint64 -gtInt32 :: Datum (Int -> Int -> Bool) -gtInt32 = Datum $ Terms.primitive _equality_gtInt32 +identity :: TTerm (x -> x) +identity = TTerm $ Terms.primitive _equality_identity -gteInt32 :: Datum (Int -> Int -> Bool) -gteInt32 = Datum $ Terms.primitive _equality_gteInt32 +gtInt32 :: TTerm (Int -> Int -> Bool) +gtInt32 = TTerm $ Terms.primitive _equality_gtInt32 -ltInt32 :: Datum (Int -> Int -> Bool) -ltInt32 = Datum $ Terms.primitive _equality_ltInt32 +gteInt32 :: TTerm (Int -> Int -> Bool) +gteInt32 = TTerm $ Terms.primitive _equality_gteInt32 -lteInt32 :: Datum (Int -> Int -> Bool) -lteInt32 = Datum $ Terms.primitive _equality_lteInt32 +ltInt32 :: TTerm (Int -> Int -> Bool) +ltInt32 = TTerm $ Terms.primitive _equality_ltInt32 + +lteInt32 :: TTerm (Int -> Int -> Bool) +lteInt32 = TTerm $ Terms.primitive _equality_lteInt32 diff --git a/src/main/haskell/Hydra/Dsl/Lib/Flows.hs b/src/main/haskell/Hydra/Dsl/Lib/Flows.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Flows.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Flows.hs @@ -13,55 +13,58 @@ -- Primitives -apply :: Datum (Flow s (x -> y) -> Flow s x -> Flow s y) -apply = Datum $ Terms.primitive _flows_apply +apply :: TTerm (Flow s (x -> y) -> Flow s x -> Flow s y) +apply = TTerm $ Terms.primitive _flows_apply -bind :: Datum (Flow s x -> (x -> Flow s y) -> Flow s y) -bind = Datum $ Terms.primitive _flows_bind +bind :: TTerm (Flow s x -> (x -> Flow s y) -> Flow s y) +bind = TTerm $ Terms.primitive _flows_bind -fail :: Datum (String -> Flow s x) -fail = Datum $ Terms.primitive _flows_fail +fail :: TTerm (String -> Flow s x) +fail = TTerm $ Terms.primitive _flows_fail -map :: Datum ((x -> y) -> Flow s x -> Flow s y) -map = Datum $ Terms.primitive _flows_map +map :: TTerm ((x -> y) -> Flow s x -> Flow s y) +map = TTerm $ Terms.primitive _flows_map -mapList :: Datum ((x -> Flow s y) -> [x] -> Flow s [y]) -mapList = Datum $ Terms.primitive _flows_mapList +mapList :: TTerm ((x -> Flow s y) -> [x] -> Flow s [y]) +mapList = TTerm $ Terms.primitive _flows_mapList -pure :: Datum (x -> Flow s x) -pure = Datum $ Terms.primitive _flows_pure +pure :: TTerm (x -> Flow s x) +pure = TTerm $ Terms.primitive _flows_pure +sequence :: TTerm ([Flow s a] -> Flow s [a]) +sequence = TTerm $ Terms.primitive _flows_sequence + -- Accessors -flowState :: Datum (Maybe x) -> Datum s -> Datum Trace -> Datum (FlowState s x) +flowState :: TTerm (Maybe x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x) flowState value state trace = record _FlowState [ _FlowState_value>>: value, _FlowState_state>>: state, _FlowState_trace>>: trace] -flowStateState :: Datum (FlowState s x -> s) +flowStateState :: TTerm (FlowState s x -> s) flowStateState = project _FlowState _FlowState_state -flowStateTrace :: Datum (FlowState s x -> Trace) +flowStateTrace :: TTerm (FlowState s x -> Trace) flowStateTrace = project _FlowState _FlowState_trace -flowStateValue :: Datum (FlowState s x -> Maybe x) +flowStateValue :: TTerm (FlowState s x -> Maybe x) flowStateValue = project _FlowState _FlowState_value -trace :: Datum [String] -> Datum [String] -> Datum (M.Map String (Term)) -> Datum Trace +trace :: TTerm [String] -> TTerm [String] -> TTerm (M.Map String (Term)) -> TTerm Trace trace stack messages other = record _Trace [ _Trace_stack>>: stack, _Trace_messages>>: messages, _Trace_other>>: other] -traceStack :: Datum (Trace -> [String]) +traceStack :: TTerm (Trace -> [String]) traceStack = project _Trace _Trace_stack -traceMessages :: Datum (Trace -> [String]) +traceMessages :: TTerm (Trace -> [String]) traceMessages = project _Trace _Trace_messages -traceOther :: Datum (Trace -> M.Map String (Term)) +traceOther :: TTerm (Trace -> M.Map String (Term)) traceOther = project _Trace _Trace_other -unFlow :: Datum (Flow s x -> s -> Trace -> FlowState s x) +unFlow :: TTerm (Flow s x -> s -> Trace -> FlowState s x) unFlow = unwrap _Flow diff --git a/src/main/haskell/Hydra/Dsl/Lib/Io.hs b/src/main/haskell/Hydra/Dsl/Lib/Io.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Io.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Io.hs @@ -6,8 +6,8 @@ import qualified Hydra.Dsl.Terms as Terms -showTerm :: Datum (Term -> String) -showTerm = Datum $ Terms.primitive _io_showTerm +showTerm :: TTerm (Term -> String) +showTerm = TTerm $ Terms.primitive _io_showTerm -showType :: Datum (Type -> String) -showType = Datum $ Terms.primitive _io_showType +showType :: TTerm (Type -> String) +showType = TTerm $ Terms.primitive _io_showType diff --git a/src/main/haskell/Hydra/Dsl/Lib/Lists.hs b/src/main/haskell/Hydra/Dsl/Lib/Lists.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Lists.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Lists.hs @@ -5,50 +5,62 @@ import qualified Hydra.Dsl.Terms as Terms -concat :: Datum ([[a]] -> [a]) -concat = Datum $ Terms.primitive _lists_concat +apply :: TTerm ([a -> b] -> [a] -> [b]) +apply = TTerm $ Terms.primitive _lists_apply -concat2 :: Datum ([a] -> [a] -> [a]) -concat2 = Datum $ Terms.primitive _lists_concat2 +at :: TTerm (Int -> [a] -> a) +at = TTerm $ Terms.primitive _lists_at -cons :: Datum (a -> [a] -> [a]) -cons = Datum $ Terms.primitive _lists_cons +bind :: TTerm ([a] -> (a -> [b]) -> [b]) +bind = TTerm $ Terms.primitive _lists_bind -foldl :: Datum ((b -> a -> b) -> b -> [a] -> b) -foldl = Datum $ Terms.primitive _lists_foldl +concat :: TTerm ([[a]] -> [a]) +concat = TTerm $ Terms.primitive _lists_concat -head :: Datum ([a] -> a) -head = Datum $ Terms.primitive _lists_head +concat2 :: TTerm ([a] -> [a] -> [a]) +concat2 = TTerm $ Terms.primitive _lists_concat2 -intercalate :: Datum ([a] -> [[a]] -> [a]) -intercalate = Datum $ Terms.primitive _lists_intercalate +cons :: TTerm (a -> [a] -> [a]) +cons = TTerm $ Terms.primitive _lists_cons -intersperse :: Datum ([a] -> a -> [a]) -intersperse = Datum $ Terms.primitive _lists_intersperse +filter :: TTerm ((a -> Bool) -> [a] -> [a]) +filter = TTerm $ Terms.primitive _lists_filter -last :: Datum ([a] -> a) -last = Datum $ Terms.primitive _lists_last +foldl :: TTerm ((b -> a -> b) -> b -> [a] -> b) +foldl = TTerm $ Terms.primitive _lists_foldl -length :: Datum ([a] -> Int) -length = Datum $ Terms.primitive _lists_length +head :: TTerm ([a] -> a) +head = TTerm $ Terms.primitive _lists_head -map :: Datum ((a -> b) -> [a] -> [b]) -map = Datum $ Terms.primitive _lists_map +intercalate :: TTerm ([a] -> [[a]] -> [a]) +intercalate = TTerm $ Terms.primitive _lists_intercalate -nub :: Eq a => Datum ([a] -> [a]) -nub = Datum $ Terms.primitive _lists_nub +intersperse :: TTerm ([a] -> a -> [a]) +intersperse = TTerm $ Terms.primitive _lists_intersperse -null :: Datum ([a] -> Bool) -null = Datum $ Terms.primitive _lists_null +last :: TTerm ([a] -> a) +last = TTerm $ Terms.primitive _lists_last -pure :: Datum (a -> [a]) -pure = Datum $ Terms.primitive _lists_pure +length :: TTerm ([a] -> Int) +length = TTerm $ Terms.primitive _lists_length -reverse :: Datum ([a] -> [a]) -reverse = Datum $ Terms.primitive _lists_reverse +map :: TTerm ((a -> b) -> [a] -> [b]) +map = TTerm $ Terms.primitive _lists_map -safeHead :: Datum ([a] -> Maybe a) -safeHead = Datum $ Terms.primitive _lists_safeHead +nub :: Eq a => TTerm ([a] -> [a]) +nub = TTerm $ Terms.primitive _lists_nub -tail :: Datum ([a] -> [a]) -tail = Datum $ Terms.primitive _lists_tail +null :: TTerm ([a] -> Bool) +null = TTerm $ Terms.primitive _lists_null + +pure :: TTerm (a -> [a]) +pure = TTerm $ Terms.primitive _lists_pure + +reverse :: TTerm ([a] -> [a]) +reverse = TTerm $ Terms.primitive _lists_reverse + +safeHead :: TTerm ([a] -> Maybe a) +safeHead = TTerm $ Terms.primitive _lists_safeHead + +tail :: TTerm ([a] -> [a]) +tail = TTerm $ Terms.primitive _lists_tail diff --git a/src/main/haskell/Hydra/Dsl/Lib/Literals.hs b/src/main/haskell/Hydra/Dsl/Lib/Literals.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Literals.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Literals.hs @@ -7,74 +7,74 @@ import Data.Int -bigfloatToBigint :: Datum (Double -> Double) -bigfloatToBigint = Datum $ Terms.primitive _literals_bigfloatToBigint +bigfloatToBigint :: TTerm (Double -> Double) +bigfloatToBigint = TTerm $ Terms.primitive _literals_bigfloatToBigint -bigfloatToFloat32 :: Datum (Double -> Float) -bigfloatToFloat32 = Datum $ Terms.primitive _literals_bigfloatToFloat32 +bigfloatToFloat32 :: TTerm (Double -> Float) +bigfloatToFloat32 = TTerm $ Terms.primitive _literals_bigfloatToFloat32 -bigfloatToFloat64 :: Datum (Double -> Double) -bigfloatToFloat64 = Datum $ Terms.primitive _literals_bigfloatToFloat64 +bigfloatToFloat64 :: TTerm (Double -> Double) +bigfloatToFloat64 = TTerm $ Terms.primitive _literals_bigfloatToFloat64 -bigintToBigfloat :: Datum (Integer -> Double) -bigintToBigfloat = Datum $ Terms.primitive _literals_bigintToBigfloat +bigintToBigfloat :: TTerm (Integer -> Double) +bigintToBigfloat = TTerm $ Terms.primitive _literals_bigintToBigfloat -bigintToInt8 :: Datum (Integer -> Int8) -bigintToInt8 = Datum $ Terms.primitive _literals_bigintToInt8 +bigintToInt8 :: TTerm (Integer -> Int8) +bigintToInt8 = TTerm $ Terms.primitive _literals_bigintToInt8 -bigintToInt16 :: Datum (Integer -> Int16) -bigintToInt16 = Datum $ Terms.primitive _literals_bigintToInt16 +bigintToInt16 :: TTerm (Integer -> Int16) +bigintToInt16 = TTerm $ Terms.primitive _literals_bigintToInt16 -bigintToInt32 :: Datum (Integer -> Int) -bigintToInt32 = Datum $ Terms.primitive _literals_bigintToInt32 +bigintToInt32 :: TTerm (Integer -> Int) +bigintToInt32 = TTerm $ Terms.primitive _literals_bigintToInt32 -bigintToInt64 :: Datum (Integer -> Int64) -bigintToInt64 = Datum $ Terms.primitive _literals_bigintToInt64 +bigintToInt64 :: TTerm (Integer -> Int64) +bigintToInt64 = TTerm $ Terms.primitive _literals_bigintToInt64 -bigintToUint8 :: Datum (Integer -> Int16) -bigintToUint8 = Datum $ Terms.primitive _literals_bigintToUint8 +bigintToUint8 :: TTerm (Integer -> Int16) +bigintToUint8 = TTerm $ Terms.primitive _literals_bigintToUint8 -bigintToUint16 :: Datum (Integer -> Int) -bigintToUint16 = Datum $ Terms.primitive _literals_bigintToUint16 +bigintToUint16 :: TTerm (Integer -> Int) +bigintToUint16 = TTerm $ Terms.primitive _literals_bigintToUint16 -bigintToUint32 :: Datum (Integer -> Int64) -bigintToUint32 = Datum $ Terms.primitive _literals_bigintToUint32 +bigintToUint32 :: TTerm (Integer -> Int64) +bigintToUint32 = TTerm $ Terms.primitive _literals_bigintToUint32 -bigintToUint64 :: Datum (Integer -> Integer) -bigintToUint64 = Datum $ Terms.primitive _literals_bigintToUint64 +bigintToUint64 :: TTerm (Integer -> Integer) +bigintToUint64 = TTerm $ Terms.primitive _literals_bigintToUint64 -float32ToBigfloat :: Datum (Float -> Double) -float32ToBigfloat = Datum $ Terms.primitive _literals_float32ToBigfloat +float32ToBigfloat :: TTerm (Float -> Double) +float32ToBigfloat = TTerm $ Terms.primitive _literals_float32ToBigfloat -float64ToBigfloat :: Datum (Double -> Double) -float64ToBigfloat = Datum $ Terms.primitive _literals_float64ToBigfloat +float64ToBigfloat :: TTerm (Double -> Double) +float64ToBigfloat = TTerm $ Terms.primitive _literals_float64ToBigfloat -int8ToBigint :: Datum (Int8 -> Integer) -int8ToBigint = Datum $ Terms.primitive _literals_int8ToBigint +int8ToBigint :: TTerm (Int8 -> Integer) +int8ToBigint = TTerm $ Terms.primitive _literals_int8ToBigint -int16ToBigint :: Datum (Int16 -> Integer) -int16ToBigint = Datum $ Terms.primitive _literals_int16ToBigint +int16ToBigint :: TTerm (Int16 -> Integer) +int16ToBigint = TTerm $ Terms.primitive _literals_int16ToBigint -int32ToBigint :: Datum (Int -> Integer) -int32ToBigint = Datum $ Terms.primitive _literals_int32ToBigint +int32ToBigint :: TTerm (Int -> Integer) +int32ToBigint = TTerm $ Terms.primitive _literals_int32ToBigint -int64ToBigint :: Datum (Int64 -> Integer) -int64ToBigint = Datum $ Terms.primitive _literals_int64ToBigint +int64ToBigint :: TTerm (Int64 -> Integer) +int64ToBigint = TTerm $ Terms.primitive _literals_int64ToBigint -showInt32 :: Datum (Int -> String) -showInt32 = Datum $ Terms.primitive _literals_showInt32 +showInt32 :: TTerm (Int -> String) +showInt32 = TTerm $ Terms.primitive _literals_showInt32 -showString :: Datum (String -> String) -showString = Datum $ Terms.primitive _literals_showString +showString :: TTerm (String -> String) +showString = TTerm $ Terms.primitive _literals_showString -uint8ToBigint :: Datum (Int16 -> Integer) -uint8ToBigint = Datum $ Terms.primitive _literals_uint8ToBigint +uint8ToBigint :: TTerm (Int16 -> Integer) +uint8ToBigint = TTerm $ Terms.primitive _literals_uint8ToBigint -uint16ToBigint :: Datum (Int -> Integer) -uint16ToBigint = Datum $ Terms.primitive _literals_uint16ToBigint +uint16ToBigint :: TTerm (Int -> Integer) +uint16ToBigint = TTerm $ Terms.primitive _literals_uint16ToBigint -uint32ToBigint :: Datum (Int64 -> Integer) -uint32ToBigint = Datum $ Terms.primitive _literals_uint32ToBigint +uint32ToBigint :: TTerm (Int64 -> Integer) +uint32ToBigint = TTerm $ Terms.primitive _literals_uint32ToBigint -uint64ToBigint :: Datum (Integer -> Integer) -uint64ToBigint = Datum $ Terms.primitive _literals_uint64ToBigint +uint64ToBigint :: TTerm (Integer -> Integer) +uint64ToBigint = TTerm $ Terms.primitive _literals_uint64ToBigint diff --git a/src/main/haskell/Hydra/Dsl/Lib/Logic.hs b/src/main/haskell/Hydra/Dsl/Lib/Logic.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Logic.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Logic.hs @@ -6,14 +6,14 @@ import qualified Hydra.Dsl.Terms as Terms -and :: Datum (Bool -> Bool -> Bool) -and = Datum $ Terms.primitive _logic_and +and :: TTerm (Bool -> Bool -> Bool) +and = TTerm $ Terms.primitive _logic_and -ifElse :: Datum (a -> a -> Bool -> a) -ifElse = Datum $ Terms.primitive _logic_ifElse +ifElse :: TTerm (a -> a -> Bool -> a) +ifElse = TTerm $ Terms.primitive _logic_ifElse -not :: Datum (Bool -> Bool) -not = Datum $ Terms.primitive _logic_not +not :: TTerm (Bool -> Bool) +not = TTerm $ Terms.primitive _logic_not -or :: Datum (Bool -> Bool -> Bool) -or = Datum $ Terms.primitive _logic_or +or :: TTerm (Bool -> Bool -> Bool) +or = TTerm $ Terms.primitive _logic_or diff --git a/src/main/haskell/Hydra/Dsl/Lib/Maps.hs b/src/main/haskell/Hydra/Dsl/Lib/Maps.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Maps.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Maps.hs @@ -7,41 +7,41 @@ import Data.Map -empty :: Datum (Map k v) -empty = Datum $ Terms.primitive _maps_empty +empty :: TTerm (Map k v) +empty = TTerm $ Terms.primitive _maps_empty -fromList :: Datum ([(k, v)] -> Map k v) -fromList = Datum $ Terms.primitive _maps_fromList +fromList :: TTerm ([(k, v)] -> Map k v) +fromList = TTerm $ Terms.primitive _maps_fromList -insert :: Datum (k -> v -> Map k v -> Map k v) -insert = Datum $ Terms.primitive _maps_insert +insert :: TTerm (k -> v -> Map k v -> Map k v) +insert = TTerm $ Terms.primitive _maps_insert -isEmpty :: Datum (Map k v -> Bool) -isEmpty = Datum $ Terms.primitive _maps_isEmpty +isEmpty :: TTerm (Map k v -> Bool) +isEmpty = TTerm $ Terms.primitive _maps_isEmpty -keys :: Datum (Map k v -> [k]) -keys = Datum $ Terms.primitive _maps_keys +keys :: TTerm (Map k v -> [k]) +keys = TTerm $ Terms.primitive _maps_keys -lookup :: Datum (k -> Map k v -> Maybe v) -lookup = Datum $ Terms.primitive _maps_lookup +lookup :: TTerm (k -> Map k v -> Maybe v) +lookup = TTerm $ Terms.primitive _maps_lookup -map :: Datum ((v1 -> v2) -> Map k v1 -> Map k v2) -map = Datum $ Terms.primitive _maps_map +map :: TTerm ((v1 -> v2) -> Map k v1 -> Map k v2) +map = TTerm $ Terms.primitive _maps_map -mapKeys :: Datum ((k1 -> k2) -> Map k1 v -> Map k2 v) -mapKeys = Datum $ Terms.primitive _maps_mapKeys +mapKeys :: TTerm ((k1 -> k2) -> Map k1 v -> Map k2 v) +mapKeys = TTerm $ Terms.primitive _maps_mapKeys -remove :: Datum (k -> Map k v -> Map k v) -remove = Datum $ Terms.primitive _maps_remove +remove :: TTerm (k -> Map k v -> Map k v) +remove = TTerm $ Terms.primitive _maps_remove -singleton :: Datum (k -> v -> Map k v) -singleton = Datum $ Terms.primitive _maps_singleton +singleton :: TTerm (k -> v -> Map k v) +singleton = TTerm $ Terms.primitive _maps_singleton -size :: Datum (Map k v -> Int) -size = Datum $ Terms.primitive _maps_size +size :: TTerm (Map k v -> Int) +size = TTerm $ Terms.primitive _maps_size -toList :: Datum (Map k v -> [(k, v)]) -toList = Datum $ Terms.primitive _maps_toList +toList :: TTerm (Map k v -> [(k, v)]) +toList = TTerm $ Terms.primitive _maps_toList -values :: Datum (Map k v -> [v]) -values = Datum $ Terms.primitive _maps_values +values :: TTerm (Map k v -> [v]) +values = TTerm $ Terms.primitive _maps_values diff --git a/src/main/haskell/Hydra/Dsl/Lib/Math.hs b/src/main/haskell/Hydra/Dsl/Lib/Math.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Math.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Math.hs @@ -5,23 +5,23 @@ import qualified Hydra.Dsl.Terms as Terms -add :: Datum (Int -> Int -> Int) -add = Datum $ Terms.primitive _math_add +add :: TTerm (Int -> Int -> Int) +add = TTerm $ Terms.primitive _math_add -div :: Datum (Int -> Int -> Int) -div = Datum $ Terms.primitive _math_div +div :: TTerm (Int -> Int -> Int) +div = TTerm $ Terms.primitive _math_div -mod :: Datum (Int -> Int -> Int) -mod = Datum $ Terms.primitive _math_mod +mod :: TTerm (Int -> Int -> Int) +mod = TTerm $ Terms.primitive _math_mod -mul :: Datum (Int -> Int -> Int) -mul = Datum $ Terms.primitive _math_mul +mul :: TTerm (Int -> Int -> Int) +mul = TTerm $ Terms.primitive _math_mul -neg :: Datum (Int -> Int) -neg = Datum $ Terms.primitive _math_neg +neg :: TTerm (Int -> Int) +neg = TTerm $ Terms.primitive _math_neg -rem :: Datum (Int -> Int -> Int) -rem = Datum $ Terms.primitive _math_rem +rem :: TTerm (Int -> Int -> Int) +rem = TTerm $ Terms.primitive _math_rem -sub :: Datum (Int -> Int -> Int) -sub = Datum $ Terms.primitive _math_sub +sub :: TTerm (Int -> Int -> Int) +sub = TTerm $ Terms.primitive _math_sub diff --git a/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs b/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Optionals.hs @@ -5,29 +5,32 @@ import qualified Hydra.Dsl.Terms as Terms -apply :: Datum (Maybe (a -> b) -> Maybe a -> Maybe b) -apply = Datum $ Terms.primitive _optionals_apply +apply :: TTerm (Maybe (a -> b) -> Maybe a -> Maybe b) +apply = TTerm $ Terms.primitive _optionals_apply -bind :: Datum (Maybe a -> (a -> Maybe b) -> Maybe b) -bind = Datum $ Terms.primitive _optionals_bind +bind :: TTerm (Maybe a -> (a -> Maybe b) -> Maybe b) +bind = TTerm $ Terms.primitive _optionals_bind -cat :: Datum ([Maybe a] -> [a]) -cat = Datum $ Terms.primitive _optionals_cat +cat :: TTerm ([Maybe a] -> [a]) +cat = TTerm $ Terms.primitive _optionals_cat -fromMaybe :: Datum (a -> Maybe a -> a) -fromMaybe = Datum $ Terms.primitive _optionals_fromMaybe +compose :: TTerm ((a -> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c)) +compose = TTerm $ Terms.primitive _optionals_compose -isJust :: Datum (Maybe a -> Bool) -isJust = Datum $ Terms.primitive _optionals_isJust +fromMaybe :: TTerm (a -> Maybe a -> a) +fromMaybe = TTerm $ Terms.primitive _optionals_fromMaybe -isNothing :: Datum (Maybe a -> Bool) -isNothing = Datum $ Terms.primitive _optionals_isNothing +isJust :: TTerm (Maybe a -> Bool) +isJust = TTerm $ Terms.primitive _optionals_isJust -map :: Datum ((a -> b) -> Maybe a -> Maybe b) -map = Datum $ Terms.primitive _optionals_map +isNothing :: TTerm (Maybe a -> Bool) +isNothing = TTerm $ Terms.primitive _optionals_isNothing -maybe :: Datum (b -> (a -> b) -> Maybe a -> b) -maybe = Datum $ Terms.primitive _optionals_maybe +map :: TTerm ((a -> b) -> Maybe a -> Maybe b) +map = TTerm $ Terms.primitive _optionals_map -pure :: Datum (a -> Maybe a) -pure = Datum $ Terms.primitive _optionals_pure +maybe :: TTerm (b -> (a -> b) -> Maybe a -> b) +maybe = TTerm $ Terms.primitive _optionals_maybe + +pure :: TTerm (a -> Maybe a) +pure = TTerm $ Terms.primitive _optionals_pure diff --git a/src/main/haskell/Hydra/Dsl/Lib/Sets.hs b/src/main/haskell/Hydra/Dsl/Lib/Sets.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Sets.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Sets.hs @@ -7,41 +7,41 @@ import Data.Set -contains :: Datum (a -> Set a -> Bool) -contains = Datum $ Terms.primitive _sets_contains +contains :: TTerm (a -> Set a -> Bool) +contains = TTerm $ Terms.primitive _sets_contains -difference :: Datum (Set a -> Set a -> Set a) -difference = Datum $ Terms.primitive _sets_difference +difference :: TTerm (Set a -> Set a -> Set a) +difference = TTerm $ Terms.primitive _sets_difference -empty :: Datum (Set a) -empty = Datum $ Terms.primitive _sets_empty +empty :: TTerm (Set a) +empty = TTerm $ Terms.primitive _sets_empty -fromList :: Datum ([a] -> Set a) -fromList = Datum $ Terms.primitive _sets_fromList +fromList :: TTerm ([a] -> Set a) +fromList = TTerm $ Terms.primitive _sets_fromList -insert :: Datum (a -> Set a -> Set a) -insert = Datum $ Terms.primitive _sets_insert +insert :: TTerm (a -> Set a -> Set a) +insert = TTerm $ Terms.primitive _sets_insert -intersection :: Datum (Set a -> Set a -> Set a) -intersection = Datum $ Terms.primitive _sets_intersection +intersection :: TTerm (Set a -> Set a -> Set a) +intersection = TTerm $ Terms.primitive _sets_intersection -isEmpty :: Datum (Set a -> Bool) -isEmpty = Datum $ Terms.primitive _sets_isEmpty +isEmpty :: TTerm (Set a -> Bool) +isEmpty = TTerm $ Terms.primitive _sets_isEmpty -map :: Datum ((a -> b) -> Set a -> Set b) -map = Datum $ Terms.primitive _sets_map +map :: TTerm ((a -> b) -> Set a -> Set b) +map = TTerm $ Terms.primitive _sets_map -remove :: Datum (a -> Set a -> Set a) -remove = Datum $ Terms.primitive _sets_remove +remove :: TTerm (a -> Set a -> Set a) +remove = TTerm $ Terms.primitive _sets_remove -singleton :: Datum (a -> Set a) -singleton = Datum $ Terms.primitive _sets_singleton +singleton :: TTerm (a -> Set a) +singleton = TTerm $ Terms.primitive _sets_singleton -size :: Datum (Set a -> Int) -size = Datum $ Terms.primitive _sets_size +size :: TTerm (Set a -> Int) +size = TTerm $ Terms.primitive _sets_size -toList :: Datum (Set a -> [a]) -toList = Datum $ Terms.primitive _sets_toList +toList :: TTerm (Set a -> [a]) +toList = TTerm $ Terms.primitive _sets_toList -union :: Datum (Set a -> Set a -> Set a) -union = Datum $ Terms.primitive _sets_union +union :: TTerm (Set a -> Set a -> Set a) +union = TTerm $ Terms.primitive _sets_union diff --git a/src/main/haskell/Hydra/Dsl/Lib/Strings.hs b/src/main/haskell/Hydra/Dsl/Lib/Strings.hs --- a/src/main/haskell/Hydra/Dsl/Lib/Strings.hs +++ b/src/main/haskell/Hydra/Dsl/Lib/Strings.hs @@ -6,40 +6,40 @@ import qualified Hydra.Dsl.Terms as Terms -(++) :: Datum String -> Datum String -> Datum String -l ++ r = (Datum $ Terms.primitive _strings_cat) @@ (list [l, r]) +(++) :: TTerm String -> TTerm String -> TTerm String +l ++ r = (TTerm $ Terms.primitive _strings_cat) @@ (list [l, r]) -cat :: Datum ([String] -> String) -cat = Datum $ Terms.primitive _strings_cat +cat :: TTerm ([String] -> String) +cat = TTerm $ Terms.primitive _strings_cat -cat2 :: Datum (String -> String -> String) -cat2 = Datum $ Terms.primitive _strings_cat2 +cat2 :: TTerm (String -> String -> String) +cat2 = TTerm $ Terms.primitive _strings_cat2 -fromList :: Datum ([Int] -> String) -fromList = Datum $ Terms.primitive _strings_fromList +fromList :: TTerm ([Int] -> String) +fromList = TTerm $ Terms.primitive _strings_fromList -intercalate :: Datum (String -> [String] -> String) -intercalate = Datum $ Terms.primitive _strings_intercalate +intercalate :: TTerm (String -> [String] -> String) +intercalate = TTerm $ Terms.primitive _strings_intercalate -isEmpty :: Datum (String -> Bool) -isEmpty = Datum $ Terms.primitive _strings_isEmpty +isEmpty :: TTerm (String -> Bool) +isEmpty = TTerm $ Terms.primitive _strings_isEmpty -length :: Datum (String -> Int) -length = Datum $ Terms.primitive _strings_length +length :: TTerm (String -> Int) +length = TTerm $ Terms.primitive _strings_length -splitOn :: Datum (String -> String -> [String]) -splitOn = Datum $ Terms.primitive _strings_splitOn +splitOn :: TTerm (String -> String -> [String]) +splitOn = TTerm $ Terms.primitive _strings_splitOn -toList :: Datum (String -> [Int]) -toList = Datum $ Terms.primitive _strings_toList +toList :: TTerm (String -> [Int]) +toList = TTerm $ Terms.primitive _strings_toList -toLower :: Datum (String -> String) -toLower = Datum $ Terms.primitive _strings_toLower +toLower :: TTerm (String -> String) +toLower = TTerm $ Terms.primitive _strings_toLower -toUpper :: Datum (String -> String) -toUpper = Datum $ Terms.primitive _strings_toUpper +toUpper :: TTerm (String -> String) +toUpper = TTerm $ Terms.primitive _strings_toUpper -- Helpers -concat :: [Datum String] -> Datum String -concat strings = (Datum $ Terms.primitive _strings_cat) @@ list strings +concat :: [TTerm String] -> TTerm String +concat strings = (TTerm $ Terms.primitive _strings_cat) @@ list strings diff --git a/src/main/haskell/Hydra/Dsl/LiteralTypes.hs b/src/main/haskell/Hydra/Dsl/LiteralTypes.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/LiteralTypes.hs @@ -0,0 +1,57 @@ +-- | A DSL of short names for literal types + +module Hydra.Dsl.LiteralTypes where + +import Hydra.Core + + +bigfloat :: LiteralType +bigfloat = float FloatTypeBigfloat + +bigint :: LiteralType +bigint = LiteralTypeInteger IntegerTypeBigint + +binary :: LiteralType +binary = LiteralTypeBinary + +boolean :: LiteralType +boolean = LiteralTypeBoolean + +float32 :: LiteralType +float32 = float FloatTypeFloat32 + +float64 :: LiteralType +float64 = float FloatTypeFloat64 + +float :: FloatType -> LiteralType +float = LiteralTypeFloat + +int16 :: LiteralType +int16 = integer IntegerTypeInt16 + +int32 :: LiteralType +int32 = integer IntegerTypeInt32 + +int64 :: LiteralType +int64 = integer IntegerTypeInt64 + +int8 :: LiteralType +int8 = integer IntegerTypeInt8 + +integer :: IntegerType -> LiteralType +integer = LiteralTypeInteger + +string :: LiteralType +string = LiteralTypeString + +uint16 :: LiteralType +uint16 = integer IntegerTypeUint16 + +uint32 :: LiteralType +uint32 = integer IntegerTypeUint32 + +uint64 :: LiteralType +uint64 = integer IntegerTypeUint64 + +uint8 :: LiteralType +uint8 = integer IntegerTypeUint8 diff --git a/src/main/haskell/Hydra/Dsl/Mantle.hs b/src/main/haskell/Hydra/Dsl/Mantle.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Dsl/Mantle.hs @@ -0,0 +1,81 @@ +module Hydra.Dsl.Mantle where + +import Hydra.Kernel +import Hydra.Dsl.Base as Base +import Hydra.Dsl.Core + +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +termAccessorAnnotatedSubject :: TTerm TermAccessor +termAccessorAnnotatedSubject = unitVariant _TermAccessor _TermAccessor_annotatedSubject + +termAccessorApplicationFunction :: TTerm TermAccessor +termAccessorApplicationFunction = unitVariant _TermAccessor _TermAccessor_applicationFunction + +termAccessorApplicationArgument :: TTerm TermAccessor +termAccessorApplicationArgument = unitVariant _TermAccessor _TermAccessor_applicationArgument + +termAccessorLambdaBody :: TTerm TermAccessor +termAccessorLambdaBody = unitVariant _TermAccessor _TermAccessor_lambdaBody + +termAccessorListFold :: TTerm TermAccessor +termAccessorListFold = unitVariant _TermAccessor _TermAccessor_listFold + +termAccessorOptionalCasesNothing :: TTerm TermAccessor +termAccessorOptionalCasesNothing = unitVariant _TermAccessor _TermAccessor_optionalCasesNothing + +termAccessorOptionalCasesJust :: TTerm TermAccessor +termAccessorOptionalCasesJust = unitVariant _TermAccessor _TermAccessor_optionalCasesJust + +termAccessorUnionCasesDefault :: TTerm TermAccessor +termAccessorUnionCasesDefault = unitVariant _TermAccessor _TermAccessor_unionCasesDefault + +termAccessorUnionCasesBranch :: TTerm Name -> TTerm TermAccessor +termAccessorUnionCasesBranch = variant _TermAccessor _TermAccessor_unionCasesBranch + +termAccessorLetEnvironment :: TTerm TermAccessor +termAccessorLetEnvironment = unitVariant _TermAccessor _TermAccessor_letEnvironment + +termAccessorLetBinding :: TTerm Name -> TTerm TermAccessor +termAccessorLetBinding = variant _TermAccessor _TermAccessor_letBinding + +termAccessorListElement :: TTerm Int -> TTerm TermAccessor +termAccessorListElement = variant _TermAccessor _TermAccessor_listElement + +termAccessorMapKey :: TTerm Int -> TTerm TermAccessor +termAccessorMapKey = variant _TermAccessor _TermAccessor_mapKey + +termAccessorMapValue :: TTerm Int -> TTerm TermAccessor +termAccessorMapValue = variant _TermAccessor _TermAccessor_mapValue + +termAccessorOptionalTerm :: TTerm TermAccessor +termAccessorOptionalTerm = unitVariant _TermAccessor _TermAccessor_optionalTerm + +termAccessorProductTerm :: TTerm Int -> TTerm TermAccessor +termAccessorProductTerm = variant _TermAccessor _TermAccessor_productTerm + +termAccessorRecordField :: TTerm Name -> TTerm TermAccessor +termAccessorRecordField = variant _TermAccessor _TermAccessor_recordField + +termAccessorSetElement :: TTerm Int -> TTerm TermAccessor +termAccessorSetElement = variant _TermAccessor _TermAccessor_setElement + +termAccessorSumTerm :: TTerm TermAccessor +termAccessorSumTerm = unitVariant _TermAccessor _TermAccessor_sumTerm + +termAccessorTypeAbstractionBody :: TTerm TermAccessor +termAccessorTypeAbstractionBody = unitVariant _TermAccessor _TermAccessor_typeAbstractionBody + +termAccessorTypeApplicationTerm :: TTerm TermAccessor +termAccessorTypeApplicationTerm = unitVariant _TermAccessor _TermAccessor_typeApplicationTerm + +termAccessorTypedTerm :: TTerm TermAccessor +termAccessorTypedTerm = unitVariant _TermAccessor _TermAccessor_typedTerm + +termAccessorInjectionTerm :: TTerm TermAccessor +termAccessorInjectionTerm = unitVariant _TermAccessor _TermAccessor_injectionTerm + +termAccessorWrappedTerm :: TTerm TermAccessor +termAccessorWrappedTerm = unitVariant _TermAccessor _TermAccessor_wrappedTerm diff --git a/src/main/haskell/Hydra/Dsl/Module.hs b/src/main/haskell/Hydra/Dsl/Module.hs --- a/src/main/haskell/Hydra/Dsl/Module.hs +++ b/src/main/haskell/Hydra/Dsl/Module.hs @@ -4,13 +4,16 @@ import Hydra.Dsl.Base as Base -qualifiedName :: Datum (Maybe Namespace) -> Datum String -> Datum QualifiedName +qualifiedName :: TTerm (Maybe Namespace) -> TTerm String -> TTerm QualifiedName qualifiedName ns local = record _QualifiedName [ _QualifiedName_namespace>>: ns, _QualifiedName_local>>: local] -qualifiedNameLocal :: Datum (QualifiedName -> String) +qualifiedNameLocal :: TTerm (QualifiedName -> String) qualifiedNameLocal = project _QualifiedName _QualifiedName_local -qualifiedNameNamespace :: Datum (QualifiedName -> Maybe Namespace) +qualifiedNameNamespace :: TTerm (QualifiedName -> Maybe Namespace) qualifiedNameNamespace = project _QualifiedName _QualifiedName_namespace + +unFileExtension :: TTerm (FileExtension -> String) +unFileExtension = unwrap _FileExtension diff --git a/src/main/haskell/Hydra/Dsl/PhantomLiterals.hs b/src/main/haskell/Hydra/Dsl/PhantomLiterals.hs --- a/src/main/haskell/Hydra/Dsl/PhantomLiterals.hs +++ b/src/main/haskell/Hydra/Dsl/PhantomLiterals.hs @@ -15,64 +15,64 @@ -- Note: does not distinguish Binary from String, because code generation does not. type Binary = String -bigfloat :: Bigfloat -> Datum Bigfloat -bigfloat = Datum . Terms.bigfloat +bigfloat :: Bigfloat -> TTerm Bigfloat +bigfloat = TTerm . Terms.bigfloat -bigint :: Integer -> Datum Integer -bigint = Datum . Terms.bigint +bigint :: Integer -> TTerm Integer +bigint = TTerm . Terms.bigint -binary :: Binary -> Datum Binary -binary = Datum . Terms.binary +binary :: Binary -> TTerm Binary +binary = TTerm . Terms.binary -bool :: Bool -> Datum Bool -bool = Datum . Terms.boolean +bool :: Bool -> TTerm Bool +bool = TTerm . Terms.boolean -boolean :: Bool -> Datum Bool +boolean :: Bool -> TTerm Bool boolean = bool -double :: Double -> Datum Double +double :: Double -> TTerm Double double = float64 -false :: Datum Bool +false :: TTerm Bool false = bool False -float :: Float -> Datum Float +float :: Float -> TTerm Float float = float32 -float32 :: Float -> Datum Float -float32 = Datum . Terms.float32 +float32 :: Float -> TTerm Float +float32 = TTerm . Terms.float32 -float64 :: Double -> Datum Double -float64 = Datum . Terms.float64 +float64 :: Double -> TTerm Double +float64 = TTerm . Terms.float64 -int :: Int -> Datum Int +int :: Int -> TTerm Int int = int32 -int8 :: Int8 -> Datum Int8 -int8 = Datum . Terms.int8 +int8 :: Int8 -> TTerm Int8 +int8 = TTerm . Terms.int8 -int16 :: Int16 -> Datum Int16 -int16 = Datum . Terms.int16 +int16 :: Int16 -> TTerm Int16 +int16 = TTerm . Terms.int16 -int32 :: Int -> Datum Int -int32 = Datum . Terms.int32 +int32 :: Int -> TTerm Int +int32 = TTerm . Terms.int32 -int64 :: Int64 -> Datum Int64 -int64 = Datum . Terms.int64 +int64 :: Int64 -> TTerm Int64 +int64 = TTerm . Terms.int64 -string :: String -> Datum String -string = Datum . Terms.string +string :: String -> TTerm String +string = TTerm . Terms.string -true :: Datum Bool +true :: TTerm Bool true = bool True -- Note: untyped integers are not yet properly supported by the DSL, -- because they are not properly supported by code generation. -uint8 :: Int8 -> Datum Int8 +uint8 :: Int8 -> TTerm Int8 uint8 = int8 -uint16 :: Int16 -> Datum Int16 +uint16 :: Int16 -> TTerm Int16 uint16 = int16 -uint32 :: Int -> Datum Int +uint32 :: Int -> TTerm Int uint32 = int -uint64 :: Int64 -> Datum Int64 +uint64 :: Int64 -> TTerm Int64 uint64 = int64 diff --git a/src/main/haskell/Hydra/Dsl/Prims.hs b/src/main/haskell/Hydra/Dsl/Prims.hs --- a/src/main/haskell/Hydra/Dsl/Prims.hs +++ b/src/main/haskell/Hydra/Dsl/Prims.hs @@ -129,45 +129,51 @@ vTerm <- coderDecode (termCoderCoder vCoder) v return $ Terms.product [kTerm, vTerm] -prim0 :: Name -> TermCoder x -> x -> Primitive -prim0 name output value = Primitive name (termCoderType output) impl +prim0 :: [String] -> Name -> TermCoder x -> x -> Primitive +prim0 vars name output value = Primitive name typ impl where + typ = TypeScheme (Name <$> vars) $ + termCoderType output impl _ = coderDecode (termCoderCoder output) value -prim1 :: Name -> TermCoder x -> TermCoder y -> (x -> y) -> Primitive -prim1 name input1 output compute = Primitive name ft impl +prim1 :: [String] -> Name -> TermCoder x -> TermCoder y -> (x -> y) -> Primitive +prim1 vars name input1 output compute = Primitive name typ impl where - ft = TypeFunction $ FunctionType (termCoderType input1) $ termCoderType output + typ = TypeScheme (Name <$> vars) $ + TypeFunction $ FunctionType (termCoderType input1) $ termCoderType output impl args = do Expect.nArgs 1 args arg1 <- coderEncode (termCoderCoder input1) (args !! 0) coderDecode (termCoderCoder output) $ compute arg1 -prim2 :: Name -> TermCoder x -> TermCoder y -> TermCoder z -> (x -> y -> z) -> Primitive -prim2 name input1 input2 output compute = Primitive name ft impl +prim2 :: [String] -> Name -> TermCoder x -> TermCoder y -> TermCoder z -> (x -> y -> z) -> Primitive +prim2 vars name input1 input2 output compute = Primitive name typ impl where - ft = TypeFunction $ FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output)) + typ = TypeScheme (Name <$> vars) $ + TypeFunction $ FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output)) impl args = do Expect.nArgs 2 args arg1 <- coderEncode (termCoderCoder input1) (args !! 0) arg2 <- coderEncode (termCoderCoder input2) (args !! 1) coderDecode (termCoderCoder output) $ compute arg1 arg2 -prim2Interp :: Name -> TermCoder x -> TermCoder y -> TermCoder z -> (Term -> Term -> Flow (Graph) (Term)) -> Primitive -prim2Interp name input1 input2 output compute = Primitive name ft impl +prim2Interp :: [String] -> Name -> TermCoder x -> TermCoder y -> TermCoder z -> (Term -> Term -> Flow (Graph) (Term)) -> Primitive +prim2Interp vars name input1 input2 output compute = Primitive name typ impl where - ft = TypeFunction $ FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output)) + typ = TypeScheme (Name <$> vars) $ + TypeFunction $ FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output)) impl args = do Expect.nArgs 2 args compute (args !! 0) (args !! 1) -prim3 :: Name -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> (w -> x -> y -> z) -> Primitive -prim3 name input1 input2 input3 output compute = Primitive name ft impl +prim3 :: [String] -> Name -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> (w -> x -> y -> z) -> Primitive +prim3 vars name input1 input2 input3 output compute = Primitive name typ impl where - ft = TypeFunction $ FunctionType - (termCoderType input1) - (Types.function (termCoderType input2) - (Types.function (termCoderType input3) (termCoderType output))) + typ = TypeScheme (Name <$> vars) $ + TypeFunction $ FunctionType + (termCoderType input1) + (Types.function (termCoderType input2) + (Types.function (termCoderType input3) (termCoderType output))) impl args = do Expect.nArgs 2 args arg1 <- coderEncode (termCoderCoder input1) (args !! 0) diff --git a/src/main/haskell/Hydra/Dsl/ShorthandTypes.hs b/src/main/haskell/Hydra/Dsl/ShorthandTypes.hs --- a/src/main/haskell/Hydra/Dsl/ShorthandTypes.hs +++ b/src/main/haskell/Hydra/Dsl/ShorthandTypes.hs @@ -20,7 +20,12 @@ annotatedTypeT = TypeVariable _AnnotatedType :: Type applicationT = TypeVariable _Application :: Type applicationTypeT = TypeVariable _ApplicationType :: Type +bT = Types.var "b" :: Type +bigfloatT = Types.bigfloat +bigintT = Types.bigint +binaryT = Types.binary booleanT = Types.boolean +cT = Types.var "c" :: Type caseStatementT = TypeVariable _CaseStatement :: Type elementT = TypeVariable _Element :: Type eliminationT = TypeVariable _Elimination :: Type @@ -29,6 +34,8 @@ fieldNameT = TypeVariable _Name :: Type fieldTypeT = TypeVariable _FieldType :: Type fileExtensionT = TypeVariable _FileExtension :: Type +float32T = Types.float32 +float64T = Types.float64 floatTypeT = TypeVariable _FloatType :: Type floatValueT = TypeVariable _FloatValue :: Type flowS1AT = flowT (Types.var "s1") aT :: Type @@ -43,10 +50,13 @@ functionVariantT = TypeVariable _FunctionVariant :: Type graphT = TypeVariable _Graph :: Type injectionT = TypeVariable _Injection :: Type +int8T = Types.int8 +int16T = Types.int16 int32T = Types.int32 +int64T = Types.int64 integerTypeT = TypeVariable _IntegerType :: Type integerValueT = TypeVariable _IntegerValue :: Type -kvT = mapT stringT termT :: Type +kvT = mapT nameT termT :: Type lambdaT = TypeVariable _Lambda :: Type lambdaTypeT = TypeVariable _LambdaType :: Type languageT = TypeVariable _Language :: Type @@ -74,12 +84,19 @@ stringT = Types.string :: Type sumT = TypeVariable _Sum :: Type termT = TypeVariable _Term :: Type +termAccessorT = TypeVariable _TermAccessor :: Type termVariantT = TypeVariable _TermVariant :: Type traceT = TypeVariable _Trace tupleProjectionT = TypeVariable _TupleProjection :: Type typeT = TypeVariable _Type :: Type +typeAbstractionT = TypeVariable _TypeAbstraction :: Type typeSchemeT = TypeVariable _TypeScheme :: Type +typedTermT = TypeVariable _TypedTerm :: Type typeVariantT = TypeVariable _TypeVariant :: Type +uint8T = Types.uint8 +uint16T = Types.uint16 +uint32T = Types.uint32 +uint64T = Types.uint64 unitT = Types.unit :: Type wrappedTermT = TypeVariable _WrappedTerm :: Type wrappedTypeT = TypeVariable _WrappedType :: Type diff --git a/src/main/haskell/Hydra/Dsl/Terms.hs b/src/main/haskell/Hydra/Dsl/Terms.hs --- a/src/main/haskell/Hydra/Dsl/Terms.hs +++ b/src/main/haskell/Hydra/Dsl/Terms.hs @@ -21,9 +21,15 @@ instance IsString Term where fromString = string +-- Two alternative symbols for term application (@@) :: Term -> Term -> Term f @@ x = apply f x +($$) :: Term -> Term -> Term +f $$ x = apply f x +--(<$>) :: Term -> Term -> Term +--f <$> x = apply f x + (<.>) :: Term -> Term -> Term f <.> g = compose f g @@ -31,7 +37,7 @@ (>:) :: String -> Term -> Field n >: t = field n t -annot :: M.Map String Term -> Term -> Term +annot :: M.Map Name Term -> Term -> Term annot ann t = TermAnnotated $ AnnotatedTerm t ann apply :: Term -> Term -> Term @@ -67,6 +73,9 @@ fieldsToMap :: [Field] -> M.Map Name Term fieldsToMap fields = M.fromList $ (\(Field name term) -> (name, term)) <$> fields +first :: Term +first = untuple 2 0 + float32 :: Float -> Term float32 = literal . Literals.float32 @@ -104,8 +113,13 @@ just = optional . Just lambda :: String -> Term -> Term -lambda param body = TermFunction $ FunctionLambda $ Lambda (Name param) body +lambda param body = TermFunction $ FunctionLambda $ Lambda (Name param) Nothing body +letMulti :: [(String, Term)] -> Term -> Term +letMulti bindings body = TermLet $ Let (toBinding <$> bindings) body + where + toBinding (name, term) = LetBinding (Name name) term Nothing + -- Construct a 'let' term with a single binding letTerm :: Name -> Term -> Term -> Term letTerm v t1 t2 = TermLet $ Let [LetBinding v t1 Nothing] t2 @@ -153,6 +167,9 @@ record :: Name -> [Field] -> Term record tname fields = TermRecord $ Record tname fields + +second :: Term +second = untuple 2 1 set :: S.Set Term -> Term set = TermSet diff --git a/src/main/haskell/Hydra/Dsl/Types.hs b/src/main/haskell/Hydra/Dsl/Types.hs --- a/src/main/haskell/Hydra/Dsl/Types.hs +++ b/src/main/haskell/Hydra/Dsl/Types.hs @@ -13,18 +13,27 @@ instance IsString (Type) where fromString = var +-- Not available: := ::= infixr 0 >: (>:) :: String -> Type -> FieldType n >: t = field n t +--(::=) :: String -> Type -> FieldType +n <=> t = field n t + + + infixr 0 --> (-->) :: Type -> Type -> Type a --> b = function a b +-- Two alternative symbols for type application (@@) :: Type -> Type -> Type f @@ x = apply f x +($$) :: Type -> Type -> Type +f $$ x = apply f x -annot :: M.Map String Term -> Type -> Type +annot :: M.Map Name Term -> Type -> Type annot ann t = TypeAnnotated $ AnnotatedType t ann apply :: Type -> Type -> Type @@ -101,18 +110,27 @@ map :: Type -> Type -> Type map kt vt = TypeMap $ MapType kt vt +mono :: Type -> TypeScheme +mono = TypeScheme [] + optional :: Type -> Type optional = TypeOptional pair :: Type -> Type -> Type pair a b = TypeProduct [a, b] +poly :: [String] -> Type -> TypeScheme +poly vs t = TypeScheme (Name <$> vs) t + product :: [Type] -> Type product = TypeProduct record :: [FieldType] -> Type -record fields = TypeRecord $ RowType placeholderName Nothing fields +record fields = TypeRecord $ RowType placeholderName fields +scheme :: [String] -> Type -> TypeScheme +scheme vars body = TypeScheme (Name <$> vars) body + set :: Type -> Type set = TypeSet @@ -135,10 +153,10 @@ uint8 = integer IntegerTypeUint8 union :: [FieldType] -> Type -union fields = TypeUnion $ RowType placeholderName Nothing fields +union fields = TypeUnion $ RowType placeholderName fields unit :: Type -unit = TypeRecord $ RowType (Name "hydra/core.Unit") Nothing [] +unit = TypeRecord $ RowType (Name "hydra/core.Unit") [] var :: String -> Type var = TypeVariable . Name diff --git a/src/main/haskell/Hydra/Ext/Avro/Coder.hs b/src/main/haskell/Hydra/Ext/Avro/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Avro/Coder.hs @@ -0,0 +1,389 @@ +module Hydra.Ext.Avro.Coder ( + AvroEnvironment(..), + AvroHydraAdapter(..), + AvroQualifiedName(..), + avroHydraAdapter, + emptyAvroEnvironment, +) where + +import Hydra.Kernel +import Hydra.Ext.Json.Eliminate +import qualified Hydra.Lib.Strings as Strings +import qualified Hydra.Dsl.Expect as Expect +import qualified Hydra.Dsl.Types as Types +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Ext.Org.Apache.Avro.Schema as Avro +import qualified Hydra.Json as Json + +import qualified Text.Read as TR +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +data AvroEnvironment = AvroEnvironment { + avroEnvironmentNamedAdapters :: M.Map AvroQualifiedName AvroHydraAdapter, + avroEnvironmentNamespace :: Maybe String, + avroEnvironmentElements :: M.Map Name Element} -- note: only used in the term coders +type AvroHydraAdapter = Adapter AvroEnvironment AvroEnvironment Avro.Schema Type Json.Value Term + +data AvroQualifiedName = AvroQualifiedName (Maybe String) String deriving (Eq, Ord, Show) + +data ForeignKey = ForeignKey Name (String -> Name) + +data PrimaryKey = PrimaryKey Name (String -> Name) + +emptyAvroEnvironment = AvroEnvironment M.empty Nothing M.empty + +avro_foreignKey = "@foreignKey" +avro_primaryKey = "@primaryKey" + +avroHydraAdapter :: Avro.Schema -> Flow AvroEnvironment AvroHydraAdapter +avroHydraAdapter schema = case schema of + Avro.SchemaArray (Avro.Array s) -> do + ad <- avroHydraAdapter s + let coder = Coder { + coderEncode = \(Json.ValueArray vals) -> Terms.list <$> (CM.mapM (coderEncode $ adapterCoder ad) vals), + coderDecode = \(TermList vals) -> Json.ValueArray <$> (CM.mapM (coderDecode $ adapterCoder ad) vals)} + return $ Adapter (adapterIsLossy ad) schema (Types.list $ adapterTarget ad) coder + Avro.SchemaMap (Avro.Map_ s) -> do + ad <- avroHydraAdapter s + let pairToHydra (k, v) = do + v' <- coderEncode (adapterCoder ad) v + return (Terms.string k, v') + let coder = Coder { + coderEncode = \(Json.ValueObject m) -> Terms.map . M.fromList <$> (CM.mapM pairToHydra $ M.toList m), + coderDecode = \m -> Json.ValueObject <$> Expect.map Expect.string (coderDecode (adapterCoder ad)) m} + return $ Adapter (adapterIsLossy ad) schema (Types.map Types.string $ adapterTarget ad) coder + Avro.SchemaNamed n -> do + let ns = Avro.namedNamespace n + env <- getState + + let manns = namedAnnotationsToCore n + let ann = if M.null manns then Nothing else (Just manns) + + let lastNs = avroEnvironmentNamespace env + let nextNs = Y.maybe lastNs Just ns + putState $ env {avroEnvironmentNamespace = nextNs} + + let qname = AvroQualifiedName nextNs (Avro.namedName n) + let hydraName = avroNameToHydraName qname + + -- Note: if a named type is redefined (an illegal state for which the Avro spec does not provide a resolution), + -- we just take the first definition and ignore the second. + ad <- case getAvroHydraAdapter qname env of + Just ad -> fail $ "Avro named type defined more than once: " ++ show qname + Nothing -> do + ad <- case Avro.namedType n of + Avro.NamedTypeEnum (Avro.Enum_ syms mdefault) -> simpleAdapter typ encode decode -- TODO: use default value + where + typ = TypeUnion (RowType hydraName $ toField <$> syms) + where + toField s = FieldType (Name s) Types.unit + encode (Json.ValueString s) = pure $ TermUnion (Injection hydraName $ Field (Name s) Terms.unit) + -- Note: we simply trust that data coming from the Hydra side is correct + decode (TermUnion (Injection _ (Field fn _))) = return $ Json.ValueString $ unName fn + Avro.NamedTypeFixed (Avro.Fixed size) -> simpleAdapter Types.binary encode decode + where + encode (Json.ValueString s) = pure $ Terms.binary s + decode term = Json.ValueString <$> Expect.binary term + Avro.NamedTypeRecord r -> do + let avroFields = Avro.recordFields r + adaptersByFieldName <- M.fromList <$> (CM.mapM prepareField avroFields) + pk <- findPrimaryKeyField qname avroFields + -- TODO: Nothing values for optional fields + let encodePair (k, v) = case M.lookup k adaptersByFieldName of + Nothing -> fail $ "unrecognized field for " ++ showQname qname ++ ": " ++ show k + Just (f, ad) -> do + v' <- coderEncode (adapterCoder ad) v + return $ Field (Name k) v' + let decodeField (Field (Name k) v) = case M.lookup k adaptersByFieldName of + Nothing -> fail $ "unrecognized field for " ++ showQname qname ++ ": " ++ show k + Just (f, ad) -> do + v' <- coderDecode (adapterCoder ad) v + return (k, v') + let lossy = L.foldl (\b (_, ad) -> b || adapterIsLossy ad) False $ M.elems adaptersByFieldName + let hfields = toHydraField <$> M.elems adaptersByFieldName + let target = TypeRecord $ RowType hydraName hfields + let coder = Coder { + -- Note: the order of the fields is changed + coderEncode = \(Json.ValueObject m) -> do + fields <- CM.mapM encodePair $ M.toList m + let term = TermRecord $ Record hydraName fields + addElement term target pk fields + return term, + coderDecode = \(TermRecord (Record _ fields)) -> Json.ValueObject . M.fromList <$> (CM.mapM decodeField fields)} + return $ Adapter lossy schema target coder + where + toHydraField (f, ad) = FieldType (Name $ Avro.fieldName f) $ adapterTarget ad + env <- getState + putState $ putAvroHydraAdapter qname ad env + return $ annotate ann ad + + env2 <- getState + putState $ env2 {avroEnvironmentNamespace = lastNs} + return ad + where + addElement term typ pk fields = case pk of + Nothing -> pure () + Just (PrimaryKey fname constr) -> case L.filter isPkField fields of + [] -> pure () + [field] -> do + s <- termToString $ fieldTerm field + let name = constr s + let el = Element name term + env <- getState + putState $ env {avroEnvironmentElements = M.insert name el (avroEnvironmentElements env)} + return () + _ -> fail $ "multiple fields named " ++ unName fname + where + isPkField field = fieldName field == fname + findPrimaryKeyField qname avroFields = do + keys <- Y.catMaybes <$> CM.mapM primaryKey avroFields + case keys of + [] -> pure Nothing + [k] -> pure $ Just k + _ -> fail $ "multiple primary key fields for " ++ show qname + prepareField f = do + fk <- foreignKey f + + let manns = fieldAnnotationsToCore f + let ann = if M.null manns then Nothing else (Just manns) :: Y.Maybe (M.Map Name Term) + + ad <- case fk of + Nothing -> avroHydraAdapter $ Avro.fieldType f + Just (ForeignKey name constr) -> do + ad <- avroHydraAdapter $ Avro.fieldType f + let decodeTerm = \(TermVariable name) -> do -- TODO: not symmetrical + term <- stringToTerm (adapterTarget ad) $ unName name + coderDecode (adapterCoder ad) term + let encodeValue v = do + s <- coderEncode (adapterCoder ad) v >>= termToString + return $ TermVariable $ constr s + -- Support three special cases of foreign key types: plain, optional, and list + case stripType (adapterTarget ad) of + TypeOptional (TypeLiteral lit) -> forTypeAndCoder ad (Types.optional elTyp) coder + where + coder = Coder { + coderEncode = \json -> (TermOptional . Just) <$> encodeValue json, + coderDecode = decodeTerm} + TypeList (TypeLiteral lit) -> forTypeAndCoder ad (Types.list elTyp) coder + where + coder = Coder { + coderEncode = \json -> TermList <$> (expectArray json >>= CM.mapM encodeValue), + coderDecode = decodeTerm} + TypeLiteral lit -> forTypeAndCoder ad elTyp coder + where + coder = Coder { + coderEncode = encodeValue, + coderDecode = decodeTerm} + _ -> fail $ "unsupported type annotated as foreign key: " ++ (show $ typeVariant $ adapterTarget ad) + where + forTypeAndCoder ad typ coder = pure $ Adapter (adapterIsLossy ad) (Avro.fieldType f) typ coder + elTyp = TypeVariable name + return (Avro.fieldName f, (f, annotate ann ad)) + Avro.SchemaPrimitive p -> case p of + Avro.PrimitiveNull -> simpleAdapter Types.unit encode decode + where + encode (Json.ValueString s) = pure $ Terms.string s + decode term = Json.ValueString <$> Expect.string term + Avro.PrimitiveBoolean -> simpleAdapter Types.boolean encode decode + where + encode (Json.ValueBoolean b) = pure $ Terms.boolean b + decode term = Json.ValueBoolean <$> Expect.boolean term + Avro.PrimitiveInt -> simpleAdapter Types.int32 encode decode + where + encode (Json.ValueNumber d) = pure $ Terms.int32 $ doubleToInt d + decode term = Json.ValueNumber . fromIntegral <$> Expect.int32 term + Avro.PrimitiveLong -> simpleAdapter Types.int64 encode decode + where + encode (Json.ValueNumber d) = pure $ Terms.int64 $ doubleToInt d + decode term = Json.ValueNumber . fromIntegral <$> Expect.int64 term + Avro.PrimitiveFloat -> simpleAdapter Types.float32 encode decode + where + encode (Json.ValueNumber d) = pure $ Terms.float32 $ realToFrac d + decode term = Json.ValueNumber . realToFrac <$> Expect.float32 term + Avro.PrimitiveDouble -> simpleAdapter Types.float64 encode decode + where + encode (Json.ValueNumber d) = pure $ Terms.float64 d + decode term = Json.ValueNumber <$> Expect.float64 term + Avro.PrimitiveBytes -> simpleAdapter Types.binary encode decode + where + encode (Json.ValueString s) = pure $ Terms.binary s + decode term = Json.ValueString <$> Expect.binary term + Avro.PrimitiveString -> simpleAdapter Types.string encode decode + where + encode (Json.ValueString s) = pure $ Terms.string s + decode term = Json.ValueString <$> Expect.string term + where + doubleToInt d = if d < 0 then ceiling d else floor d + Avro.SchemaReference name -> do + env <- getState + let qname = parseAvroName (avroEnvironmentNamespace env) name + case getAvroHydraAdapter qname env of + Nothing -> fail $ "Referenced Avro type has not been defined: " ++ show qname + ++ ". Defined types: " ++ show (M.keys $ avroEnvironmentNamedAdapters env) + Just ad -> pure ad + Avro.SchemaUnion (Avro.Union schemas) -> if L.length nonNulls > 1 + then fail $ "general-purpose unions are not yet supported: " ++ show schema + else if L.null nonNulls + then fail $ "cannot generate the empty type" + else if hasNull + then forOptional $ L.head nonNulls + else do + ad <- avroHydraAdapter $ L.head nonNulls + return $ Adapter (adapterIsLossy ad) schema (adapterTarget ad) (adapterCoder ad) + where + hasNull = (not . L.null . L.filter isNull) schemas + nonNulls = L.filter (not . isNull) schemas + isNull schema = case schema of + Avro.SchemaPrimitive Avro.PrimitiveNull -> True + _ -> False + forOptional s = do + ad <- avroHydraAdapter s + let coder = Coder { + coderDecode = \(TermOptional ot) -> case ot of + Nothing -> pure $ Json.ValueNull + Just term -> coderDecode (adapterCoder ad) term, + coderEncode = \v -> case v of + Json.ValueNull -> pure $ TermOptional Nothing + _ -> TermOptional . Just <$> coderEncode (adapterCoder ad) v} + return $ Adapter (adapterIsLossy ad) schema (Types.optional $ adapterTarget ad) coder + where + simpleAdapter typ encode decode = pure $ Adapter False schema typ $ Coder encode decode + annotate ann ad = case ann of + Nothing -> ad + Just n -> ad {adapterTarget = Types.annot n (adapterTarget ad)} + +avroNameToHydraName :: AvroQualifiedName -> Name +avroNameToHydraName (AvroQualifiedName mns local) = unqualifyName $ QualifiedName (Namespace <$> mns) local + +-- TODO: use me (for encoding annotations for which the type is not know) or lose me +-- A more robust solution would use jsonCoder together with an expected type +encodeAnnotationValue :: Json.Value -> Term +encodeAnnotationValue v = case v of + Json.ValueArray vals -> Terms.list (encodeAnnotationValue <$> vals) + Json.ValueBoolean b -> Terms.boolean b + Json.ValueNull -> Terms.product [] + Json.ValueNumber d -> Terms.float64 d + -- Note: JSON objects are untyped maps, not records, in that fields are unordered + Json.ValueObject m -> Terms.map $ M.fromList (toEntry <$> M.toList m) + where + toEntry (k, v) = (Terms.string k, encodeAnnotationValue v) + Json.ValueString s -> Terms.string s + +fieldAnnotationsToCore :: Avro.Field -> M.Map Name Term +fieldAnnotationsToCore f = M.fromList (toCore <$> (M.toList $ Avro.fieldAnnotations f)) + where + toCore (k, v) = (Name k, encodeAnnotationValue v) + +namedAnnotationsToCore :: Avro.Named -> M.Map Name Term +namedAnnotationsToCore n = M.fromList (toCore <$> (M.toList $ Avro.namedAnnotations n)) + where + toCore (k, v) = (Name k, encodeAnnotationValue v) + +getAvroHydraAdapter :: AvroQualifiedName -> AvroEnvironment -> Y.Maybe AvroHydraAdapter +getAvroHydraAdapter qname = M.lookup qname . avroEnvironmentNamedAdapters + +foreignKey :: Avro.Field -> Flow s (Maybe ForeignKey) +foreignKey f = case M.lookup avro_foreignKey (Avro.fieldAnnotations f) of + Nothing -> pure Nothing + Just v -> do + m <- expectObject v + tname <- Name <$> requireString "type" m + pattern <- optString "pattern" m + let constr = case pattern of + Nothing -> Name + Just pat -> patternToNameConstructor pat + return $ Just $ ForeignKey tname constr + +patternToNameConstructor :: String -> String -> Name +patternToNameConstructor pat = \s -> Name $ L.intercalate s $ Strings.splitOn "${}" pat + +primaryKey :: Avro.Field -> Flow s (Maybe PrimaryKey) +primaryKey f = do + case M.lookup avro_primaryKey $ Avro.fieldAnnotations f of + Nothing -> pure Nothing + Just v -> do + s <- expectString v + return $ Just $ PrimaryKey (Name $ Avro.fieldName f) $ patternToNameConstructor s + +parseAvroName :: Maybe String -> String -> AvroQualifiedName +parseAvroName mns name = case L.reverse $ Strings.splitOn "." name of + [local] -> AvroQualifiedName mns local + (local:rest) -> AvroQualifiedName (Just $ L.intercalate "." $ L.reverse rest) local + +putAvroHydraAdapter :: AvroQualifiedName -> AvroHydraAdapter -> AvroEnvironment -> AvroEnvironment +putAvroHydraAdapter qname ad env = env {avroEnvironmentNamedAdapters = M.insert qname ad $ avroEnvironmentNamedAdapters env} + +rewriteAvroSchemaM :: ((Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema +rewriteAvroSchemaM f = rewrite fsub f + where + fsub recurse schema = case schema of + Avro.SchemaArray (Avro.Array els) -> Avro.SchemaArray <$> (Avro.Array <$> recurse els) + Avro.SchemaMap (Avro.Map_ vschema) -> Avro.SchemaMap <$> (Avro.Map_ <$> recurse vschema) + Avro.SchemaNamed n -> do + nt <- case Avro.namedType n of + Avro.NamedTypeRecord (Avro.Record fields) -> Avro.NamedTypeRecord <$> (Avro.Record <$> (CM.mapM forField fields)) + t -> pure t + return $ Avro.SchemaNamed $ n {Avro.namedType = nt} + Avro.SchemaUnion (Avro.Union schemas) -> Avro.SchemaUnion <$> (Avro.Union <$> (CM.mapM recurse schemas)) + _ -> pure schema + where + forField f = do + t <- recurse $ Avro.fieldType f + return f {Avro.fieldType = t} + +jsonToString :: Json.Value -> Flow s String +jsonToString v = case v of + Json.ValueBoolean b -> pure $ if b then "true" else "false" + Json.ValueString s -> pure s + Json.ValueNumber d -> pure $ if fromIntegral (round d) == d + then show (round d) + else show d + _ -> unexpected "string, number, or boolean" $ show v + +showQname :: AvroQualifiedName -> String +showQname (AvroQualifiedName mns local) = (Y.maybe "" (\ns -> ns ++ ".") mns) ++ local + +stringToTerm :: Type -> String -> Flow s Term +stringToTerm typ s = case stripType typ of + TypeLiteral lt -> TermLiteral <$> case lt of + LiteralTypeBoolean -> LiteralBoolean <$> doRead s + LiteralTypeInteger it -> LiteralInteger <$> case it of + IntegerTypeBigint -> IntegerValueBigint <$> doRead s + IntegerTypeInt8 -> IntegerValueInt8 <$> doRead s + IntegerTypeInt16 -> IntegerValueInt16 <$> doRead s + IntegerTypeInt32 -> IntegerValueInt32 <$> doRead s + IntegerTypeInt64 -> IntegerValueInt64 <$> doRead s + IntegerTypeUint8 -> IntegerValueUint8 <$> doRead s + IntegerTypeUint16 -> IntegerValueUint16 <$> doRead s + IntegerTypeUint32 -> IntegerValueUint32 <$> doRead s + IntegerTypeUint64 -> IntegerValueUint64 <$> doRead s + LiteralTypeString -> LiteralString <$> pure s + _ -> unexpected "literal type" $ show lt + where + doRead s = case TR.readEither s of + Left msg -> fail $ "failed to read value: " ++ msg + Right term -> pure term + +termToString :: Term -> Flow s String +termToString term = case stripTerm term of + TermLiteral l -> case l of + LiteralBoolean b -> pure $ show b + LiteralInteger iv -> pure $ case iv of + IntegerValueBigint i -> show i + IntegerValueInt8 i -> show i + IntegerValueInt16 i -> show i + IntegerValueInt32 i -> show i + IntegerValueInt64 i -> show i + IntegerValueUint8 i -> show i + IntegerValueUint16 i -> show i + IntegerValueUint32 i -> show i + IntegerValueUint64 i -> show i + LiteralString s -> pure s + _ -> unexpected "boolean, integer, or string" $ show l + TermOptional (Just term') -> termToString term' + _ -> unexpected "literal value" $ show term diff --git a/src/main/haskell/Hydra/Ext/Avro/Language.hs b/src/main/haskell/Hydra/Ext/Avro/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Avro/Language.hs @@ -0,0 +1,32 @@ +module Hydra.Ext.Avro.Language where + +import Hydra.Kernel + +import qualified Data.Set as S + + +avroLanguage :: Language +avroLanguage = Language (LanguageName "hydra/ext/avro") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.empty, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBinary, LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString], + languageConstraintsFloatTypes = S.fromList [FloatTypeFloat32, FloatTypeFloat64], + languageConstraintsFunctionVariants = S.empty, + languageConstraintsIntegerTypes = S.fromList [IntegerTypeInt32, IntegerTypeInt64], + languageConstraintsTermVariants = S.fromList [ + TermVariantList, + TermVariantLiteral, + TermVariantMap, + TermVariantOptional, + TermVariantRecord], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantAnnotated, + TypeVariantList, + TypeVariantLiteral, + TypeVariantMap, + TypeVariantWrap, + TypeVariantOptional, + TypeVariantRecord], + languageConstraintsTypes = \typ -> case stripType typ of + TypeOptional (TypeOptional _) -> False + _ -> True } diff --git a/src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs b/src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs @@ -0,0 +1,166 @@ +module Hydra.Ext.Avro.SchemaJson where + +import Hydra.Kernel +import Hydra.Ext.Json.Serde +import Hydra.Ext.Json.Eliminate +import qualified Hydra.Ext.Org.Apache.Avro.Schema as Avro +import qualified Hydra.Json as Json + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +avro_aliases = "aliases" +avro_array = "array" +avro_ascending = "ascending" +avro_boolean = "boolean" +avro_bytes = "bytes" +avro_default = "default" +avro_descending = "descending" +avro_doc = "doc" +avro_double = "double" +avro_enum = "enum" +avro_fields = "fields" +avro_fixed = "fixed" +avro_float = "float" +avro_ignore = "ignore" +avro_int = "int" +avro_items = "items" +avro_long = "long" +avro_map = "map" +avro_name = "name" +avro_namespace = "namespace" +avro_null = "null" +avro_order = "order" +avro_record = "record" +avro_size = "size" +avro_string = "string" +avro_symbols = "symbols" +avro_type = "type" +avro_values = "values" + +avroSchemaJsonCoder :: Coder s s Avro.Schema Json.Value +avroSchemaJsonCoder = Coder { + coderEncode = \schema -> fail "not implemented", + coderDecode = decodeNamedSchema} + +avroSchemaStringCoder :: Coder s s Avro.Schema String +avroSchemaStringCoder = Coder { + coderEncode = \schema -> jsonValueToString <$> coderEncode avroSchemaJsonCoder schema, + coderDecode = \s -> do + json <- case stringToJsonValue s of + Left msg -> fail $ "failed to parse JSON: " ++ msg + Right j -> pure j + coderDecode avroSchemaJsonCoder json} + +decodeAliases :: M.Map String Json.Value -> Flow s (Maybe [String]) +decodeAliases m = do + aliasesJson <- optArray avro_aliases m + case aliasesJson of + Nothing -> pure Nothing + Just a -> Just <$> CM.mapM expectString a + +decodeEnum :: M.Map String Json.Value -> Flow s Avro.NamedType +decodeEnum m = do + symbolsJson <- requireArray avro_symbols m + symbols <- CM.mapM expectString symbolsJson + dflt <- optString avro_default m + return $ Avro.NamedTypeEnum $ Avro.Enum_ symbols dflt + +decodeField :: M.Map String Json.Value -> Flow s Avro.Field +decodeField m = do + fname <- requireString avro_name m + doc <- optString avro_doc m + typ <- require avro_type m >>= decodeSchema + let dflt = opt avro_default m + order <- case opt avro_order m of + Nothing -> pure Nothing + Just o -> Just <$> (expectString o >>= decodeOrder) + aliases <- decodeAliases m + let anns = getAnnotations m + return $ Avro.Field fname doc typ dflt order aliases anns + +decodeFixed :: M.Map String Json.Value -> Flow s Avro.NamedType +decodeFixed m = do + size <- doubleToInt <$> requireNumber avro_size m + return $ Avro.NamedTypeFixed $ Avro.Fixed size + where + doubleToInt d = if d < 0 then ceiling d else floor d + +decodeNamedSchema :: Json.Value -> Flow s Avro.Schema +decodeNamedSchema value = do + m <- expectObject value + name <- requireString avro_name m + ns <- optString avro_namespace m + typ <- requireString avro_type m + nt <- case M.lookup typ decoders of + Nothing -> unexpected "Avro type" $ show typ + Just d -> d m + aliases <- decodeAliases m + doc <- optString avro_doc m + let anns = getAnnotations m + return $ Avro.SchemaNamed $ Avro.Named name ns aliases doc nt anns + where + decoders = M.fromList [ + (avro_enum, decodeEnum), + (avro_fixed, decodeFixed), + (avro_record, decodeRecord)] + +decodeOrder :: String -> Flow s Avro.Order +decodeOrder o = case M.lookup o orderMap of + Nothing -> unexpected "ordering" $ show o + Just order -> pure order + where + orderMap = M.fromList [ + (avro_ascending, Avro.OrderAscending), + (avro_descending, Avro.OrderDescending), + (avro_ignore, Avro.OrderIgnore)] + +decodeRecord :: M.Map String Json.Value -> Flow s Avro.NamedType +decodeRecord m = do + fields <- requireArray avro_fields m >>= CM.mapM expectObject >>= CM.mapM decodeField + return $ Avro.NamedTypeRecord $ Avro.Record fields + +decodeSchema :: Json.Value -> Flow s Avro.Schema +decodeSchema v = case v of + Json.ValueArray els -> Avro.SchemaUnion <$> (Avro.Union <$> (CM.mapM decodeSchema els)) + Json.ValueObject m -> do + typ <- requireString avro_type m + case M.lookup typ decoders of + Nothing -> unexpected "\"array\" or \"map\"" $ show typ + Just d -> d m + where + decoders = M.fromList [ + (avro_array, \m -> do + items <- require avro_items m >>= decodeSchema + return $ Avro.SchemaArray $ Avro.Array items), + (avro_enum, \m -> decodeNamedSchema $ Json.ValueObject m), + (avro_fixed, \m -> decodeNamedSchema $ Json.ValueObject m), + (avro_map, \m -> do + values <- require avro_values m >>= decodeSchema + return $ Avro.SchemaMap $ Avro.Map_ values), + (avro_record, \m -> decodeNamedSchema $ Json.ValueObject m)] + Json.ValueString s -> pure $ case M.lookup s schemas of + Just prim -> Avro.SchemaPrimitive prim + Nothing -> Avro.SchemaReference s + where + schemas = M.fromList [ + (avro_boolean, Avro.PrimitiveBoolean), + (avro_bytes, Avro.PrimitiveBytes), + (avro_double, Avro.PrimitiveDouble), + (avro_float, Avro.PrimitiveFloat), + (avro_int, Avro.PrimitiveInt), + (avro_long, Avro.PrimitiveLong), + (avro_null, Avro.PrimitiveNull), + (avro_string, Avro.PrimitiveString)] + Json.ValueNull -> pure $ Avro.SchemaPrimitive $ Avro.PrimitiveNull + _ -> unexpected "JSON array, object, or string" $ show v + +getAnnotations :: M.Map String Json.Value -> M.Map String Json.Value +getAnnotations = M.fromList . Y.catMaybes . fmap toPair . M.toList + where + toPair (k, v) = if L.take 1 k == "@" + then Just (L.drop 1 k, v) + else Nothing diff --git a/src/main/haskell/Hydra/Ext/Graphql/Coder.hs b/src/main/haskell/Hydra/Ext/Graphql/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Graphql/Coder.hs @@ -0,0 +1,164 @@ +module Hydra.Ext.Graphql.Coder (moduleToGraphql) where + +import Hydra.Kernel +import Hydra.Ext.Graphql.Language +import Hydra.Ext.Graphql.Serde +import qualified Hydra.Ext.Org.Graphql.Syntax as G +import Hydra.Tools.Serialization +import Hydra.Tools.Formatting + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +type Prefixes = M.Map Namespace String + +moduleToGraphql :: Module -> Flow (Graph) (M.Map FilePath String) +moduleToGraphql mod = do + files <- moduleToGraphqlSchemas mod + return $ M.fromList (mapPair <$> M.toList files) + where + mapPair (path, sf) = (path, printExpr $ parenthesize $ exprDocument sf) + +moduleToGraphqlSchemas :: Module -> Flow (Graph) (M.Map FilePath G.Document) +moduleToGraphqlSchemas mod = transformModule graphqlLanguage encodeTerm constructModule mod + +constructModule :: Module + -> M.Map (Type) (Coder (Graph) (Graph) (Term) ()) + -> [(Element, TypedTerm)] + -> Flow (Graph) (M.Map FilePath G.Document) +constructModule mod coders pairs = do + -- Gather all dependencies because GraphQL does not support imports (in a standard way) + withDeps <- elementsWithDependencies $ fst <$> pairs + -- Qualify the names of dependencies with prefixes, so as to avoid name collisions + let prefixes = findPrefixes withDeps + -- Elements to GraphQL type definitions + tdefs <- CM.mapM (toTypeDef prefixes) withDeps + let doc = G.Document $ (G.DefinitionTypeSystem . G.TypeSystemDefinitionOrExtensionDefinition . G.TypeSystemDefinitionType) <$> tdefs + return $ M.fromList [(filePath, doc)] + where + filePath = namespaceToFilePath False (FileExtension "graphql") (moduleNamespace mod) + findPrefixes els = M.fromList $ toPair <$> namespaces + where + namespaces = L.nub $ (Y.fromJust . namespaceOfEager . elementName) <$> els + toPair ns = (ns, if ns == moduleNamespace mod then "" else (sanitizeWithUnderscores S.empty (unNamespace ns)) ++ "_") + toTypeDef prefixes el = do + typ <- requireTermType (elementData el) + if isType typ + then coreDecodeType (elementData el) >>= encodeNamedType prefixes el + else fail $ "mapping of non-type elements to GraphQL is not yet supported: " ++ unName (elementName el) + +descriptionFromType :: Type -> Flow (Graph) (Maybe G.Description) +descriptionFromType typ = do + mval <- getTypeDescription typ + return $ G.Description . G.StringValue <$> mval + +encodeEnumFieldType :: FieldType -> Flow (Graph) G.EnumValueDefinition +encodeEnumFieldType ft = do + desc <- descriptionFromType $ fieldTypeType ft + return G.EnumValueDefinition { + G.enumValueDefinitionDescription = desc, + G.enumValueDefinitionEnumValue = encodeEnumFieldName $ fieldTypeName ft, + G.enumValueDefinitionDirectives = Nothing} + +encodeEnumFieldName :: Name -> G.EnumValue +encodeEnumFieldName = G.EnumValue . G.Name . sanitize . unName + +encodeFieldName :: Name -> G.Name +encodeFieldName = G.Name . sanitize . unName + +encodeFieldType :: Prefixes -> FieldType -> Flow (Graph) G.FieldDefinition +encodeFieldType prefixes ft = do + gtype <- encodeType prefixes $ fieldTypeType ft + desc <- descriptionFromType $ fieldTypeType ft + return G.FieldDefinition { + G.fieldDefinitionDescription = desc, + G.fieldDefinitionName = encodeFieldName $ fieldTypeName ft, + G.fieldDefinitionArgumentsDefinition = Nothing, + G.fieldDefinitionType = gtype, + G.fieldDefinitionDirectives = Nothing} + +encodeLiteralType :: LiteralType -> Flow (Graph) G.NamedType +encodeLiteralType lt = G.NamedType . G.Name <$> case lt of + LiteralTypeBoolean -> pure "Boolean" + LiteralTypeFloat ft -> case ft of + FloatTypeFloat64 -> pure "Float" + _ -> unexpected "64-bit float type" $ show ft + LiteralTypeInteger it -> case it of + IntegerTypeInt32 -> pure "Int" + _ -> unexpected "32-bit signed integer type" $ show it + LiteralTypeString -> pure "String" + _ -> unexpected "GraphQL-compatible literal type" $ show lt + +encodeNamedType :: Prefixes -> Element -> Type -> Flow (Graph) G.TypeDefinition +encodeNamedType prefixes el typ = do + g <- getState + let cx = AdapterContext g graphqlLanguage M.empty + ad <- withState cx $ termAdapter typ + case stripType (adapterTarget ad) of + TypeRecord rt -> do + gfields <- CM.mapM (encodeFieldType prefixes) $ rowTypeFields rt + desc <- descriptionFromType typ + return $ G.TypeDefinitionObject $ G.ObjectTypeDefinition { + G.objectTypeDefinitionDescription = desc, + G.objectTypeDefinitionName = encodeTypeName prefixes $ elementName el, + G.objectTypeDefinitionImplementsInterfaces = Nothing, + G.objectTypeDefinitionDirectives = Nothing, + G.objectTypeDefinitionFieldsDefinition = Just $ G.FieldsDefinition gfields} + TypeUnion rt -> do + values <- CM.mapM encodeEnumFieldType $ rowTypeFields rt + desc <- descriptionFromType typ + return $ G.TypeDefinitionEnum $ G.EnumTypeDefinition { + G.enumTypeDefinitionDescription = desc, + G.enumTypeDefinitionName = encodeTypeName prefixes $ elementName el, + G.enumTypeDefinitionDirectives = Nothing, + G.enumTypeDefinitionEnumValuesDefinition = Just $ G.EnumValuesDefinition values} + TypeList _ -> wrapAsRecord + TypeLiteral _ -> wrapAsRecord + TypeVariable _ -> wrapAsRecord + t -> unexpected "record or union type" $ show t + where + wrapAsRecord = encodeNamedType prefixes el $ TypeRecord $ RowType (elementName el) [ + FieldType (Name "value") typ] + +encodeTerm :: Term -> Flow (Graph) () +encodeTerm term = fail "not yet implemented" + +encodeType :: Prefixes -> Type -> Flow (Graph) G.Type +encodeType prefixes typ = case stripType typ of + TypeOptional et -> case stripType et of + TypeList et -> G.TypeList . G.ListType <$> encodeType prefixes et + TypeLiteral lt -> G.TypeNamed <$> encodeLiteralType lt + TypeRecord rt -> forRowType rt + TypeUnion rt -> forRowType rt +-- TypeWrap name -> forName name + TypeVariable name -> forName name + t -> unexpected "GraphQL-compatible type" $ show t + where + forName = pure . G.TypeNamed . G.NamedType . encodeTypeName prefixes + forRowType = forName . rowTypeTypeName + t -> G.TypeNonNull <$> nonnull t + where + nonnull t = case stripType t of + TypeList et -> G.NonNullTypeList . G.ListType <$> encodeType prefixes et + TypeLiteral lt -> G.NonNullTypeNamed <$> encodeLiteralType lt + TypeRecord rt -> forRowType rt + TypeUnion rt -> forRowType rt + TypeVariable name -> forName name +-- TypeWrap name -> forName name + _ -> unexpected "GraphQL-compatible non-null type" $ show t + where + forName = pure . G.NonNullTypeNamed . G.NamedType . encodeTypeName prefixes + forRowType = forName . rowTypeTypeName + +encodeTypeName :: Prefixes -> Name -> G.Name +encodeTypeName prefixes name = G.Name $ (prefix ++ sanitize local) + where + prefix = Y.fromMaybe "UNKNOWN" $ M.lookup ns prefixes + QualifiedName (Just ns) local = qualifyNameEager name + +sanitize :: String -> String +sanitize = sanitizeWithUnderscores graphqlReservedWords diff --git a/src/main/haskell/Hydra/Ext/Graphql/Language.hs b/src/main/haskell/Hydra/Ext/Graphql/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Graphql/Language.hs @@ -0,0 +1,51 @@ +module Hydra.Ext.Graphql.Language where + +import Hydra.Kernel + +import qualified Data.List as L +import qualified Data.Set as S + + +graphqlLanguage :: Language +graphqlLanguage = Language (LanguageName "hydra/ext/graphql") $ LanguageConstraints { + -- Note: this language is for schemas and data only; support for queries may be added later + languageConstraintsEliminationVariants = S.empty, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBoolean, -- Boolean + LiteralVariantFloat, -- Float + LiteralVariantInteger, -- Int + LiteralVariantString], -- String + languageConstraintsFloatTypes = S.fromList [ + FloatTypeFloat64], -- Float + languageConstraintsFunctionVariants = S.empty, + languageConstraintsIntegerTypes = S.fromList [ + IntegerTypeInt32], -- Int + languageConstraintsTermVariants = S.fromList [ + TermVariantList, + TermVariantLiteral, + TermVariantOptional, + TermVariantRecord, + TermVariantUnion], -- Unions are supported only in the form of enums + languageConstraintsTypeVariants = S.fromList [ + TypeVariantList, + TypeVariantLiteral, + TypeVariantWrap, + TypeVariantOptional, + TypeVariantRecord, + TypeVariantUnion, -- Unions are supported only in the form of enums + TypeVariantVariable], + languageConstraintsTypes = \typ -> case stripType typ of + -- If it is a union type, make sure it can be treated as an enum. + TypeUnion rt -> L.foldl (\b f -> b && isEnumField f) True $ rowTypeFields rt + where + isUnitType t = case stripType t of + TypeRecord (RowType name fields) -> L.null fields || name == _Unit + _ -> False + isEnumField = isUnitType . fieldTypeType + TypeOptional et -> case stripType et of + TypeOptional _ -> False -- No encoding for optionals within optionals + _ -> True + _ -> True} + +graphqlReservedWords :: S.Set String +graphqlReservedWords = S.fromList ["true", "false"] diff --git a/src/main/haskell/Hydra/Ext/Graphql/Serde.hs b/src/main/haskell/Hydra/Ext/Graphql/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Graphql/Serde.hs @@ -0,0 +1,106 @@ +module Hydra.Ext.Graphql.Serde (exprDocument) where + +import Hydra.Tools.Serialization +import Hydra.Tools.Formatting +import qualified Hydra.Ast as CT +import qualified Hydra.Ext.Org.Graphql.Syntax as G + +import qualified Data.List as L +import qualified Data.Maybe as Y + + +commentDelim = cst "\"\"\"" :: CT.Expr + +exprDefinition :: G.Definition -> CT.Expr +exprDefinition def = case def of + G.DefinitionExecutable _ -> unsup def + G.DefinitionTypeSystem de -> exprTypeSystemDefinitionOrExtension de + +exprDescription :: G.Description -> CT.Expr +exprDescription desc = newlineSep [ + commentDelim, + cst $ G.unStringValue $ G.unDescription desc, + commentDelim] + +exprDocument :: G.Document -> CT.Expr +exprDocument d = doubleNewlineSep (exprDefinition <$> G.unDocument d) + +exprEnumTypeDefinition :: G.EnumTypeDefinition -> CT.Expr +exprEnumTypeDefinition def = withDescription (G.enumTypeDefinitionDescription def) $ + spaceSep [cst "enum", exprName (G.enumTypeDefinitionName def), + curlyBracesList Nothing fullBlockStyle valuesExpr] + where + valuesExpr = case G.enumTypeDefinitionEnumValuesDefinition def of + Nothing -> [] + Just values -> exprEnumValueDefinition <$> G.unEnumValuesDefinition values + +exprEnumValue :: G.EnumValue -> CT.Expr +exprEnumValue = exprName . G.unEnumValue + +exprEnumValueDefinition :: G.EnumValueDefinition -> CT.Expr +exprEnumValueDefinition def = withDescription (G.enumValueDefinitionDescription def) $ + exprEnumValue $ G.enumValueDefinitionEnumValue def + +exprFieldDefinition :: G.FieldDefinition -> CT.Expr +exprFieldDefinition def = withDescription (G.fieldDefinitionDescription def) $ + spaceSep [namePart, typePart] + where + namePart = noSep[exprName (G.fieldDefinitionName def), cst ":"] + typePart = exprType $ G.fieldDefinitionType def + +exprListType :: G.ListType -> CT.Expr +exprListType lt = noSep[cst "[", exprType $ G.unListType lt, cst "]"] + +exprName :: G.Name -> CT.Expr +exprName = cst . G.unName + +exprNamedType :: G.NamedType -> CT.Expr +exprNamedType = exprName . G.unNamedType + +exprNonNullType :: G.NonNullType -> CT.Expr +exprNonNullType nnt = noSep [typeExpr, cst "!"] + where + typeExpr = case nnt of + G.NonNullTypeNamed nt -> exprNamedType nt + G.NonNullTypeList lt -> exprListType lt + +exprObjectTypeDefinition :: G.ObjectTypeDefinition -> CT.Expr +exprObjectTypeDefinition def = withDescription (G.objectTypeDefinitionDescription def) $ + spaceSep [cst "type", exprName (G.objectTypeDefinitionName def), + curlyBracesList Nothing fullBlockStyle fieldsExpr] + where + fieldsExpr = case G.objectTypeDefinitionFieldsDefinition def of + Nothing -> [] + Just fields -> exprFieldDefinition <$> G.unFieldsDefinition fields + +exprType :: G.Type -> CT.Expr +exprType typ = case typ of + G.TypeNamed nt -> exprNamedType nt + G.TypeList lt -> exprListType lt + G.TypeNonNull nnt -> exprNonNullType nnt + +exprTypeDefinition :: G.TypeDefinition -> CT.Expr +exprTypeDefinition def = case def of + G.TypeDefinitionScalar _ -> unsup def + G.TypeDefinitionObject od -> exprObjectTypeDefinition od + G.TypeDefinitionInterface _ -> unsup def + G.TypeDefinitionUnion _ -> unsup def + G.TypeDefinitionEnum ed -> exprEnumTypeDefinition ed + G.TypeDefinitionInputObject _ -> unsup def + +exprTypeSystemDefinition :: G.TypeSystemDefinition -> CT.Expr +exprTypeSystemDefinition def = case def of + G.TypeSystemDefinitionSchema _ -> unsup def + G.TypeSystemDefinitionType dt -> exprTypeDefinition dt + G.TypeSystemDefinitionDirective _ -> unsup def + +exprTypeSystemDefinitionOrExtension :: G.TypeSystemDefinitionOrExtension -> CT.Expr +exprTypeSystemDefinitionOrExtension de = case de of + G.TypeSystemDefinitionOrExtensionDefinition d -> exprTypeSystemDefinition d + G.TypeSystemDefinitionOrExtensionExtension _ -> unsup de + +unsup :: Show x => x -> CT.Expr +unsup obj = cst $ "Unsupported: " ++ show obj + +withDescription :: Maybe G.Description -> CT.Expr -> CT.Expr +withDescription mdesc expr = newlineSep $ Y.catMaybes [exprDescription <$> mdesc, Y.Just expr] diff --git a/src/main/haskell/Hydra/Ext/Haskell/Coder.hs b/src/main/haskell/Hydra/Ext/Haskell/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Haskell/Coder.hs @@ -0,0 +1,417 @@ +module Hydra.Ext.Haskell.Coder (moduleToHaskell) where + +import Hydra.Kernel +import Hydra.Adapters +import Hydra.Ext.Haskell.Language +import Hydra.Ext.Haskell.Utils +import Hydra.Dsl.Terms +import Hydra.Tools.Serialization +import Hydra.Ext.Haskell.Serde +import Hydra.Ext.Haskell.Settings +import qualified Hydra.Ext.Haskell.Ast as H +import qualified Hydra.Lib.Strings as Strings +import qualified Hydra.Dsl.Types as Types +import Hydra.Dsl.ShorthandTypes +import Hydra.Lib.Io +import qualified Hydra.Decode as Decode + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Hydra.Rewriting (removeTypeAnnotations, removeTermAnnotations) + + +data HaskellGenerationOptions = HaskellGenerationOptions { + haskellGenerationOptionsIncludeTypeDefinitions :: Bool +} + +key_haskellVar = Name "haskellVar" + +-- TODO: make these settings configurable +defaultHaskellGenerationOptions = HaskellGenerationOptions False + +adaptTypeToHaskellAndEncode :: Namespaces -> Type -> Flow Graph H.Type +adaptTypeToHaskellAndEncode namespaces = adaptAndEncodeType haskellLanguage (encodeType namespaces) + +constantForFieldName tname fname = "_" ++ localNameOfEager tname ++ "_" ++ unName fname +constantForTypeName tname = "_" ++ localNameOfEager tname + +constructModule :: Namespaces + -> Module + -> M.Map Type (Coder Graph Graph Term H.Expression) + -> [(Element, TypedTerm)] -> Flow Graph H.Module +constructModule namespaces mod coders pairs = do + g <- getState + decls <- L.concat <$> CM.mapM (createDeclarations g) pairs + let mc = moduleDescription mod + return $ H.Module (Just $ H.ModuleHead mc (importName $ h $ moduleNamespace mod) []) imports decls + where + h (Namespace name) = name + + createDeclarations g pair@(el, TypedTerm term typ) = do + if isType typ + then toTypeDeclarations namespaces el term + else do + d <- toDataDeclaration coders namespaces pair + return [d] + + importName name = H.ModuleName $ L.intercalate "." (capitalize <$> Strings.splitOn "/" name) + imports = domainImports ++ standardImports + where + domainImports = toImport <$> M.toList (namespacesMapping namespaces) + where + toImport (Namespace name, alias) = H.Import True (importName name) (Just alias) Nothing + standardImports = toImport <$> [ + ("Data.Int", Nothing), + ("Data.List", Just "L"), + ("Data.Map", Just "M"), + ("Data.Set", Just "S")] + where + toImport (name, alias) = H.Import False (H.ModuleName name) (H.ModuleName <$> alias) Nothing + +encodeFunction :: Namespaces -> Function -> Flow Graph H.Expression +encodeFunction namespaces fun = case fun of + FunctionElimination e -> case e of + EliminationList fun -> do + let lhs = hsvar "L.foldl" + rhs <- encodeTerm namespaces fun + return $ hsapp lhs rhs + EliminationWrap name -> pure $ H.ExpressionVariable $ elementReference namespaces $ + qname (Y.fromJust $ namespaceOfEager name) $ newtypeAccessorName name + EliminationOptional (OptionalCases nothing just) -> do + nothingRhs <- H.CaseRhs <$> encodeTerm namespaces nothing + let nothingAlt = H.Alternative (H.PatternName $ rawName "Nothing") nothingRhs Nothing + justAlt <- do + -- Note: some of the following could be brought together with FunctionCases + v0 <- (\i -> "v" ++ show i) <$> nextCount key_haskellVar + let rhsTerm = simplifyTerm $ apply just (var v0) + let v1 = if S.member (Name v0) $ freeVariablesInTerm rhsTerm then v0 else ignoredVariable + let lhs = applicationPattern (rawName "Just") [H.PatternName $ rawName v1] + rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm + return $ H.Alternative lhs rhs Nothing + return $ hslambda "x" $ H.ExpressionCase $ H.Expression_Case (hsvar "x") [nothingAlt, justAlt] + EliminationProduct (TupleProjection arity idx) -> if arity == 2 + then return $ hsvar $ if idx == 0 then "fst" else "snd" + else fail "Eliminations for tuples of arity > 2 are not supported yet in the Haskell coder" + EliminationRecord (Projection dn fname) -> return $ H.ExpressionVariable $ recordFieldReference namespaces dn fname + EliminationUnion (CaseStatement dn def fields) -> hslambda "x" <$> caseExpr -- note: could use a lambda case here + where + caseExpr = do + rt <- withSchemaContext $ requireUnionType dn + let fieldMap = M.fromList $ (\f -> (fieldTypeName f, f)) <$> rowTypeFields rt + ecases <- CM.mapM (toAlt fieldMap) fields + dcases <- case def of + Nothing -> pure [] + Just d -> do + cs <- H.CaseRhs <$> encodeTerm namespaces d + let lhs = H.PatternName $ rawName ignoredVariable + return [H.Alternative lhs cs Nothing] + return $ H.ExpressionCase $ H.Expression_Case (hsvar "x") $ ecases ++ dcases + toAlt fieldMap (Field fn fun') = do + v0 <- (\i -> "v" ++ show i) <$> nextCount key_haskellVar + let raw = apply fun' (var v0) + let rhsTerm = simplifyTerm raw + let v1 = if isFreeIn (Name v0) rhsTerm then ignoredVariable else v0 + let hname = unionFieldReference namespaces dn fn + args <- case M.lookup fn fieldMap of + Just (FieldType _ ft) -> case stripType ft of + TypeRecord (RowType _ []) -> pure [] + _ -> pure [H.PatternName $ rawName v1] + Nothing -> fail $ "field " ++ show fn ++ " not found in " ++ show dn + let lhs = applicationPattern hname args + rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm + return $ H.Alternative lhs rhs Nothing + FunctionLambda (Lambda (Name v) _ body) -> hslambda v <$> encodeTerm namespaces body + FunctionPrimitive name -> pure $ H.ExpressionVariable $ hsPrimitiveReference name + +encodeLiteral :: Literal -> Flow Graph H.Expression +encodeLiteral av = case av of + LiteralBoolean b -> pure $ hsvar $ if b then "True" else "False" + LiteralFloat fv -> case fv of + FloatValueFloat32 f -> pure $ hslit $ H.LiteralFloat f + FloatValueFloat64 f -> pure $ hslit $ H.LiteralDouble f + _ -> unexpected "floating-point number" $ show fv + LiteralInteger iv -> case iv of + IntegerValueBigint i -> pure $ hslit $ H.LiteralInteger i + IntegerValueInt32 i -> pure $ hslit $ H.LiteralInt i + _ -> unexpected "integer" $ show iv + LiteralString s -> pure $ hslit $ H.LiteralString s + _ -> unexpected "literal value" $ show av + +encodeTerm :: Namespaces -> Term -> Flow Graph H.Expression +encodeTerm namespaces term = do + case fullyStripTerm term of + TermApplication (Application fun arg) -> hsapp <$> encode fun <*> encode arg + TermFunction f -> encodeFunction namespaces f + TermLet (Let bindings env) -> do + hbindings <- CM.mapM encodeBinding bindings + hinner <- encode env + return $ H.ExpressionLet $ H.Expression_Let hbindings hinner + where + encodeBinding (LetBinding name term _) = do + let hname = simpleName $ unName name + hexpr <- encode term + return $ H.LocalBindingValue $ simpleValueBinding hname hexpr Nothing + TermList els -> H.ExpressionList <$> CM.mapM encode els + TermLiteral v -> encodeLiteral v + TermWrap (WrappedTerm tname term') -> if newtypesNotTypedefs + then hsapp <$> pure (H.ExpressionVariable $ elementReference namespaces tname) <*> encode term' + else encode term' + TermOptional m -> case m of + Nothing -> pure $ hsvar "Nothing" + Just t -> hsapp (hsvar "Just") <$> encode t + TermProduct terms -> H.ExpressionTuple <$> (CM.mapM encode terms) + TermRecord (Record sname fields) -> do + if L.null fields -- TODO: too permissive; not all empty record types are the unit type + then pure $ H.ExpressionTuple [] + else do + let typeName = elementReference namespaces sname + updates <- CM.mapM toFieldUpdate fields + return $ H.ExpressionConstructRecord $ H.Expression_ConstructRecord typeName updates + where + toFieldUpdate (Field fn ft) = H.FieldUpdate (recordFieldReference namespaces sname fn) <$> encode ft + TermUnion (Injection sname (Field fn ft)) -> do + let lhs = H.ExpressionVariable $ unionFieldReference namespaces sname fn + case fullyStripTerm ft of + TermRecord (Record _ []) -> pure lhs + _ -> hsapp lhs <$> encode ft + TermVariable name -> pure $ H.ExpressionVariable $ elementReference namespaces name --pure $ hsvar v + t -> fail $ "unexpected term: " ++ show t + where + encode = encodeTerm namespaces + +encodeType :: Namespaces -> Type -> Flow Graph H.Type +encodeType namespaces typ = withTrace "encode type" $ case stripType typ of + TypeApplication (ApplicationType lhs rhs) -> toTypeApplication <$> CM.sequence [encode lhs, encode rhs] + TypeFunction (FunctionType dom cod) -> H.TypeFunction <$> (H.Type_Function <$> encode dom <*> encode cod) + TypeLambda (LambdaType (Name v) body) -> toTypeApplication <$> CM.sequence [ + encode body, + pure $ H.TypeVariable $ simpleName v] + TypeList lt -> H.TypeList <$> encode lt + TypeLiteral lt -> H.TypeVariable . rawName <$> case lt of + LiteralTypeBoolean -> pure "Bool" + LiteralTypeFloat ft -> case ft of + FloatTypeFloat32 -> pure "Float" + FloatTypeFloat64 -> pure "Double" + FloatTypeBigfloat -> pure "Double" -- TODO: type adapter should prevent this +-- _ -> fail $ "unexpected floating-point type: " ++ show ft + LiteralTypeInteger it -> case it of + IntegerTypeBigint -> pure "Integer" + IntegerTypeInt8 -> pure "Int8" + IntegerTypeInt16 -> pure "Int16" + IntegerTypeInt32 -> pure "Int" + IntegerTypeInt64 -> pure "Int64" + _ -> fail $ "unexpected integer type: " ++ show it + LiteralTypeString -> pure "String" + _ -> fail $ "unexpected literal type: " ++ show lt + TypeMap (MapType kt vt) -> toTypeApplication <$> CM.sequence [ + pure $ H.TypeVariable $ rawName "Map", + encode kt, + encode vt] + TypeOptional ot -> toTypeApplication <$> CM.sequence [ + pure $ H.TypeVariable $ rawName "Maybe", + encode ot] + TypeProduct types -> H.TypeTuple <$> (CM.mapM encode types) + TypeRecord rt -> case rowTypeFields rt of + [] -> pure $ H.TypeTuple [] -- TODO: too permissive; not all empty record types are the unit type + _ -> ref $ rowTypeTypeName rt + TypeSet st -> toTypeApplication <$> CM.sequence [ + pure $ H.TypeVariable $ rawName "Set", + encode st] + TypeUnion rt -> ref $ rowTypeTypeName rt + TypeVariable v -> ref v + TypeWrap (WrappedType name _) -> ref name + _ -> fail $ "unexpected type: " ++ show typ + where + encode = encodeType namespaces + ref name = pure $ H.TypeVariable $ elementReference namespaces name + +encodeTypeWithClassAssertions :: Namespaces -> M.Map Name (S.Set TypeClass) -> Type -> Flow Graph H.Type +encodeTypeWithClassAssertions namespaces classes typ = withTrace "encode with assertions" $ do + htyp <- adaptTypeToHaskellAndEncode namespaces typ + if L.null assertPairs + then pure htyp + else do + let encoded = encodeAssertion <$> assertPairs + let hassert = if L.length encoded > 1 then L.head encoded else H.AssertionTuple encoded + return $ H.TypeCtx $ H.Type_Context hassert htyp + where + encodeAssertion (name, cls) = H.AssertionClass $ H.Assertion_Class hname [htype] + where + hname = rawName $ case cls of + TypeClassEquality -> "Eq" + TypeClassOrdering -> "Ord" + htype = H.TypeVariable $ rawName $ unName name -- TODO: sanitization + + assertPairs = L.concat (toPairs <$> M.toList classes) + where + toPairs (name, cls) = toPair <$> S.toList cls + where + toPair c = (name, c) + +moduleToHaskellModule :: Module -> Flow Graph H.Module +moduleToHaskellModule mod = do + namespaces <- namespacesForModule mod + transformModule haskellLanguage (encodeTerm namespaces) (constructModule namespaces) mod + +moduleToHaskell :: Module -> Flow Graph (M.Map FilePath String) +moduleToHaskell mod = do + hsmod <- moduleToHaskellModule mod + let s = printExpr $ parenthesize $ toTree hsmod + return $ M.fromList [(namespaceToFilePath True (FileExtension "hs") $ moduleNamespace mod, s)] + +nameDecls :: Graph -> Namespaces -> Name -> Type -> [H.DeclarationWithComments] +nameDecls g namespaces name@(Name nm) typ = if useCoreImport + then (toDecl _Name nameDecl):(toDecl _Name <$> fieldDecls) + else [] + where + toDecl n (k, v) = H.DeclarationWithComments decl Nothing + where + decl = H.DeclarationValueBinding $ H.ValueBindingSimple $ H.ValueBinding_Simple pat rhs Nothing + pat = applicationPattern (simpleName k) [] + rhs = H.RightHandSide $ H.ExpressionApplication $ H.Expression_Application + (H.ExpressionVariable $ elementReference namespaces n) + (H.ExpressionLiteral $ H.LiteralString v) + nameDecl = (constantForTypeName name, nm) + fieldDecls = toConstant <$> fieldsOf typ + toConstant (FieldType fname _) = (constantForFieldName name fname, unName fname) + +toDataDeclaration :: M.Map Type (Coder Graph Graph Term H.Expression) -> Namespaces + -> (Element, TypedTerm) -> Flow Graph H.DeclarationWithComments +toDataDeclaration coders namespaces (el, TypedTerm term typ) = do + comments <- getTermDescription term + toDecl comments hname term coder Nothing + where + coder = Y.fromJust $ M.lookup typ coders + hname = simpleName $ localNameOfEager $ elementName el + + rewriteValueBinding vb = case vb of + H.ValueBindingSimple (H.ValueBinding_Simple (H.PatternApplication (H.Pattern_Application name args)) rhs bindings) -> case rhs of + H.RightHandSide (H.ExpressionLambda (H.Expression_Lambda vars body)) -> rewriteValueBinding $ + H.ValueBindingSimple $ H.ValueBinding_Simple + (applicationPattern name (args ++ vars)) (H.RightHandSide body) bindings + _ -> vb + + toDecl comments hname term coder bindings = case fullyStripTerm term of + TermLet (Let lbindings env) -> do + -- A "let" constant cannot be predicted in advance, so we infer its type and construct a coder on the fly + -- This makes program code with "let" terms more expensive to transform than simple data. + ts <- (CM.mapM inferredTypeOf (letBindingTerm <$> lbindings)) + coders <- CM.mapM (constructCoder haskellLanguage (encodeTerm namespaces)) ts + let hnames = simpleName <$> (unName . letBindingName <$> lbindings) + hterms <- CM.zipWithM coderEncode coders (letBindingTerm <$> lbindings) + + let hbindings = L.zipWith toBinding hnames hterms + toDecl comments hname env coder (Just $ H.LocalBindings hbindings) + where + toBinding hname' hterm' = H.LocalBindingValue $ simpleValueBinding hname' hterm' Nothing + _ -> do + hterm <- coderEncode coder term + let vb = simpleValueBinding hname hterm bindings + classes <- getTypeClasses typ + htype <- encodeTypeWithClassAssertions namespaces classes typ + let decl = H.DeclarationTypedBinding $ H.TypedBinding (H.TypeSignature hname htype) (rewriteValueBinding vb) + return $ H.DeclarationWithComments decl comments + +toTypeDeclarations :: Namespaces -> Element -> Term -> Flow Graph [H.DeclarationWithComments] +toTypeDeclarations namespaces el term = withTrace ("type element " ++ unName (elementName el)) $ do + g <- getState + let lname = localNameOfEager $ elementName el + let hname = simpleName lname + t <- coreDecodeType term + + isSer <- isSerializable el + let deriv = H.Deriving $ if isSer + then rawName <$> ["Eq", "Ord", "Read", "Show"] + else [] + let (vars, t') = unpackLambdaType g t + let hd = declHead hname $ L.reverse vars + decl <- case stripType t' of + TypeRecord rt -> do + cons <- recordCons lname $ rowTypeFields rt + return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordData [] hd [cons] [deriv] + TypeUnion rt -> do + cons <- CM.mapM (unionCons lname) $ rowTypeFields rt + return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordData [] hd cons [deriv] + TypeWrap (WrappedType tname wt) -> do + cons <- newtypeCons el wt + return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv] + _ -> if newtypesNotTypedefs + then do + cons <- newtypeCons el t' + return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv] + else do + htype <- adaptTypeToHaskellAndEncode namespaces t + return $ H.DeclarationType (H.TypeDeclaration hd htype) + comments <- getTermDescription term + tdecls <- if haskellGenerationOptionsIncludeTypeDefinitions defaultHaskellGenerationOptions + then do + decl <- typeDecl namespaces (elementName el) t + pure [decl] + else pure [] + return $ [H.DeclarationWithComments decl comments] + ++ nameDecls g namespaces (elementName el) t + ++ tdecls + where + declHead name vars = case vars of + [] -> H.DeclarationHeadSimple name + ((Name h):rest) -> H.DeclarationHeadApplication $ + H.DeclarationHead_Application (declHead name rest) (H.Variable $ simpleName h) + + newtypeCons el typ = do + let hname = simpleName $ newtypeAccessorName $ elementName el + htype <- adaptTypeToHaskellAndEncode namespaces typ + let hfield = H.FieldWithComments (H.Field hname htype) Nothing + return $ H.ConstructorWithComments + (H.ConstructorRecord $ H.Constructor_Record (simpleName $ localNameOfEager $ elementName el) [hfield]) Nothing + + recordCons lname fields = do + hFields <- CM.mapM toField fields + return $ H.ConstructorWithComments (H.ConstructorRecord $ H.Constructor_Record (simpleName lname) hFields) Nothing + where + toField (FieldType (Name fname) ftype) = do + let hname = simpleName $ decapitalize lname ++ capitalize fname + htype <- adaptTypeToHaskellAndEncode namespaces ftype + comments <- getTypeDescription ftype + return $ H.FieldWithComments (H.Field hname htype) comments + + unionCons lname (FieldType (Name fname) ftype) = do + comments <- getTypeDescription ftype + let nm = capitalize lname ++ capitalize fname + typeList <- if stripType ftype == Types.unit + then pure [] + else do + htype <- adaptTypeToHaskellAndEncode namespaces ftype + return [htype] + return $ H.ConstructorWithComments (H.ConstructorOrdinary $ H.Constructor_Ordinary (simpleName nm) typeList) comments + +-- | Constructs a Hydra Type definition which can be included along with the nativized Haskell type definition +typeDecl :: Namespaces -> Name -> Type -> Flow Graph H.DeclarationWithComments +typeDecl namespaces name typ = do + -- Note: consider constructing this coder just once, then reusing it + coder <- constructCoder haskellLanguage (encodeTerm namespaces) typeT + expr <- coderEncode coder finalTerm + let rhs = H.RightHandSide expr + let hname = simpleName $ typeNameLocal name + let pat = applicationPattern hname [] + let decl = H.DeclarationValueBinding $ H.ValueBindingSimple $ H.ValueBinding_Simple pat rhs Nothing + return $ H.DeclarationWithComments decl Nothing + where + typeName ns name = qname ns (typeNameLocal name) + typeNameLocal name = "_" ++ localNameOfEager name ++ "_type_" + rawTerm = coreEncodeType typ + finalTerm = rewriteTerm rewrite rawTerm + where + rewrite :: (Term -> Term) -> Term -> Term + rewrite recurse term = Y.fromMaybe (recurse term) (Decode.variant _Type term >>= forType) + where + forType (Field fname fterm) = if fname == _Type_record + then Nothing -- TODO + else if fname == _Type_variable + then Decode.name fterm >>= forVariableType + else Nothing + forVariableType name = (\ns -> TermVariable $ qname ns $ "_" ++ local ++ "_type_") <$> mns + where + (QualifiedName mns local) = qualifyNameEager name diff --git a/src/main/haskell/Hydra/Ext/Haskell/Language.hs b/src/main/haskell/Hydra/Ext/Haskell/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Haskell/Language.hs @@ -0,0 +1,77 @@ +module Hydra.Ext.Haskell.Language where + +import Hydra.Kernel + +import qualified Data.Set as S + + +haskellLanguage :: Language +haskellLanguage = Language (LanguageName "hydra/ext/haskell") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.fromList eliminationVariants, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBoolean, + LiteralVariantFloat, + LiteralVariantInteger, + LiteralVariantString], + languageConstraintsFloatTypes = S.fromList [ + -- Bigfloat is excluded for now + FloatTypeFloat32, -- Float + FloatTypeFloat64], -- Double + languageConstraintsFunctionVariants = S.fromList functionVariants, + languageConstraintsIntegerTypes = S.fromList [ + IntegerTypeBigint, -- Integer + IntegerTypeInt8, -- Int8 + IntegerTypeInt16, -- Int16 + IntegerTypeInt32, -- Int + IntegerTypeInt64], -- Int64 + languageConstraintsTermVariants = S.fromList [ + TermVariantApplication, + TermVariantFunction, + TermVariantLet, + TermVariantList, + TermVariantLiteral, + TermVariantMap, + TermVariantOptional, + TermVariantProduct, + TermVariantRecord, + TermVariantSet, + TermVariantUnion, + TermVariantVariable, + TermVariantWrap], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantAnnotated, + TypeVariantApplication, + TypeVariantFunction, + TypeVariantLambda, + TypeVariantList, + TypeVariantLiteral, + TypeVariantMap, + TypeVariantOptional, + TypeVariantProduct, + TypeVariantRecord, + TypeVariantSet, + TypeVariantUnion, + TypeVariantVariable, + TypeVariantWrap], + languageConstraintsTypes = const True } + +reservedWords :: S.Set String +reservedWords = S.fromList $ preludeSymbols ++ extSymbols + where + -- See: https://www.haskell.org/onlinereport/standard-prelude.html + -- List created on 2022-06-01. Symbols not containing at least one alphanumeric character are excluded. + preludeSymbols = [ + "Bool", "Bounded", "Char", "Double", "EQ", "Either", "Enum", "Eq", "False", "Float", "Floating", "Fractional", + "Functor", "GT", "IO", "Int", "Integer", "Integral", "Just", "LT", "Left", "Maybe", "Monad", "Nothing", "Num", + "Ord", "Ordering", "Rational", "Real", "RealFloat", "RealFrac", "Right", "String", "True", "abs", "acos", "acosh", + "asTypeOf", "asin", "asinh", "atan", "atan2", "atanh", "ceiling", "compare", "const", "cos", "cosh", "curry", + "decodeFloat", "div", "divMod", "either", "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo", + "enumFromTo", "error", "even", "exp", "exponent", "fail", "flip", "floatDigits", "floatRadix", "floatRange", + "floor", "fmap", "fromEnum", "fromInteger", "fromIntegral", "fromRational", "fst", "gcd", "id", "isDenormalized", + "isIEEE", "isInfinite", "isNaN", "isNegativeZero", "lcm", "log", "logBase", "mapM", "mapM_", "max", "maxBound", + "maybe", "min", "minBound", "mod", "negate", "not", "odd", "otherwise", "pi", "pred", "properFraction", "quot", + "quotRem", "realToFrac", "recip", "rem", "return", "round", "scaleFloat", "seq", "sequence", "sequence_", + "significand", "signum", "sin", "sinh", "snd", "sqrt", "subtract", "succ", "tan", "tanh", "toEnum", "toInteger", + "toRational", "truncate", "uncurry", "undefined", "until"] + -- Additional symbols which need to be reserved, as the Haskell coder uses them in their unqualified form + extSymbols = ["Map", "Set"] diff --git a/src/main/haskell/Hydra/Ext/Haskell/Operators.hs b/src/main/haskell/Hydra/Ext/Haskell/Operators.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Haskell/Operators.hs @@ -0,0 +1,42 @@ +module Hydra.Ext.Haskell.Operators where + +import Hydra.Ast +import Hydra.Tools.Serialization + + +andOp = op "&&" 3 AssociativityRight :: Op +apOp = op "<*>" 4 AssociativityLeft :: Op +appOp = Op (Symbol "") (Padding WsNone WsSpace) (Precedence 0) AssociativityLeft :: Op -- No source +applyOp = op "$" 0 AssociativityRight :: Op +arrowOp = op "->" (negate 1) AssociativityRight :: Op +assertOp = op "=>" 0 AssociativityNone :: Op -- No source +--assignOp = op "<-" +bindOp = op ">>=" 1 AssociativityLeft :: Op +caseOp = op "->" 0 AssociativityNone :: Op -- No source +composeOp = op "." 9 AssociativityLeft :: Op +concatOp = op "++" 5 AssociativityRight :: Op +consOp = op ":" 5 AssociativityRight :: Op +defineOp = op "=" 0 AssociativityNone :: Op -- No source +diamondOp = op "<>" 6 AssociativityRight :: Op +divOp = op "`div`" 7 AssociativityLeft :: Op +divideOp = op "/" 7 AssociativityLeft :: Op +elemOp = op "`elem`" 4 AssociativityNone :: Op +equalOp = op "==" 4 AssociativityNone :: Op +fmapOp = op "<$>" 4 AssociativityLeft :: Op +gtOp = op ">" 4 AssociativityNone :: Op +gteOp = op ">=" 4 AssociativityNone :: Op +indexOp = op "!!" 9 AssociativityLeft :: Op +lambdaOp = op "->" (negate 1) AssociativityRight :: Op -- No source +ltOp = op "<" 4 AssociativityNone :: Op +lteOp = op ">=" 4 AssociativityNone :: Op +minusOp = op "-" 6 AssociativityBoth :: Op -- Originally: AssociativityLeft +modOp = op "`mod`" 7 AssociativityLeft :: Op +multOp = op "*" 7 AssociativityBoth :: Op -- Originally: AssociativityLeft +neqOp = op "/=" 4 AssociativityNone :: Op +notElemOp = op "`notElem`" 4 AssociativityNone :: Op +orOp = op "||" 2 AssociativityRight :: Op +plusOp = op "+" 6 AssociativityBoth :: Op -- Originally: AssociativityLeft +quotOp = op "`quot`" 7 AssociativityLeft :: Op +remOp = op "`rem`" 7 AssociativityLeft :: Op +--suchThatOp = op "|" +typeOp = op "::" 0 AssociativityNone :: Op -- No source diff --git a/src/main/haskell/Hydra/Ext/Haskell/Serde.hs b/src/main/haskell/Hydra/Ext/Haskell/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Haskell/Serde.hs @@ -0,0 +1,241 @@ +-- | Haskell operator precendence and associativity are drawn from: +-- https://self-learning-java-tutorial.blogspot.com/2016/04/haskell-operator-precedence.html +-- Other operators were investigated using GHCi, e.g. ":info (->)" +-- Operator names are drawn (loosely) from: +-- https://stackoverflow.com/questions/7746894/are-there-pronounceable-names-for-common-haskell-operators + +module Hydra.Ext.Haskell.Serde where + +import Hydra.Ast +import Hydra.Tools.Serialization +import Hydra.Ext.Haskell.Operators +import qualified Hydra.Ext.Haskell.Ast as H + +import qualified Data.Char as C +import qualified Data.List as L +import qualified Data.Maybe as Y + + +class ToTree a where + toTree :: a -> Expr + +instance ToTree H.Alternative where + toTree (H.Alternative pat rhs _) = ifx caseOp (toTree pat) (toTree rhs) + +instance ToTree H.Assertion where + toTree sert = case sert of + H.AssertionClass cls -> toTree cls + H.AssertionTuple serts -> parenList False (toTree <$> serts) + +instance ToTree H.Assertion_Class where + toTree (H.Assertion_Class name types) = spaceSep [toTree name, commaSep halfBlockStyle (toTree <$> types)] + +instance ToTree H.CaseRhs where + toTree (H.CaseRhs expr) = toTree expr + +instance ToTree H.Constructor where + toTree cons = case cons of + H.ConstructorOrdinary (H.Constructor_Ordinary name types) -> spaceSep [ + toTree name, + spaceSep (toTree <$> types)] + H.ConstructorRecord (H.Constructor_Record name fields) -> spaceSep [ + toTree name, + curlyBracesList Nothing halfBlockStyle (toTree <$> fields)] + +instance ToTree H.ConstructorWithComments where + toTree (H.ConstructorWithComments body mc) = case mc of + Nothing -> toTree body + Just c -> newlineSep [cst $ toHaskellComments c, toTree body] + +instance ToTree H.DataDeclaration_Keyword where + toTree kw = case kw of + H.DataDeclaration_KeywordData -> cst "data" + H.DataDeclaration_KeywordNewtype -> cst "newtype" + +instance ToTree H.Declaration where + toTree decl = case decl of + H.DeclarationData (H.DataDeclaration kw _ hd cons deriv) -> indentBlock $ + [spaceSep [toTree kw, toTree hd, cst "="], constructors] + ++ if L.null derivCat then [] else [spaceSep [cst "deriving", parenList False (toTree <$> derivCat)]] + where + derivCat = L.concat $ h <$> deriv + where + h (H.Deriving names) = names + constructors = orSep halfBlockStyle (toTree <$> cons) + H.DeclarationType (H.TypeDeclaration hd typ) -> spaceSep [cst "type", toTree hd, cst "=", toTree typ] + H.DeclarationValueBinding vb -> toTree vb + H.DeclarationTypedBinding (H.TypedBinding (H.TypeSignature name htype) vb) -> newlineSep [ -- TODO: local bindings + ifx typeOp (toTree name) (toTree htype), + toTree vb] + +instance ToTree H.DeclarationHead where + toTree hd = case hd of + H.DeclarationHeadApplication (H.DeclarationHead_Application fun op) -> spaceSep [toTree fun, toTree op] +-- H.DeclarationHeadParens ... -> + H.DeclarationHeadSimple name -> toTree name + +instance ToTree H.DeclarationWithComments where + toTree (H.DeclarationWithComments body mc) = case mc of + Nothing -> toTree body + Just c -> newlineSep [cst $ toHaskellComments c, toTree body] + +instance ToTree H.Expression where + toTree expr = case expr of + H.ExpressionApplication app -> toTree app + H.ExpressionCase cases -> toTree cases + H.ExpressionConstructRecord r -> toTree r + H.ExpressionDo statements -> indentBlock $ [cst "do"] ++ (toTree <$> statements) + H.ExpressionIf ifte -> toTree ifte + -- H.ExpressionInfixApplication Term_InfixApplication + H.ExpressionLiteral lit -> toTree lit + -- Note: the need for extra parens may point to an operator precedence issue + H.ExpressionLambda lam -> parenthesize $ toTree lam + -- H.ExpressionLeftSection Term_Section + H.ExpressionLet (H.Expression_Let bindings inner) -> indentBlock [ + cst "", + spaceSep [cst "let", customIndentBlock " " (encodeBinding <$> bindings)], + spaceSep [cst "in", toTree inner]] + where + -- Note: indentation should depend on the length of the pattern + encodeBinding = indentSubsequentLines " " . toTree + H.ExpressionList exprs -> bracketList halfBlockStyle $ toTree <$> exprs + H.ExpressionParens expr' -> parenthesize $ toTree expr' + -- H.ExpressionPrefixApplication Term_PrefixApplication + -- H.ExpressionRightSection Term_Section + H.ExpressionTuple exprs -> parenList False $ toTree <$> exprs + -- H.ExpressionTypeSignature Term_TypeSignature + -- H.ExpressionUpdateRecord Term_UpdateRecord + H.ExpressionVariable name -> toTree name + +instance ToTree H.Expression_Application where + toTree (H.Expression_Application fun arg) = ifx appOp (toTree fun) (toTree arg) + +instance ToTree H.Expression_Case where + toTree (H.Expression_Case cs alts) = ifx ofOp lhs rhs + where + lhs = spaceSep [cst "case", toTree cs] + rhs = newlineSep (toTree <$> alts) + ofOp = Op (Symbol "of") (Padding WsSpace $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone + +instance ToTree H.Expression_ConstructRecord where + toTree (H.Expression_ConstructRecord name updates) = spaceSep [toTree name, brackets curlyBraces halfBlockStyle body] + where + body = commaSep halfBlockStyle (fromUpdate <$> updates) + fromUpdate (H.FieldUpdate fn val) = ifx defineOp (toTree fn) (toTree val) + +instance ToTree H.Expression_If where + toTree (H.Expression_If eif ethen eelse) = ifx ifOp (spaceSep [cst "if", toTree eif]) body + where + ifOp = Op (Symbol "") (Padding WsNone $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone + body = newlineSep [spaceSep [cst "then", toTree ethen], spaceSep [cst "else", toTree eelse]] + +instance ToTree H.Expression_Lambda where + toTree (H.Expression_Lambda bindings inner) = ifx lambdaOp (prefix "\\" head) body + where + head = spaceSep (toTree <$> bindings) + body = toTree inner + +instance ToTree H.Field where + toTree (H.Field name typ) = spaceSep [toTree name, cst "::", toTree typ] + +instance ToTree H.FieldWithComments where + toTree (H.FieldWithComments field mc) = case mc of + Nothing -> toTree field + Just c -> newlineSep [cst $ toHaskellComments c, toTree field] + +instance ToTree H.Import where + toTree (H.Import qual (H.ModuleName name) mod _) = spaceSep $ Y.catMaybes [ + Just $ cst "import", + if qual then Just (cst "qualified") else Nothing, + Just $ cst name, + (\(H.ModuleName m) -> cst $ "as " ++ m) <$> mod] + +instance ToTree H.Literal where + toTree lit = cst $ case lit of + H.LiteralChar c -> show $ C.chr $ fromIntegral c + H.LiteralDouble d -> if d < 0 then "(0" ++ show d ++ ")" else show d + H.LiteralFloat f -> if f < 0 then "(0" ++ show f ++ ")" else show f + H.LiteralInt i -> if i < 0 then "(0" ++ show i ++ ")" else show i + H.LiteralInteger i -> show i + H.LiteralString s -> show s + +instance ToTree H.LocalBinding where + toTree binding = case binding of + H.LocalBindingSignature ts -> toTree ts + H.LocalBindingValue vb -> toTree vb + +instance ToTree H.Module where + toTree (H.Module mh imports decls) = doubleNewlineSep $ + headerLine ++ importLines ++ declLines + where + headerLine = Y.maybe [] (\h -> [toTree h]) mh + declLines = toTree <$> decls + importLines = [newlineSep $ toTree <$> imports | not (L.null imports)] + +instance ToTree H.Name where + toTree name = cst $ case name of + H.NameImplicit qn -> "?" ++ writeQualifiedName qn + H.NameNormal qn -> writeQualifiedName qn + H.NameParens qn -> "(" ++ writeQualifiedName qn ++ ")" + +instance ToTree H.ModuleHead where + toTree (H.ModuleHead mc (H.ModuleName mname) _) = case mc of + Nothing -> head + Just c -> newlineSep [cst $ toHaskellComments c, cst "", head] + where + head = spaceSep [cst "module", cst mname, cst "where"] + +instance ToTree H.Pattern where + toTree pat = case pat of + H.PatternApplication app -> toTree app +-- H.PatternAs (H.Pattern_As ) -> + H.PatternList pats -> bracketList halfBlockStyle $ toTree <$> pats + H.PatternLiteral lit -> toTree lit + H.PatternName name -> toTree name + H.PatternParens pat -> parenthesize $ toTree pat +-- H.PatternRecord (H.Pattern_Record ) -> + H.PatternTuple pats -> parenList False $ toTree <$> pats +-- H.PatternTyped (H.Pattern_Typed ) -> + H.PatternWildcard -> cst "_" + +instance ToTree H.Pattern_Application where + toTree (H.Pattern_Application name pats) = spaceSep $ toTree name:(toTree <$> pats) + +instance ToTree H.RightHandSide where + toTree (H.RightHandSide expr) = toTree expr + +instance ToTree H.Statement where + toTree (H.Statement expr) = toTree expr + +instance ToTree H.Type where + toTree htype = case htype of + H.TypeApplication (H.Type_Application lhs rhs) -> ifx appOp (toTree lhs) (toTree rhs) + H.TypeCtx (H.Type_Context ctx typ) -> ifx assertOp (toTree ctx) (toTree typ) + H.TypeFunction (H.Type_Function dom cod) -> ifx arrowOp (toTree dom) (toTree cod) +-- H.TypeInfix Type_Infix + H.TypeList htype -> bracketList inlineStyle [toTree htype] +-- H.TypeParens Type + H.TypeTuple types -> parenList False $ toTree <$> types + H.TypeVariable name -> toTree name + +instance ToTree H.TypeSignature where + toTree (H.TypeSignature name typ) = spaceSep [toTree name, cst "::", toTree typ] + +instance ToTree H.ValueBinding where + toTree vb = case vb of + H.ValueBindingSimple (H.ValueBinding_Simple pat rhs local) -> case local of + Nothing -> body + Just (H.LocalBindings bindings) -> indentBlock [body, indentBlock $ [cst "where"] ++ (toTree <$> bindings)] + where + body = ifx defineOp (toTree pat) (toTree rhs) + +instance ToTree H.Variable where + toTree (H.Variable v) = toTree v + +toHaskellComments :: String -> String +toHaskellComments c = L.intercalate "\n" $ ("-- | " ++) <$> L.lines c + +writeQualifiedName :: H.QualifiedName -> String +writeQualifiedName (H.QualifiedName qualifiers unqual) = L.intercalate "." $ (h <$> qualifiers) ++ [h unqual] + where + h (H.NamePart part) = part diff --git a/src/main/haskell/Hydra/Ext/Haskell/Settings.hs b/src/main/haskell/Hydra/Ext/Haskell/Settings.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Haskell/Settings.hs @@ -0,0 +1,7 @@ +module Hydra.Ext.Haskell.Settings where + +newtypesNotTypedefs :: Bool +newtypesNotTypedefs = True + +useCoreImport :: Bool +useCoreImport = True diff --git a/src/main/haskell/Hydra/Ext/Haskell/Utils.hs b/src/main/haskell/Hydra/Ext/Haskell/Utils.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Haskell/Utils.hs @@ -0,0 +1,109 @@ +module Hydra.Ext.Haskell.Utils where + +import Hydra.Kernel +import Hydra.Ext.Haskell.Language +import qualified Hydra.Ext.Haskell.Ast as H +import qualified Hydra.Lib.Strings as Strings + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S + + +data Namespaces = Namespaces { + namespacesFocus :: (Namespace, H.ModuleName), + namespacesMapping :: M.Map Namespace H.ModuleName} deriving Show + +applicationPattern name args = H.PatternApplication $ H.Pattern_Application name args + +elementReference :: Namespaces -> Name -> H.Name +elementReference (Namespaces (gname, H.ModuleName gmod) namespaces) name = case (qualifiedNameNamespace qname) of + Nothing -> simpleName local + Just ns -> case M.lookup ns namespaces of + Nothing -> simpleName local + Just (H.ModuleName a) -> if ns == gname + then simpleName escLocal + else rawName $ a ++ "." ++ escLocal + where + qname = qualifyNameEager name + local = qualifiedNameLocal qname + escLocal = sanitizeHaskellName local + simple = simpleName $ qualifiedNameLocal qname + +hsapp :: H.Expression -> H.Expression -> H.Expression +hsapp l r = H.ExpressionApplication $ H.Expression_Application l r + +hslambda :: String -> H.Expression -> H.Expression +hslambda v rhs = H.ExpressionLambda (H.Expression_Lambda [H.PatternName $ rawName v] rhs) + +hslit :: H.Literal -> H.Expression +hslit = H.ExpressionLiteral + +hsPrimitiveReference :: Name -> H.Name +hsPrimitiveReference name = H.NameNormal $ H.QualifiedName [prefix] $ H.NamePart local + where + QualifiedName (Just (Namespace ns)) local = qualifyNameEager name + prefix = H.NamePart $ capitalize $ L.last $ Strings.splitOn "/" ns + +hsvar :: String -> H.Expression +hsvar s = H.ExpressionVariable $ rawName s + +namespacesForModule :: Module -> Flow (Graph) Namespaces +namespacesForModule mod = do + nss <- moduleDependencyNamespaces True True True True mod + return $ Namespaces focusPair $ fst $ L.foldl addPair (M.empty, S.empty) (toPair <$> S.toList nss) + where + ns = moduleNamespace mod + focusPair = toPair ns + toModuleName (Namespace n) = H.ModuleName $ capitalize $ L.last $ Strings.splitOn "/" n + toPair name = (name, toModuleName name) + addPair (m, s) (name, alias@(H.ModuleName aliasStr)) = if S.member alias s + then addPair (m, s) (name, H.ModuleName $ aliasStr ++ "_") + else (M.insert name alias m, S.insert alias s) + +newtypeAccessorName :: Name -> String +newtypeAccessorName name = "un" ++ localNameOfEager name + +rawName :: String -> H.Name +rawName n = H.NameNormal $ H.QualifiedName [] $ H.NamePart n + +recordFieldReference :: Namespaces -> Name -> Name -> H.Name +recordFieldReference namespaces sname (Name fname) = elementReference namespaces $ + unqualifyName $ QualifiedName (qualifiedNameNamespace $ qualifyNameEager sname) nm + where + nm = decapitalize (typeNameForRecord sname) ++ capitalize fname + +sanitizeHaskellName :: String -> String +sanitizeHaskellName = sanitizeWithUnderscores reservedWords + +simpleName :: String -> H.Name +simpleName = rawName . sanitizeHaskellName + +simpleValueBinding :: H.Name -> H.Expression -> Maybe H.LocalBindings -> H.ValueBinding +simpleValueBinding hname rhs bindings = H.ValueBindingSimple $ H.ValueBinding_Simple pat (H.RightHandSide rhs) bindings + where + pat = H.PatternApplication $ H.Pattern_Application hname [] + +toTypeApplication :: [H.Type] -> H.Type +toTypeApplication = app . L.reverse + where + app l = case l of + [e] -> e + (h:r) -> H.TypeApplication $ H.Type_Application (app r) h + +typeNameForRecord :: Name -> String +typeNameForRecord (Name sname) = L.last (Strings.splitOn "." sname) + +unionFieldReference :: Namespaces -> Name -> Name -> H.Name +unionFieldReference namespaces sname (Name fname) = elementReference namespaces $ + unqualifyName $ QualifiedName ns nm + where + ns = qualifiedNameNamespace $ qualifyNameEager sname + nm = capitalize (typeNameForRecord sname) ++ capitalize fname + +unpackLambdaType :: Graph -> Type -> ([Name], Type) +unpackLambdaType cx t = case stripType t of + TypeLambda (LambdaType v tbody) -> (v:vars, t') + where + (vars, t') = unpackLambdaType cx tbody + _ -> ([], t) diff --git a/src/main/haskell/Hydra/Ext/Java/Coder.hs b/src/main/haskell/Hydra/Ext/Java/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Java/Coder.hs @@ -0,0 +1,987 @@ +module Hydra.Ext.Java.Coder ( + JavaFeatures(..), + java8Features, + moduleToJava, +) where + +import Hydra.Kernel +import Hydra.Reduction +import Hydra.Ext.Java.Utils +import Hydra.Ext.Java.Language +import Hydra.Ext.Java.Names +import Hydra.Adapters +import Hydra.Tools.Serialization +import Hydra.Ext.Java.Serde +import Hydra.Ext.Java.Settings +import Hydra.AdapterUtils +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types +import qualified Hydra.Ext.Java.Syntax as Java +import Hydra.Lib.Io + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.List.Split as LS +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Data.String (String) + + +data JavaSymbolClass = JavaSymbolClassConstant | JavaSymbolClassNullaryFunction | JavaSymbolClassUnaryFunction | JavaSymbolLocalVariable + +data JavaFeatures = JavaFeatures { + supportsDiamondOperator :: Bool +} + +java8Features = JavaFeatures { + supportsDiamondOperator = False +} + +java11Features = JavaFeatures { + supportsDiamondOperator = True +} + +-- For now, the supported features are hard-coded to those of Java 11, rather than being configurable. +javaFeatures = java11Features + +moduleToJava :: Module -> Flow Graph (M.Map FilePath String) +moduleToJava mod = withTrace "encode module in Java" $ do + units <- moduleToJavaCompilationUnit mod + return $ M.fromList $ forPair <$> M.toList units + where + forPair (name, unit) = (elementNameToFilePath name, printExpr $ parenthesize $ writeCompilationUnit unit) + +adaptTypeToJavaAndEncode :: Aliases -> Type -> Flow Graph Java.Type +adaptTypeToJavaAndEncode aliases = adaptAndEncodeType javaLanguage (encodeType aliases) + +addComment :: Java.ClassBodyDeclaration -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments +addComment decl field = Java.ClassBodyDeclarationWithComments decl <$> commentsFromFieldType field + +boundTypeVariables :: Type -> [Name] +boundTypeVariables typ = case typ of + TypeAnnotated (AnnotatedType typ1 _) -> boundTypeVariables typ1 + TypeLambda (LambdaType v body) -> v:(boundTypeVariables body) + _ -> [] + +classModsPublic :: [Java.ClassModifier] +classModsPublic = [Java.ClassModifierPublic] + +classifyDataReference :: Name -> Flow Graph JavaSymbolClass +classifyDataReference name = do + mel <- dereferenceElement name + case mel of + Nothing -> return JavaSymbolLocalVariable + Just el -> do + typ <- requireElementType el + return $ classifyDataTerm typ $ elementData el + +classifyDataTerm :: Type -> Term -> JavaSymbolClass +classifyDataTerm typ term = if isLambda term + then JavaSymbolClassUnaryFunction + else if hasTypeParameters || isUnsupportedVariant + then JavaSymbolClassNullaryFunction + else JavaSymbolClassConstant + where + hasTypeParameters = not $ S.null $ freeVariablesInType typ + isUnsupportedVariant = case fullyStripTerm term of + TermLet _ -> True + _ -> False + +commentsFromElement :: Element -> Flow Graph (Maybe String) +commentsFromElement = getTermDescription . elementData + +commentsFromFieldType :: FieldType -> Flow Graph (Maybe String) +commentsFromFieldType = getTypeDescription . fieldTypeType + +constantDecl :: String -> Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments +constantDecl javaName aliases name = do + jt <- adaptTypeToJavaAndEncode aliases $ TypeVariable _Name + arg <- encodeTerm aliases $ Terms.string $ unName name + let init = Java.VariableInitializerExpression $ javaConstructorCall (javaConstructorName nameName Nothing) [arg] Nothing + let var = javaVariableDeclarator (Java.Identifier javaName) (Just init) + return $ noComment $ javaMemberField mods jt var + where + mods = [Java.FieldModifierPublic, Java.FieldModifierStatic, Java.FieldModifierFinal] + nameName = nameToJavaName aliases _Name + +constantDeclForFieldType :: Aliases -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments +constantDeclForFieldType aliases ftyp = constantDecl javaName aliases name + where + name = fieldTypeName ftyp + javaName = "FIELD_NAME_" ++ nonAlnumToUnderscores (convertCase CaseConventionCamel CaseConventionUpperSnake $ unName name) + +constantDeclForTypeName :: Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments +constantDeclForTypeName = constantDecl "TYPE_NAME" + +constructElementsInterface :: Module -> [Java.InterfaceMemberDeclaration] -> (Name, Java.CompilationUnit) +constructElementsInterface mod members = (elName, cu) + where + cu = Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) [] [decl] + pkg = javaPackageDeclaration $ moduleNamespace mod + mods = [Java.InterfaceModifierPublic] + className = elementsClassName $ moduleNamespace mod + elName = unqualifyName $ QualifiedName (Just $ moduleNamespace mod) className + body = Java.InterfaceBody members + itf = Java.TypeDeclarationInterface $ Java.InterfaceDeclarationNormalInterface $ + Java.NormalInterfaceDeclaration mods (javaTypeIdentifier className) [] [] body + decl = Java.TypeDeclarationWithComments itf $ moduleDescription mod + +constructModule :: Module + -> M.Map Type (Coder Graph Graph (Term) Java.Expression) + -> [(Element, TypedTerm)] + -> Flow Graph (M.Map Name Java.CompilationUnit) +constructModule mod coders pairs = do + let isTypePair = isType . typedTermType . snd + let typePairs = L.filter isTypePair pairs + let dataPairs = L.filter (not . isTypePair) pairs + typeUnits <- CM.mapM typeToClass typePairs + dataMembers <- CM.mapM (termToInterfaceMember coders) dataPairs + return $ M.fromList $ typeUnits ++ ([constructElementsInterface mod dataMembers | not (L.null dataMembers)]) + where + pkg = javaPackageDeclaration $ moduleNamespace mod + aliases = importAliasesForModule mod + + typeToClass pair@(el, _) = do + isSer <- isSerializable el + let imports = if isSer + then [Java.ImportDeclarationSingleType $ Java.SingleTypeImportDeclaration $ javaTypeName $ Java.Identifier "java.io.Serializable"] + else [] + decl <- declarationForType isSer aliases pair + return (elementName el, + Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) imports [decl]) + + -- Lambdas cannot (in general) be turned into top-level constants, as there is no way of declaring type parameters for constants + -- These functions must be capable of handling various combinations of let and lambda terms: + -- * Plain lambdas such as \x y -> x + y + 42 + -- * Lambdas with nested let terms, such as \x y -> let z = x + y in z + 42 + -- * Let terms with nested lambdas, such as let z = 42 in \x y -> x + y + z + termToInterfaceMember coders pair = withTrace ("element " ++ unName (elementName el)) $ do + let expanded = contractTerm $ unshadowVariables $ expandTypedLambdas $ typedTermTerm $ snd pair + case classifyDataTerm typ expanded of + JavaSymbolClassConstant -> termToConstant coders el expanded + JavaSymbolClassNullaryFunction -> termToNullaryMethod coders el expanded + JavaSymbolClassUnaryFunction -> termToUnaryMethod coders el expanded + where + el = fst pair + typ = typedTermType $ snd pair + tparams = javaTypeParametersForType typ + mname = sanitizeJavaName $ decapitalize $ localNameOfEager $ elementName el + + termToConstant coders el term = do + jtype <- Java.UnannType <$> adaptTypeToJavaAndEncode aliases typ + jterm <- coderEncode (Y.fromJust $ M.lookup typ coders) term + let mods = [] + let var = javaVariableDeclarator (javaVariableName $ elementName el) $ Just $ Java.VariableInitializerExpression jterm + return $ Java.InterfaceMemberDeclarationConstant $ Java.ConstantDeclaration mods jtype [var] + + termToNullaryMethod coders el term0 = maybeLet aliases term0 forInnerTerm + where + forInnerTerm aliases2 term stmts = do + result <- javaTypeToJavaResult <$> adaptTypeToJavaAndEncode aliases2 typ + jbody <- encodeTerm aliases2 term + let mods = [Java.InterfaceMethodModifierStatic] + let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody + return $ interfaceMethodDeclaration mods tparams mname [] result (Just $ stmts ++ [returnSt]) + + termToUnaryMethod coders el term = case stripType typ of + TypeFunction (FunctionType dom cod) -> maybeLet aliases term $ \aliases2 term2 stmts2 -> case fullyStripTerm term2 of + TermFunction (FunctionLambda (Lambda v _ body)) -> do + jdom <- adaptTypeToJavaAndEncode aliases2 dom + jcod <- adaptTypeToJavaAndEncode aliases2 cod + let mods = [Java.InterfaceMethodModifierStatic] + let param = javaTypeToJavaFormalParameter jdom (Name $ unName v) + let result = javaTypeToJavaResult jcod + maybeLet aliases2 body $ \aliases3 term3 stmts3 -> do + jbody <- encodeTerm aliases3 term3 + -- TODO: use coders + --jbody <- coderEncode (Y.fromJust $ M.lookup typ coders) body + let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody + return $ interfaceMethodDeclaration mods tparams mname [param] result (Just $ stmts2 ++ stmts3 ++ [returnSt]) + _ -> unexpected "function term" $ show term + _ -> unexpected "function type" $ show typ + +declarationForLambdaType :: Bool -> Aliases + -> [Java.TypeParameter] -> Name -> LambdaType -> Flow Graph Java.ClassDeclaration +declarationForLambdaType isSer aliases tparams elName (LambdaType (Name v) body) = + toClassDecl False isSer aliases (tparams ++ [param]) elName body + where + param = javaTypeParameter $ capitalize v + +declarationForRecordType :: Bool -> Bool -> Aliases -> [Java.TypeParameter] -> Name + -> [FieldType] -> Flow Graph Java.ClassDeclaration +declarationForRecordType isInner isSer aliases tparams elName fields = do + memberVars <- CM.mapM toMemberVar fields + memberVars' <- CM.zipWithM addComment memberVars fields + withMethods <- if L.length fields > 1 + then CM.mapM toWithMethod fields + else pure [] + cons <- constructor + tn <- if isInner then pure [] else do + d <- constantDeclForTypeName aliases elName + dfields <- CM.mapM (constantDeclForFieldType aliases) fields + return (d:dfields) + let bodyDecls = tn ++ memberVars' ++ (noComment <$> [cons, equalsMethod, hashCodeMethod] ++ withMethods) + return $ javaClassDeclaration aliases tparams elName classModsPublic Nothing (interfaceTypes isSer) bodyDecls + where + constructor = do + params <- CM.mapM (fieldTypeToFormalParam aliases) fields + let nullCheckStmts = fieldToNullCheckStatement <$> fields + let assignStmts = fieldToAssignStatement <$> fields + return $ makeConstructor aliases elName False params $ nullCheckStmts ++ assignStmts + + fieldToAssignStatement = Java.BlockStatementStatement . toAssignStmt . fieldTypeName + + fieldArgs = fieldNameToJavaExpression . fieldTypeName <$> fields + + toMemberVar (FieldType fname ft) = do + let mods = [Java.FieldModifierPublic, Java.FieldModifierFinal] + jt <- adaptTypeToJavaAndEncode aliases ft + let var = fieldNameToJavaVariableDeclarator fname + return $ javaMemberField mods jt var + + toWithMethod field = do + param <- fieldTypeToFormalParam aliases field + return $ methodDeclaration mods [] anns methodName [param] result (Just [nullCheck, returnStmt]) + where + anns = [] -- TODO + mods = [Java.MethodModifierPublic] + methodName = "with" ++ nonAlnumToUnderscores (capitalize (unName $ fieldTypeName field)) + nullCheck = fieldToNullCheckStatement field + result = referenceTypeToResult $ nameToJavaReferenceType aliases False [] elName Nothing + consId = Java.Identifier $ sanitizeJavaName $ localNameOfEager elName + returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just $ + javaConstructorCall (javaConstructorName consId Nothing) fieldArgs Nothing + + equalsMethod = methodDeclaration mods [] anns equalsMethodName [param] result $ + Just [instanceOfStmt, + castStmt, + returnAllFieldsEqual] + where + anns = [overrideAnnotation] + mods = [Java.MethodModifierPublic] + param = javaTypeToJavaFormalParameter (javaRefType [] Nothing "Object") (Name otherInstanceName) + result = javaTypeToJavaResult javaBooleanType + tmpName = "o" + + instanceOfStmt = Java.BlockStatementStatement $ Java.StatementIfThen $ + Java.IfThenStatement cond returnFalse + where + cond = javaUnaryExpressionToJavaExpression $ + Java.UnaryExpressionOther $ + Java.UnaryExpressionNotPlusMinusNot $ + javaRelationalExpressionToJavaUnaryExpression $ + javaInstanceOf other parent + where + other = javaIdentifierToJavaRelationalExpression $ javaIdentifier otherInstanceName + parent = nameToJavaReferenceType aliases False [] elName Nothing + + returnFalse = javaReturnStatement $ Just $ javaBooleanExpression False + + castStmt = variableDeclarationStatement aliases jtype id rhs + where + jtype = javaTypeFromTypeName aliases elName + id = javaIdentifier tmpName + rhs = javaCastExpressionToJavaExpression $ javaCastExpression rt var + var = javaIdentifierToJavaUnaryExpression $ Java.Identifier $ sanitizeJavaName otherInstanceName + rt = nameToJavaReferenceType aliases False [] elName Nothing + + returnAllFieldsEqual = Java.BlockStatementStatement $ javaReturnStatement $ Just $ if L.null fields + then javaBooleanExpression True + else javaConditionalAndExpressionToJavaExpression $ + Java.ConditionalAndExpression (eqClause . fieldTypeName <$> fields) + where + eqClause (Name fname) = javaPostfixExpressionToJavaInclusiveOrExpression $ + javaMethodInvocationToJavaPostfixExpression $ Java.MethodInvocation header [arg] + where + arg = javaExpressionNameToJavaExpression $ + fieldExpression (javaIdentifier tmpName) (javaIdentifier fname) + header = Java.MethodInvocation_HeaderComplex $ Java.MethodInvocation_Complex var [] (Java.Identifier equalsMethodName) + var = Java.MethodInvocation_VariantExpression $ Java.ExpressionName Nothing $ Java.Identifier $ + sanitizeJavaName fname + + hashCodeMethod = methodDeclaration mods [] anns hashCodeMethodName [] result $ Just [returnSum] + where + anns = [overrideAnnotation] + mods = [Java.MethodModifierPublic] + result = javaTypeToJavaResult javaIntType + + returnSum = Java.BlockStatementStatement $ if L.null fields + then returnZero + else javaReturnStatement $ Just $ + javaAdditiveExpressionToJavaExpression $ addExpressions $ + L.zipWith multPair multipliers (fieldTypeName <$> fields) + where + returnZero = javaReturnStatement $ Just $ javaIntExpression 0 + + multPair :: Int -> Name -> Java.MultiplicativeExpression + multPair i (Name fname) = Java.MultiplicativeExpressionTimes $ + Java.MultiplicativeExpression_Binary lhs rhs + where + lhs = Java.MultiplicativeExpressionUnary $ javaPrimaryToJavaUnaryExpression $ + javaLiteralToJavaPrimary $ javaInt i + rhs = javaPostfixExpressionToJavaUnaryExpression $ + javaMethodInvocationToJavaPostfixExpression $ + methodInvocationStatic (javaIdentifier fname) (Java.Identifier hashCodeMethodName) [] + + multipliers = L.cycle first20Primes + where + first20Primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71] + +declarationForType :: Bool -> Aliases -> (Element, TypedTerm) -> Flow Graph Java.TypeDeclarationWithComments +declarationForType isSer aliases (el, TypedTerm term _) = withTrace ("element " ++ unName (elementName el)) $ do + t <- coreDecodeType term >>= adaptType javaLanguage + cd <- toClassDecl False isSer aliases [] (elementName el) t + comments <- commentsFromElement el + return $ Java.TypeDeclarationWithComments (Java.TypeDeclarationClass cd) comments + +declarationForUnionType :: Bool -> Aliases + -> [Java.TypeParameter] -> Name -> [FieldType] -> Flow Graph Java.ClassDeclaration +declarationForUnionType isSer aliases tparams elName fields = do + variantClasses <- CM.mapM (fmap augmentVariantClass . unionFieldClass) fields + let variantDecls = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationClass <$> variantClasses + variantDecls' <- CM.zipWithM addComment variantDecls fields + let otherDecls = noComment <$> [privateConstructor, toAcceptMethod True tparams, visitor, partialVisitor] + tn <- do + d <- constantDeclForTypeName aliases elName + dfields <- CM.mapM (constantDeclForFieldType aliases) fields + return (d:dfields) + let bodyDecls = tn ++ otherDecls ++ variantDecls' + let mods = classModsPublic ++ [Java.ClassModifierAbstract] + return $ javaClassDeclaration aliases tparams elName mods Nothing (interfaceTypes isSer) bodyDecls + where + privateConstructor = makeConstructor aliases elName True [] [] + unionFieldClass (FieldType fname ftype) = do + let rtype = Types.record $ if isUnitType ftype then [] else [FieldType (Name valueFieldName) $ stripType ftype] + toClassDecl True isSer aliases [] (variantClassName False elName fname) rtype + augmentVariantClass (Java.ClassDeclarationNormal cd) = Java.ClassDeclarationNormal $ cd { + Java.normalClassDeclarationModifiers = [Java.ClassModifierPublic, Java.ClassModifierStatic, Java.ClassModifierFinal], + Java.normalClassDeclarationExtends = Just $ nameToJavaClassType aliases True args elName Nothing, + Java.normalClassDeclarationParameters = tparams, + Java.normalClassDeclarationBody = newBody (Java.normalClassDeclarationBody cd)} + where + newBody (Java.ClassBody decls) = Java.ClassBody $ decls ++ [noComment $ toAcceptMethod False tparams] + args = typeParameterToTypeArgument <$> tparams + + visitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $ + Java.NormalInterfaceDeclaration mods ti vtparams extends body + where + mods = [Java.InterfaceModifierPublic] + ti = Java.TypeIdentifier $ Java.Identifier visitorName + vtparams = tparams ++ [javaTypeParameter visitorReturnParameter] + extends = [] + body = Java.InterfaceBody (toVisitMethod . fieldTypeName <$> fields) + where + toVisitMethod fname = interfaceMethodDeclaration [] [] visitMethodName [variantInstanceParam fname] resultR Nothing + + partialVisitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $ + Java.NormalInterfaceDeclaration { + Java.normalInterfaceDeclarationModifiers = [Java.InterfaceModifierPublic], + Java.normalInterfaceDeclarationIdentifier = Java.TypeIdentifier $ Java.Identifier partialVisitorName, + Java.normalInterfaceDeclarationParameters = tparams ++ [javaTypeParameter visitorReturnParameter], + Java.normalInterfaceDeclarationExtends = + [Java.InterfaceType $ javaClassType ((typeParameterToReferenceType <$> tparams) ++ [visitorTypeVariable]) Nothing visitorName], + Java.normalInterfaceDeclarationBody = Java.InterfaceBody $ otherwise:(toVisitMethod . fieldTypeName <$> fields)} + where + otherwise = interfaceMethodDeclaration defaultMod [] otherwiseMethodName [mainInstanceParam] resultR $ Just [throw] + where + typeArgs = typeParameterToTypeArgument <$> tparams + throw = Java.BlockStatementStatement $ javaThrowIllegalStateException args + where + args = [javaAdditiveExpressionToJavaExpression $ addExpressions [ + javaStringMultiplicativeExpression "Non-exhaustive patterns when matching: ", + Java.MultiplicativeExpressionUnary $ javaIdentifierToJavaUnaryExpression $ Java.Identifier "instance"]] + + toVisitMethod fname = interfaceMethodDeclaration defaultMod [] visitMethodName [variantInstanceParam fname] resultR $ + Just [returnOtherwise] + where + returnOtherwise = Java.BlockStatementStatement $ javaReturnStatement $ Just $ + javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray $ Java.PrimaryNoNewArrayMethodInvocation $ + methodInvocation Nothing (Java.Identifier otherwiseMethodName) [javaIdentifierToJavaExpression $ Java.Identifier "instance"] + + defaultMod = [Java.InterfaceMethodModifierDefault] + + resultR = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable + + typeArgs = typeParameterToTypeArgument <$> tparams + + mainInstanceParam = javaTypeToJavaFormalParameter classRef $ Name instanceName + where + classRef = javaClassTypeToJavaType $ + nameToJavaClassType aliases False typeArgs elName Nothing + + variantInstanceParam fname = javaTypeToJavaFormalParameter classRef $ Name instanceName + where + classRef = javaClassTypeToJavaType $ + nameToJavaClassType aliases False typeArgs (variantClassName False elName fname) Nothing + +elementJavaIdentifier :: Bool -> Bool -> Aliases -> Name -> Java.Identifier +elementJavaIdentifier isPrim isMethod aliases name = Java.Identifier $ if isPrim + then (qualify $ capitalize local) ++ "." ++ applyMethodName + else case ns of + Nothing -> local + Just n -> (qualify $ elementsClassName n) ++ sep ++ local + where + sep = if isMethod then "::" else "." + qualify s = Java.unIdentifier $ nameToJavaName aliases $ unqualifyName $ QualifiedName ns s + QualifiedName ns local = qualifyNameEager name + +elementNameToFilePath :: Name -> FilePath +elementNameToFilePath name = nameToFilePath False (FileExtension "java") $ unqualifyName $ QualifiedName ns (sanitizeJavaName local) + where + QualifiedName ns local = qualifyNameEager name + +elementsClassName :: Namespace -> String +elementsClassName (Namespace ns) = capitalize $ L.last $ LS.splitOn "/" ns + +encodeApplication :: Aliases -> Application -> Flow Graph Java.Expression +encodeApplication aliases app@(Application lhs rhs) = case fullyStripTerm fun of + TermFunction f -> case f of + FunctionPrimitive name -> functionCall aliases True name args + _ -> fallback + TermVariable name -> do + firstCall <- functionCall aliases False name [L.head args] + calls firstCall $ L.tail args + where + calls exp args = case args of + [] -> pure exp + (h:r) -> do + jarg <- encodeTerm aliases h + calls (apply exp jarg) r + _ -> fallback + where + (fun, args) = uncurry [] lhs rhs + where + uncurry args lhs rhs = case fullyStripTerm lhs of + TermApplication (Application lhs' rhs') -> uncurry (rhs:args) lhs' rhs' + _ -> (lhs, (rhs:args)) + + fallback = withTrace "fallback" $ do + if Y.isNothing (getTermType lhs) + -- then fail $ "app: " ++ showTerm (TermApplication app) + then fail $ "lhs: " ++ showTerm lhs + else pure () + + t <- requireTermType lhs + (dom, cod) <- case stripTypeParameters $ stripType t of + TypeFunction (FunctionType dom cod) -> pure (dom, cod) + t' -> fail $ "expected a function type on function " ++ show lhs ++ ", but found " ++ show t' + case fullyStripTerm lhs of + TermFunction f -> case f of + FunctionElimination e -> do + jarg <- encodeTerm aliases rhs + encodeElimination aliases (Just jarg) dom cod e + _ -> defaultExpression + _ -> defaultExpression + where + defaultExpression = do + -- Note: the domain type will not be used, so we just substitute the unit type + jfun <- encodeTerm aliases lhs + jarg <- encodeTerm aliases rhs + let prim = javaExpressionToJavaPrimary jfun + return $ apply jfun jarg + apply exp jarg = javaMethodInvocationToJavaExpression $ + methodInvocation (Just $ Right $ javaExpressionToJavaPrimary exp) (Java.Identifier applyMethodName) [jarg] + +encodeElimination :: Aliases -> Maybe Java.Expression -> Type -> Type -> Elimination -> Flow Graph Java.Expression +encodeElimination aliases marg dom cod elm = case elm of + EliminationOptional (OptionalCases nothing just) -> do + jnothing <- encodeTerm aliases nothing + jjust <- encodeTerm aliases just + let var = Name "m" + + let jobj = case marg of + Nothing -> Left $ javaIdentifierToJavaExpressionName $ variableToJavaIdentifier var + Just jarg -> Right $ javaExpressionToJavaPrimary jarg + let jhead = javaMethodInvocationToJavaExpression $ methodInvocation + (Just jobj) + (Java.Identifier "map") [jjust] + let jbody = javaMethodInvocationToJavaExpression $ methodInvocation + (Just $ Right $ javaExpressionToJavaPrimary jhead) + (Java.Identifier "orElse") [jnothing] + castType <- adaptTypeToJavaAndEncode aliases (TypeFunction $ FunctionType dom cod) >>= javaTypeToJavaReferenceType + return $ case marg of + Nothing -> javaCastExpressionToJavaExpression $ javaCastExpression castType $ + javaExpressionToJavaUnaryExpression $ javaLambda var jbody + Just _ -> jbody + EliminationRecord (Projection _ fname) -> do + jdomr <- adaptTypeToJavaAndEncode aliases dom >>= javaTypeToJavaReferenceType + jexp <- case marg of + Nothing -> pure $ javaLambda var jbody + where + var = Name "r" + jbody = javaExpressionNameToJavaExpression $ + fieldExpression (variableToJavaIdentifier var) (javaIdentifier $ unName fname) + Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier $ unName fname) + where + qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg + return jexp + EliminationProduct (TupleProjection arity idx) -> if arity > javaMaxTupleLength + then fail $ "Tuple eliminations of arity greater than " ++ show javaMaxTupleLength ++ " are unsupported" + else pure $ case marg of + Nothing -> javaLambda var $ accessExpr $ javaIdentifierToJavaExpression $ variableToJavaIdentifier var + where + var = Name "w" + Just jarg -> accessExpr jarg + where + accessExpr jarg = javaFieldAccessToJavaExpression $ Java.FieldAccess qual accessor + where + accessor = javaIdentifier $ "object" ++ show (idx + 1) + qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg + EliminationUnion (CaseStatement tname def fields) -> do + case marg of + Nothing -> do + g <- getState + let lhs = setTermType (Just $ Types.function (TypeVariable tname) cod) $ Terms.elimination elm + let var = "u" + encodeTerm aliases $ Terms.lambda var $ Terms.apply lhs (Terms.var var) + -- TODO: default value + Just jarg -> applyElimination jarg + where + applyElimination jarg = do + let prim = javaExpressionToJavaPrimary jarg + let consId = innerClassRef aliases tname $ case def of + Nothing -> visitorName + Just _ -> partialVisitorName + jcod <- adaptTypeToJavaAndEncode aliases cod + rt <- javaTypeToJavaReferenceType jcod + let targs = typeArgsOrDiamond $ javaTypeArgumentsForType dom ++ [Java.TypeArgumentReference rt] + otherwiseBranches <- case def of + Nothing -> pure [] + Just d -> do + b <- otherwiseBranch jcod d + return [b] + visitBranches <- CM.mapM (visitBranch jcod) fields + let body = Java.ClassBody $ otherwiseBranches ++ visitBranches + let visitor = javaConstructorCall (javaConstructorName consId $ Just targs) [] (Just body) + return $ javaMethodInvocationToJavaExpression $ + methodInvocation (Just $ Right prim) (Java.Identifier acceptMethodName) [visitor] + where + otherwiseBranch jcod d = do + targs <- javaTypeArgumentsForNamedType tname + let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True targs tname Nothing + let mods = [Java.MethodModifierPublic] + let anns = [overrideAnnotation] + let param = javaTypeToJavaFormalParameter jdom $ Name instanceName + let result = Java.ResultType $ Java.UnannType jcod + jret <- encodeTerm aliases d + let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret + return $ noComment $ methodDeclaration mods [] anns otherwiseMethodName [param] result (Just [returnStmt]) + + visitBranch jcod field = do + targs <- javaTypeArgumentsForNamedType tname + let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True targs tname (Just $ capitalize $ unName $ fieldName field) + let mods = [Java.MethodModifierPublic] + let anns = [overrideAnnotation] + let param = javaTypeToJavaFormalParameter jdom $ Name instanceName + let result = Java.ResultType $ Java.UnannType jcod + -- Note: the escaping is necessary because the instance.value field reference does not correspond to an actual Hydra projection term + let value = Terms.var ("$" ++ instanceName ++ "." ++ valueFieldName) + jret <- encodeTerm aliases $ contractTerm $ Terms.apply (fieldTerm field) value + let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret + return $ noComment $ methodDeclaration mods [] anns visitMethodName [param] result (Just [returnStmt]) + EliminationWrap name -> case marg of + Nothing -> pure $ javaLambda var jbody + where + var = Name "w" + arg = javaIdentifierToJavaExpression $ variableToJavaIdentifier var + jbody = javaConstructorCall (javaConstructorName (nameToJavaName aliases name) Nothing) [arg] Nothing + Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier valueFieldName) + where + qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg + _ -> pure $ encodeLiteral $ LiteralString $ + "Unimplemented elimination variant: " ++ show (eliminationVariant elm) -- TODO: temporary + +encodeFunction :: Aliases -> Type -> Type -> Function -> Flow Graph Java.Expression +encodeFunction aliases dom cod fun = case fun of + FunctionElimination elm -> withTrace ("elimination (" ++ show (eliminationVariant elm) ++ ")") $ do + encodeElimination aliases Nothing dom cod elm + FunctionLambda (Lambda var _ body) -> withTrace ("lambda " ++ unName var) $ do + lam <- toLambda var body + if needsCast body + then do + jtype <- adaptTypeToJavaAndEncode aliases (TypeFunction $ FunctionType dom cod) + rt <- javaTypeToJavaReferenceType jtype + return $ javaCastExpressionToJavaExpression $ + javaCastExpression rt (javaExpressionToJavaUnaryExpression lam) + else return lam + where + needsCast _ = True -- TODO: try to discriminate between lambdas which really need a cast, and those which do not + _ -> pure $ encodeLiteral $ LiteralString $ + "Unimplemented function variant: " ++ show (functionVariant fun) -- TODO: temporary + where + toLambda var body = maybeLet aliases body cons + where + cons aliases' term stmts = if L.null stmts + then do + jbody <- encodeTerm aliases term + return $ javaLambda var jbody + else do + jbody <- encodeTerm aliases term + return $ javaLambdaFromBlock var $ Java.Block $ stmts + ++ [Java.BlockStatementStatement $ javaReturnStatement $ Just jbody] + +encodeLiteral :: Literal -> Java.Expression +encodeLiteral lit = javaLiteralToJavaExpression $ case lit of + LiteralBoolean b -> javaBoolean b + LiteralFloat f -> Java.LiteralFloatingPoint $ Java.FloatingPointLiteral $ case f of + FloatValueFloat32 v -> realToFrac v + FloatValueFloat64 v -> v + LiteralInteger i -> case i of + IntegerValueBigint v -> integer v -- BigInteger + IntegerValueInt8 v -> integer $ fromIntegral v -- byte + IntegerValueInt16 v -> integer $ fromIntegral v -- short + IntegerValueInt32 v -> integer $ fromIntegral v -- int + IntegerValueInt64 v -> integer $ fromIntegral v -- long + IntegerValueUint16 v -> Java.LiteralCharacter $ fromIntegral v -- char + where + integer = Java.LiteralInteger . Java.IntegerLiteral + LiteralString s -> javaString s + +-- Note: we use Java object types everywhere, rather than primitive types, as the latter cannot be used +-- to build function types, parameterized types, etc. +encodeLiteralType :: LiteralType -> Flow Graph Java.Type +encodeLiteralType lt = case lt of + LiteralTypeBoolean -> simple "Boolean" + LiteralTypeFloat ft -> case ft of + FloatTypeFloat32 -> simple "Float" + FloatTypeFloat64 -> simple "Double" + FloatTypeBigfloat -> simple "Double" -- TODO: type adapter should prevent this +-- _ -> fail $ "unexpected float type: " ++ show ft + LiteralTypeInteger it -> case it of + IntegerTypeBigint -> pure $ javaRefType [] (Just $ javaPackageName ["java", "math"]) "BigInteger" + IntegerTypeInt8 -> simple "Byte" + IntegerTypeInt16 -> simple "Short" + IntegerTypeInt32 -> simple "Integer" + IntegerTypeInt64 -> simple "Long" + IntegerTypeUint16 -> simple "Character" + _ -> fail $ "unexpected integer type: " ++ show it + LiteralTypeString -> simple "String" + _ -> fail $ "unexpected literal type: " ++ show lt + where + simple n = pure $ javaRefType [] Nothing n + +encodeNullaryConstant :: Aliases -> Type -> Function -> Flow Graph Java.Expression +encodeNullaryConstant aliases typ fun = case fun of + FunctionPrimitive name -> functionCall aliases True name [] + _ -> unexpected "nullary function" $ show fun + +encodeTerm :: Aliases -> Term -> Flow Graph Java.Expression +encodeTerm aliases term0 = encodeInternal [] term0 + where + encode = encodeTerm aliases + failAsLiteral msg = pure $ encodeLiteral $ LiteralString msg + encodeInternal anns term = case term of + TermAnnotated (AnnotatedTerm term' ann) -> encodeInternal (ann:anns) term' + + TermApplication app -> withTrace "encode application" $ encodeApplication aliases app + + TermFunction f -> withTrace ("encode function (" ++ show (functionVariant f) ++ ")") $ do + t <- requireTermType term0 + case stripType t of + TypeFunction (FunctionType dom cod) -> do + encodeFunction aliases dom cod f + _ -> encodeNullaryConstant aliases t f + + TermLet _ -> fail $ "nested let is unsupported for Java: " ++ showTerm term + + TermList els -> do + jels <- CM.mapM encode els + return $ javaMethodInvocationToJavaExpression $ + methodInvocationStatic (Java.Identifier "java.util.Arrays") (Java.Identifier "asList") jels + + TermLiteral l -> pure $ encodeLiteral l + + TermOptional mt -> case mt of + Nothing -> pure $ javaMethodInvocationToJavaExpression $ + methodInvocationStatic (Java.Identifier "hydra.util.Opt") (Java.Identifier "empty") [] + Just term1 -> do + expr <- encode term1 + return $ javaMethodInvocationToJavaExpression $ + methodInvocationStatic (Java.Identifier "hydra.util.Opt") (Java.Identifier "of") [expr] + + TermProduct terms -> do + jterms <- CM.mapM encode terms + let tupleTypeName = "hydra.util.Tuple.Tuple" ++ show (length terms) + return $ javaConstructorCall (javaConstructorName (Java.Identifier tupleTypeName) Nothing) jterms Nothing + + TermRecord (Record name fields) -> do + fieldExprs <- CM.mapM encode (fieldTerm <$> fields) + let consId = nameToJavaName aliases name + return $ javaConstructorCall (javaConstructorName consId Nothing) fieldExprs Nothing + + TermSet s -> do + jels <- CM.mapM encode $ S.toList s + let prim = javaMethodInvocationToJavaPrimary $ + methodInvocationStatic (Java.Identifier "java.util.Stream") (Java.Identifier "of") jels + let coll = javaMethodInvocationToJavaExpression $ + methodInvocationStatic (Java.Identifier "java.util.stream.Collectors") (Java.Identifier "toSet") [] + return $ javaMethodInvocationToJavaExpression $ + methodInvocation (Just $ Right prim) (Java.Identifier "collect") [coll] + + TermTyped (TypedTerm term1 _) -> encodeInternal anns term1 + + TermUnion (Injection name (Field (Name fname) v)) -> do + let (Java.Identifier typeId) = nameToJavaName aliases name + let consId = Java.Identifier $ typeId ++ "." ++ sanitizeJavaName (capitalize fname) + args <- if isUnitTerm v + then return [] + else do + ex <- encode v + return [ex] + return $ javaConstructorCall (javaConstructorName consId Nothing) args Nothing + + TermVariable name -> encodeVariable aliases name + + TermWrap (WrappedTerm tname arg) -> do + jarg <- encode arg + return $ javaConstructorCall (javaConstructorName (nameToJavaName aliases tname) Nothing) [jarg] Nothing + + _ -> failAsLiteral $ "Unimplemented term variant: " ++ show (termVariant term) + +encodeType :: Aliases -> Type -> Flow Graph Java.Type +encodeType aliases t = case stripType t of + TypeApplication (ApplicationType lhs rhs) -> do + jlhs <- encode lhs + jrhs <- encode rhs >>= javaTypeToJavaReferenceType + addJavaTypeParameter jrhs jlhs + TypeFunction (FunctionType dom cod) -> do + jdom <- encode dom >>= javaTypeToJavaReferenceType + jcod <- encode cod >>= javaTypeToJavaReferenceType + return $ javaRefType [jdom, jcod] javaUtilFunctionPackageName "Function" + TypeLambda (LambdaType (Name v) body) -> do + jbody <- encode body + addJavaTypeParameter (javaTypeVariable v) jbody + TypeList et -> do + jet <- encode et + if listsAsArrays + then toJavaArrayType jet + else do + rt <- javaTypeToJavaReferenceType jet + return $ javaRefType [rt] javaUtilPackageName "List" + TypeLiteral lt -> encodeLiteralType lt + TypeMap (MapType kt vt) -> do + jkt <- encode kt >>= javaTypeToJavaReferenceType + jvt <- encode vt >>= javaTypeToJavaReferenceType + return $ javaRefType [jkt, jvt] javaUtilPackageName "Map" + TypeProduct types -> case types of + [] -> unit + _ -> do + jtypes <- CM.mapM encode types >>= mapM javaTypeToJavaReferenceType + return $ javaRefType jtypes hydraUtilPackageName $ "Tuple.Tuple" ++ (show $ length types) + TypeRecord (RowType _Unit []) -> unit + TypeRecord (RowType name _) -> pure $ + Java.TypeReference $ nameToJavaReferenceType aliases True (javaTypeArgumentsForType t) name Nothing + TypeOptional ot -> do + jot <- encode ot >>= javaTypeToJavaReferenceType + return $ javaRefType [jot] hydraUtilPackageName "Opt" + TypeSet st -> do + jst <- encode st >>= javaTypeToJavaReferenceType + return $ javaRefType [jst] javaUtilPackageName "Set" + TypeUnion (RowType name _) -> pure $ + Java.TypeReference $ nameToJavaReferenceType aliases True (javaTypeArgumentsForType t) name Nothing + TypeVariable name -> forReference name + TypeWrap (WrappedType name _) -> forReference name + _ -> fail $ "can't encode unsupported type in Java: " ++ show t + where + forReference name = pure $ if isLambdaBoundVariable name + then variableReference name + else nameReference name + nameReference name = Java.TypeReference $ nameToJavaReferenceType aliases True [] name Nothing + variableReference name = Java.TypeReference $ javaTypeVariable $ unName name + encode = encodeType aliases + unit = return $ javaRefType [] javaLangPackageName "Void" + +encodeVariable :: Aliases -> Name -> Flow Graph Java.Expression +encodeVariable aliases name = if isRecursiveVariable aliases name + then return $ javaMethodInvocationToJavaExpression $ + methodInvocation (Just $ Left $ Java.ExpressionName Nothing jid) (Java.Identifier getMethodName) [] + else do + cls <- classifyDataReference name + return $ case cls of + JavaSymbolLocalVariable -> javaIdentifierToJavaExpression $ elementJavaIdentifier False False aliases name + JavaSymbolClassConstant -> javaIdentifierToJavaExpression $ elementJavaIdentifier False False aliases name + JavaSymbolClassNullaryFunction -> javaIdentifierToJavaExpression $ elementJavaIdentifier False True aliases name -- TODO + JavaSymbolClassUnaryFunction -> javaIdentifierToJavaExpression $ elementJavaIdentifier False True aliases name + where + jid = javaIdentifier $ unName name + +fieldToNullCheckStatement :: FieldType -> Java.BlockStatement +fieldToNullCheckStatement field = Java.BlockStatementStatement $ javaMethodInvocationToJavaStatement $ Java.MethodInvocation header [arg] + where + arg = javaIdentifierToJavaExpression $ fieldNameToJavaIdentifier $ fieldTypeName field + header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $ + Java.Identifier "java.util.Objects.requireNonNull" + +fieldTypeToFormalParam aliases (FieldType fname ft) = do + jt <- adaptTypeToJavaAndEncode aliases ft + return $ javaTypeToJavaFormalParameter jt fname + +functionCall :: Aliases -> Bool -> Name -> [Term] -> Flow Graph Java.Expression +functionCall aliases isPrim name args = do + jargs <- CM.mapM (encodeTerm aliases) args + if isLocalVariable name + then do + prim <- javaExpressionToJavaPrimary <$> encodeVariable aliases name + return $ javaMethodInvocationToJavaExpression $ + methodInvocation (Just $ Right prim) (Java.Identifier applyMethodName) jargs + else do + let header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $ elementJavaIdentifier isPrim False aliases name + return $ javaMethodInvocationToJavaExpression $ Java.MethodInvocation header jargs + +getCodomain :: M.Map Name Term -> Flow Graph Type +getCodomain ann = functionTypeCodomain <$> getFunctionType ann + +getFunctionType :: M.Map Name Term -> Flow Graph FunctionType +getFunctionType ann = do + mt <- getType ann + case mt of + Nothing -> fail "type annotation is required for function and elimination terms in Java" + Just t -> case t of + TypeFunction ft -> return ft + _ -> unexpected "function type (3)" $ show t + +innerClassRef :: Aliases -> Name -> String -> Java.Identifier +innerClassRef aliases name local = Java.Identifier $ id ++ "." ++ local + where + Java.Identifier id = nameToJavaName aliases name + +interfaceTypes :: Bool -> [Java.InterfaceType] +interfaceTypes isSer = if isSer then [javaSerializableType] else [] + where + javaSerializableType = Java.InterfaceType $ + Java.ClassType [] Java.ClassTypeQualifierNone (javaTypeIdentifier "Serializable") [] + +isLambdaBoundVariable :: Name -> Bool +isLambdaBoundVariable (Name v) = L.length v <= 4 + +isLocalVariable :: Name -> Bool +isLocalVariable name = Y.isNothing $ qualifiedNameNamespace $ qualifyNameEager name + +isRecursiveVariable :: Aliases -> Name -> Bool +isRecursiveVariable aliases name = S.member name (aliasesRecursiveVars aliases) + +javaTypeArgumentsForNamedType :: Name -> Flow Graph [Java.TypeArgument] +javaTypeArgumentsForNamedType tname = do + params <- javaTypeParametersForType <$> requireType tname + return $ typeParameterToTypeArgument <$> params + +javaTypeArgumentsForType :: Type -> [Java.TypeArgument] +javaTypeArgumentsForType typ = L.reverse (typeParameterToTypeArgument <$> javaTypeParametersForType typ) + +-- Note: this is somewhat of a hack; it compensates for the irregular way in which type parameters are currently used. +-- When this irregularity is resolved, a better approach will be to simply pick up type parameters from type applications. +javaTypeParametersForType :: Type -> [Java.TypeParameter] +javaTypeParametersForType typ = toParam <$> vars + where + toParam (Name v) = Java.TypeParameter [] (javaTypeIdentifier $ capitalize v) Nothing + vars = L.nub $ boundVars typ ++ freeVars + boundVars t = case stripType t of + TypeLambda (LambdaType v body) -> v:(boundVars body) + _ -> [] + freeVars = L.filter isLambdaBoundVariable $ S.toList $ freeVariablesInType typ + +maybeLet :: Aliases -> Term -> (Aliases -> Term -> [Java.BlockStatement] -> Flow Graph x) -> Flow Graph x +maybeLet aliases term cons = helper Nothing [] term + where + -- Note: let-flattening could be done at the top level for better efficiency + helper mtyp anns term = case flattenLetTerms term of + TermAnnotated (AnnotatedTerm term' ann) -> helper mtyp (ann:anns) term' + TermTyped (TypedTerm term' typ) -> helper (Just typ) anns term' + TermLet (Let bindings env) -> do + stmts <- L.concat <$> CM.mapM toDeclStatements sorted + maybeLet aliasesWithRecursive env $ \aliases' tm stmts' -> cons aliases' (reannotate mtyp anns tm) (stmts ++ stmts') + where + aliasesWithRecursive = aliases { aliasesRecursiveVars = recursiveVars } + toDeclStatements names = do + inits <- Y.catMaybes <$> CM.mapM toDeclInit names + impls <- CM.mapM toDeclStatement names + return $ inits ++ impls + + toDeclInit name = if S.member name recursiveVars + then do + -- TODO: repeated + let value = letBindingTerm $ L.head $ L.filter (\b -> letBindingName b == name) bindings + typ <- requireTermType value + jtype <- adaptTypeToJavaAndEncode aliasesWithRecursive typ + let id = variableToJavaIdentifier name + + let pkg = javaPackageName ["java", "util", "concurrent", "atomic"] + let arid = Java.Identifier "java.util.concurrent.atomic.AtomicReference" -- TODO + let aid = Java.AnnotatedIdentifier [] arid + rt <- javaTypeToJavaReferenceType jtype + let targs = typeArgsOrDiamond [Java.TypeArgumentReference rt] + let ci = Java.ClassOrInterfaceTypeToInstantiate [aid] (Just targs) + let body = javaConstructorCall ci [] Nothing + let artype = javaRefType [rt] (Just pkg) "AtomicReference" + return $ Just $ variableDeclarationStatement aliasesWithRecursive artype id body + else pure Nothing + + toDeclStatement name = do + -- TODO: repeated + let value = letBindingTerm $ L.head $ L.filter (\b -> letBindingName b == name) bindings + typ <- requireTermType value + jtype <- adaptTypeToJavaAndEncode aliasesWithRecursive typ + let id = variableToJavaIdentifier name + rhs <- encodeTerm aliasesWithRecursive value + return $ if S.member name recursiveVars + then Java.BlockStatementStatement $ javaMethodInvocationToJavaStatement $ + methodInvocation (Just $ Left $ Java.ExpressionName Nothing id) (Java.Identifier setMethodName) [rhs] + else variableDeclarationStatement aliasesWithRecursive jtype id rhs + bindingVars = S.fromList (letBindingName <$> bindings) + recursiveVars = S.fromList $ L.concat (ifRec <$> sorted) + where + ifRec names = case names of + [name] -> case M.lookup name allDeps of + Nothing -> [] + Just deps -> if S.member name deps + then [name] + else [] + _ -> names + allDeps = M.fromList (toDeps <$> bindings) + where + toDeps (LetBinding key value _) = (key, S.filter (\n -> S.member n bindingVars) $ freeVariablesInTerm value) + sorted = topologicalSortComponents (toDeps <$> M.toList allDeps) + where + toDeps (key, deps) = (key, S.toList deps) + _ -> cons aliases (reannotate mtyp anns term) [] + +moduleToJavaCompilationUnit :: Module -> Flow Graph (M.Map Name Java.CompilationUnit) +moduleToJavaCompilationUnit mod = transformModule javaLanguage encode constructModule mod + where + aliases = importAliasesForModule mod + encode = encodeTerm aliases . contractTerm + +noComment :: Java.ClassBodyDeclaration -> Java.ClassBodyDeclarationWithComments +noComment decl = Java.ClassBodyDeclarationWithComments decl Nothing + +reannotate mtyp anns term = case mtyp of + Nothing -> base + Just typ -> TermTyped (TypedTerm base typ) + where + base = reann anns term + reann anns term = case anns of + [] -> term + (h:r) -> reann r $ TermAnnotated (AnnotatedTerm term h) + +toClassDecl :: Bool -> Bool -> Aliases -> [Java.TypeParameter] + -> Name -> Type -> Flow Graph Java.ClassDeclaration +toClassDecl isInner isSer aliases tparams elName t = case stripType t of + TypeRecord rt -> declarationForRecordType isInner isSer aliases tparams elName $ rowTypeFields rt + TypeUnion rt -> declarationForUnionType isSer aliases tparams elName $ rowTypeFields rt + TypeLambda ut -> declarationForLambdaType isSer aliases tparams elName ut + TypeWrap (WrappedType tname wt) -> declarationForRecordType isInner isSer aliases tparams elName + [FieldType (Name "value") wt] + -- Other types are not supported as class declarations, so we wrap them as record types. + _ -> wrap t -- TODO: wrap and unwrap the corresponding terms as record terms. + where + wrap t' = declarationForRecordType isInner isSer aliases tparams elName [Types.field valueFieldName $ stripType t'] + +toDataDeclaration :: Aliases -> (a, TypedTerm) -> Flow Graph a +toDataDeclaration aliases (el, TypedTerm term typ) = do + fail "not implemented" -- TODO + +typeArgsOrDiamond :: [Java.TypeArgument] -> Java.TypeArgumentsOrDiamond +typeArgsOrDiamond args = if supportsDiamondOperator javaFeatures + then Java.TypeArgumentsOrDiamondDiamond + else Java.TypeArgumentsOrDiamondArguments args diff --git a/src/main/haskell/Hydra/Ext/Java/Names.hs b/src/main/haskell/Hydra/Ext/Java/Names.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Java/Names.hs @@ -0,0 +1,39 @@ +module Hydra.Ext.Java.Names where + +import Hydra.Kernel + +import qualified Hydra.Ext.Java.Syntax as Java + + +acceptMethodName = "accept" :: String +applyMethodName = "apply" :: String +equalsMethodName = "equals" :: String +getMethodName = "get" :: String +hashCodeMethodName = "hashCode" :: String +instanceName = "instance" :: String +otherInstanceName = "other" :: String +otherwiseMethodName = "otherwise" :: String +partialVisitorName = "PartialVisitor" :: String +setMethodName = "set" :: String +valueFieldName = "value" :: String +visitMethodName = "visit" :: String +visitorName = "Visitor" :: String +visitorReturnParameter = "R" :: String + +javaPackageName :: [String] -> Java.PackageName +javaPackageName parts = Java.PackageName (Java.Identifier <$> parts) + +hydraCorePackageName :: Maybe Java.PackageName +hydraCorePackageName = Just $ javaPackageName ["hydra", "core"] + +hydraUtilPackageName :: Maybe Java.PackageName +hydraUtilPackageName = Just $ javaPackageName ["hydra", "util"] + +javaLangPackageName :: Maybe Java.PackageName +javaLangPackageName = Just $ javaPackageName ["java", "lang"] + +javaUtilFunctionPackageName :: Maybe Java.PackageName +javaUtilFunctionPackageName = Just $ javaPackageName ["java", "util", "function"] + +javaUtilPackageName :: Maybe Java.PackageName +javaUtilPackageName = Just $ javaPackageName ["java", "util"] diff --git a/src/main/haskell/Hydra/Ext/Java/Serde.hs b/src/main/haskell/Hydra/Ext/Java/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Java/Serde.hs @@ -0,0 +1,926 @@ +module Hydra.Ext.Java.Serde where + +import Hydra.Tools.Serialization +import qualified Hydra.Ast as CT +import qualified Hydra.Ext.Java.Syntax as Java +import Hydra.Messages + +import qualified Data.List as L +import qualified Data.Maybe as Y + + +sanitizeJavaComment :: String -> String +sanitizeJavaComment s = L.concat (fromChar <$> s) + where + fromChar c = case c of + '<' -> "<" + '>' -> ">" + _ -> [c] + +singleLineComment :: String -> CT.Expr +singleLineComment c = cst $ "// " ++ sanitizeJavaComment c + +withComments :: Maybe String -> CT.Expr -> CT.Expr +withComments mc expr = case mc of + Nothing -> expr + Just c -> newlineSep [writeComments c, expr] + where + writeComments c = cst $ "/**\n" ++ unlines (toLine <$> (lines $ sanitizeJavaComment c)) ++ " */" + where + toLine l = " * " ++ l + +writeAdditionalBound :: Java.AdditionalBound -> CT.Expr +writeAdditionalBound _ = cst "TODO:AdditionalBound" + +writeAdditiveExpression :: Java.AdditiveExpression -> CT.Expr +writeAdditiveExpression e = case e of + Java.AdditiveExpressionUnary m -> writeMultiplicativeExpression m + Java.AdditiveExpressionPlus (Java.AdditiveExpression_Binary lhs rhs) -> + infixWs "+" (writeAdditiveExpression lhs) (writeMultiplicativeExpression rhs) + Java.AdditiveExpressionMinus (Java.AdditiveExpression_Binary lhs rhs) -> + infixWs "-" (writeAdditiveExpression lhs) (writeMultiplicativeExpression rhs) + +writeAmbiguousName :: Java.AmbiguousName -> CT.Expr +writeAmbiguousName (Java.AmbiguousName parts) = dotSep (writeIdentifier <$> parts) + +writeAndExpression :: Java.AndExpression -> CT.Expr +writeAndExpression (Java.AndExpression eqs) = infixWsList "&" (writeEqualityExpression <$> eqs) + +writeAnnotatedIdentifier :: Java.AnnotatedIdentifier -> CT.Expr +writeAnnotatedIdentifier (Java.AnnotatedIdentifier anns id) = writeIdentifier id -- Note: ignoring annotations for now + +writeAnnotation :: Java.Annotation -> CT.Expr +writeAnnotation ann = case ann of + Java.AnnotationNormal n -> writeNormalAnnotation n + Java.AnnotationMarker m -> writeMarkerAnnotation m + Java.AnnotationSingleElement s -> writeSingleElementAnnotation s + +writeAnnotationTypeDeclaration :: Java.AnnotationTypeDeclaration -> CT.Expr +writeAnnotationTypeDeclaration _ = cst "TODO:AnnotationTypeDeclaration" + +writeArrayAccess :: Java.ArrayAccess -> CT.Expr +writeArrayAccess _ = cst "TODO:ArrayAccess" + +writeArrayCreationExpression :: Java.ArrayCreationExpression -> CT.Expr +writeArrayCreationExpression _ = cst "TODO:ArrayCreationExpression" + +writeArrayInitializer :: Java.ArrayInitializer -> CT.Expr +writeArrayInitializer _ = cst "TODO:ArrayInitializer" + +writeArrayType :: Java.ArrayType -> CT.Expr +writeArrayType _ = cst "TODO:ArrayType" + +writeAssertStatement :: Java.AssertStatement -> CT.Expr +writeAssertStatement _ = cst "TODO:AssertStatement" + +writeAssignment :: Java.Assignment -> CT.Expr +writeAssignment (Java.Assignment lhs op rhs) = infixWs ctop (writeLeftHandSide lhs) (writeExpression rhs) + where + ctop = case op of + Java.AssignmentOperatorSimple -> "=" + Java.AssignmentOperatorTimes -> "*=" + Java.AssignmentOperatorDiv -> "/=" + Java.AssignmentOperatorMod -> "%=" + Java.AssignmentOperatorPlus -> "+=" + Java.AssignmentOperatorMinus -> "-=" + Java.AssignmentOperatorShiftLeft -> "<<=" + Java.AssignmentOperatorShiftRight -> ">>=" + Java.AssignmentOperatorShiftRightZeroFill -> ">>>=" + Java.AssignmentOperatorAnd -> "&=" + Java.AssignmentOperatorXor -> "^=" + Java.AssignmentOperatorOr -> "|=" + +writeAssignmentExpression :: Java.AssignmentExpression -> CT.Expr +writeAssignmentExpression e = case e of + Java.AssignmentExpressionConditional c -> writeConditionalExpression c + Java.AssignmentExpressionAssignment a -> writeAssignment a + +writeBlock :: Java.Block -> CT.Expr +writeBlock (Java.Block stmts) = curlyBlock fullBlockStyle $ newlineSep (writeBlockStatement <$> stmts) + +writeBlockStatement :: Java.BlockStatement -> CT.Expr +writeBlockStatement s = case s of + Java.BlockStatementLocalVariableDeclaration d -> writeLocalVariableDeclarationStatement d + Java.BlockStatementClass cd -> writeClassDeclaration cd + Java.BlockStatementStatement s -> writeStatement s + +writeBreakStatement :: Java.BreakStatement -> CT.Expr +writeBreakStatement _ = cst "TODO:BreakStatement" + +writeCastExpression :: Java.CastExpression -> CT.Expr +writeCastExpression e = case e of + Java.CastExpressionPrimitive p -> writeCastExpression_Primitive p + Java.CastExpressionNotPlusMinus npm -> writeCastExpression_NotPlusMinus npm + Java.CastExpressionLambda l -> writeCastExpression_Lambda l + +writeCastExpression_Lambda :: Java.CastExpression_Lambda -> CT.Expr +writeCastExpression_Lambda _ = cst "TODO:CastExpression_Lambda" + +writeCastExpression_NotPlusMinus :: Java.CastExpression_NotPlusMinus -> CT.Expr +writeCastExpression_NotPlusMinus (Java.CastExpression_NotPlusMinus rb ex) = spaceSep [ + writeCastExpression_RefAndBounds rb, + writeUnaryExpression ex] + +writeCastExpression_RefAndBounds :: Java.CastExpression_RefAndBounds -> CT.Expr +writeCastExpression_RefAndBounds (Java.CastExpression_RefAndBounds rt adds) = parenList False [spaceSep $ Y.catMaybes [ + Just $ writeReferenceType rt, + if L.null adds then Nothing else Just $ spaceSep (writeAdditionalBound <$> adds)]] + +writeCastExpression_Primitive :: Java.CastExpression_Primitive -> CT.Expr +writeCastExpression_Primitive _ = cst "TODO:CastExpression_Primitive" + +writeCharacterLiteral :: Int -> CT.Expr +writeCharacterLiteral _ = cst "TODO:CharacterLiteral" + +writeClassBody :: Java.ClassBody -> CT.Expr +writeClassBody (Java.ClassBody decls) = curlyBlock fullBlockStyle $ + doubleNewlineSep (writeClassBodyDeclarationWithComments <$> decls) + +writeClassBodyDeclaration :: Java.ClassBodyDeclaration -> CT.Expr +writeClassBodyDeclaration d = case d of + Java.ClassBodyDeclarationClassMember d -> writeClassMemberDeclaration d + Java.ClassBodyDeclarationInstanceInitializer i -> writeInstanceInitializer i + Java.ClassBodyDeclarationStaticInitializer i -> writeStaticInitializer i + Java.ClassBodyDeclarationConstructorDeclaration d -> writeConstructorDeclaration d + +writeClassBodyDeclarationWithComments :: Java.ClassBodyDeclarationWithComments -> CT.Expr +writeClassBodyDeclarationWithComments (Java.ClassBodyDeclarationWithComments d mc) = withComments mc $ + writeClassBodyDeclaration d + +writeClassDeclaration :: Java.ClassDeclaration -> CT.Expr +writeClassDeclaration d = case d of + Java.ClassDeclarationNormal nd -> writeNormalClassDeclaration nd + Java.ClassDeclarationEnum ed -> writeEnumDeclaration ed + +writeClassInstanceCreationExpression :: Java.ClassInstanceCreationExpression -> CT.Expr +writeClassInstanceCreationExpression (Java.ClassInstanceCreationExpression mqual e) = case mqual of + Nothing -> writeUnqualifiedClassInstanceCreationExpression e + Just q -> dotSep [writeClassInstanceCreationExpression_Qualifier q, writeUnqualifiedClassInstanceCreationExpression e] + +writeClassInstanceCreationExpression_Qualifier :: Java.ClassInstanceCreationExpression_Qualifier -> CT.Expr +writeClassInstanceCreationExpression_Qualifier q = case q of + Java.ClassInstanceCreationExpression_QualifierExpression en -> writeExpressionName en + Java.ClassInstanceCreationExpression_QualifierPrimary p -> writePrimary p + +writeClassLiteral :: Java.ClassLiteral -> CT.Expr +writeClassLiteral _ = cst "TODO:ClassLiteral" + +writeClassMemberDeclaration :: Java.ClassMemberDeclaration -> CT.Expr +writeClassMemberDeclaration d = case d of + Java.ClassMemberDeclarationField fd -> writeFieldDeclaration fd + Java.ClassMemberDeclarationMethod md -> writeMethodDeclaration md + Java.ClassMemberDeclarationClass cd -> writeClassDeclaration cd + Java.ClassMemberDeclarationInterface id -> writeInterfaceDeclaration id + Java.ClassMemberDeclarationNone -> semi + +writeClassModifier :: Java.ClassModifier -> CT.Expr +writeClassModifier m = case m of + Java.ClassModifierAnnotation ann -> writeAnnotation ann + Java.ClassModifierPublic -> cst "public" + Java.ClassModifierProtected -> cst "protected" + Java.ClassModifierPrivate -> cst "private" + Java.ClassModifierAbstract -> cst "abstract" + Java.ClassModifierStatic -> cst "static" + Java.ClassModifierFinal -> cst "final" + Java.ClassModifierStrictfp -> cst "strictfp" + +writeClassOrInterfaceType :: Java.ClassOrInterfaceType -> CT.Expr +writeClassOrInterfaceType cit = case cit of + Java.ClassOrInterfaceTypeClass ct -> writeClassType ct + Java.ClassOrInterfaceTypeInterface it -> writeInterfaceType it + +writeClassOrInterfaceTypeToInstantiate :: Java.ClassOrInterfaceTypeToInstantiate -> CT.Expr +writeClassOrInterfaceTypeToInstantiate (Java.ClassOrInterfaceTypeToInstantiate ids margs) = + noSep $ Y.catMaybes [ + Just $ dotSep (writeAnnotatedIdentifier <$> ids), + writeTypeArgumentsOrDiamond <$> margs] + +writeClassType :: Java.ClassType -> CT.Expr +writeClassType (Java.ClassType anns qual id args) = noSep $ Y.catMaybes [ + Just $ spaceSep $ Y.catMaybes [ + if L.null anns then Nothing else Just $ commaSep inlineStyle (writeAnnotation <$> anns), + Just qualifiedId], + if L.null args then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> args)] + where + qualifiedId = case qual of + Java.ClassTypeQualifierNone -> writeTypeIdentifier id + Java.ClassTypeQualifierPackage pkg -> dotSep [writePackageName pkg, writeTypeIdentifier id] + Java.ClassTypeQualifierParent cit -> dotSep [writeClassOrInterfaceType cit, writeTypeIdentifier id] + +writeCompilationUnit :: Java.CompilationUnit -> CT.Expr +writeCompilationUnit u = case u of + Java.CompilationUnitOrdinary (Java.OrdinaryCompilationUnit mpkg imports types) -> doubleNewlineSep $ Y.catMaybes + [warning, pkgSec, importsSec, typesSec] + where + warning = Just $ singleLineComment warningAutoGeneratedFile + pkgSec = fmap writePackageDeclaration mpkg + importsSec = if L.null imports + then Nothing + else Just $ newlineSep (writeImportDeclaration <$> imports) + typesSec = if L.null types + then Nothing + else Just $ doubleNewlineSep (writeTypeDeclarationWithComments <$> types) + +writeConditionalAndExpression :: Java.ConditionalAndExpression -> CT.Expr +writeConditionalAndExpression (Java.ConditionalAndExpression ors) + = infixWsList "&&" (writeInclusiveOrExpression <$> ors) + +writeConditionalExpression :: Java.ConditionalExpression -> CT.Expr +writeConditionalExpression c = case c of + Java.ConditionalExpressionSimple co -> writeConditionalOrExpression co + Java.ConditionalExpressionTernaryCond tc -> writeConditionalExpression_TernaryCond tc + Java.ConditionalExpressionTernaryLambda tl -> writeConditionalExpression_TernaryLambda tl + +writeConditionalExpression_TernaryCond :: Java.ConditionalExpression_TernaryCond -> CT.Expr +writeConditionalExpression_TernaryCond _ = cst "TODO:ConditionalExpression_TernaryCond" + +writeConditionalExpression_TernaryLambda :: Java.ConditionalExpression_TernaryLambda -> CT.Expr +writeConditionalExpression_TernaryLambda _ = cst "TODO:ConditionalExpression_TernaryLambda" + +writeConditionalOrExpression :: Java.ConditionalOrExpression -> CT.Expr +writeConditionalOrExpression (Java.ConditionalOrExpression ands) + = infixWsList "||" (writeConditionalAndExpression <$> ands) + +writeConstantDeclaration :: Java.ConstantDeclaration -> CT.Expr +writeConstantDeclaration (Java.ConstantDeclaration mods typ vars) = suffixSemi $ spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeConstantModifier <$> mods), + Just $ writeUnannType typ, + Just $ commaSep inlineStyle (writeVariableDeclarator <$> vars)] + +writeConstantModifier :: Java.ConstantModifier -> CT.Expr +writeConstantModifier _ = cst "TODO:ConstantModifier" + +writeConstructorBody :: Java.ConstructorBody -> CT.Expr +writeConstructorBody (Java.ConstructorBody minvoc stmts) = curlyBlock fullBlockStyle $ doubleNewlineSep $ Y.catMaybes [ + writeExplicitConstructorInvocation <$> minvoc, + Just $ newlineSep (writeBlockStatement <$> stmts)] + +writeConstructorDeclaration :: Java.ConstructorDeclaration -> CT.Expr +writeConstructorDeclaration (Java.ConstructorDeclaration mods cons mthrows body) = spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeConstructorModifier <$> mods), + Just $ writeConstructorDeclarator cons, + writeThrows <$> mthrows, + Just $ writeConstructorBody body] + +writeConstructorDeclarator :: Java.ConstructorDeclarator -> CT.Expr +writeConstructorDeclarator (Java.ConstructorDeclarator tparams name mrecparam fparams) = spaceSep $ Y.catMaybes [ + if L.null tparams then Nothing else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams), + Just $ writeSimpleTypeName name, + writeReceiverParameter <$> mrecparam, + Just $ parenList False (writeFormalParameter <$> fparams)] + +writeConstructorModifier :: Java.ConstructorModifier -> CT.Expr +writeConstructorModifier m = case m of + Java.ConstructorModifierAnnotation ann -> writeAnnotation ann + Java.ConstructorModifierPublic -> cst "public" + Java.ConstructorModifierProtected -> cst "protected" + Java.ConstructorModifierPrivate -> cst "private" + +writeContinueStatement :: Java.ContinueStatement -> CT.Expr +writeContinueStatement _ = cst "TODO:ContinueStatement" + +writeDims :: Java.Dims -> CT.Expr +writeDims (Java.Dims anns) = noSep (write <$> anns) + where + write _ = cst "[]" -- Note: ignoring annotations on dimensions for now + +writeDoStatement :: Java.DoStatement -> CT.Expr +writeDoStatement _ = cst "TODO:DoStatement" + +writeElementValue :: Java.ElementValue -> CT.Expr +writeElementValue ev = case ev of + Java.ElementValueConditionalExpression c -> writeConditionalExpression c + Java.ElementValueElementValueArrayInitializer (Java.ElementValueArrayInitializer values) -> + commaSep inlineStyle (writeElementValue <$> values) + Java.ElementValueAnnotation ann -> writeAnnotation ann + +writeElementValuePair :: Java.ElementValuePair -> CT.Expr +writeElementValuePair (Java.ElementValuePair k v) = infixWs "=" (writeIdentifier k) (writeElementValue v) + +writeEmptyStatement :: Java.EmptyStatement -> CT.Expr +writeEmptyStatement _ = semi + +writeEnumDeclaration :: Java.EnumDeclaration -> CT.Expr +writeEnumDeclaration _ = cst "TODO:EnumDeclaration" + +writeEqualityExpression :: Java.EqualityExpression -> CT.Expr +writeEqualityExpression e = case e of + Java.EqualityExpressionUnary r -> writeRelationalExpression r + Java.EqualityExpressionEqual (Java.EqualityExpression_Binary lhs rhs) -> + infixWs "==" (writeEqualityExpression lhs) (writeRelationalExpression rhs) + Java.EqualityExpressionNotEqual (Java.EqualityExpression_Binary lhs rhs) -> + infixWs "!=" (writeEqualityExpression lhs) (writeRelationalExpression rhs) + +writeExclusiveOrExpression :: Java.ExclusiveOrExpression -> CT.Expr +writeExclusiveOrExpression (Java.ExclusiveOrExpression ands) = infixWsList "^" (writeAndExpression <$> ands) + +writeExplicitConstructorInvocation :: Java.ExplicitConstructorInvocation -> CT.Expr +writeExplicitConstructorInvocation _ = cst "TODO:ExplicitConstructorInvocation" + +writeExpression :: Java.Expression -> CT.Expr +writeExpression e = case e of + Java.ExpressionLambda l -> writeLambdaExpression l + Java.ExpressionAssignment a -> writeAssignmentExpression a + +writeExpressionName :: Java.ExpressionName -> CT.Expr +writeExpressionName (Java.ExpressionName mqual id) = dotSep $ Y.catMaybes [ + writeAmbiguousName <$> mqual, + Just $ writeIdentifier id] + +writeExpressionStatement :: Java.ExpressionStatement -> CT.Expr +writeExpressionStatement (Java.ExpressionStatement stmt) = suffixSemi $ writeStatementExpression stmt + +writeFieldAccess :: Java.FieldAccess -> CT.Expr +writeFieldAccess (Java.FieldAccess qual id) = dotSep $ case qual of + Java.FieldAccess_QualifierPrimary p -> [writePrimary p, writeIdentifier id] + Java.FieldAccess_QualifierSuper -> [cst "super", writeIdentifier id] + Java.FieldAccess_QualifierTyped tn -> [writeTypeName tn, cst "super", writeIdentifier id] + +writeFieldDeclaration :: Java.FieldDeclaration -> CT.Expr +writeFieldDeclaration (Java.FieldDeclaration mods typ vars) = suffixSemi $ spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeFieldModifier <$> mods), + Just $ writeUnannType typ, + Just $ commaSep inlineStyle (writeVariableDeclarator <$> vars)] + +writeFieldModifier :: Java.FieldModifier -> CT.Expr +writeFieldModifier m = case m of + Java.FieldModifierAnnotation ann -> writeAnnotation ann + Java.FieldModifierPublic -> cst "public" + Java.FieldModifierProtected -> cst "protected" + Java.FieldModifierPrivate -> cst "private" + Java.FieldModifierStatic -> cst "static" + Java.FieldModifierFinal -> cst "final" + Java.FieldModifierTransient -> cst "transient" + Java.FieldModifierVolatile -> cst "volatile" + +writeFloatingPointLiteral :: Java.FloatingPointLiteral -> CT.Expr +writeFloatingPointLiteral _ = cst "TODO:FloatingPointLiteral" + +writeFloatingPointType :: Java.FloatingPointType -> CT.Expr +writeFloatingPointType _ = cst "TODO:FloatingPointType" + +writeForStatement :: Java.ForStatement -> CT.Expr +writeForStatement _ = cst "TODO:ForStatement" + +writeFormalParameter :: Java.FormalParameter -> CT.Expr +writeFormalParameter p = case p of + Java.FormalParameterSimple s -> writeFormalParameter_Simple s + Java.FormalParameterVariableArity v -> writeVariableArityParameter v + +writeFormalParameter_Simple :: Java.FormalParameter_Simple -> CT.Expr +writeFormalParameter_Simple (Java.FormalParameter_Simple mods typ id) = spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeVariableModifier <$> mods), + Just $ writeUnannType typ, + Just $ writeVariableDeclaratorId id] + +writeIdentifier :: Java.Identifier -> CT.Expr +writeIdentifier (Java.Identifier s) = cst s + +writeIfThenStatement :: Java.IfThenStatement -> CT.Expr +writeIfThenStatement (Java.IfThenStatement cond thn) = spaceSep [ + cst "if", + parenList False [writeExpression cond], + writeBlock (Java.Block [Java.BlockStatementStatement thn])] + +writeIfThenElseStatement :: Java.IfThenElseStatement -> CT.Expr +writeIfThenElseStatement _ = cst "TODO:IfThenElseStatement" + +writeImportDeclaration :: Java.ImportDeclaration -> CT.Expr +writeImportDeclaration imp = case imp of + Java.ImportDeclarationSingleType (Java.SingleTypeImportDeclaration tn) -> suffixSemi $ + spaceSep [cst "import", writeTypeName tn] + Java.ImportDeclarationTypeImportOnDemand d -> cst "TODO:ImportDeclarationTypeImportOnDemand" + Java.ImportDeclarationSingleStaticImport d -> cst "TODO:ImportDeclarationSingleStaticImport" + Java.ImportDeclarationStaticImportOnDemand d -> cst "TODO:ImportDeclarationStaticImportOnDemand" + +writeInclusiveOrExpression :: Java.InclusiveOrExpression -> CT.Expr +writeInclusiveOrExpression (Java.InclusiveOrExpression ors) + = infixWsList "|" (writeExclusiveOrExpression <$> ors) + +writeInstanceInitializer :: Java.InstanceInitializer -> CT.Expr +writeInstanceInitializer _ = cst "TODO:InstanceInitializer" + +writeIntegerLiteral :: Java.IntegerLiteral -> CT.Expr +writeIntegerLiteral (Java.IntegerLiteral i) = cst $ show i + +writeIntegralType :: Java.IntegralType -> CT.Expr +writeIntegralType t = cst $ case t of + Java.IntegralTypeByte -> "byte" + Java.IntegralTypeShort -> "short" + Java.IntegralTypeInt -> "int" + Java.IntegralTypeLong -> "long" + Java.IntegralTypeChar -> "char" + +writeInterfaceBody :: Java.InterfaceBody -> CT.Expr +writeInterfaceBody (Java.InterfaceBody decls) = curlyBlock fullBlockStyle $ doubleNewlineSep + (writeInterfaceMemberDeclaration <$> decls) + +writeInterfaceDeclaration :: Java.InterfaceDeclaration -> CT.Expr +writeInterfaceDeclaration d = case d of + Java.InterfaceDeclarationNormalInterface n -> writeNormalInterfaceDeclaration n + Java.InterfaceDeclarationAnnotationType a -> writeAnnotationTypeDeclaration a + +writeInterfaceMemberDeclaration :: Java.InterfaceMemberDeclaration -> CT.Expr +writeInterfaceMemberDeclaration d = case d of + Java.InterfaceMemberDeclarationConstant c -> writeConstantDeclaration c + Java.InterfaceMemberDeclarationInterfaceMethod im -> writeInterfaceMethodDeclaration im + Java.InterfaceMemberDeclarationClass cd -> writeClassDeclaration cd + Java.InterfaceMemberDeclarationInterface id -> writeInterfaceDeclaration id + +writeInterfaceMethodDeclaration :: Java.InterfaceMethodDeclaration -> CT.Expr +writeInterfaceMethodDeclaration (Java.InterfaceMethodDeclaration mods header body) = spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeInterfaceMethodModifier <$> mods), + Just $ writeMethodHeader header, + Just $ writeMethodBody body] + +writeInterfaceMethodModifier :: Java.InterfaceMethodModifier -> CT.Expr +writeInterfaceMethodModifier m = case m of + Java.InterfaceMethodModifierAnnotation a -> writeAnnotation a + Java.InterfaceMethodModifierPublic -> cst "public" + Java.InterfaceMethodModifierPrivate -> cst "private" + Java.InterfaceMethodModifierAbstract -> cst "abstract" + Java.InterfaceMethodModifierDefault -> cst "default" + Java.InterfaceMethodModifierStatic -> cst "static" + Java.InterfaceMethodModifierStrictfp -> cst "strictfp" + +writeInterfaceModifier :: Java.InterfaceModifier -> CT.Expr +writeInterfaceModifier m = case m of + Java.InterfaceModifierAnnotation a -> writeAnnotation a + Java.InterfaceModifierPublic -> cst "public" + Java.InterfaceModifierProtected -> cst "protected" + Java.InterfaceModifierPrivate -> cst "private" + Java.InterfaceModifierAbstract -> cst "abstract" + Java.InterfaceModifierStatic -> cst "static" + Java.InterfaceModifierStrictfb -> cst "strictfb" + +writeInterfaceType :: Java.InterfaceType -> CT.Expr +writeInterfaceType (Java.InterfaceType ct) = writeClassType ct + +writeLabeledStatement :: Java.LabeledStatement -> CT.Expr +writeLabeledStatement _ = cst "TODO:LabeledStatement" + +writeLambdaBody :: Java.LambdaBody -> CT.Expr +writeLambdaBody b = case b of + Java.LambdaBodyExpression e -> writeExpression e + Java.LambdaBodyBlock b -> writeBlock b + +writeLambdaExpression :: Java.LambdaExpression -> CT.Expr +writeLambdaExpression (Java.LambdaExpression params body) = + infixWs "->" (writeLambdaParameters params) (writeLambdaBody body) + +writeLambdaParameters :: Java.LambdaParameters -> CT.Expr +writeLambdaParameters p = case p of + Java.LambdaParametersTuple l -> parenList False (writeLambdaParameters <$> l) + Java.LambdaParametersSingle id -> writeIdentifier id + +writeLeftHandSide :: Java.LeftHandSide -> CT.Expr +writeLeftHandSide lhs = case lhs of + Java.LeftHandSideExpressionName en -> writeExpressionName en + Java.LeftHandSideFieldAccess fa -> writeFieldAccess fa + Java.LeftHandSideArrayAccess aa -> writeArrayAccess aa + +writeLiteral :: Java.Literal -> CT.Expr +writeLiteral l = case l of + Java.LiteralNull -> cst "null" + Java.LiteralInteger il -> writeIntegerLiteral il + Java.LiteralFloatingPoint fl -> writeFloatingPointLiteral fl + Java.LiteralBoolean b -> cst $ if b then "true" else "false" + Java.LiteralCharacter c -> writeCharacterLiteral c + Java.LiteralString sl -> writeStringLiteral sl + +writeLocalVariableDeclaration :: Java.LocalVariableDeclaration -> CT.Expr +writeLocalVariableDeclaration (Java.LocalVariableDeclaration mods t decls) = spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeVariableModifier <$> mods), + Just $ writeLocalName t, + Just $ commaSep inlineStyle (writeVariableDeclarator <$> decls)] + +writeLocalVariableDeclarationStatement :: Java.LocalVariableDeclarationStatement -> CT.Expr +writeLocalVariableDeclarationStatement (Java.LocalVariableDeclarationStatement d) = suffixSemi $ writeLocalVariableDeclaration d + +writeLocalName :: Java.LocalVariableType -> CT.Expr +writeLocalName t = case t of + Java.LocalVariableTypeType ut -> writeUnannType ut + Java.LocalVariableTypeVar -> cst "var" + +writeMarkerAnnotation :: Java.MarkerAnnotation -> CT.Expr +writeMarkerAnnotation (Java.MarkerAnnotation tname) = prefixAt $ writeTypeName tname + +writeMethodBody :: Java.MethodBody -> CT.Expr +writeMethodBody b = case b of + Java.MethodBodyBlock block -> writeBlock block + Java.MethodBodyNone -> semi + +writeMethodDeclaration :: Java.MethodDeclaration -> CT.Expr +writeMethodDeclaration (Java.MethodDeclaration anns mods header body) = newlineSep $ Y.catMaybes [ + if L.null anns then Nothing else Just $ newlineSep (writeAnnotation <$> anns), + Just headerAndBody] + where + headerAndBody = spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeMethodModifier <$> mods), + Just $ writeMethodHeader header, + Just $ writeMethodBody body] + +writeMethodDeclarator :: Java.MethodDeclarator -> CT.Expr +writeMethodDeclarator (Java.MethodDeclarator id rparam params) = noSep [ + writeIdentifier id, + -- Note: ignoring receiver param for now + parenList False (writeFormalParameter <$> params)] + +writeMethodHeader :: Java.MethodHeader -> CT.Expr +writeMethodHeader (Java.MethodHeader params result decl mthrows) = spaceSep $ Y.catMaybes [ + if L.null params then Nothing else Just $ angleBracesList inlineStyle (writeTypeParameter <$> params), + Just $ writeResult result, + Just $ writeMethodDeclarator decl, + writeThrows <$> mthrows] + +writeMethodInvocation :: Java.MethodInvocation -> CT.Expr +writeMethodInvocation (Java.MethodInvocation header args) = noSep [headerSec, argSec] + where + argSec = parenList True (writeExpression <$> args) + headerSec = case header of + Java.MethodInvocation_HeaderSimple mname -> writeMethodName mname + Java.MethodInvocation_HeaderComplex (Java.MethodInvocation_Complex var targs id) -> case var of + Java.MethodInvocation_VariantType tname -> dotSep [writeTypeName tname, idSec] + Java.MethodInvocation_VariantExpression en -> dotSep [writeExpressionName en, idSec] + Java.MethodInvocation_VariantPrimary p -> dotSep [writePrimary p, idSec] + Java.MethodInvocation_VariantSuper -> dotSep [super, idSec] + Java.MethodInvocation_VariantTypeSuper tname -> dotSep [writeTypeName tname, super, idSec] + where + super = cst "super" + idSec = noSep $ Y.catMaybes [ + if L.null targs then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> targs), + Just $ writeIdentifier id] + +writeMethodModifier :: Java.MethodModifier -> CT.Expr +writeMethodModifier m = case m of + Java.MethodModifierAnnotation ann -> writeAnnotation ann + Java.MethodModifierPublic -> cst "public" + Java.MethodModifierProtected -> cst "protected" + Java.MethodModifierPrivate -> cst "private" + Java.MethodModifierAbstract -> cst "abstract" + Java.MethodModifierFinal -> cst "final" + Java.MethodModifierSynchronized -> cst "synchronized" + Java.MethodModifierNative -> cst "native" + Java.MethodModifierStrictfb -> cst "strictfb" + +writeMethodName :: Java.MethodName -> CT.Expr +writeMethodName (Java.MethodName id) = writeIdentifier id + +writeMethodReference :: Java.MethodReference -> CT.Expr +writeMethodReference _ = cst "TODO:MethodReference" + +writeMultiplicativeExpression :: Java.MultiplicativeExpression -> CT.Expr +writeMultiplicativeExpression e = case e of + Java.MultiplicativeExpressionUnary u -> writeUnaryExpression u + Java.MultiplicativeExpressionTimes (Java.MultiplicativeExpression_Binary lhs rhs) -> + infixWs "*" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs) + Java.MultiplicativeExpressionDivide (Java.MultiplicativeExpression_Binary lhs rhs) -> + infixWs "/" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs) + Java.MultiplicativeExpressionMod (Java.MultiplicativeExpression_Binary lhs rhs) -> + infixWs "%" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs) + +writeNormalAnnotation :: Java.NormalAnnotation -> CT.Expr +writeNormalAnnotation (Java.NormalAnnotation tname pairs) = prefixAt $ noSep [ + writeTypeName tname, + commaSep inlineStyle (writeElementValuePair <$> pairs)] + +writeNormalClassDeclaration :: Java.NormalClassDeclaration -> CT.Expr +writeNormalClassDeclaration (Java.NormalClassDeclaration mods id tparams msuperc superi body) = + spaceSep $ Y.catMaybes [modSec, classSec, idSec, extendsSec, implementsSec, bodySec] + where + modSec = if L.null mods + then Nothing + else Just $ spaceSep (writeClassModifier <$> mods) + classSec = Just $ cst "class" + idSec = Just $ noSep $ Y.catMaybes [Just $ writeTypeIdentifier id, params] + where + params = if L.null tparams + then Nothing + else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams) + extendsSec = fmap (\c -> spaceSep [cst "extends", writeClassType c]) msuperc + implementsSec = if L.null superi + then Nothing + else Just $ spaceSep [cst "implements", commaSep inlineStyle (writeInterfaceType <$> superi)] + bodySec = Just $ writeClassBody body + +writeNormalInterfaceDeclaration :: Java.NormalInterfaceDeclaration -> CT.Expr +writeNormalInterfaceDeclaration (Java.NormalInterfaceDeclaration mods id tparams extends body) = + spaceSep $ Y.catMaybes [modSec, classSec, idSec, extendsSec, bodySec] + where + modSec = if L.null mods + then Nothing + else Just $ spaceSep (writeInterfaceModifier <$> mods) + classSec = Just $ cst "interface" + idSec = Just $ noSep $ Y.catMaybes [Just $ writeTypeIdentifier id, params] + where + params = if L.null tparams + then Nothing + else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams) + extendsSec = if L.null extends then Nothing else Just $ + spaceSep [cst "extends", commaSep inlineStyle (writeInterfaceType <$> extends)] + bodySec = Just $ writeInterfaceBody body + +writeNumericType :: Java.NumericType -> CT.Expr +writeNumericType nt = case nt of + Java.NumericTypeIntegral it -> writeIntegralType it + Java.NumericTypeFloatingPoint ft -> writeFloatingPointType ft + +writePackageDeclaration :: Java.PackageDeclaration -> CT.Expr +writePackageDeclaration (Java.PackageDeclaration mods ids) = suffixSemi $ spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writePackageModifier <$> mods), + Just $ spaceSep [cst "package", cst $ L.intercalate "." (Java.unIdentifier <$> ids)]] + +writePackageName :: Java.PackageName -> CT.Expr +writePackageName (Java.PackageName ids) = dotSep (writeIdentifier <$> ids) + +writePackageOrTypeName :: Java.PackageOrTypeName -> CT.Expr +writePackageOrTypeName (Java.PackageOrTypeName ids) = dotSep (writeIdentifier <$> ids) + +writePackageModifier :: Java.PackageModifier -> CT.Expr +writePackageModifier (Java.PackageModifier ann) = writeAnnotation ann + +writePostDecrementExpression :: Java.PostDecrementExpression -> CT.Expr +writePostDecrementExpression _ = cst "TODO:PostDecrementExpression" + +writePostIncrementExpression :: Java.PostIncrementExpression -> CT.Expr +writePostIncrementExpression _ = cst "TODO:PostIncrementExpression" + +writePostfixExpression :: Java.PostfixExpression -> CT.Expr +writePostfixExpression e = case e of + Java.PostfixExpressionPrimary p -> writePrimary p + Java.PostfixExpressionName en -> writeExpressionName en + Java.PostfixExpressionPostIncrement pi -> writePostIncrementExpression pi + Java.PostfixExpressionPostDecrement pd -> writePostDecrementExpression pd + +writePreDecrementExpression:: Java.PreDecrementExpression -> CT.Expr +writePreDecrementExpression _ = cst "TODO:PreDecrementExpression" + +writePreIncrementExpression :: Java.PreIncrementExpression -> CT.Expr +writePreIncrementExpression _ = cst "TODO:PreIncrementExpression" + +writePrimary :: Java.Primary -> CT.Expr +writePrimary p = case p of + Java.PrimaryNoNewArray n -> writePrimaryNoNewArray n + Java.PrimaryArrayCreation a -> writeArrayCreationExpression a + +writePrimaryNoNewArray :: Java.PrimaryNoNewArray -> CT.Expr +writePrimaryNoNewArray p = case p of + Java.PrimaryNoNewArrayLiteral l -> writeLiteral l + Java.PrimaryNoNewArrayClassLiteral cl -> writeClassLiteral cl + Java.PrimaryNoNewArrayThis -> cst "this" + Java.PrimaryNoNewArrayDotThis n -> dotSep [writeTypeName n, cst "this"] + Java.PrimaryNoNewArrayParens e -> parenList False [writeExpression e] + Java.PrimaryNoNewArrayClassInstance ci -> writeClassInstanceCreationExpression ci + Java.PrimaryNoNewArrayFieldAccess fa -> writeFieldAccess fa + Java.PrimaryNoNewArrayArrayAccess aa -> writeArrayAccess aa + Java.PrimaryNoNewArrayMethodInvocation mi -> writeMethodInvocation mi + Java.PrimaryNoNewArrayMethodReference mr -> writeMethodReference mr + +writePrimitiveType :: Java.PrimitiveType -> CT.Expr +writePrimitiveType pt = case pt of + Java.PrimitiveTypeNumeric nt -> writeNumericType nt + Java.PrimitiveTypeBoolean -> cst "boolean" + +writePrimitiveTypeWithAnnotations :: Java.PrimitiveTypeWithAnnotations -> CT.Expr +writePrimitiveTypeWithAnnotations (Java.PrimitiveTypeWithAnnotations pt anns) = spaceSep $ Y.catMaybes [ + if L.null anns then Nothing else Just $ spaceSep (writeAnnotation <$> anns), + Just $ writePrimitiveType pt] + +writeReceiverParameter :: Java.ReceiverParameter -> CT.Expr +writeReceiverParameter _ = cst "TODO:ReceiverParameter" + +writeReferenceType :: Java.ReferenceType -> CT.Expr +writeReferenceType rt = case rt of + Java.ReferenceTypeClassOrInterface cit -> writeClassOrInterfaceType cit + Java.ReferenceTypeVariable v -> writeName v + Java.ReferenceTypeArray at -> writeArrayType at + +writeRelationalExpression :: Java.RelationalExpression -> CT.Expr +writeRelationalExpression e = case e of + Java.RelationalExpressionSimple s -> writeShiftExpression s + Java.RelationalExpressionLessThan lt -> writeRelationalExpression_LessThan lt + Java.RelationalExpressionGreaterThan gt -> writeRelationalExpression_GreaterThan gt + Java.RelationalExpressionLessThanEqual lte -> writeRelationalExpression_LessThanEqual lte + Java.RelationalExpressionGreaterThanEqual gte -> writeRelationalExpression_GreaterThanEqual gte + Java.RelationalExpressionInstanceof i -> writeRelationalExpression_InstanceOf i + +writeRelationalExpression_GreaterThan :: Java.RelationalExpression_GreaterThan -> CT.Expr +writeRelationalExpression_GreaterThan _ = cst "TODO:RelationalExpression_GreaterThan" + +writeRelationalExpression_GreaterThanEqual :: Java.RelationalExpression_GreaterThanEqual -> CT.Expr +writeRelationalExpression_GreaterThanEqual _ = cst "TODO:RelationalExpression_GreaterThanEqual" + +writeRelationalExpression_InstanceOf :: Java.RelationalExpression_InstanceOf -> CT.Expr +writeRelationalExpression_InstanceOf (Java.RelationalExpression_InstanceOf lhs rhs) = + infixWs "instanceof" (writeRelationalExpression lhs) (writeReferenceType rhs) + +writeRelationalExpression_LessThan :: Java.RelationalExpression_LessThan -> CT.Expr +writeRelationalExpression_LessThan _ = cst "TODO:RelationalExpression_LessThan" + +writeRelationalExpression_LessThanEqual :: Java.RelationalExpression_LessThanEqual -> CT.Expr +writeRelationalExpression_LessThanEqual _ = cst "TODO:RelationalExpression_LessThanEqual" + +writeResult :: Java.Result -> CT.Expr +writeResult r = case r of + Java.ResultType t -> writeUnannType t + Java.ResultVoid -> cst "void" + +writeReturnStatement :: Java.ReturnStatement -> CT.Expr +writeReturnStatement (Java.ReturnStatement mex) = suffixSemi $ spaceSep $ Y.catMaybes [ + Just $ cst "return", + writeExpression <$> mex] + +writeShiftExpression :: Java.ShiftExpression -> CT.Expr +writeShiftExpression e = case e of + Java.ShiftExpressionUnary a -> writeAdditiveExpression a + Java.ShiftExpressionShiftLeft (Java.ShiftExpression_Binary lhs rhs) -> + infixWs "<<" (writeShiftExpression lhs) (writeAdditiveExpression rhs) + Java.ShiftExpressionShiftRight (Java.ShiftExpression_Binary lhs rhs) -> + infixWs ">>" (writeShiftExpression lhs) (writeAdditiveExpression rhs) + Java.ShiftExpressionShiftRightZeroFill (Java.ShiftExpression_Binary lhs rhs) -> + infixWs ">>>" (writeShiftExpression lhs) (writeAdditiveExpression rhs) + +writeSimpleTypeName :: Java.SimpleTypeName -> CT.Expr +writeSimpleTypeName (Java.SimpleTypeName tid) = writeTypeIdentifier tid + +writeSingleElementAnnotation :: Java.SingleElementAnnotation -> CT.Expr +writeSingleElementAnnotation (Java.SingleElementAnnotation tname mv) = case mv of + Nothing -> writeMarkerAnnotation (Java.MarkerAnnotation tname) + Just v -> prefixAt $ noSep [writeTypeName tname, parenList False [writeElementValue v]] + +writeStatement :: Java.Statement -> CT.Expr +writeStatement s = case s of + Java.StatementWithoutTrailing s -> writeStatementWithoutTrailingSubstatement s + Java.StatementLabeled l -> writeLabeledStatement l + Java.StatementIfThen it -> writeIfThenStatement it + Java.StatementIfThenElse ite -> writeIfThenElseStatement ite + Java.StatementWhile w -> writeWhileStatement w + Java.StatementFor f -> writeForStatement f + +writeStatementExpression :: Java.StatementExpression -> CT.Expr +writeStatementExpression e = case e of + Java.StatementExpressionAssignment ass -> writeAssignment ass + Java.StatementExpressionPreIncrement pi -> writePreIncrementExpression pi + Java.StatementExpressionPreDecrement pd -> writePreDecrementExpression pd + Java.StatementExpressionPostIncrement pi -> writePostIncrementExpression pi + Java.StatementExpressionPostDecrement pd -> writePostDecrementExpression pd + Java.StatementExpressionMethodInvocation m -> writeMethodInvocation m + Java.StatementExpressionClassInstanceCreation cic -> writeClassInstanceCreationExpression cic + +writeStatementWithoutTrailingSubstatement :: Java.StatementWithoutTrailingSubstatement -> CT.Expr +writeStatementWithoutTrailingSubstatement s = case s of + Java.StatementWithoutTrailingSubstatementBlock b -> writeBlock b + Java.StatementWithoutTrailingSubstatementEmpty e -> writeEmptyStatement e + Java.StatementWithoutTrailingSubstatementExpression e -> writeExpressionStatement e + Java.StatementWithoutTrailingSubstatementAssert a -> writeAssertStatement a + Java.StatementWithoutTrailingSubstatementSwitch s -> writeSwitchStatement s + Java.StatementWithoutTrailingSubstatementDo d -> writeDoStatement d + Java.StatementWithoutTrailingSubstatementBreak b -> writeBreakStatement b + Java.StatementWithoutTrailingSubstatementContinue c -> writeContinueStatement c + Java.StatementWithoutTrailingSubstatementReturn r -> writeReturnStatement r + Java.StatementWithoutTrailingSubstatementSynchronized s -> writeSynchronizedStatement s + Java.StatementWithoutTrailingSubstatementThrow t -> writeThrowStatement t + Java.StatementWithoutTrailingSubstatementTry t -> writeTryStatement t + +writeStaticInitializer :: Java.StaticInitializer -> CT.Expr +writeStaticInitializer _ = cst "TODO:StaticInitializer" + +writeStringLiteral :: Java.StringLiteral -> CT.Expr +writeStringLiteral (Java.StringLiteral s) = cst $ show s + +writeSwitchStatement :: Java.SwitchStatement -> CT.Expr +writeSwitchStatement _ = cst "TODO:SwitchStatement" + +writeSynchronizedStatement :: Java.SynchronizedStatement -> CT.Expr +writeSynchronizedStatement _ = cst "TODO:SynchronizedStatement" + +writeThrowStatement :: Java.ThrowStatement -> CT.Expr +writeThrowStatement (Java.ThrowStatement ex) = suffixSemi $ spaceSep [cst "throw", writeExpression ex] + +writeThrows :: Java.Throws -> CT.Expr +writeThrows _ = cst "TODO:Throws" + +writeTryStatement :: Java.TryStatement -> CT.Expr +writeTryStatement _ = cst "TODO:TryStatement" + +writeType :: Java.Type -> CT.Expr +writeType t = case t of + Java.TypePrimitive pt -> writePrimitiveTypeWithAnnotations pt + Java.TypeReference rt -> writeReferenceType rt + +writeTypeArgument :: Java.TypeArgument -> CT.Expr +writeTypeArgument a = case a of + Java.TypeArgumentReference rt -> writeReferenceType rt + Java.TypeArgumentWildcard w -> writeWildcard w + +writeTypeArgumentsOrDiamond :: Java.TypeArgumentsOrDiamond -> CT.Expr +writeTypeArgumentsOrDiamond targs = case targs of + Java.TypeArgumentsOrDiamondArguments args -> angleBracesList inlineStyle (writeTypeArgument <$> args) + Java.TypeArgumentsOrDiamondDiamond -> cst "<>" + +writeTypeBound :: Java.TypeBound -> CT.Expr +writeTypeBound _ = cst "TODO:TypeBound" + +writeTypeDeclaration :: Java.TypeDeclaration -> CT.Expr +writeTypeDeclaration d = case d of + Java.TypeDeclarationClass d -> writeClassDeclaration d + Java.TypeDeclarationInterface d -> writeInterfaceDeclaration d + Java.TypeDeclarationNone -> semi + +writeTypeDeclarationWithComments :: Java.TypeDeclarationWithComments -> CT.Expr +writeTypeDeclarationWithComments (Java.TypeDeclarationWithComments d mc) = withComments mc $ writeTypeDeclaration d + +writeTypeIdentifier :: Java.TypeIdentifier -> CT.Expr +writeTypeIdentifier (Java.TypeIdentifier id) = writeIdentifier id + +writeTypeName :: Java.TypeName -> CT.Expr +writeTypeName (Java.TypeName id mqual) = dotSep $ Y.catMaybes [ + writePackageOrTypeName <$> mqual, + Just $ writeTypeIdentifier id] + +writeTypeParameter :: Java.TypeParameter -> CT.Expr +writeTypeParameter (Java.TypeParameter mods id bound) = spaceSep $ Y.catMaybes [ + if L.null mods then Nothing else Just $ spaceSep (writeTypeParameterModifier <$> mods), + Just $ writeTypeIdentifier id, + fmap (\b -> spaceSep [cst "extends", writeTypeBound b]) bound] + +writeTypeParameterModifier :: Java.TypeParameterModifier -> CT.Expr +writeTypeParameterModifier (Java.TypeParameterModifier ann) = writeAnnotation ann + +writeName :: Java.TypeVariable -> CT.Expr +writeName (Java.TypeVariable anns id) = spaceSep $ Y.catMaybes [ + if L.null anns then Nothing else Just $ spaceSep (writeAnnotation <$> anns), + Just $ writeTypeIdentifier id] + +writeUnannType :: Java.UnannType -> CT.Expr +writeUnannType (Java.UnannType t) = writeType t + +writeUnaryExpression :: Java.UnaryExpression -> CT.Expr +writeUnaryExpression e = case e of + Java.UnaryExpressionPreIncrement pi -> writePreIncrementExpression pi + Java.UnaryExpressionPreDecrement pd -> writePreDecrementExpression pd + Java.UnaryExpressionPlus p -> spaceSep [cst "+", writeUnaryExpression p] + Java.UnaryExpressionMinus m -> spaceSep [cst "-", writeUnaryExpression m] + Java.UnaryExpressionOther o -> writeUnaryExpressionNotPlusMinus o + +writeUnaryExpressionNotPlusMinus :: Java.UnaryExpressionNotPlusMinus -> CT.Expr +writeUnaryExpressionNotPlusMinus e = case e of + Java.UnaryExpressionNotPlusMinusPostfix p -> writePostfixExpression p + Java.UnaryExpressionNotPlusMinusTilde u -> spaceSep [cst "~", writeUnaryExpression u] + Java.UnaryExpressionNotPlusMinusNot u -> noSep [cst "!", writeUnaryExpression u] + Java.UnaryExpressionNotPlusMinusCast c -> writeCastExpression c + +writeUnqualifiedClassInstanceCreationExpression :: Java.UnqualifiedClassInstanceCreationExpression -> CT.Expr +writeUnqualifiedClassInstanceCreationExpression (Java.UnqualifiedClassInstanceCreationExpression targs cit args mbody) + = spaceSep $ Y.catMaybes [ + Just $ cst "new", + if L.null targs then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> targs), + Just $ noSep [writeClassOrInterfaceTypeToInstantiate cit, parenList False (writeExpression <$> args)], + writeClassBody <$> mbody] + +writeVariableArityParameter :: Java.VariableArityParameter -> CT.Expr +writeVariableArityParameter _ = cst "TODO:VariableArityParameter" + +writeVariableDeclarator :: Java.VariableDeclarator -> CT.Expr +writeVariableDeclarator (Java.VariableDeclarator id minit) = + Y.maybe idSec (infixWs "=" idSec . writeVariableInitializer) minit + where + idSec = writeVariableDeclaratorId id + +writeVariableDeclaratorId :: Java.VariableDeclaratorId -> CT.Expr +writeVariableDeclaratorId (Java.VariableDeclaratorId id mdims) = noSep $ Y.catMaybes [ + Just $ writeIdentifier id, + writeDims <$> mdims] + +writeVariableInitializer :: Java.VariableInitializer -> CT.Expr +writeVariableInitializer i = case i of + Java.VariableInitializerExpression e -> writeExpression e + Java.VariableInitializerArrayInitializer ai -> writeArrayInitializer ai + +writeVariableModifier :: Java.VariableModifier -> CT.Expr +writeVariableModifier m = case m of + Java.VariableModifierAnnotation ann -> writeAnnotation ann + Java.VariableModifierFinal -> cst "final" + +writeWhileStatement :: Java.WhileStatement -> CT.Expr +writeWhileStatement _ = cst "TODO:WhileStatement" + +writeWildcard :: Java.Wildcard -> CT.Expr +writeWildcard (Java.Wildcard anns mbounds) = spaceSep $ Y.catMaybes [ + if L.null anns then Nothing else Just $ commaSep inlineStyle (writeAnnotation <$> anns), + Just $ cst "*", + writeWildcardBounds <$> mbounds] + +writeWildcardBounds :: Java.WildcardBounds -> CT.Expr +writeWildcardBounds b = case b of + Java.WildcardBoundsExtends rt -> spaceSep [cst "extends", writeReferenceType rt] + Java.WildcardBoundsSuper rt -> spaceSep [cst "super", writeReferenceType rt] + +prefixAt :: CT.Expr -> CT.Expr +prefixAt e = noSep [cst "@", e] + +semi :: CT.Expr +semi = cst ";" + +suffixSemi :: CT.Expr -> CT.Expr +suffixSemi e = noSep [e, semi] diff --git a/src/main/haskell/Hydra/Ext/Java/Settings.hs b/src/main/haskell/Hydra/Ext/Java/Settings.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Java/Settings.hs @@ -0,0 +1,4 @@ +module Hydra.Ext.Java.Settings where + +listsAsArrays :: Bool +listsAsArrays = False diff --git a/src/main/haskell/Hydra/Ext/Java/Utils.hs b/src/main/haskell/Hydra/Ext/Java/Utils.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Java/Utils.hs @@ -0,0 +1,556 @@ +module Hydra.Ext.Java.Utils where + +import Hydra.Kernel +import Hydra.Ext.Java.Language +import Hydra.Ext.Java.Names +import qualified Hydra.Ext.Java.Syntax as Java +import qualified Hydra.Lib.Strings as Strings + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +type PackageMap = M.Map Namespace Java.PackageName + +data Aliases = Aliases { + aliasesCurrentNamespace :: Namespace, + aliasesPackages :: PackageMap, + aliasesRecursiveVars :: S.Set Name } deriving Show + +addExpressions :: [Java.MultiplicativeExpression] -> Java.AdditiveExpression +addExpressions exprs = L.foldl add (Java.AdditiveExpressionUnary $ L.head exprs) $ L.tail exprs + where + add ae me = Java.AdditiveExpressionPlus $ Java.AdditiveExpression_Binary ae me + +addJavaTypeParameter :: Java.ReferenceType -> Java.Type -> Flow (Graph) Java.Type +addJavaTypeParameter rt t = case t of + Java.TypeReference rt1 -> case rt1 of + Java.ReferenceTypeClassOrInterface cit -> case cit of + Java.ClassOrInterfaceTypeClass (Java.ClassType anns qual id args) -> pure $ + Java.TypeReference $ Java.ReferenceTypeClassOrInterface $ + Java.ClassOrInterfaceTypeClass $ Java.ClassType anns qual id (args ++ [Java.TypeArgumentReference rt]) + _ -> fail $ "expected a Java class type. Found: " ++ show cit + Java.ReferenceTypeVariable tv -> pure $ javaTypeVariableToType tv + _ -> fail $ "expected a Java class or interface type, or a variable. Found: " ++ show rt + _ -> fail $ "expected a reference type. Found: " ++ show t + +fieldExpression :: Java.Identifier -> Java.Identifier -> Java.ExpressionName +fieldExpression varId fieldId = Java.ExpressionName (Just $ Java.AmbiguousName [varId]) fieldId + +fieldNameToJavaExpression :: Name -> Java.Expression +fieldNameToJavaExpression fname = javaPostfixExpressionToJavaExpression $ + Java.PostfixExpressionName $ Java.ExpressionName Nothing (fieldNameToJavaIdentifier fname) + +fieldNameToJavaIdentifier :: Name -> Java.Identifier +fieldNameToJavaIdentifier (Name name) = javaIdentifier name + +fieldNameToJavaVariableDeclarator :: Name -> Java.VariableDeclarator +fieldNameToJavaVariableDeclarator (Name n) = javaVariableDeclarator (javaIdentifier n) Nothing + +fieldNameToJavaVariableDeclaratorId :: Name -> Java.VariableDeclaratorId +fieldNameToJavaVariableDeclaratorId (Name n) = javaVariableDeclaratorId $ javaIdentifier n + +importAliasesForModule :: Module -> Aliases +importAliasesForModule mod = Aliases (moduleNamespace mod) M.empty S.empty + +interfaceMethodDeclaration :: [Java.InterfaceMethodModifier] -> [Java.TypeParameter] -> String -> [Java.FormalParameter] + -> Java.Result -> Maybe [Java.BlockStatement] -> Java.InterfaceMemberDeclaration +interfaceMethodDeclaration mods tparams methodName params result stmts = Java.InterfaceMemberDeclarationInterfaceMethod $ + Java.InterfaceMethodDeclaration mods header body + where + header = javaMethodHeader tparams methodName params result + body = javaMethodBody stmts + +isEscaped :: String -> Bool +isEscaped s = L.head s == '$' + +javaAdditiveExpressionToJavaExpression :: Java.AdditiveExpression -> Java.Expression +javaAdditiveExpressionToJavaExpression = javaRelationalExpressionToJavaExpression . + Java.RelationalExpressionSimple . Java.ShiftExpressionUnary + +javaAssignmentStatement :: Java.LeftHandSide -> Java.Expression -> Java.Statement +javaAssignmentStatement lhs rhs = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementExpression $ + Java.ExpressionStatement $ Java.StatementExpressionAssignment ass + where + ass = Java.Assignment lhs Java.AssignmentOperatorSimple rhs + +javaBoolean :: Bool -> Java.Literal +javaBoolean = Java.LiteralBoolean + +javaBooleanExpression :: Bool -> Java.Expression +javaBooleanExpression = javaPrimaryToJavaExpression . javaLiteralToJavaPrimary . javaBoolean + +javaBooleanType :: Java.Type +javaBooleanType = javaPrimitiveTypeToJavaType Java.PrimitiveTypeBoolean + +javaCastExpression :: Java.ReferenceType -> Java.UnaryExpression -> Java.CastExpression +javaCastExpression rt expr = Java.CastExpressionNotPlusMinus $ Java.CastExpression_NotPlusMinus rb expr + where + rb = Java.CastExpression_RefAndBounds rt [] + +javaCastExpressionToJavaExpression :: Java.CastExpression -> Java.Expression +javaCastExpressionToJavaExpression = javaUnaryExpressionToJavaExpression . Java.UnaryExpressionOther . + Java.UnaryExpressionNotPlusMinusCast + +javaClassDeclaration :: Aliases -> [Java.TypeParameter] -> Name -> [Java.ClassModifier] + -> Maybe Name -> [Java.InterfaceType] -> [Java.ClassBodyDeclarationWithComments] -> Java.ClassDeclaration +javaClassDeclaration aliases tparams elName mods supname impls bodyDecls = Java.ClassDeclarationNormal $ Java.NormalClassDeclaration { + Java.normalClassDeclarationModifiers = mods, + Java.normalClassDeclarationIdentifier = javaDeclName elName, + Java.normalClassDeclarationParameters = tparams, + Java.normalClassDeclarationExtends = fmap (\n -> nameToJavaClassType aliases True [] n Nothing) supname, + Java.normalClassDeclarationImplements = impls, + Java.normalClassDeclarationBody = Java.ClassBody bodyDecls} + +javaClassType :: [Java.ReferenceType] -> Maybe Java.PackageName -> String -> Java.ClassType +javaClassType args pkg id = Java.ClassType [] qual (javaTypeIdentifier id) targs + where + qual = maybe Java.ClassTypeQualifierNone Java.ClassTypeQualifierPackage pkg + targs = Java.TypeArgumentReference <$> args + +javaClassTypeToJavaType :: Java.ClassType -> Java.Type +javaClassTypeToJavaType = Java.TypeReference . Java.ReferenceTypeClassOrInterface . Java.ClassOrInterfaceTypeClass + +javaConditionalAndExpressionToJavaExpression :: Java.ConditionalAndExpression -> Java.Expression +javaConditionalAndExpressionToJavaExpression condAndEx = Java.ExpressionAssignment $ + Java.AssignmentExpressionConditional $ Java.ConditionalExpressionSimple $ Java.ConditionalOrExpression [condAndEx] + +javaConstructorCall :: Java.ClassOrInterfaceTypeToInstantiate -> [Java.Expression] -> Maybe Java.ClassBody -> Java.Expression +javaConstructorCall ci args mbody = javaPrimaryToJavaExpression $ + Java.PrimaryNoNewArray $ + Java.PrimaryNoNewArrayClassInstance $ + Java.ClassInstanceCreationExpression Nothing $ + Java.UnqualifiedClassInstanceCreationExpression [] ci args mbody + +javaConstructorName :: Java.Identifier -> Maybe Java.TypeArgumentsOrDiamond -> Java.ClassOrInterfaceTypeToInstantiate +javaConstructorName id targs = Java.ClassOrInterfaceTypeToInstantiate [Java.AnnotatedIdentifier [] id] targs + +javaDeclName :: Name -> Java.TypeIdentifier +javaDeclName = Java.TypeIdentifier . javaVariableName + +javaEmptyStatement :: Java.Statement +javaEmptyStatement = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementEmpty Java.EmptyStatement + +javaEqualityExpressionToJavaExpression :: Java.EqualityExpression -> Java.Expression +javaEqualityExpressionToJavaExpression eqEx = javaConditionalAndExpressionToJavaExpression $ + Java.ConditionalAndExpression [javaEqualityExpressionToJavaInclusiveOrExpression eqEx] + +javaEqualityExpressionToJavaInclusiveOrExpression :: Java.EqualityExpression -> Java.InclusiveOrExpression +javaEqualityExpressionToJavaInclusiveOrExpression eq = Java.InclusiveOrExpression [ + Java.ExclusiveOrExpression [Java.AndExpression [eq]]] + +javaEquals :: Java.EqualityExpression -> Java.RelationalExpression -> Java.EqualityExpression +javaEquals lhs rhs = Java.EqualityExpressionEqual $ Java.EqualityExpression_Binary lhs rhs + +javaEqualsNull :: Java.EqualityExpression -> Java.EqualityExpression +javaEqualsNull lhs = javaEquals lhs $ javaLiteralToJavaRelationalExpression Java.LiteralNull + +javaExpressionNameToJavaExpression :: Java.ExpressionName -> Java.Expression +javaExpressionNameToJavaExpression = javaPostfixExpressionToJavaExpression . Java.PostfixExpressionName + +javaExpressionToJavaPrimary :: Java.Expression -> Java.Primary +javaExpressionToJavaPrimary = Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayParens + +javaExpressionToJavaUnaryExpression :: Java.Expression -> Java.UnaryExpression +javaExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression . javaExpressionToJavaPrimary + +javaFieldAccessToJavaExpression :: Java.FieldAccess -> Java.Expression +javaFieldAccessToJavaExpression = javaPrimaryToJavaExpression . Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayFieldAccess + +javaIdentifier :: String -> Java.Identifier +javaIdentifier = Java.Identifier . sanitizeJavaName + +javaIdentifierToJavaExpressionName :: Java.Identifier -> Java.ExpressionName +javaIdentifierToJavaExpressionName id = Java.ExpressionName Nothing id + +javaIdentifierToJavaExpression :: Java.Identifier -> Java.Expression +javaIdentifierToJavaExpression = javaUnaryExpressionToJavaExpression . javaIdentifierToJavaUnaryExpression + +javaIdentifierToJavaRelationalExpression :: Java.Identifier -> Java.RelationalExpression +javaIdentifierToJavaRelationalExpression id = javaPostfixExpressionToJavaRelationalExpression $ + Java.PostfixExpressionName $ Java.ExpressionName Nothing id + +javaIdentifierToJavaUnaryExpression :: Java.Identifier -> Java.UnaryExpression +javaIdentifierToJavaUnaryExpression = javaRelationalExpressionToJavaUnaryExpression . javaIdentifierToJavaRelationalExpression + +javaInstanceOf :: Java.RelationalExpression -> Java.ReferenceType -> Java.RelationalExpression +javaInstanceOf lhs rhs = Java.RelationalExpressionInstanceof $ Java.RelationalExpression_InstanceOf lhs rhs + +javaInt :: Integral a => a -> Java.Literal +javaInt i = Java.LiteralInteger $ Java.IntegerLiteral $ fromIntegral i + +javaIntExpression :: Integer -> Java.Expression +javaIntExpression = javaPrimaryToJavaExpression . javaLiteralToJavaPrimary . javaInt + +javaIntType :: Java.Type +javaIntType = javaPrimitiveTypeToJavaType $ Java.PrimitiveTypeNumeric $ Java.NumericTypeIntegral Java.IntegralTypeInt + +javaInterfaceDeclarationToJavaClassBodyDeclaration :: Java.NormalInterfaceDeclaration -> Java.ClassBodyDeclaration +javaInterfaceDeclarationToJavaClassBodyDeclaration = Java.ClassBodyDeclarationClassMember . + Java.ClassMemberDeclarationInterface . Java.InterfaceDeclarationNormalInterface + +javaLambda :: Name -> Java.Expression -> Java.Expression +javaLambda var jbody = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyExpression jbody) + where + params = Java.LambdaParametersSingle $ variableToJavaIdentifier var + +javaLambdaFromBlock :: Name -> Java.Block -> Java.Expression +javaLambdaFromBlock var block = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyBlock block) + where + params = Java.LambdaParametersSingle $ variableToJavaIdentifier var + +javaLiteralToJavaRelationalExpression :: Java.Literal -> Java.RelationalExpression +javaLiteralToJavaRelationalExpression = javaMultiplicativeExpressionToJavaRelationalExpression . + javaLiteralToJavaMultiplicativeExpression + +javaLiteralToJavaExpression = javaRelationalExpressionToJavaExpression . + javaMultiplicativeExpressionToJavaRelationalExpression . + javaLiteralToJavaMultiplicativeExpression + +javaLiteralToJavaMultiplicativeExpression = Java.MultiplicativeExpressionUnary . javaPrimaryToJavaUnaryExpression . + javaLiteralToJavaPrimary + +javaLiteralToJavaPrimary :: Java.Literal -> Java.Primary +javaLiteralToJavaPrimary = Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayLiteral + +javaMemberField :: [Java.FieldModifier] -> Java.Type -> Java.VariableDeclarator -> Java.ClassBodyDeclaration +javaMemberField mods jt var = Java.ClassBodyDeclarationClassMember $ Java.ClassMemberDeclarationField $ + Java.FieldDeclaration mods (Java.UnannType jt) [var] + +javaMethodBody :: Maybe [Java.BlockStatement] -> Java.MethodBody +javaMethodBody stmts = Y.maybe Java.MethodBodyNone (Java.MethodBodyBlock . Java.Block) stmts + +javaMethodDeclarationToJavaClassBodyDeclaration :: Java.MethodDeclaration -> Java.ClassBodyDeclaration +javaMethodDeclarationToJavaClassBodyDeclaration = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationMethod + +javaMethodHeader :: [Java.TypeParameter] -> String -> [Java.FormalParameter] -> Java.Result -> Java.MethodHeader +javaMethodHeader tparams methodName params result = Java.MethodHeader tparams result decl mthrows + where + decl = Java.MethodDeclarator (Java.Identifier methodName) Nothing params + mthrows = Nothing + +javaMethodInvocationToJavaExpression :: Java.MethodInvocation -> Java.Expression +javaMethodInvocationToJavaExpression = javaPrimaryToJavaExpression . javaMethodInvocationToJavaPrimary + +javaMethodInvocationToJavaStatement :: Java.MethodInvocation -> Java.Statement +javaMethodInvocationToJavaStatement = Java.StatementWithoutTrailing . Java.StatementWithoutTrailingSubstatementExpression . + Java.ExpressionStatement . Java.StatementExpressionMethodInvocation + +javaMethodInvocationToJavaPostfixExpression :: Java.MethodInvocation -> Java.PostfixExpression +javaMethodInvocationToJavaPostfixExpression = Java.PostfixExpressionPrimary . Java.PrimaryNoNewArray . + Java.PrimaryNoNewArrayMethodInvocation + +javaMethodInvocationToJavaPrimary :: Java.MethodInvocation -> Java.Primary +javaMethodInvocationToJavaPrimary = Java.PrimaryNoNewArray . + Java.PrimaryNoNewArrayMethodInvocation + +javaMultiplicativeExpressionToJavaRelationalExpression :: Java.MultiplicativeExpression -> Java.RelationalExpression +javaMultiplicativeExpressionToJavaRelationalExpression = Java.RelationalExpressionSimple . + Java.ShiftExpressionUnary . Java.AdditiveExpressionUnary + +javaPackageDeclaration :: Namespace -> Java.PackageDeclaration +javaPackageDeclaration (Namespace name) = Java.PackageDeclaration [] (Java.Identifier <$> Strings.splitOn "/" name) + +javaPostfixExpressionToJavaEqualityExpression :: Java.PostfixExpression -> Java.EqualityExpression +javaPostfixExpressionToJavaEqualityExpression = Java.EqualityExpressionUnary . + javaUnaryExpressionToJavaRelationalExpression . Java.UnaryExpressionOther . Java.UnaryExpressionNotPlusMinusPostfix + +javaPostfixExpressionToJavaExpression :: Java.PostfixExpression -> Java.Expression +javaPostfixExpressionToJavaExpression = javaRelationalExpressionToJavaExpression . + javaPostfixExpressionToJavaRelationalExpression + +javaPostfixExpressionToJavaInclusiveOrExpression :: Java.PostfixExpression -> Java.InclusiveOrExpression +javaPostfixExpressionToJavaInclusiveOrExpression = javaEqualityExpressionToJavaInclusiveOrExpression . + javaPostfixExpressionToJavaEqualityExpression + +javaPostfixExpressionToJavaRelationalExpression :: Java.PostfixExpression -> Java.RelationalExpression +javaPostfixExpressionToJavaRelationalExpression = + javaUnaryExpressionToJavaRelationalExpression . javaPostfixExpressionToJavaUnaryExpression + +javaPostfixExpressionToJavaUnaryExpression :: Java.PostfixExpression -> Java.UnaryExpression +javaPostfixExpressionToJavaUnaryExpression = Java.UnaryExpressionOther . Java.UnaryExpressionNotPlusMinusPostfix + +javaPrimaryToJavaExpression :: Java.Primary -> Java.Expression +javaPrimaryToJavaExpression = javaPostfixExpressionToJavaExpression . Java.PostfixExpressionPrimary + +javaPrimaryToJavaUnaryExpression :: Java.Primary -> Java.UnaryExpression +javaPrimaryToJavaUnaryExpression = Java.UnaryExpressionOther . + Java.UnaryExpressionNotPlusMinusPostfix . + Java.PostfixExpressionPrimary + +javaPrimitiveTypeToJavaType :: Java.PrimitiveType -> Java.Type +javaPrimitiveTypeToJavaType pt = Java.TypePrimitive $ Java.PrimitiveTypeWithAnnotations pt [] + +javaRefType :: [Java.ReferenceType] -> Maybe Java.PackageName -> String -> Java.Type +javaRefType args pkg id = Java.TypeReference $ Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $ + javaClassType args pkg id + +javaRelationalExpressionToJavaEqualityExpression :: Java.RelationalExpression -> Java.EqualityExpression +javaRelationalExpressionToJavaEqualityExpression = Java.EqualityExpressionUnary + +javaRelationalExpressionToJavaExpression :: Java.RelationalExpression -> Java.Expression +javaRelationalExpressionToJavaExpression = javaEqualityExpressionToJavaExpression . javaRelationalExpressionToJavaEqualityExpression + +javaRelationalExpressionToJavaUnaryExpression :: Java.RelationalExpression -> Java.UnaryExpression +javaRelationalExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression . + Java.PrimaryNoNewArray . + Java.PrimaryNoNewArrayParens . + javaRelationalExpressionToJavaExpression + +javaReturnStatement :: Y.Maybe Java.Expression -> Java.Statement +javaReturnStatement = Java.StatementWithoutTrailing . Java.StatementWithoutTrailingSubstatementReturn . + Java.ReturnStatement + +javaStatementsToBlock :: [Java.Statement] -> Java.Block +javaStatementsToBlock stmts = Java.Block (Java.BlockStatementStatement <$> stmts) + +javaString :: String -> Java.Literal +javaString = Java.LiteralString . Java.StringLiteral + +javaStringMultiplicativeExpression :: String -> Java.MultiplicativeExpression +javaStringMultiplicativeExpression = javaLiteralToJavaMultiplicativeExpression . javaString + +javaThrowIllegalArgumentException :: [Java.Expression] -> Java.Statement +javaThrowIllegalArgumentException args = javaThrowStatement $ + javaConstructorCall (javaConstructorName (Java.Identifier "IllegalArgumentException") Nothing) args Nothing + +javaThrowIllegalStateException :: [Java.Expression] -> Java.Statement +javaThrowIllegalStateException args = javaThrowStatement $ + javaConstructorCall (javaConstructorName (Java.Identifier "IllegalStateException") Nothing) args Nothing + +javaThrowStatement :: Java.Expression -> Java.Statement +javaThrowStatement = Java.StatementWithoutTrailing . + Java.StatementWithoutTrailingSubstatementThrow . Java.ThrowStatement + +javaThis :: Java.Expression +javaThis = javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis + +javaTypeFromTypeName :: Aliases -> Name -> Java.Type +javaTypeFromTypeName aliases elName = javaTypeVariableToType $ Java.TypeVariable [] $ + nameToJavaTypeIdentifier aliases False elName + +javaTypeIdentifier :: String -> Java.TypeIdentifier +javaTypeIdentifier = Java.TypeIdentifier . Java.Identifier + +javaTypeIdentifierToJavaTypeArgument :: Java.TypeIdentifier -> Java.TypeArgument +javaTypeIdentifierToJavaTypeArgument id = Java.TypeArgumentReference $ Java.ReferenceTypeVariable $ Java.TypeVariable [] id + +javaTypeName :: Java.Identifier -> Java.TypeName +javaTypeName id = Java.TypeName (Java.TypeIdentifier id) Nothing + +javaTypeParameter :: String -> Java.TypeParameter +javaTypeParameter v = Java.TypeParameter [] (javaTypeIdentifier v) Nothing + +javaTypeToJavaFormalParameter :: Java.Type -> Name -> Java.FormalParameter +javaTypeToJavaFormalParameter jt fname = Java.FormalParameterSimple $ Java.FormalParameter_Simple [] argType argId + where + argType = Java.UnannType jt + argId = fieldNameToJavaVariableDeclaratorId fname + +javaTypeToJavaReferenceType :: Java.Type -> Flow (Graph) Java.ReferenceType +javaTypeToJavaReferenceType t = case t of + Java.TypeReference rt -> pure rt + _ -> fail $ "expected a Java reference type. Found: " ++ show t + +javaTypeToJavaResult :: Java.Type -> Java.Result +javaTypeToJavaResult = Java.ResultType . Java.UnannType + +javaTypeToJavaTypeArgument :: Java.Type -> Java.TypeArgument +javaTypeToJavaTypeArgument t = case t of + Java.TypeReference rt -> Java.TypeArgumentReference rt + _ -> Java.TypeArgumentWildcard $ Java.Wildcard [] Nothing -- TODO + +javaTypeVariable :: String -> Java.ReferenceType +javaTypeVariable v = Java.ReferenceTypeVariable $ Java.TypeVariable [] $ javaTypeIdentifier $ capitalize v + +javaTypeVariableToType :: Java.TypeVariable -> Java.Type +javaTypeVariableToType = Java.TypeReference . Java.ReferenceTypeVariable + +javaUnaryExpressionToJavaExpression :: Java.UnaryExpression -> Java.Expression +javaUnaryExpressionToJavaExpression = javaRelationalExpressionToJavaExpression . + javaUnaryExpressionToJavaRelationalExpression + +javaUnaryExpressionToJavaRelationalExpression :: Java.UnaryExpression -> Java.RelationalExpression +javaUnaryExpressionToJavaRelationalExpression = javaMultiplicativeExpressionToJavaRelationalExpression . + Java.MultiplicativeExpressionUnary + +javaVariableDeclarator :: Java.Identifier -> Y.Maybe Java.VariableInitializer -> Java.VariableDeclarator +javaVariableDeclarator id = Java.VariableDeclarator (javaVariableDeclaratorId id) + +javaVariableDeclaratorId :: Java.Identifier -> Java.VariableDeclaratorId +javaVariableDeclaratorId id = Java.VariableDeclaratorId id Nothing + +javaVariableName :: Name -> Java.Identifier +javaVariableName = javaIdentifier . localNameOfEager + +makeConstructor :: Aliases -> Name -> Bool -> [Java.FormalParameter] + -> [Java.BlockStatement] -> Java.ClassBodyDeclaration +makeConstructor aliases elName private params stmts = Java.ClassBodyDeclarationConstructorDeclaration $ + Java.ConstructorDeclaration mods cons Nothing body + where + nm = Java.SimpleTypeName $ nameToJavaTypeIdentifier aliases False elName + cons = Java.ConstructorDeclarator [] nm Nothing params + mods = [if private then Java.ConstructorModifierPrivate else Java.ConstructorModifierPublic] + body = Java.ConstructorBody Nothing stmts + +methodDeclaration :: [Java.MethodModifier] -> [Java.TypeParameter] -> [Java.Annotation] -> String + -> [Java.FormalParameter] -> Java.Result -> Maybe [Java.BlockStatement] -> Java.ClassBodyDeclaration +methodDeclaration mods tparams anns methodName params result stmts = + javaMethodDeclarationToJavaClassBodyDeclaration $ + Java.MethodDeclaration anns mods header body + where + header = javaMethodHeader tparams methodName params result + body = javaMethodBody stmts + +methodInvocation :: Y.Maybe (Either Java.ExpressionName Java.Primary) -> Java.Identifier -> [Java.Expression] -> Java.MethodInvocation +methodInvocation lhs methodName = Java.MethodInvocation header + where + header = case lhs of + Nothing -> Java.MethodInvocation_HeaderSimple $ Java.MethodName methodName + Just either -> Java.MethodInvocation_HeaderComplex $ Java.MethodInvocation_Complex variant targs methodName + where + targs = [] + variant = case either of + Left name -> Java.MethodInvocation_VariantExpression name + Right prim -> Java.MethodInvocation_VariantPrimary prim + +methodInvocationStatic :: Java.Identifier -> Java.Identifier -> [Java.Expression] -> Java.MethodInvocation +methodInvocationStatic self methodName = methodInvocation (Just $ Left name) methodName + where + name = Java.ExpressionName Nothing self + +nameToJavaClassType :: Aliases -> Bool -> [Java.TypeArgument] -> Name -> Maybe String -> Java.ClassType +nameToJavaClassType aliases qualify args name mlocal = Java.ClassType [] pkg id args + where + (id, pkg) = nameToQualifiedJavaName aliases qualify name mlocal + +nameToQualifiedJavaName :: Aliases -> Bool -> Name -> Maybe String -> (Java.TypeIdentifier, Java.ClassTypeQualifier) +nameToQualifiedJavaName aliases qualify name mlocal = (jid, pkg) + where + QualifiedName ns local = qualifyNameEager name + alias = case ns of + Nothing -> Nothing + Just n -> case M.lookup n (aliasesPackages aliases) of + Nothing -> Just $ javaPackageName $ Strings.splitOn "/" $ unNamespace n + Just id -> Just id + pkg = if qualify + then Y.maybe none Java.ClassTypeQualifierPackage alias + else none + none = Java.ClassTypeQualifierNone + jid = javaTypeIdentifier $ case mlocal of + Nothing -> sanitizeJavaName local + Just l -> sanitizeJavaName local ++ "." ++ sanitizeJavaName l + +nameToJavaName :: Aliases -> Name -> Java.Identifier +nameToJavaName aliases name = Java.Identifier $ if isEscaped (unName name) + then sanitizeJavaName local + else case ns of + Nothing -> local + Just gname -> case M.lookup gname (aliasesPackages aliases) of + Nothing -> fromParts $ Strings.splitOn "/" $ unNamespace gname + Just (Java.PackageName parts) -> fromParts (Java.unIdentifier <$> parts) + where + QualifiedName ns local = qualifyNameEager name + fromParts parts = L.intercalate "." $ parts ++ [sanitizeJavaName local] + +nameToJavaReferenceType :: Aliases -> Bool -> [Java.TypeArgument] -> Name -> Maybe String -> Java.ReferenceType +nameToJavaReferenceType aliases qualify args name mlocal = Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $ + nameToJavaClassType aliases qualify args name mlocal + +nameToJavaTypeIdentifier :: Aliases -> Bool -> Name -> Java.TypeIdentifier +nameToJavaTypeIdentifier aliases qualify name = fst $ nameToQualifiedJavaName aliases qualify name Nothing + +overrideAnnotation :: Java.Annotation +overrideAnnotation = Java.AnnotationMarker $ Java.MarkerAnnotation $ javaTypeName $ Java.Identifier "Override" + +referenceTypeToResult :: Java.ReferenceType -> Java.Result +referenceTypeToResult = javaTypeToJavaResult . Java.TypeReference + +sanitizeJavaName :: String -> String +sanitizeJavaName name = if isEscaped name + -- The '$' prefix allows names to be excluded from sanitization + then unescape name + else sanitizeWithUnderscores reservedWords name + +toAcceptMethod :: Bool -> [Java.TypeParameter] -> Java.ClassBodyDeclaration +toAcceptMethod abstract vtparams = methodDeclaration mods tparams anns acceptMethodName [param] result body + where + mods = [Java.MethodModifierPublic] ++ if abstract then [Java.MethodModifierAbstract] else [] + tparams = [javaTypeParameter visitorReturnParameter] + anns = if abstract + then [] + else [overrideAnnotation] + param = javaTypeToJavaFormalParameter ref (Name varName) + where + ref = javaClassTypeToJavaType $ + Java.ClassType + [] + Java.ClassTypeQualifierNone + (javaTypeIdentifier visitorName) + (typeArgs ++ [Java.TypeArgumentReference visitorTypeVariable]) + typeArgs = (Java.TypeArgumentReference . typeParameterToReferenceType) <$> vtparams + result = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable + varName = "visitor" + body = if abstract + then Nothing + else Just [Java.BlockStatementStatement $ javaReturnStatement $ Just returnExpr] + returnExpr = javaMethodInvocationToJavaExpression $ + methodInvocationStatic (Java.Identifier varName) (Java.Identifier visitMethodName) [javaThis] + +toAssignStmt :: Name -> Java.Statement +toAssignStmt fname = javaAssignmentStatement lhs rhs + where + lhs = Java.LeftHandSideFieldAccess $ thisField id + where + id = fieldNameToJavaIdentifier fname + rhs = fieldNameToJavaExpression fname + thisField = Java.FieldAccess $ Java.FieldAccess_QualifierPrimary $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis + +toJavaArrayType :: Java.Type -> Flow (Graph) Java.Type +toJavaArrayType t = Java.TypeReference . Java.ReferenceTypeArray <$> case t of + Java.TypeReference rt -> case rt of + Java.ReferenceTypeClassOrInterface cit -> pure $ + Java.ArrayType (Java.Dims [[]]) $ Java.ArrayType_VariantClassOrInterface cit + Java.ReferenceTypeArray (Java.ArrayType (Java.Dims d) v) -> pure $ + Java.ArrayType (Java.Dims $ d ++ [[]]) v + _ -> fail $ "don't know how to make Java reference type into array type: " ++ show rt + _ -> fail $ "don't know how to make Java type into array type: " ++ show t + +typeParameterToTypeArgument :: Java.TypeParameter -> Java.TypeArgument +typeParameterToTypeArgument (Java.TypeParameter _ id _) = javaTypeIdentifierToJavaTypeArgument id + +typeParameterToReferenceType :: Java.TypeParameter -> Java.ReferenceType +typeParameterToReferenceType = javaTypeVariable . unTypeParameter + +unTypeParameter :: Java.TypeParameter -> String +unTypeParameter (Java.TypeParameter [] (Java.TypeIdentifier (Java.Identifier v)) Nothing) = v + +unescape :: String -> String +unescape = L.tail + +variableDeclarationStatement :: Aliases -> Java.Type -> Java.Identifier -> Java.Expression -> Java.BlockStatement +variableDeclarationStatement aliases jtype id rhs = Java.BlockStatementLocalVariableDeclaration $ + Java.LocalVariableDeclarationStatement $ Java.LocalVariableDeclaration [] (Java.LocalVariableTypeType $ Java.UnannType jtype) [vdec] + where + vdec = javaVariableDeclarator id (Just init) + where + init = Java.VariableInitializerExpression rhs + +variableToJavaIdentifier :: Name -> Java.Identifier +variableToJavaIdentifier (Name var) = Java.Identifier $ if var == ignoredVariable + then "ignored" + else var -- TODO: escape + +variantClassName :: Bool -> Name -> Name -> Name +variantClassName qualify elName (Name fname) = unqualifyName (QualifiedName ns local1) + where + QualifiedName ns local = qualifyNameEager elName + flocal = capitalize fname + local1 = if qualify + then local ++ "." ++ flocal + else if flocal == local then flocal ++ "_" else flocal + +visitorTypeVariable :: Java.ReferenceType +visitorTypeVariable = javaTypeVariable "r" diff --git a/src/main/haskell/Hydra/Ext/Json/Coder.hs b/src/main/haskell/Hydra/Ext/Json/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Json/Coder.hs @@ -0,0 +1,211 @@ +module Hydra.Ext.Json.Coder (jsonCoder, literalJsonCoder, untypedTermToJson) where + +import Hydra.Core +import Hydra.Compute +import Hydra.Graph +import Hydra.Strip +import Hydra.Basics +import Hydra.CoreEncoding +import Hydra.Tier1 +import Hydra.Tier2 +import Hydra.Adapters +import Hydra.TermAdapters +import Hydra.Ext.Json.Language +import Hydra.Lib.Literals +import Hydra.AdapterUtils +import qualified Hydra.Json as Json +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types + +import qualified Control.Monad as CM +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +jsonCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value) +jsonCoder typ = do + adapter <- languageAdapter jsonLanguage typ + coder <- termCoder $ adapterTarget adapter + return $ composeCoders (adapterCoder adapter) coder + +literalJsonCoder :: LiteralType -> Flow Graph (Coder Graph Graph Literal Json.Value) +literalJsonCoder at = pure $ case at of + LiteralTypeBoolean -> Coder { + coderEncode = \(LiteralBoolean b) -> pure $ Json.ValueBoolean b, + coderDecode = \s -> case s of + Json.ValueBoolean b -> pure $ LiteralBoolean b + _ -> unexpected "boolean" $ show s} + LiteralTypeFloat _ -> Coder { + coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ Json.ValueNumber f, + coderDecode = \s -> case s of + Json.ValueNumber f -> pure $ LiteralFloat $ FloatValueBigfloat f + _ -> unexpected "number" $ show s} + LiteralTypeInteger _ -> Coder { + coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ Json.ValueNumber $ bigintToBigfloat i, + coderDecode = \s -> case s of + Json.ValueNumber f -> pure $ LiteralInteger $ IntegerValueBigint $ bigfloatToBigint f + _ -> unexpected "number" $ show s} + LiteralTypeString -> Coder { + coderEncode = \(LiteralString s) -> pure $ Json.ValueString s, + coderDecode = \s -> case s of + Json.ValueString s' -> pure $ LiteralString s' + _ -> unexpected "string" $ show s} + +recordCoder :: RowType -> Flow Graph (Coder Graph Graph Term Json.Value) +recordCoder rt = do + coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt) + return $ Coder (encode coders) (decode coders) + where + encode coders term = case stripTerm term of + TermRecord (Record _ fields) -> Json.ValueObject . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields + where + encodeField (ft, coder) (Field fname fv) = case (fieldTypeType ft, fv) of + (TypeOptional _, TermOptional Nothing) -> pure Nothing + _ -> Just <$> ((,) <$> pure (unName fname) <*> coderEncode coder fv) + _ -> unexpected "record" $ show term + decode coders n = case n of + Json.ValueObject m -> Terms.record (rowTypeTypeName rt) <$> CM.mapM (decodeField m) coders -- Note: unknown fields are ignored + where + decodeField a (FieldType fname _, coder) = do + v <- coderDecode coder $ Y.fromMaybe Json.ValueNull $ M.lookup (unName fname) m + return $ Field fname v + _ -> unexpected "mapping" $ show n + getCoder coders fname = Y.maybe error pure $ M.lookup fname coders + where + error = fail $ "no such field: " ++ fname + +termCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value) +termCoder typ = case stripType typ of + TypeLiteral at -> do + ac <- literalJsonCoder at + return Coder { + coderEncode = \(TermLiteral av) -> coderEncode ac av, + coderDecode = \n -> case n of + s -> Terms.literal <$> coderDecode ac s} + TypeList lt -> do + lc <- termCoder lt + return Coder { + coderEncode = \(TermList els) -> Json.ValueArray <$> CM.mapM (coderEncode lc) els, + coderDecode = \n -> case n of + Json.ValueArray nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes + _ -> unexpected "sequence" $ show n} + TypeOptional ot -> do + oc <- termCoder ot + return Coder { + coderEncode = \t -> case fullyStripTerm t of + TermOptional el -> Y.maybe (pure Json.ValueNull) (coderEncode oc) el + _ -> unexpected "optional term" $ show t, + coderDecode = \n -> case n of + Json.ValueNull -> pure $ Terms.optional Nothing + _ -> Terms.optional . Just <$> coderDecode oc n} + TypeMap (MapType kt vt) -> do + kc <- termCoder kt + vc <- termCoder vt + cx <- getState + let encodeEntry (k, v) = (,) (toString cx k) <$> coderEncode vc v + let decodeEntry (k, v) = (,) (fromString cx k) <$> coderDecode vc v + return Coder { + coderEncode = \(TermMap m) -> Json.ValueObject . M.fromList <$> CM.mapM encodeEntry (M.toList m), + coderDecode = \n -> case n of + Json.ValueObject m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m) + _ -> unexpected "mapping" $ show n} + where + toString cx v = if isStringKey cx + then case stripTerm v of + TermLiteral (LiteralString s) -> s + else show v + fromString cx s = Terms.string $ if isStringKey cx then s else read s + isStringKey cx = stripType kt == Types.string + TypeRecord rt -> recordCoder rt + TypeVariable name -> return $ Coder encode decode + where + encode term = pure $ Json.ValueString $ "variable '" ++ unName name ++ "' for: " ++ show term + decode term = fail $ "type variable " ++ unName name ++ " does not support decoding" + _ -> fail $ "unsupported type in JSON: " ++ show (typeVariant typ) + +-- | A simplistic, unidirectional encoding for terms as JSON values. Not type-aware; best used for human consumption. +untypedTermToJson :: Term -> Flow s Json.Value +untypedTermToJson term = case term of + TermAnnotated (AnnotatedTerm term1 ann) -> do + json <- untypedTermToJson term1 + pairs <- CM.mapM encodePair $ M.toList ann + return $ Json.ValueObject $ M.fromList $ [ + ("term", json), + ("annotations", Json.ValueObject $ M.fromList pairs)] + where + encodePair (Name k, v) = do + json <- untypedTermToJson v + return (k, json) + TermApplication (Application lhs rhs) -> asRecord [ + Field _Application_function lhs, + Field _Application_argument rhs] + TermFunction f -> case f of + FunctionElimination elm -> case elm of + EliminationList term1 -> asVariant "fold" term1 + EliminationRecord (Projection _ fname) -> asVariant "project" $ TermVariable fname + _ -> unexp $ "unexpected elimination variant: " ++ show (eliminationVariant elm) + FunctionLambda (Lambda v d body) -> asRecord [ + Field _Lambda_parameter $ TermVariable v, + Field _Lambda_domain $ TermOptional (coreEncodeType <$> d), + Field _Lambda_body body] + FunctionPrimitive name -> pure $ Json.ValueString $ unName name + TermLet (Let bindings env) -> asRecord [ + Field _Let_bindings $ TermRecord $ Record (Name "") (fromBinding <$> bindings), + Field _Let_environment env] + where + fromBinding (LetBinding k v _) = Field k v + TermList terms -> Json.ValueArray <$> (CM.mapM untypedTermToJson terms) + TermLiteral lit -> pure $ case lit of + LiteralBinary s -> Json.ValueString s + LiteralBoolean b -> Json.ValueBoolean b + LiteralFloat f -> Json.ValueNumber $ floatValueToBigfloat f + LiteralInteger i -> Json.ValueNumber $ bigintToBigfloat $ integerValueToBigint i + LiteralString s -> Json.ValueString s + TermOptional mt -> case mt of + Nothing -> pure Json.ValueNull + Just t -> untypedTermToJson t + TermProduct els -> untypedTermToJson $ TermList els + TermRecord (Record _ fields) -> do + keyvals <- CM.mapM fieldToKeyval fields + return $ Json.ValueObject $ M.fromList $ Y.catMaybes keyvals + TermSet vals -> untypedTermToJson $ TermList $ S.toList vals + TermSum (Sum idx size term1) -> asRecord [ + Field _Sum_index $ TermLiteral $ LiteralInteger $ IntegerValueInt32 idx, + Field _Sum_size $ TermLiteral $ LiteralInteger $ IntegerValueInt32 size, + Field _Sum_term term1] + TermTypeAbstraction (TypeAbstraction v term) -> asRecord [ + Field _TypeAbstraction_parameter $ TermVariable v, + Field _TypeAbstraction_body term] + TermTypeApplication (TypedTerm term1 typ) -> asRecord [ -- Note: TermTypeApplication and TermTyped appear identical + Field _TypedTerm_term term1, + Field _TypedTerm_type $ coreEncodeType typ] + TermTyped (TypedTerm term1 typ) -> asRecord [ + Field _TypedTerm_term term1, + Field _TypedTerm_type $ coreEncodeType typ] + TermUnion (Injection _ field) -> if fieldTerm field == Terms.unit + then return $ Json.ValueString $ unName $ fieldName field + else do + mkeyval <- fieldToKeyval field + return $ Json.ValueObject $ M.fromList $ case mkeyval of + Nothing -> [] + Just keyval -> [keyval] + TermVariable v -> pure $ Json.ValueString $ unName v + TermWrap (WrappedTerm _ t) -> untypedTermToJson t + t -> unexp $ "unsupported term variant: " ++ show (termVariant t) +-- t -> fail $ "unexpected term variant: " ++ show (termVariant t) + where + unexp msg = pure $ Json.ValueString $ "FAIL: " ++ msg + asRecord = untypedTermToJson . TermRecord . Record (Name "") + asVariant name term = untypedTermToJson $ TermUnion $ Injection (Name "") $ Field (Name name) term + fieldToKeyval f = do + mjson <- forTerm $ fieldTerm f + return $ case mjson of + Nothing -> Nothing + Just j -> Just (unName $ fieldName f, j) + where + forTerm t = case t of + TermOptional mt -> case mt of + Nothing -> pure Nothing + Just t' -> forTerm t' + t' -> Just <$> untypedTermToJson t' diff --git a/src/main/haskell/Hydra/Ext/Json/Eliminate.hs b/src/main/haskell/Hydra/Ext/Json/Eliminate.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Json/Eliminate.hs @@ -0,0 +1,54 @@ +module Hydra.Ext.Json.Eliminate where + +import Hydra.Kernel +import qualified Hydra.Json as Json + +import qualified Data.Map as M + + +expectArray :: Json.Value -> Flow s [Json.Value] +expectArray value = case value of + Json.ValueArray els -> pure els + _ -> unexpected "JSON array" $ show value + +expectNumber :: Json.Value -> Flow s Double +expectNumber value = case value of + Json.ValueNumber d -> pure d + _ -> unexpected "JSON number" $ show value + +expectObject :: Json.Value -> Flow s (M.Map String Json.Value) +expectObject value = case value of + Json.ValueObject m -> pure m + _ -> unexpected "JSON object" $ show value + +expectString :: Json.Value -> Flow s String +expectString value = case value of + Json.ValueString s -> pure s + _ -> unexpected "JSON string" $ show value + +opt :: String -> M.Map String Json.Value -> Maybe Json.Value +opt = M.lookup + +optArray :: String -> M.Map String Json.Value -> Flow s (Maybe [Json.Value]) +optArray fname m = case opt fname m of + Nothing -> pure Nothing + Just a -> Just <$> expectArray a + +optString :: String -> M.Map String Json.Value -> Flow s (Maybe String) +optString fname m = case opt fname m of + Nothing -> pure Nothing + Just s -> Just <$> expectString s + +require :: String -> M.Map String Json.Value -> Flow s Json.Value +require fname m = case M.lookup fname m of + Nothing -> fail $ "required attribute " ++ show fname ++ " not found" + Just value -> pure value + +requireArray :: String -> M.Map String Json.Value -> Flow s [Json.Value] +requireArray fname m = require fname m >>= expectArray + +requireNumber :: String -> M.Map String Json.Value -> Flow s Double +requireNumber fname m = require fname m >>= expectNumber + +requireString :: String -> M.Map String Json.Value -> Flow s String +requireString fname m = require fname m >>= expectString diff --git a/src/main/haskell/Hydra/Ext/Json/Language.hs b/src/main/haskell/Hydra/Ext/Json/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Json/Language.hs @@ -0,0 +1,33 @@ +module Hydra.Ext.Json.Language where + +import Hydra.Core +import Hydra.Coders +import Hydra.Strip +import Hydra.Mantle + +import qualified Data.Set as S + + +jsonLanguage :: Language +jsonLanguage = Language (LanguageName "hydra/ext/json") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.empty, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString], + languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat], + languageConstraintsFunctionVariants = S.empty, + languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint], + languageConstraintsTermVariants = S.fromList [ + TermVariantList, + TermVariantLiteral, + TermVariantMap, + TermVariantOptional, + TermVariantRecord], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantList, + TypeVariantLiteral, + TypeVariantMap, + TypeVariantOptional, + TypeVariantRecord], + languageConstraintsTypes = \typ -> case stripType typ of + TypeOptional (TypeOptional _) -> False + _ -> True } diff --git a/src/main/haskell/Hydra/Ext/Json/Serde.hs b/src/main/haskell/Hydra/Ext/Json/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Json/Serde.hs @@ -0,0 +1,79 @@ +module Hydra.Ext.Json.Serde where + +import Hydra.Core +import Hydra.Compute +import Hydra.Graph +import Hydra.Ext.Json.Coder +import Hydra.Tools.Bytestrings +import qualified Hydra.Json as Json + +import qualified Data.ByteString.Lazy as BS +import qualified Control.Monad as CM +import qualified Data.Aeson as A +import qualified Data.Aeson.KeyMap as AKM +import qualified Data.Aeson.Key as AK +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Scientific as SC +import qualified Data.Char as C +import qualified Data.String as String + + +aesonValueToBytes :: A.Value -> BS.ByteString +aesonValueToBytes = A.encode + +aesonValueToJsonValue :: A.Value -> Json.Value +aesonValueToJsonValue v = case v of + A.Object km -> Json.ValueObject $ M.fromList (mapPair <$> AKM.toList km) + where + mapPair (k, v) = (AK.toString k, aesonValueToJsonValue v) + A.Array a -> Json.ValueArray (aesonValueToJsonValue <$> V.toList a) + A.String t -> Json.ValueString $ T.unpack t + A.Number s -> Json.ValueNumber $ SC.toRealFloat s + A.Bool b -> Json.ValueBoolean b + A.Null -> Json.ValueNull + +bytesToAesonValue :: BS.ByteString -> Either String A.Value +bytesToAesonValue = A.eitherDecode + +bytesToJsonValue :: BS.ByteString -> Either String Json.Value +bytesToJsonValue bs = aesonValueToJsonValue <$> bytesToAesonValue bs + +jsonByteStringCoder :: Type -> Flow Graph (Coder Graph Graph Term BS.ByteString) +jsonByteStringCoder typ = do + coder <- jsonCoder typ + return Coder { + coderEncode = fmap jsonValueToBytes . coderEncode coder, + coderDecode = \bs -> case bytesToJsonValue bs of + Left msg -> fail $ "JSON parsing failed: " ++ msg + Right v -> coderDecode coder v} + +-- | A convenience which maps typed terms to and from pretty-printed JSON strings, as opposed to JSON objects +jsonStringCoder :: Type -> Flow Graph (Coder Graph Graph Term String) +jsonStringCoder typ = do + serde <- jsonByteStringCoder typ + return Coder { + coderEncode = fmap bytesToString . coderEncode serde, + coderDecode = coderDecode serde . stringToBytes} + +jsonValueToAesonValue :: Json.Value -> A.Value +jsonValueToAesonValue v = case v of + Json.ValueArray l -> A.Array $ V.fromList (jsonValueToAesonValue <$> l) + Json.ValueBoolean b -> A.Bool b + Json.ValueNull -> A.Null + Json.ValueNumber d -> A.Number $ SC.fromFloatDigits d + Json.ValueObject m -> A.Object $ AKM.fromList (mapPair <$> M.toList m) + where + mapPair (k, v) = (AK.fromString k, jsonValueToAesonValue v) + Json.ValueString s -> A.String $ T.pack s + +jsonValueToBytes :: Json.Value -> BS.ByteString +jsonValueToBytes = aesonValueToBytes . jsonValueToAesonValue + +jsonValueToString :: Json.Value -> String +jsonValueToString = bytesToString . jsonValueToBytes + +stringToJsonValue :: String -> Either String Json.Value +stringToJsonValue = bytesToJsonValue . stringToBytes diff --git a/src/main/haskell/Hydra/Ext/Pegasus/Coder.hs b/src/main/haskell/Hydra/Ext/Pegasus/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Pegasus/Coder.hs @@ -0,0 +1,188 @@ +module Hydra.Ext.Pegasus.Coder (moduleToPdl) where + +import Hydra.Kernel +import Hydra.TermAdapters +import Hydra.Adapters +import Hydra.Ext.Pegasus.Language +import Hydra.Tools.Serialization +import Hydra.Ext.Pegasus.Serde +import qualified Hydra.Ext.Pegasus.Pdl as PDL +import qualified Hydra.Dsl.Types as Types + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +moduleToPdl :: Module -> Flow (Graph) (M.Map FilePath String) +moduleToPdl mod = do + files <- moduleToPegasusSchemas mod + return $ M.fromList (mapPair <$> M.toList files) + where + mapPair (path, sf) = (path, printExpr $ parenthesize $ exprSchemaFile sf) + +constructModule :: + M.Map Namespace String + -> Module + -> M.Map (Type) (Coder (Graph) (Graph) (Term) ()) + -> [(Element, TypedTerm)] + -> Flow (Graph) (M.Map FilePath PDL.SchemaFile) +constructModule aliases mod coders pairs = do + sortedPairs <- case (topologicalSortElements $ fst <$> pairs) of + Left comps -> fail $ "types form a cycle (unsupported in PDL): " ++ show (L.head comps) + Right sorted -> pure $ Y.catMaybes $ fmap (\n -> M.lookup n pairByName) sorted + schemas <- CM.mapM toSchema sortedPairs + return $ M.fromList (toPair <$> schemas) + where + ns = pdlNameForModule mod + pkg = Nothing + toPair (schema, imports) = (path, PDL.SchemaFile ns pkg imports [schema]) + where + path = namespaceToFilePath False (FileExtension "pdl") (Namespace $ (unNamespace $ moduleNamespace mod) ++ "/" ++ local) + local = PDL.unName $ PDL.qualifiedNameName $ PDL.namedSchemaQualifiedName schema + + pairByName = L.foldl (\m p -> M.insert (elementName $ fst p) p m) M.empty pairs + toSchema (el, TypedTerm term typ) = do + if isType typ + then coreDecodeType term >>= typeToSchema el + else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el) + typeToSchema el typ = do + res <- encodeAdaptedType aliases typ + let ptype = case res of + Left schema -> PDL.NamedSchema_TypeTyperef schema + Right t -> t + r <- getTermDescription $ elementData el + let anns = doc r + return (PDL.NamedSchema qname ptype anns, imports) + where + qname = pdlNameForElement aliases False $ elementName el + imports = [] +-- imports = L.filter isExternal (pdlNameForElement aliases True <$> deps) +-- where +-- deps = S.toList $ termDependencyNames False False False $ elementData el +-- isExternal qn = PDL.qualifiedNameNamespace qn /= PDL.qualifiedNameNamespace qname + +moduleToPegasusSchemas :: Module -> Flow (Graph) (M.Map FilePath PDL.SchemaFile) +moduleToPegasusSchemas mod = do + aliases <- importAliasesForModule mod + transformModule pdlLanguage (encodeTerm aliases) (constructModule aliases) mod + +doc :: Y.Maybe String -> PDL.Annotations +doc s = PDL.Annotations s False + +encodeAdaptedType :: + M.Map Namespace String -> Type + -> Flow (Graph) (Either PDL.Schema PDL.NamedSchema_Type) +encodeAdaptedType aliases typ = do + g <- getState + let cx = AdapterContext g pdlLanguage M.empty + ad <- withState cx $ termAdapter typ + encodeType aliases $ adapterTarget ad + +encodeTerm :: M.Map Namespace String -> Term -> Flow (Graph) () +encodeTerm aliases term = fail "not yet implemented" + +encodeType :: M.Map Namespace String -> Type -> Flow (Graph) (Either PDL.Schema PDL.NamedSchema_Type) +encodeType aliases typ = case typ of + TypeAnnotated (AnnotatedType typ' _) -> encodeType aliases typ' + TypeList lt -> Left . PDL.SchemaArray <$> encode lt + TypeLiteral lt -> Left . PDL.SchemaPrimitive <$> case lt of + LiteralTypeBinary -> pure PDL.PrimitiveTypeBytes + LiteralTypeBoolean -> pure PDL.PrimitiveTypeBoolean + LiteralTypeFloat ft -> case ft of + FloatTypeFloat32 -> pure PDL.PrimitiveTypeFloat + FloatTypeFloat64 -> pure PDL.PrimitiveTypeDouble + _ -> unexpected "float32 or float64" $ show ft + LiteralTypeInteger it -> case it of + IntegerTypeInt32 -> pure PDL.PrimitiveTypeInt + IntegerTypeInt64 -> pure PDL.PrimitiveTypeLong + _ -> unexpected "int32 or int64" $ show it + LiteralTypeString -> pure PDL.PrimitiveTypeString + TypeMap (MapType kt vt) -> Left . PDL.SchemaMap <$> encode vt -- note: we simply assume string as a key type + TypeVariable name -> pure $ Left $ PDL.SchemaNamed $ pdlNameForElement aliases True name + TypeOptional ot -> fail $ "optionals unexpected at top level" + TypeRecord rt -> do + let includes = [] + rfields <- CM.mapM encodeRecordField $ rowTypeFields rt + return $ Right $ PDL.NamedSchema_TypeRecord $ PDL.RecordSchema rfields includes + TypeUnion rt -> if isEnum + then do + fs <- CM.mapM encodeEnumField $ rowTypeFields rt + return $ Right $ PDL.NamedSchema_TypeEnum $ PDL.EnumSchema fs + else Left . PDL.SchemaUnion . PDL.UnionSchema <$> CM.mapM encodeUnionField (rowTypeFields rt) + where + isEnum = L.foldl (\b t -> b && stripType t == Types.unit) True $ fmap fieldTypeType (rowTypeFields rt) + _ -> unexpected "PDL-supported type" $ show typ + where + encode t = case stripType t of + TypeRecord (RowType _ []) -> encode Types.int32 -- special case for the unit type + _ -> do + res <- encodeType aliases t + case res of + Left schema -> pure schema + Right _ -> fail $ "type resolved to an unsupported nested named schema: " ++ show t + encodeRecordField (FieldType (Name name) typ) = do + anns <- getAnns typ + (schema, optional) <- encodePossiblyOptionalType typ + return PDL.RecordField { + PDL.recordFieldName = PDL.FieldName name, + PDL.recordFieldValue = schema, + PDL.recordFieldOptional = optional, + PDL.recordFieldDefault = Nothing, + PDL.recordFieldAnnotations = anns} + encodeUnionField (FieldType (Name name) typ) = do + anns <- getAnns typ + (s, optional) <- encodePossiblyOptionalType typ + let schema = if optional + then PDL.SchemaUnion $ PDL.UnionSchema (simpleUnionMember <$> [PDL.SchemaNull, s]) + else s + return PDL.UnionMember { + PDL.unionMemberAlias = Just $ PDL.FieldName name, + PDL.unionMemberValue = schema, + PDL.unionMemberAnnotations = anns} + encodeEnumField (FieldType (Name name) typ) = do + anns <- getAnns typ + return PDL.EnumField { + PDL.enumFieldName = PDL.EnumFieldName $ convertCase CaseConventionCamel CaseConventionUpperSnake name, + PDL.enumFieldAnnotations = anns} + encodePossiblyOptionalType typ = case stripType typ of + TypeOptional ot -> do + t <- encode ot + return (t, True) + _ -> do + t <- encode typ + return (t, False) + getAnns typ = do + r <- getTypeDescription typ + return $ doc r + +importAliasesForModule mod = do + nss <- moduleDependencyNamespaces False True True False mod + return $ M.fromList (toPair <$> S.toList nss) + where + toPair ns = (ns, slashesToDots $ unNamespace ns) + +noAnnotations :: PDL.Annotations +noAnnotations = PDL.Annotations Nothing False + +pdlNameForElement :: M.Map Namespace String -> Bool -> Name -> PDL.QualifiedName +pdlNameForElement aliases withNs name = PDL.QualifiedName (PDL.Name local) + $ if withNs + then PDL.Namespace <$> alias + else Nothing + where + QualifiedName (Just ns) local = qualifyNameEager name + alias = M.lookup ns aliases + +pdlNameForModule :: Module -> PDL.Namespace +pdlNameForModule = PDL.Namespace . slashesToDots . h . moduleNamespace + where + h (Namespace n) = n + +simpleUnionMember :: PDL.Schema -> PDL.UnionMember +simpleUnionMember schema = PDL.UnionMember Nothing schema noAnnotations + +slashesToDots :: String -> String +slashesToDots = fmap (\c -> if c == '/' then '.' else c) diff --git a/src/main/haskell/Hydra/Ext/Pegasus/Language.hs b/src/main/haskell/Hydra/Ext/Pegasus/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Pegasus/Language.hs @@ -0,0 +1,41 @@ +module Hydra.Ext.Pegasus.Language where + +import Hydra.Kernel + +import qualified Data.Set as S + + +pdlLanguage :: Language +pdlLanguage = Language (LanguageName "hydra/ext/pegasus/pdl") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.empty, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBinary, + LiteralVariantBoolean, + LiteralVariantFloat, + LiteralVariantInteger, + LiteralVariantString], + languageConstraintsFloatTypes = S.fromList [ + FloatTypeFloat32, + FloatTypeFloat64], + languageConstraintsFunctionVariants = S.empty, + languageConstraintsIntegerTypes = S.fromList [ + IntegerTypeInt32, + IntegerTypeInt64], + languageConstraintsTermVariants = S.fromList [ + TermVariantList, + TermVariantLiteral, + TermVariantMap, + TermVariantWrap, + TermVariantOptional, + TermVariantRecord, + TermVariantUnion], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantAnnotated, + TypeVariantList, + TypeVariantLiteral, + TypeVariantMap, + TypeVariantWrap, + TypeVariantOptional, + TypeVariantRecord, + TypeVariantUnion], + languageConstraintsTypes = const True } diff --git a/src/main/haskell/Hydra/Ext/Pegasus/Serde.hs b/src/main/haskell/Hydra/Ext/Pegasus/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Pegasus/Serde.hs @@ -0,0 +1,81 @@ +module Hydra.Ext.Pegasus.Serde where + +import Hydra.Tools.Serialization +import Hydra.Tools.Formatting +import qualified Hydra.Ast as CT +import qualified Hydra.Ext.Pegasus.Pdl as PDL + +import qualified Data.List as L +import qualified Data.Maybe as Y + + +exprAnnotations :: PDL.Annotations -> Y.Maybe CT.Expr +exprAnnotations (PDL.Annotations doc _) = cst . javaStyleComment <$> doc + +exprEnumField :: PDL.EnumField -> CT.Expr +exprEnumField (PDL.EnumField (PDL.EnumFieldName name) anns) = withAnnotations anns $ cst name + +exprImport :: PDL.QualifiedName -> CT.Expr +exprImport qn = spaceSep [cst "import", exprQualifiedName qn] + +exprNamedSchema :: PDL.NamedSchema -> CT.Expr +exprNamedSchema (PDL.NamedSchema qn t anns) = withAnnotations anns $ + case t of + PDL.NamedSchema_TypeRecord (PDL.RecordSchema fields _) -> spaceSep [cst "record", exprQualifiedName qn, + curlyBracesList Nothing fullBlockStyle (exprRecordField <$> fields)] + PDL.NamedSchema_TypeEnum (PDL.EnumSchema fields) -> spaceSep [cst "enum", exprQualifiedName qn, + curlyBracesList Nothing fullBlockStyle (exprEnumField <$> fields)] + PDL.NamedSchema_TypeTyperef schema -> spaceSep [cst "typeref", exprQualifiedName qn, cst "=", exprSchema schema] + +exprPrimitiveType :: PDL.PrimitiveType -> CT.Expr +exprPrimitiveType pt = cst $ case pt of + PDL.PrimitiveTypeBoolean -> "boolean" + PDL.PrimitiveTypeBytes -> "bytes" + PDL.PrimitiveTypeDouble -> "double" + PDL.PrimitiveTypeFloat -> "float" + PDL.PrimitiveTypeInt -> "int" + PDL.PrimitiveTypeLong -> "long" + PDL.PrimitiveTypeString -> "string" + +exprQualifiedName :: PDL.QualifiedName -> CT.Expr +exprQualifiedName (PDL.QualifiedName (PDL.Name name) ns) = cst $ L.intercalate "." $ Y.catMaybes [h <$> ns, Just name] + where + h (PDL.Namespace ns) = ns + +exprRecordField :: PDL.RecordField -> CT.Expr +exprRecordField (PDL.RecordField (PDL.FieldName name) schema optional def anns) = withAnnotations anns $ + spaceSep $ Y.catMaybes [ -- TODO: default + Just $ cst $ name ++ ":", + if optional then Just (cst "optional") else Nothing, + Just $ exprSchema schema] + +exprSchema :: PDL.Schema -> CT.Expr +exprSchema schema = case schema of + PDL.SchemaArray s -> noSep [cst "array", bracketList inlineStyle [exprSchema s]] +-- PDL.SchemaFixed i -> +-- PDL.SchemaInline ns -> + PDL.SchemaMap s -> noSep [cst "map", bracketList inlineStyle [cst "string", exprSchema s]] + PDL.SchemaNamed qn -> exprQualifiedName qn + PDL.SchemaNull -> cst "null" + PDL.SchemaPrimitive pt -> exprPrimitiveType pt + PDL.SchemaUnion (PDL.UnionSchema us) -> noSep [cst "union", bracketList fullBlockStyle (exprUnionMember <$> us)] + +exprSchemaFile :: PDL.SchemaFile -> CT.Expr +exprSchemaFile (PDL.SchemaFile (PDL.Namespace ns) pkg imports schemas) = doubleNewlineSep $ Y.catMaybes + [namespaceSec, packageSec, importsSec] ++ schemaSecs + where + namespaceSec = Just $ spaceSep [cst "namespace", cst ns] + packageSec = fmap (\(PDL.Package p) -> spaceSep [cst "package", cst p]) pkg + importsSec = if L.null imports + then Nothing + else Just $ newlineSep (exprImport <$> imports) + schemaSecs = exprNamedSchema <$> schemas + +exprUnionMember :: PDL.UnionMember -> CT.Expr +exprUnionMember (PDL.UnionMember alias schema anns) = withAnnotations anns $ + spaceSep $ Y.catMaybes [ + fmap (\(PDL.FieldName n) -> cst $ n ++ ":") alias, + Just $ exprSchema schema] + +withAnnotations :: PDL.Annotations -> CT.Expr -> CT.Expr +withAnnotations anns expr = newlineSep $ Y.catMaybes [exprAnnotations anns, Y.Just expr] diff --git a/src/main/haskell/Hydra/Ext/Pg/Coder.hs b/src/main/haskell/Hydra/Ext/Pg/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Pg/Coder.hs @@ -0,0 +1,355 @@ +module Hydra.Ext.Pg.Coder ( + elementCoder, +) where + +import Hydra.Kernel +import Hydra.Pg.Mapping +import Hydra.Ext.Pg.TermsToElements +import qualified Hydra.Pg.Model as PG +import qualified Hydra.Dsl.Expect as Expect +import qualified Hydra.Dsl.Terms as Terms + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +type ElementAdapter s t v = Adapter s s (Type) (PG.ElementTypeTree t) (Term) (PG.ElementTree v) + +type PropertyAdapter s t v = Adapter s s (FieldType) (PG.PropertyType t) (Field) (PG.Property v) + +type IdAdapter s t v = (Name, Adapter s s (Type) t (Term) v) + +data AdjacentEdgeAdapter s a t v = AdjacentEdgeAdapter { + adjacentEdgeAdapterDirection :: PG.Direction, + adjacentEdgeAdapterField :: FieldType, + adjacentEdgeAdapterLabel :: PG.EdgeLabel, + adjacentEdgeAdapterAdapter :: ElementAdapter s t v} + +data ProjectionSpec a = ProjectionSpec { + projectionSpecField :: FieldType, + projectionSpecValues :: ValueSpec, + projectionSpecAlias :: Maybe String} + +-- TODO: deprecate "kind" +key_kind = Name "kind" + +check :: Bool -> Flow s () -> Flow s () +check b err = if b then pure () else err + +checkRecordName expected actual = check (actual == expected) $ + unexpected ("record of type " ++ unName expected) ("record of type " ++ unName actual) + +edgeCoder :: PG.Direction -> Schema s t v + -> Type + -> t + -> Name + -> PG.EdgeLabel -> PG.VertexLabel -> PG.VertexLabel + -> Maybe (IdAdapter s t v) -> Maybe (IdAdapter s t v) -> Maybe (IdAdapter s t v) -> [PropertyAdapter s t v] + -> ElementAdapter s t v +edgeCoder dir schema source eidType tname label outLabel inLabel mIdAdapter outAdapter inAdapter propAdapters + = Adapter lossy source (elementTypeTreeEdge et []) coder + where + et = PG.EdgeType label eidType outLabel inLabel $ propertyTypes propAdapters + coder = Coder encode decode + where + encode term = case stripTerm term of + TermOptional (Just ot) -> encode ot + TermRecord (Record tname' fields) -> do + checkRecordName tname tname' + let fieldsm = fieldMap fields + id <- case mIdAdapter of + Nothing -> pure $ schemaDefaultEdgeId schema + Just ad -> selectEdgeId fieldsm ad + props <- encodeProperties fieldsm propAdapters + outId <- getVertexId PG.DirectionOut fieldsm outAdapter + inId <- getVertexId PG.DirectionIn fieldsm inAdapter + return $ elementTreeEdge (PG.Edge label id outId inId props) [] + _ -> unexpected "record (1)" $ show term + decode el = noDecoding "edge" + getVertexId dir1 fieldsm adapter = if dir1 == dir + then pure $ schemaDefaultVertexId schema + else case adapter of + Nothing -> fail $ "no adapter for " ++ show dir1 ++ " with " ++ show dir + Just ad -> selectVertexId fieldsm ad + +elementCoder :: (Show t, Show v) => Y.Maybe (PG.Direction, PG.VertexLabel) + -> Schema s t v + -> Type + -> t -> t + -> Flow s (ElementAdapter s t v) +elementCoder mparent schema source vidType eidType = case stripType source of + TypeOptional ot -> elementCoder mparent schema ot vidType eidType + TypeRecord (RowType name fields) -> withTrace ("adapter for " ++ unName name) $ do + mOutSpec <- findProjectionSpec name outVertexKey outVertexLabelKey fields + mInSpec <- findProjectionSpec name inVertexKey inVertexLabelKey fields + + kind <- case getTypeAnnotation key_kind source of + Nothing -> pure $ if hasVertexAdapters mOutSpec mInSpec + then PG.ElementKindEdge + else PG.ElementKindVertex + Just kindTerm -> do + s <- Expect.string kindTerm + case s of + "vertex" -> return PG.ElementKindVertex + "edge" -> if Y.isNothing mOutSpec || Y.isNothing mInSpec + then fail $ "Record type marked as an edge type, but missing 'out' and/or 'in' fields: " ++ unName name + else return PG.ElementKindEdge + + propSpecs <- findPropertySpecs kind fields + propAdapters <- CM.mapM (propertyAdapter schema) propSpecs + + case kind of + PG.ElementKindVertex -> do + label <- PG.VertexLabel <$> findLabelString name vertexLabelKey + idAdapter <- vertexIdAdapter name vertexIdKey fields + outEdgeAdapters <- edgeAdapters label PG.DirectionOut fields + inEdgeAdapters <- edgeAdapters label PG.DirectionIn fields + return $ vertexCoder schema source vidType name label idAdapter propAdapters (outEdgeAdapters ++ inEdgeAdapters) + PG.ElementKindEdge -> do + label <- PG.EdgeLabel <$> findLabelString name edgeLabelKey + idAdapter <- edgeIdAdapter name edgeIdKey fields + outAdapter <- Y.maybe (pure Nothing) (\s -> Just <$> projectionAdapter vidType (schemaVertexIds schema) s "out") mOutSpec + inAdapter <- Y.maybe (pure Nothing) (\s -> Just <$> projectionAdapter vidType (schemaVertexIds schema) s "in") mInSpec + outLabel <- case mOutSpec of + Nothing -> pure parentLabel + Just spec -> Y.maybe (fail "no out-vertex label") (pure . PG.VertexLabel) $ projectionSpecAlias spec + inLabel <- case mInSpec of + Nothing -> pure parentLabel + Just spec -> Y.maybe (fail "no in-vertex label") (pure . PG.VertexLabel) $ projectionSpecAlias spec + return $ edgeCoder dir schema source eidType name label outLabel inLabel idAdapter outAdapter inAdapter propAdapters + + _ -> unexpected "record type" $ show source + where + dir = Y.maybe PG.DirectionBoth fst mparent + parentLabel = Y.maybe (PG.VertexLabel "NOLABEL") snd mparent + + vertexIdAdapter name idKey fields = do + idSpec <- Y.fromJust <$> findId True name idKey fields + idAdapter <- projectionAdapter vidType (schemaVertexIds schema) idSpec "id" + return idAdapter + + edgeIdAdapter name idKey fields = do + mIdSpec <- findId False name idKey fields + case mIdSpec of + Nothing -> pure Nothing + Just idSpec -> Just <$> projectionAdapter eidType (schemaEdgeIds schema) idSpec "id" + + hasVertexAdapters mOutSpec mInSpec = case dir of + PG.DirectionOut -> Y.isJust mInSpec + PG.DirectionIn -> Y.isJust mOutSpec + PG.DirectionBoth -> Y.isJust mOutSpec && Y.isJust mInSpec + + vertexLabelKey = Name $ annotationSchemaVertexLabel $ schemaAnnotations schema + edgeLabelKey = Name $ annotationSchemaEdgeLabel $ schemaAnnotations schema + vertexIdKey = Name $ annotationSchemaVertexId $ schemaAnnotations schema + edgeIdKey = Name $ annotationSchemaEdgeId $ schemaAnnotations schema + propertyKeyKey = Name $ annotationSchemaPropertyKey $ schemaAnnotations schema + propertyValueKey = Name $ annotationSchemaPropertyValue $ schemaAnnotations schema + outVertexKey = Name $ annotationSchemaOutVertex $ schemaAnnotations schema + outVertexLabelKey = Name $ annotationSchemaOutVertexLabel $ schemaAnnotations schema + inVertexKey = Name $ annotationSchemaInVertex $ schemaAnnotations schema + inVertexLabelKey = Name $ annotationSchemaInVertexLabel $ schemaAnnotations schema + outEdgeLabelKey = Name $ annotationSchemaOutEdgeLabel $ schemaAnnotations schema + inEdgeLabelKey = Name $ annotationSchemaInEdgeLabel $ schemaAnnotations schema + ignoreKey = Name $ annotationSchemaIgnore $ schemaAnnotations schema + + findLabelString tname labelKey = case getTypeAnnotation labelKey source of + Nothing -> pure $ unName tname + Just labelTerm -> Expect.string labelTerm + + findId required tname idKey fields = withTrace "find id field" $ do + mid <- findField tname idKey fields + case mid of + Nothing -> if required + then fail $ "no " ++ unName idKey ++ " field" + else pure Nothing + Just mi -> do + spec <- case getTypeAnnotation idKey (fieldTypeType mi) of + Nothing -> pure ValueSpecValue + Just t -> decodeValueSpec t + return $ Just $ ProjectionSpec mi spec Nothing + + findProjectionSpec tname key aliasKey fields = withTrace ("find " ++ show key ++ " projection") $ do + mfield <- findField tname key fields + case mfield of + Nothing -> pure Nothing + Just field -> do + spec <- decodeValueSpec $ Y.fromJust $ getTypeAnnotation key $ fieldTypeType field + alias <- case getTypeAnnotation aliasKey $ fieldTypeType field of + Nothing -> pure Nothing + Just t -> Just <$> Expect.string t + return $ Just $ ProjectionSpec field spec alias + + findField tname key fields = withTrace ("find " ++ show key ++ " field") $ do + let matches = L.filter (\f -> Y.isJust $ getTypeAnnotation key $ fieldTypeType f) fields + if L.length matches > 1 + then fail $ "Multiple fields marked as '" ++ unName key ++ "' in record type " ++ unName tname ++ ": " + ++ (L.intercalate ", " (unName . fieldTypeName <$> matches)) + else return $ if L.null matches then Nothing else Just $ L.head matches + + findPropertySpecs kind fields = CM.mapM toSpec $ L.filter isPropField fields + where + isPropField field = not (hasSpecialAnnotation || hasSpecialFieldName) + where + hasSpecialAnnotation = L.foldl (\b k -> b || hasAnnotation k) False (ignoreKey:specialKeys) + hasSpecialFieldName = L.foldl (\b n -> b || hasName n) False specialKeys + specialKeys = case kind of + PG.ElementKindVertex -> [vertexIdKey, outEdgeLabelKey, inEdgeLabelKey] + PG.ElementKindEdge -> [edgeIdKey, outVertexKey, inVertexKey] + hasAnnotation key = Y.isJust $ getTypeAnnotation key $ fieldTypeType field + hasName fname = fieldTypeName field == fname + toSpec field = do + alias <- case (getTypeAnnotation propertyKeyKey $ fieldTypeType field) of + Nothing -> pure Nothing + Just a -> Just <$> Expect.string a + values <- case (getTypeAnnotation propertyValueKey $ fieldTypeType field) of + Nothing -> pure ValueSpecValue + Just sp -> decodeValueSpec sp + return $ ProjectionSpec field values alias + + edgeAdapters vlabel dir fields = Y.catMaybes <$> CM.mapM toSpec fields + where + toSpec field = case getTypeAnnotation key (fieldTypeType field) of + Nothing -> pure Nothing + Just a -> do + label <- PG.EdgeLabel <$> Expect.string a + elad <- elementCoder (Just (dir, vlabel)) schema (fieldTypeType field) vidType eidType + return $ Just $ AdjacentEdgeAdapter dir field label elad + key = case dir of + PG.DirectionOut -> outEdgeLabelKey + PG.DirectionIn -> inEdgeLabelKey + +elementTreeEdge :: PG.Edge v -> [PG.ElementTree v] -> PG.ElementTree v +elementTreeEdge edge = PG.ElementTree (PG.ElementEdge edge) + +elementTreeVertex :: PG.Vertex v -> [PG.ElementTree v] -> PG.ElementTree v +elementTreeVertex vertex = PG.ElementTree (PG.ElementVertex vertex) + +elementTypeTreeEdge :: PG.EdgeType t -> [PG.ElementTypeTree t] -> PG.ElementTypeTree t +elementTypeTreeEdge etype = PG.ElementTypeTree (PG.ElementTypeEdge etype) + +elementTypeTreeVertex :: PG.VertexType t -> [PG.ElementTypeTree t] -> PG.ElementTypeTree t +elementTypeTreeVertex vtype = PG.ElementTypeTree (PG.ElementTypeVertex vtype) + +encodeProperties :: M.Map Name (Term) -> [PropertyAdapter s t v] -> Flow s (M.Map PG.PropertyKey v) +encodeProperties fields adapters = do + props <- Y.catMaybes <$> CM.mapM (encodeProperty fields) adapters + return $ M.fromList $ fmap (\(PG.Property key val) -> (key, val)) props + +encodeProperty :: M.Map Name (Term) -> PropertyAdapter s t v -> Flow s (Maybe (PG.Property v)) +encodeProperty fields adapter = do + case M.lookup fname fields of + Nothing -> case ftyp of + TypeOptional _ -> pure Nothing + _ -> fail $ "expected field not found in record: " ++ unName fname + Just value -> case ftyp of + TypeOptional _ -> case fullyStripTerm value of + TermOptional ov -> case ov of + Nothing -> pure Nothing + Just v -> Just <$> encodeValue v + _ -> unexpected "optional term" $ show value + _ -> Just <$> encodeValue value + where + fname = fieldTypeName $ adapterSource adapter + ftyp = stripType (fieldTypeType $ adapterSource adapter) + encodeValue v = coderEncode (adapterCoder adapter) (Field fname v) + +-- TODO; infer lossiness +lossy = True + +noDecoding :: String -> Flow s x +noDecoding cat = fail $ cat ++ " decoding is not yet supported" + +projectionAdapter :: t + -> Coder s s (Term) v + -> ProjectionSpec a + -> String + -> Flow s (IdAdapter s t v) +projectionAdapter idtype coder spec key = do + traversal <- parseValueSpec $ projectionSpecValues spec + let field = projectionSpecField spec + let encode = \typ -> traverseToSingleTerm (key ++ "-projection") traversal typ >>= coderEncode coder + return (fieldTypeName field, Adapter lossy (fieldTypeType field) idtype $ Coder encode decode) + where + decode _ = noDecoding $ "edge '" ++ key ++ "'" + +propertyAdapter :: Schema s t v -> ProjectionSpec a -> Flow s (PropertyAdapter s t v) +propertyAdapter schema (ProjectionSpec tfield values alias) = do + let key = PG.PropertyKey $ case alias of + Nothing -> unName $ fieldTypeName tfield + Just k -> k + pt <- coderEncode (schemaPropertyTypes schema) $ fieldTypeType tfield + traversal <- parseValueSpec values + let coder = Coder encode decode + where + encode dfield = withTrace ("encode property field " ++ show (unName $ fieldTypeName tfield)) $ do + if fieldName dfield /= fieldTypeName tfield + then unexpected ("field '" ++ unName (fieldTypeName tfield) ++ "'") $ show dfield + else do + result <- traverseToSingleTerm "property traversal" traversal $ fieldTerm dfield + value <- coderEncode (schemaPropertyValues schema) result + return $ PG.Property key value + decode _ = noDecoding "property" + return $ Adapter lossy tfield (PG.PropertyType key pt True) coder + +propertyTypes propAdapters = toPropertyType <$> propAdapters + where + toPropertyType a = PG.PropertyType (PG.propertyTypeKey $ adapterTarget a) (PG.propertyTypeValue $ adapterTarget a) True + +selectEdgeId fields (fname, ad) = case M.lookup fname fields of + Nothing -> fail $ "no " ++ unName fname ++ " in record" + Just t -> coderEncode (adapterCoder ad) t + +selectVertexId :: M.Map Name (Term) -> IdAdapter s t v -> Flow s v +selectVertexId fields (fname, ad) = case M.lookup fname fields of + Nothing -> fail $ "no " ++ unName fname ++ " in record" + Just t -> coderEncode (adapterCoder ad) t + +traverseToSingleTerm :: String -> (Term -> Flow s [Term]) -> Term -> Flow s (Term) +traverseToSingleTerm desc traversal term = do + terms <- traversal term + case terms of + [] -> fail $ desc ++ " did not resolve to a term" + [t] -> pure t + _ -> fail $ desc ++ " resolved to multiple terms" + +vertexCoder :: (Show t, Show v) + => Schema s t v + -> Type + -> t + -> Name + -> PG.VertexLabel -> IdAdapter s t v -> [PropertyAdapter s t v] + -> [AdjacentEdgeAdapter s a t v] + -> ElementAdapter s t v +vertexCoder schema source vidType tname label idAdapter propAdapters edgeAdapters = Adapter lossy source target coder + where + target = elementTypeTreeVertex vtype depTypes + vtype = PG.VertexType label vidType $ propertyTypes propAdapters + depTypes = adapterTarget . adjacentEdgeAdapterAdapter <$> edgeAdapters + coder = Coder encode decode + where + encode term = case stripTerm term of + TermOptional (Just ot) -> encode ot + TermRecord (Record tname' fields) -> do + checkRecordName tname tname' + let fieldsm = fieldMap fields + vid <- selectVertexId fieldsm idAdapter + props <- encodeProperties (fieldMap fields) propAdapters + deps <- Y.catMaybes <$> CM.mapM (findDeps vid fieldsm) edgeAdapters + return $ elementTreeVertex (PG.Vertex label vid props) deps + _ -> unexpected "record (2)" $ show term + where + findDeps vid fieldsm (AdjacentEdgeAdapter dir field label ad) = do + case M.lookup (fieldTypeName field) fieldsm of + Nothing -> pure Nothing + Just fterm -> Just <$> (coderEncode (adapterCoder ad) fterm >>= fixTree) + where + fixTree tree = case PG.elementTreeSelf tree of + PG.ElementEdge e -> pure $ tree {PG.elementTreeSelf = PG.ElementEdge $ fixEdge e} + _ -> unexpected "edge tree" $ show tree + fixEdge e = case dir of + PG.DirectionOut -> e {PG.edgeOut = vid} + PG.DirectionIn -> e {PG.edgeIn = vid} + decode el = noDecoding "vertex" diff --git a/src/main/haskell/Hydra/Ext/Pg/TermsToElements.hs b/src/main/haskell/Hydra/Ext/Pg/TermsToElements.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Pg/TermsToElements.hs @@ -0,0 +1,253 @@ +module Hydra.Ext.Pg.TermsToElements ( + decodeValueSpec, + parseValueSpec, + termToElementsAdapter, +) where + +import Hydra.Kernel +import Hydra.Pg.Mapping +import qualified Hydra.Pg.Model as PG +import qualified Hydra.Dsl.Expect as Expect +import qualified Hydra.Dsl.Terms as Terms + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.List.Split as LS +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +type PgAdapter s v = Adapter s s Type [PG.Label] Term [PG.Element v] + +key_elements = Name "elements" + +termToElementsAdapter :: Schema s t v -> Type -> Flow s (PgAdapter s v) +termToElementsAdapter schema typ = do + case getTypeAnnotation key_elements typ of + Nothing -> pure trivialAdapter + Just term -> do + specs <- Expect.list decodeElementSpec term >>= CM.mapM (parseElementSpec schema) + let labels = L.nub (fst <$> specs) + let encoders = snd <$> specs + let encode term = L.concat <$> CM.mapM (\e -> e term) encoders + return $ Adapter lossy typ labels $ Coder encode (\els -> noDecoding "element") + where + trivialAdapter = Adapter False typ [] $ Coder (\term -> pure []) (\el -> fail "no corresponding element type") + +-- TODO; infer lossiness +lossy = False + +noDecoding :: String -> Flow s x +noDecoding cat = fail $ cat ++ " decoding is not yet supported" + +parseEdgeIdPattern :: Schema s t v -> ValueSpec -> Flow s (Term -> Flow s [v]) +parseEdgeIdPattern schema spec = do + fun <- parseValueSpec spec + return $ \term -> fun term >>= CM.mapM (coderEncode $ schemaEdgeIds schema) + +parseEdgeSpec :: Schema s t v -> EdgeSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v]) +parseEdgeSpec schema (EdgeSpec label id outV inV props) = do + getId <- parseEdgeIdPattern schema id + getOut <- parseVertexIdPattern schema outV + getIn <- parseVertexIdPattern schema inV + getProps <- CM.mapM (parsePropertySpec schema) props + let encode term = withTrace "encode as edge" $ do + tid <- requireUnique "edge id" getId term + tout <- requireUnique "vertex id" getOut term + tin <- requireUnique "edge id" getIn term + tprops <- M.fromList <$> CM.mapM (\g -> requireUnique "property key" g term) getProps + return [PG.ElementEdge $ PG.Edge label tid tout tin tprops] + return (PG.LabelEdge label, encode) + +parseElementSpec :: Schema s t v -> ElementSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v]) +parseElementSpec schema spec = case spec of + ElementSpecVertex vspec -> parseVertexSpec schema vspec + ElementSpecEdge espec -> parseEdgeSpec schema espec + +parsePattern :: String -> Flow s (Term -> Flow s [Term]) +parsePattern pat = withTrace "parse path pattern" $ do + (lits, paths) <- parsePattern [] [] "" pat + return $ traverse lits paths + where + parsePattern lits paths cur s = case s of + [] -> pure (L.reverse (nextLit:lits), L.reverse paths) + ('$':'{':rest) -> parsePath (nextLit:lits) paths "" rest + (c:rest) -> parsePattern lits paths (c:cur) rest + where + nextLit = L.reverse cur + parsePath lits paths cur s = case s of + [] -> fail $ "Unfinished path expression: " ++ pat + ('}':rest) -> parsePattern lits (path:paths) "" rest + where + path = LS.splitOn "/" $ L.reverse cur + (c:rest) -> parsePath lits paths (c:cur) rest + traverse lits paths term = withTrace ("traverse pattern: " ++ pat) $ recurse [""] True lits paths + where + recurse values lp lits paths = if L.null values + then pure [] + else if lp + -- Try to apply a literal + then case lits of + -- All done. The last segment is always a literal. + [] -> return $ Terms.string <$> values + -- Append the literal and continue traversing. + (l:rest) -> recurse (append l) False rest paths + -- Try to apply a path + else case paths of + -- No more paths; continue with literals + [] -> recurse values True lits [] + -- Apply the next path + (path:rest) -> do + strings <- evalPath path term >>= CM.mapM toString + recurse (appendAll strings) True lits rest + where + append s = fmap (\v -> v ++ s) values + appendAll strings = L.concat (append <$> strings) + evalPath path term = case path of + [] -> pure [term] + (step:rest) -> do + results <- evalStep step term + L.concat <$> (CM.mapM (evalPath rest) results) + where + evalStep step term = if L.null step + then pure [term] + else case stripTerm term of + TermList terms -> L.concat <$> CM.mapM (evalStep step) terms + TermOptional mt -> case mt of + Nothing -> pure [] + Just term' -> evalStep step term' + TermRecord (Record _ fields) -> case M.lookup (Name step) (fieldMap fields) of + Nothing -> fail $ "No such field " ++ step ++ " in record: " ++ show term + Just term' -> pure [term'] + TermUnion (Injection _ field) -> if unName (fieldName field) == step + then evalStep step $ fieldTerm field + else pure [] -- Note: not checking the step against the union type; assuming it is correct but that it references a field unused by the injection + TermWrap (WrappedTerm _ term') -> evalStep step term' + _ -> fail $ "Can't traverse through term for step " ++ show step ++ ": " ++ show term + + -- TODO: replace this with a more standard function + toString term = case stripTerm term of + TermLiteral lit -> pure $ case lit of + LiteralBinary b -> b + LiteralBoolean b -> show b + LiteralInteger i -> case i of + IntegerValueBigint v -> show v + IntegerValueInt8 v -> show v + IntegerValueInt16 v -> show v + IntegerValueInt32 v -> show v + IntegerValueInt64 v -> show v + IntegerValueUint8 v -> show v + IntegerValueUint16 v -> show v + IntegerValueUint32 v -> show v + IntegerValueUint64 v -> show v + LiteralFloat f -> case f of + FloatValueBigfloat v -> show v + FloatValueFloat32 v -> show v + FloatValueFloat64 v -> show v + LiteralString s -> s + TermOptional mt -> case mt of + Nothing -> pure "nothing" + Just t -> toString t + _ -> pure $ show term + +parsePropertySpec :: Schema s t v -> PropertySpec -> Flow s (Term -> Flow s [(PG.PropertyKey, v)]) +parsePropertySpec schema (PropertySpec key value) = withTrace "parse property spec" $ do + fun <- parseValueSpec value + return $ \term -> withTrace ("encode property " ++ PG.unPropertyKey key) $ do + results <- fun term + values <- CM.mapM (coderEncode $ schemaPropertyValues schema) results + return $ fmap (\v -> (key, v)) values + +parseValueSpec :: ValueSpec -> Flow s (Term -> Flow s [Term]) +parseValueSpec spec = case spec of + ValueSpecValue -> pure $ \term -> pure [term] + ValueSpecPattern pat -> parsePattern pat + +parseVertexIdPattern :: Schema s t v -> ValueSpec -> Flow s (Term -> Flow s [v]) +parseVertexIdPattern schema spec = do + fun <- parseValueSpec spec + return $ \term -> fun term >>= CM.mapM (coderEncode $ schemaVertexIds schema) + +parseVertexSpec :: Schema s t v -> VertexSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v]) +parseVertexSpec schema (VertexSpec label id props) = do + getId <- parseVertexIdPattern schema id + getProps <- CM.mapM (parsePropertySpec schema) props + let encode term = withTrace "encode as vertex" $ do + tid <- requireUnique "vertex id" getId term + tprops <- M.fromList <$> CM.mapM (\g -> requireUnique "property key" g term) getProps + return [PG.ElementVertex $ PG.Vertex label tid tprops] + return (PG.LabelVertex label, encode) + +requireUnique :: String -> (Term -> Flow s [x]) -> Term -> Flow s x +requireUnique context fun term = do + results <- fun term + case results of + [] -> fail $ "No value found: " ++ context + [value] -> pure value + _ -> fail $ "Multiple values found: " ++ context + + +-- Element spec decoding. TODO: this should code should really be generated rather than hand-written. + +decodeEdgeLabel :: Term -> Flow s PG.EdgeLabel +decodeEdgeLabel t = PG.EdgeLabel <$> Expect.string t + +decodeEdgeSpec :: Term -> Flow s EdgeSpec +decodeEdgeSpec term = withTrace "decode edge spec" $ matchRecord (\fields -> EdgeSpec + <$> readField fields _EdgeSpec_label decodeEdgeLabel + <*> readField fields _EdgeSpec_id decodeValueSpec + <*> readField fields _EdgeSpec_out decodeValueSpec + <*> readField fields _EdgeSpec_in decodeValueSpec + <*> readField fields _EdgeSpec_properties (Expect.list decodePropertySpec)) term + +decodeElementSpec :: Term -> Flow s ElementSpec +decodeElementSpec term = withTrace "decode element spec" $ matchInjection [ + (_ElementSpec_vertex, \t -> ElementSpecVertex <$> decodeVertexSpec t), + (_ElementSpec_edge, \t -> ElementSpecEdge <$> decodeEdgeSpec t)] term + +decodePropertyKey :: Term -> Flow s PG.PropertyKey +decodePropertyKey t = PG.PropertyKey <$> Expect.string t + +decodePropertySpec :: Term -> Flow s PropertySpec +decodePropertySpec term = withTrace "decode property spec" $ matchRecord (\fields -> PropertySpec + <$> readField fields _PropertySpec_key decodePropertyKey + <*> readField fields _PropertySpec_value decodeValueSpec) term + +decodeValueSpec :: Term -> Flow s ValueSpec +decodeValueSpec term = withTrace "decode value spec" $ case stripTerm term of + -- Allow an abbreviated specification consisting of only the pattern string + TermLiteral (LiteralString s) -> pure $ ValueSpecPattern s + _ -> matchInjection [ + (_ValueSpec_value, \t -> pure ValueSpecValue), + (_ValueSpec_pattern, \t -> ValueSpecPattern <$> Expect.string t)] term + +decodeVertexLabel :: Term -> Flow s PG.VertexLabel +decodeVertexLabel t = PG.VertexLabel <$> Expect.string t + +decodeVertexSpec :: Term -> Flow s VertexSpec +decodeVertexSpec term = withTrace "decode vertex spec" $ matchRecord (\fields -> VertexSpec + <$> readField fields _VertexSpec_label decodeVertexLabel + <*> readField fields _VertexSpec_id decodeValueSpec + <*> readField fields _VertexSpec_properties (Expect.list decodePropertySpec)) term + + +-- General-purpose code for decoding + +matchInjection :: [(Name, Term -> Flow s x)] -> Term -> Flow s x +matchInjection cases encoded = do + mp <- Expect.map (\k -> Name <$> Expect.string k) pure encoded + f <- case M.toList mp of + [] -> fail "empty injection" + [(k, v)] -> pure $ Field k v + _ -> fail $ "invalid injection: " ++ show mp + case snd <$> (L.filter (\c -> fst c == fieldName f) cases) of + [] -> fail $ "unexpected field: " ++ unName (fieldName f) + [fun] -> fun (fieldTerm f) + _ -> fail "duplicate field name in cases" + +matchRecord :: (M.Map Name Term -> Flow s x) -> Term -> Flow s x +matchRecord cons term = Expect.map (\k -> Name <$> Expect.string k) pure term >>= cons + +readField fields fname fun = case M.lookup fname fields of + Nothing -> fail $ "no such field: " ++ unName fname + Just t -> fun t diff --git a/src/main/haskell/Hydra/Ext/Protobuf/Coder.hs b/src/main/haskell/Hydra/Ext/Protobuf/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Protobuf/Coder.hs @@ -0,0 +1,303 @@ +module Hydra.Ext.Protobuf.Coder (moduleToProtobuf) where + +import Hydra.Kernel +import Hydra.Ext.Protobuf.Language +import qualified Hydra.Ext.Protobuf.Proto3 as P3 +import qualified Hydra.Lib.Strings as Strings +import Hydra.Ext.Protobuf.Language +import Hydra.Ext.Protobuf.Serde +import Hydra.Tools.Serialization +import qualified Hydra.Dsl.Types as Types +import Hydra.Dsl.Annotations +import Hydra.Lib.Io + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Text.Read as TR +import qualified Data.Maybe as Y + + +key_proto_field_index = Name "proto_field_index" + +-- | Note: follows the Protobuf Style Guide (https://protobuf.dev/programming-guides/style) +moduleToProtobuf :: Module -> Flow Graph (M.Map FilePath String) +moduleToProtobuf mod = do + files <- transformModule protobufLanguage encodeTerm constructModule mod + return $ M.fromList (mapPair <$> M.toList files) + where + mapPair (path, sf) = (path, printExpr $ parenthesize $ writeProtoFile sf) + encodeTerm _ = fail "term-level encoding is not yet supported" + +-- + +javaMultipleFilesOptionName = "java_multiple_files" +javaPackageOptionName = "java_package" + +checkIsStringType :: Type -> Flow Graph () +checkIsStringType typ = case simplifyType typ of + TypeLiteral lt -> case lt of + LiteralTypeString -> pure () + _ -> unexpected "string type" $ show lt + TypeVariable name -> requireType name >>= checkIsStringType + _ -> unexpected "literal (string) type" $ show typ + +constructModule :: Module + -> M.Map Type (Coder Graph Graph Term ()) + -> [(Element, TypedTerm)] + -> Flow Graph (M.Map FilePath P3.ProtoFile) +constructModule mod@(Module ns els _ _ desc) _ pairs = do + schemaImports <- (fmap namespaceToFileReference . S.toList) <$> moduleDependencyNamespaces True False False False mod + types <- CM.mapM toType pairs + definitions <- CM.mapM toDef types + let pfile = P3.ProtoFile { + P3.protoFilePackage = namespaceToPackageName ns, + P3.protoFileImports = schemaImports ++ (wrapperImport $ snd <$> types) ++ (emptyImport $ snd <$> types), + P3.protoFileTypes = definitions, + P3.protoFileOptions = descOption:javaOptions} + return $ M.singleton path pfile + where + javaOptions = [ + P3.Option javaMultipleFilesOptionName $ P3.ValueBoolean True, + P3.Option javaPackageOptionName $ P3.ValueString $ P3.unPackageName $ namespaceToPackageName ns] + descOption = P3.Option descriptionOptionName $ P3.ValueString $ + (Y.maybe "" (\d -> d ++ "\n\n") desc) ++ warningAutoGeneratedFile + path = P3.unFileReference $ namespaceToFileReference ns + toType (el, (TypedTerm term typ)) = do + if isType typ + then do + t <- coreDecodeType term + return (el, t) + else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el) + toDef (el, typ) = do + typ <- coreDecodeType $ elementData el + adaptAndEncodeType protobufLanguage (encodeDefinition ns (elementName el)) $ flattenType typ + checkFields checkType checkFieldType types = L.foldl (||) False (hasMatches <$> types) + where + hasMatches = foldOverType TraversalOrderPre (\b t -> b || hasMatch t) False + hasMatch typ = case checkType typ of + Just b -> b + Nothing -> case typ of + TypeRecord rt -> checkRowType rt + TypeUnion rt -> checkRowType rt + _ -> False + checkRowType (RowType _ fields) = L.foldl (||) False (checkField <$> fields) + checkField (FieldType _ typ) = checkFieldType $ stripType typ + wrapperImport types = if checkFields (const Nothing) isOptionalScalarField types + then [P3.FileReference "google/protobuf/wrappers.proto"] + else [] + where + isOptionalScalarField typ = case typ of + TypeOptional ot -> case stripType ot of + TypeLiteral _ -> True + _ -> False + _ -> False + emptyImport types = if checkFields checkType isUnitField types + then [P3.FileReference "google/protobuf/empty.proto"] + else [] + where + checkType typ = if isEnumDefinition typ + then Just False + else Nothing + isUnitField typ = case typ of + TypeRecord (RowType name _) -> name == _Unit + _ -> False + +encodeDefinition :: Namespace -> Name -> Type -> Flow Graph P3.Definition +encodeDefinition localNs name typ = withTrace ("encoding " ++ unName name) $ do + resetCount key_proto_field_index + nextIndex + options <- findOptions typ + encode options typ + where + wrapAsRecordType t = TypeRecord $ RowType name [FieldType (Name "value") t] + encode options typ = case simplifyType typ of + TypeRecord rt -> P3.DefinitionMessage <$> encodeRecordType localNs options rt + TypeUnion rt -> if isEnumDefinition typ + then P3.DefinitionEnum <$> encodeEnumDefinition options rt + else encode options $ wrapAsRecordType $ TypeUnion rt + t -> encode options $ wrapAsRecordType t + +encodeEnumDefinition :: [P3.Option] -> RowType -> Flow Graph P3.EnumDefinition +encodeEnumDefinition options (RowType tname fields) = do + values <- CM.zipWithM encodeEnumField fields [1..] + return $ P3.EnumDefinition { + P3.enumDefinitionName = encodeTypeName tname, + P3.enumDefinitionValues = unspecifiedField:values, + P3.enumDefinitionOptions = options} + where + unspecifiedField = P3.EnumValue { + P3.enumValueName = encodeEnumValueName tname $ Name "unspecified", + P3.enumValueNumber = 0, + P3.enumValueOptions = []} + encodeEnumField (FieldType fname ftype) idx = do + opts <- findOptions ftype + return $ P3.EnumValue { + P3.enumValueName = encodeEnumValueName tname fname, + P3.enumValueNumber = idx, + P3.enumValueOptions = opts} + +encodeEnumValueName :: Name -> Name -> P3.EnumValueName +encodeEnumValueName tname fname = P3.EnumValueName (prefix ++ "_" ++ suffix) + where + prefix = nonAlnumToUnderscores $ convertCaseCamelToUpperSnake $ localNameOfEager tname + suffix = nonAlnumToUnderscores $ convertCaseCamelToUpperSnake $ unName fname + +encodeFieldName :: Bool -> Name -> P3.FieldName +encodeFieldName preserve = P3.FieldName . toPname . unName + where + toPname = if preserve + then id + else convertCaseCamelToLowerSnake + +encodeFieldType :: Namespace -> FieldType -> Flow Graph P3.Field +encodeFieldType localNs (FieldType fname ftype) = withTrace ("encode field " ++ show (unName fname)) $ do + options <- findOptions ftype + ft <- encodeType ftype + idx <- nextIndex + preserve <- readBooleanAnnotation key_preserveFieldName ftype + return $ P3.Field { + P3.fieldName = encodeFieldName preserve fname, + P3.fieldJsonName = Nothing, + P3.fieldType = ft, + P3.fieldNumber = idx, + P3.fieldOptions = options} + where + encodeType typ = case simplifyType typ of + TypeList lt -> do + P3.FieldTypeRepeated <$> encodeSimpleType lt + TypeMap (MapType kt vt) -> do +-- checkIsStringType kt + P3.FieldTypeMap <$> encodeSimpleType vt + TypeOptional ot -> case stripType ot of + TypeLiteral lt -> P3.FieldTypeSimple <$> encodeScalarTypeWrapped lt + _ -> encodeType ot -- TODO + TypeUnion (RowType _ fields) -> do + pfields <- CM.mapM (encodeFieldType localNs) fields + return $ P3.FieldTypeOneof pfields + _ -> do + P3.FieldTypeSimple <$> encodeSimpleType typ + encodeSimpleType typ = case simplifyType typ of + TypeLiteral lt -> P3.SimpleTypeScalar <$> encodeScalarType lt + TypeRecord (RowType name _) -> if name == _Unit + then pure $ P3.SimpleTypeReference $ P3.TypeName $ "google.protobuf.Empty" + else forNominal name + TypeUnion (RowType name _) -> forNominal name + TypeVariable name -> forNominal name + t -> unexpected "simple type" $ show $ removeTypeAnnotations t + where + forNominal name = pure $ P3.SimpleTypeReference $ encodeTypeReference localNs name + +encodeRecordType :: Namespace -> [P3.Option] -> RowType -> Flow Graph P3.MessageDefinition +encodeRecordType localNs options (RowType tname fields) = do + pfields <- CM.mapM (encodeFieldType localNs) fields + return P3.MessageDefinition { + P3.messageDefinitionName = encodeTypeName tname, + P3.messageDefinitionFields = pfields, + P3.messageDefinitionOptions = options} + +encodeScalarType :: LiteralType -> Flow s P3.ScalarType +encodeScalarType lt = case lt of + LiteralTypeBinary -> return P3.ScalarTypeBytes + LiteralTypeBoolean -> return P3.ScalarTypeBool + LiteralTypeFloat ft -> case ft of + FloatTypeFloat32 -> return P3.ScalarTypeFloat + FloatTypeFloat64 -> return P3.ScalarTypeDouble + _ -> unexpected "32-bit or 64-bit floating-point type" $ show ft + LiteralTypeInteger it -> case it of + IntegerTypeInt32 -> return P3.ScalarTypeInt32 + IntegerTypeInt64 -> return P3.ScalarTypeInt64 + IntegerTypeUint32 -> return P3.ScalarTypeUint32 + IntegerTypeUint64 -> return P3.ScalarTypeUint64 + _ -> unexpected "32-bit or 64-bit integer type" $ show it + LiteralTypeString -> return P3.ScalarTypeString + +encodeScalarTypeWrapped :: LiteralType -> Flow s P3.SimpleType +encodeScalarTypeWrapped lt = toType <$> case lt of + LiteralTypeBinary -> return "Bytes" + LiteralTypeBoolean -> return "Bool" + LiteralTypeFloat ft -> case ft of + FloatTypeFloat32 -> return "Float" + FloatTypeFloat64 -> return "Double" + _ -> unexpected "32-bit or 64-bit floating-point type" $ show ft + LiteralTypeInteger it -> case it of + IntegerTypeInt32 -> return "Int32" + IntegerTypeInt64 -> return "Int64" + IntegerTypeUint32 -> return "UInt32" + IntegerTypeUint64 -> return "UInt64" + _ -> unexpected "32-bit or 64-bit integer type" $ show it + LiteralTypeString -> return "String" + where + toType label = P3.SimpleTypeReference $ P3.TypeName $ "google.protobuf." ++ label ++ "Value" + +encodeTypeName :: Name -> P3.TypeName +encodeTypeName = P3.TypeName . localNameOfEager + +encodeTypeReference :: Namespace -> Name -> P3.TypeName +encodeTypeReference localNs name = P3.TypeName $ if nsParts == Just localNsParts + then local + else case nsParts of + Nothing -> local + Just parts -> L.intercalate "." (parts ++ [local]) + where + QualifiedName ns local = qualifyNameEager name + nsParts = fmap (\n -> L.init $ Strings.splitOn "/" $ unNamespace n) ns + localNsParts = L.init $ Strings.splitOn "/" $ unNamespace localNs + +-- Eliminate type lambdas and type applications, simply replacing type variables with the string type +flattenType :: Type -> Type +flattenType = rewriteType f + where + f recurse typ = case typ of + TypeLambda (LambdaType v body) -> recurse $ replaceFreeName v Types.string body + TypeApplication (ApplicationType lhs _) -> recurse lhs + _ -> recurse typ + +findOptions :: Type -> Flow Graph [P3.Option] +findOptions typ = do + mdesc <- getTypeDescription typ + bdep <- readBooleanAnnotation key_deprecated typ + let mdescAnn = fmap (\desc -> P3.Option descriptionOptionName $ P3.ValueString desc) mdesc + let mdepAnn = if bdep then Just (P3.Option deprecatedOptionName $ P3.ValueBoolean True) else Nothing + return $ Y.catMaybes [mdescAnn, mdepAnn] + +isEnumFields :: [FieldType] -> Bool +isEnumFields fields = L.foldl (&&) True $ fmap isEnumField fields + where + isEnumField = isUnitType . simplifyType . fieldTypeType + +isEnumDefinition :: Type -> Bool +isEnumDefinition typ = case simplifyType typ of + TypeUnion (RowType _ fields) -> isEnumFields fields + _ -> False + +isEnumDefinitionReference :: Name -> Flow Graph Bool +isEnumDefinitionReference name = isEnumDefinition <$> ((elementData <$> requireElement name) >>= coreDecodeType) + +namespaceToFileReference :: Namespace -> P3.FileReference +namespaceToFileReference (Namespace ns) = P3.FileReference $ pns ++ ".proto" + where + pns = Strings.intercalate "/" (convertCaseCamelToLowerSnake <$> (Strings.splitOn "/" ns)) + +namespaceToPackageName :: Namespace -> P3.PackageName +namespaceToPackageName (Namespace ns) = P3.PackageName $ Strings.intercalate "." $ + convertCaseCamelToLowerSnake <$> (L.init $ Strings.splitOn "/" ns) + +nextIndex :: Flow s Int +nextIndex = nextCount key_proto_field_index + +readBooleanAnnotation :: Name -> Type -> Flow Graph Bool +readBooleanAnnotation key typ = do + let ann = typeAnnotationInternal typ + case TR.readMaybe $ show ann of + Just kv -> case getAnnotation key kv of + Just _ -> return True + Nothing -> return False + Nothing -> return False + +-- Note: this should probably be done in the term adapters +simplifyType :: Type -> Type +simplifyType typ = case stripType typ of + TypeWrap (WrappedType _ t) -> simplifyType t + t -> t diff --git a/src/main/haskell/Hydra/Ext/Protobuf/Serde.hs b/src/main/haskell/Hydra/Ext/Protobuf/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Protobuf/Serde.hs @@ -0,0 +1,147 @@ +module Hydra.Ext.Protobuf.Serde ( + deprecatedOptionName, + descriptionOptionName, + writeProtoFile) where + +import Hydra.Tools.Serialization +import Hydra.Tools.Formatting +import qualified Hydra.Ast as CT +import qualified Hydra.Ext.Protobuf.Proto3 as P3 + +import qualified Data.List as L +import qualified Data.Maybe as Y + + +deprecatedOptionName = "deprecated" +-- A special Protobuf option for descriptions (documentation) +descriptionOptionName = "_description" + +excludeInternalOptions :: [P3.Option] -> [P3.Option] +excludeInternalOptions = L.filter (\opt -> L.head (P3.optionName opt) /= '_' ) + +protoBlock :: [CT.Expr] -> CT.Expr +protoBlock = brackets curlyBraces fullBlockStyle . doubleNewlineSep + +semi :: CT.Expr -> CT.Expr +semi e = noSep [e, cst ";"] + +optDesc :: Bool -> [P3.Option] -> CT.Expr -> CT.Expr +optDesc doubleNewline opts expr = if L.null descs + then expr + else sep [cst $ asComment (unValue $ P3.optionValue $ L.head descs), expr] + where + sep = if doubleNewline then doubleNewlineSep else newlineSep + descs = L.filter (\(P3.Option name value) -> name == descriptionOptionName) opts + asComment = L.intercalate "\n" . fmap (\s -> "// " ++ s) . lines + unValue v = case v of + P3.ValueBoolean b -> if b then "true" else "false" + P3.ValueString s -> s + +writeDefinition :: P3.Definition -> CT.Expr +writeDefinition def = case def of + P3.DefinitionEnum enum -> writeEnumDefinition enum + P3.DefinitionMessage msg -> writeMessageDefinition msg + +writeEnumDefinition :: P3.EnumDefinition -> CT.Expr +writeEnumDefinition (P3.EnumDefinition name values options) = optDesc False options $ spaceSep [ + cst "enum", + cst $ P3.unTypeName name, + protoBlock (writeEnumValue <$> values)] + +writeEnumValue :: P3.EnumValue -> CT.Expr +writeEnumValue (P3.EnumValue name number options) = optDesc False options $ semi $ spaceSep [ + cst $ P3.unEnumValueName name, + cst "=", + cst $ show number] + +writeField :: P3.Field -> CT.Expr +writeField (P3.Field name jsonName typ num options) = optDesc False options $ case typ of + P3.FieldTypeOneof fields -> spaceSep [ + cst "oneof", + cst $ P3.unFieldName name, + protoBlock (writeField <$> fields)] + _ -> semi $ spaceSep $ Y.catMaybes [ -- TODO: jsonName + Just $ writeFieldType typ, + Just $ cst $ P3.unFieldName name, + Just $ cst "=", + Just $ cst $ show num, + writeFieldOptions options] + +writeFieldOption :: P3.Option -> CT.Expr +writeFieldOption (P3.Option name value) = spaceSep [cst name, cst "=", writeValue value] + +writeFieldOptions :: [P3.Option] -> Y.Maybe CT.Expr +writeFieldOptions options0 = if L.null options + then Nothing + else Just $ bracketList inlineStyle (writeFieldOption <$> options) + where + options = excludeInternalOptions options0 + +writeFieldType :: P3.FieldType -> CT.Expr +writeFieldType ftyp = case ftyp of + P3.FieldTypeMap st -> noSep [cst "map", angleBracesList inlineStyle [cst "string", writeSimpleType st]] + P3.FieldTypeRepeated st -> spaceSep [cst "repeated", writeSimpleType st] + P3.FieldTypeSimple st -> writeSimpleType st + +writeFileOption :: P3.Option -> CT.Expr +writeFileOption (P3.Option name value) = semi $ spaceSep [cst "option", cst name, cst "=", writeValue value] + +writeFileOptions :: [P3.Option] -> Y.Maybe CT.Expr +writeFileOptions options0 = if L.null options + then Nothing + else Just $ newlineSep $ writeFileOption <$> options + where + options = excludeInternalOptions options0 + +writeImport :: P3.FileReference -> CT.Expr +writeImport (P3.FileReference path) = semi $ spaceSep [cst "import", cst $ show path] + +writeMessageDefinition :: P3.MessageDefinition -> CT.Expr +writeMessageDefinition (P3.MessageDefinition name fields options) = optDesc False options $ spaceSep [ + cst "message", + cst $ P3.unTypeName name, + protoBlock (writeField <$> fields)] + +writeProtoFile :: P3.ProtoFile -> CT.Expr +writeProtoFile (P3.ProtoFile pkg imports defs options) = optDesc True options $ doubleNewlineSep + $ Y.catMaybes [headerSec, importsSec, optionsSec, defsSec] + where + headerSec = Just $ newlineSep [ + semi $ cst "syntax = \"proto3\"", + semi $ spaceSep [cst "package", cst (P3.unPackageName pkg)]] + importsSec = if L.null imports + then Nothing + else Just $ newlineSep $ writeImport <$> imports + optionsSec = writeFileOptions options1 + defsSec = if L.null defs + then Nothing + else Just $ doubleNewlineSep $ writeDefinition <$> defs + options1 = L.filter (\(P3.Option name value) -> name /= descriptionOptionName) options + +writeScalarType :: P3.ScalarType -> CT.Expr +writeScalarType sct = cst $ case sct of + P3.ScalarTypeBool -> "bool" + P3.ScalarTypeBytes -> "bytes" + P3.ScalarTypeDouble -> "double" + P3.ScalarTypeFixed32 -> "fixed32" + P3.ScalarTypeFixed64 -> "fixed64" + P3.ScalarTypeFloat -> "float" + P3.ScalarTypeInt32 -> "int32" + P3.ScalarTypeInt64 -> "int64" + P3.ScalarTypeSfixed32 -> "sfixed32" + P3.ScalarTypeSfixed64 -> "sfixed64" + P3.ScalarTypeSint32 -> "sint32" + P3.ScalarTypeSint64 -> "sint64" + P3.ScalarTypeString -> "string" + P3.ScalarTypeUint32 -> "uint32" + P3.ScalarTypeUint64 -> "uint64" + +writeSimpleType :: P3.SimpleType -> CT.Expr +writeSimpleType st = case st of + P3.SimpleTypeReference name -> cst $ P3.unTypeName name + P3.SimpleTypeScalar sct -> writeScalarType sct + +writeValue :: P3.Value -> CT.Expr +writeValue v = cst $ case v of + P3.ValueBoolean b -> if b then "true" else "false" + P3.ValueString s -> show s diff --git a/src/main/haskell/Hydra/Ext/Rdf/Serde.hs b/src/main/haskell/Hydra/Ext/Rdf/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Rdf/Serde.hs @@ -0,0 +1,81 @@ +-- | Serialize RDF using an approximation (because it does not yet support Unicode escape sequences) of the N-triples format + +module Hydra.Ext.Rdf.Serde ( + rdfGraphToNtriples, +) where + +import Hydra.Tools.Serialization +import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Rdf +import qualified Hydra.Ast as CT + +import qualified Data.List as L +import qualified Data.Set as S + + +-- IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>' +-- TODO: Unicode escape sequences +escapeIriStr :: String -> String +escapeIriStr s = L.concat (esc <$> s) + where + esc c = if c >= '\128' || c <= '\32' || S.member c others + then "?" + else [c] + others = S.fromList $ "<>\"{}|^`\\" + +-- STRING_LITERAL_QUOTE ::= '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"' +-- TODO: Unicode escape sequences +escapeLiteralString :: String -> String +escapeLiteralString s = L.concat (esc <$> s) + where + esc c = if c >= '\128' + then "?" + else case c of + '\"' -> "\\\"" + '\\' -> "\\\\" + '\n' -> "\\n" + '\r' -> "\\r" + _ -> [c] + +rdfGraphToNtriples :: Rdf.Graph -> String +rdfGraphToNtriples = printExpr . writeGraph + +writeBlankNode :: Rdf.BlankNode -> CT.Expr +writeBlankNode bnode = noSep [cst "_:", cst $ Rdf.unBlankNode bnode] + +writeGraph :: Rdf.Graph -> CT.Expr +writeGraph g = newlineSep (writeTriple <$> (S.toList $ Rdf.unGraph g)) + +writeIri :: Rdf.Iri -> CT.Expr +writeIri iri = noSep [cst "<", cst $ escapeIriStr $ Rdf.unIri iri, cst ">"] + +-- LANGTAG ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)* +-- Note: we simply trust language tags to be valid +writeLanguageTag :: Rdf.LanguageTag -> CT.Expr +writeLanguageTag lang = noSep [cst "@", cst $ Rdf.unLanguageTag lang] + +writeLiteral :: Rdf.Literal -> CT.Expr +writeLiteral lit = noSep [cst lex, suffix] + where + suffix = case Rdf.literalLanguageTag lit of + Nothing -> noSep [cst "^^", writeIri dt] + Just lang -> writeLanguageTag lang + lex = "\"" ++ (escapeLiteralString $ Rdf.literalLexicalForm lit) ++ "\"" + dt = Rdf.literalDatatypeIri lit + +writeNode :: Rdf.Node -> CT.Expr +writeNode n = case n of + Rdf.NodeIri iri -> writeIri iri + Rdf.NodeBnode bnode -> writeBlankNode bnode + Rdf.NodeLiteral lit -> writeLiteral lit + +writeResource :: Rdf.Resource -> CT.Expr +writeResource r = case r of + Rdf.ResourceIri iri -> writeIri iri + Rdf.ResourceBnode bnode -> writeBlankNode bnode + +writeTriple :: Rdf.Triple -> CT.Expr +writeTriple t = spaceSep [ + writeResource $ Rdf.tripleSubject t, + writeIri $ Rdf.triplePredicate t, + writeNode $ Rdf.tripleObject t, + cst "."] diff --git a/src/main/haskell/Hydra/Ext/Rdf/Utils.hs b/src/main/haskell/Hydra/Ext/Rdf/Utils.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Rdf/Utils.hs @@ -0,0 +1,89 @@ +module Hydra.Ext.Rdf.Utils where + +import Hydra.Kernel +import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Rdf + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S + + +key_rdfBlankNodeCounter = Name "rdfBlankNodeCounter" + +descriptionsToGraph :: [Rdf.Description] -> Rdf.Graph +descriptionsToGraph ds = Rdf.Graph $ S.fromList $ triplesOf ds + +emptyDescription :: Rdf.Node -> Rdf.Description +emptyDescription node = Rdf.Description node emptyGraph + +emptyGraph :: Rdf.Graph +emptyGraph = Rdf.Graph S.empty + +emptyLangStrings :: Rdf.LangStrings +emptyLangStrings = Rdf.LangStrings M.empty + +encodeLiteral :: Literal -> Flow (Graph) Rdf.Literal +encodeLiteral lit = case lit of + LiteralBinary s -> fail "base 64 encoding not yet implemented" + LiteralBoolean b -> pure $ xsd (\b -> if b then "true" else "false") b "boolean" + LiteralFloat f -> pure $ case f of + FloatValueBigfloat v -> xsd show v "decimal" + FloatValueFloat32 v -> xsd show v "float" + FloatValueFloat64 v -> xsd show v "double" + LiteralInteger i -> pure $ case i of + IntegerValueBigint v -> xsd show v "integer" + IntegerValueInt8 v -> xsd show v "byte" + IntegerValueInt16 v -> xsd show v "short" + IntegerValueInt32 v -> xsd show v "int" + IntegerValueInt64 v -> xsd show v "long" + IntegerValueUint8 v -> xsd show v "unsignedByte" + IntegerValueUint16 v -> xsd show v "unsignedShort" + IntegerValueUint32 v -> xsd show v "unsignedInt" + IntegerValueUint64 v -> xsd show v "unsignedLong" + LiteralString s -> pure $ xsd id s "string" + where + -- TODO: using Haskell's built-in show function is a cheat, and may not be correct/optimal in all cases + xsd ser x local = Rdf.Literal (ser x) (xmlSchemaDatatypeIri local) Nothing + +forObjects :: Rdf.Resource -> Rdf.Iri -> [Rdf.Node] -> [Rdf.Triple] +forObjects subj pred objs = (Rdf.Triple subj pred) <$> objs + +iri :: String -> String -> Rdf.Iri +iri ns local = Rdf.Iri $ ns ++ local + +keyIri :: String -> Rdf.Iri +keyIri = iri "urn:key:" -- Note: not an official URN scheme + +mergeGraphs :: [Rdf.Graph] -> Rdf.Graph +mergeGraphs graphs = Rdf.Graph $ L.foldl S.union S.empty (Rdf.unGraph <$> graphs) + +nameToIri :: Name -> Rdf.Iri +nameToIri name = Rdf.Iri $ "urn:" ++ unName name + +nextBlankNode :: Flow (Graph) Rdf.Resource +nextBlankNode = do + count <- nextCount key_rdfBlankNodeCounter + return $ Rdf.ResourceBnode $ Rdf.BlankNode $ "b" ++ show count + +-- Note: these are not "proper" URNs, as they do not use an established URN scheme +propertyIri :: Name -> Name -> Rdf.Iri +propertyIri rname fname = Rdf.Iri $ "urn:" ++ unNamespace gname ++ "#" ++ decapitalize local ++ capitalize (unName fname) + where + QualifiedName (Just gname) local = qualifyNameLazy rname + +rdfIri :: String -> Rdf.Iri +rdfIri = iri "http://www.w3.org/1999/02/22-rdf-syntax-ns#" + +resourceToNode :: Rdf.Resource -> Rdf.Node +resourceToNode r = case r of + Rdf.ResourceIri i -> Rdf.NodeIri i + Rdf.ResourceBnode b -> Rdf.NodeBnode b + +subjectsOf :: [Rdf.Description] -> [Rdf.Node] +subjectsOf descs = Rdf.descriptionSubject <$> descs + +triplesOf :: [Rdf.Description] -> [Rdf.Triple] +triplesOf descs = L.concat ((S.toList . Rdf.unGraph . Rdf.descriptionGraph) <$> descs) + +xmlSchemaDatatypeIri :: String -> Rdf.Iri +xmlSchemaDatatypeIri = iri "http://www.w3.org/2001/XMLSchema#" diff --git a/src/main/haskell/Hydra/Ext/Scala/Coder.hs b/src/main/haskell/Hydra/Ext/Scala/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Scala/Coder.hs @@ -0,0 +1,227 @@ +module Hydra.Ext.Scala.Coder (moduleToScala) where + +import Hydra.Kernel +import Hydra.Dsl.Terms +import Hydra.Ext.Scala.Language +import Hydra.Ext.Scala.Utils +import Hydra.Adapters +import Hydra.Tools.Serialization +import Hydra.Ext.Scala.Serde +import qualified Hydra.Dsl.Types as Types +import qualified Hydra.Ext.Scala.Meta as Scala +import qualified Hydra.Lib.Strings as Strings + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +moduleToScala :: Module -> Flow Graph (M.Map FilePath String) +moduleToScala mod = do + pkg <- moduleToScalaPackage mod + let s = printExpr $ parenthesize $ writePkg pkg + return $ M.fromList [(namespaceToFilePath False (FileExtension "scala") $ moduleNamespace mod, s)] + +moduleToScalaPackage :: Module -> Flow Graph Scala.Pkg +moduleToScalaPackage = transformModule scalaLanguage encodeUntypedTerm constructModule + +constructModule :: Module -> M.Map Type (Coder Graph Graph Term Scala.Data) -> [(Element, TypedTerm)] + -> Flow Graph Scala.Pkg +constructModule mod coders pairs = do + defs <- CM.mapM toDef pairs + let pname = toScalaName $ h $ moduleNamespace mod + let pref = Scala.Data_RefName pname + imports <- findImports + return $ Scala.Pkg pname pref (imports ++ defs) + where + h (Namespace n) = n + findImports = do + elImps <- moduleDependencyNamespaces False False True False mod + primImps <- moduleDependencyNamespaces False True False False mod + return $ (toElImport <$> S.toList elImps) ++ (toPrimImport <$> S.toList primImps) + where + toElImport (Namespace ns) = Scala.StatImportExport $ Scala.ImportExportStatImport $ Scala.Import [ + Scala.Importer (Scala.Data_RefName $ toScalaName ns) [Scala.ImporteeWildcard]] + toPrimImport (Namespace ns) = Scala.StatImportExport $ Scala.ImportExportStatImport $ Scala.Import [ + Scala.Importer (Scala.Data_RefName $ toScalaName ns) []] + toScalaName name = Scala.Data_Name $ Scala.PredefString $ L.intercalate "." $ Strings.splitOn "/" name + toDef (el, TypedTerm term typ) = withTrace ("element " ++ unName (elementName el)) $ do + let coder = Y.fromJust $ M.lookup typ coders + rhs <- coderEncode coder term + Scala.StatDefn <$> case rhs of + Scala.DataApply _ -> toVal rhs + Scala.DataFunctionData fun -> case stripType typ of + TypeFunction (FunctionType _ cod) -> toDefn fun cod + _ -> fail $ "expected function type, but found " ++ show typ + Scala.DataLit _ -> toVal rhs + Scala.DataRef _ -> toVal rhs -- TODO + _ -> fail $ "unexpected RHS: " ++ show rhs + where + lname = localNameOfEager $ elementName el + + freeTypeVars = S.toList $ freeVariablesInType typ + + toDefn (Scala.Data_FunctionDataFunction (Scala.Data_Function params body)) cod = do + let tparams = stparam <$> freeTypeVars + scod <- encodeType cod + return $ Scala.DefnDef $ Scala.Defn_Def [] + (Scala.Data_Name $ Scala.PredefString lname) tparams [params] (Just scod) body + + toVal rhs = pure $ Scala.DefnVal $ Scala.Defn_Val [] [namePat] Nothing rhs + where + namePat = Scala.PatVar $ Scala.Pat_Var $ Scala.Data_Name $ Scala.PredefString lname + +encodeFunction :: M.Map Name Term -> Function -> Y.Maybe Term -> Flow Graph Scala.Data +encodeFunction meta fun arg = case fun of + FunctionLambda (Lambda (Name v) _ body) -> slambda v <$> encodeTerm body <*> findSdom + FunctionPrimitive name -> pure $ sprim name + FunctionElimination e -> case e of + EliminationWrap name -> pure $ sname $ "ELIM-NOMINAL(" ++ show name ++ ")" -- TODO + EliminationOptional c -> pure $ sname "ELIM-OPTIONAL" -- TODO + EliminationRecord p -> fail "unapplied projection not yet supported" + EliminationUnion (CaseStatement _ def cases) -> do + let v = "v" + dom <- findDomain + ftypes <- withSchemaContext $ fieldTypes dom + cx <- getState + let sn = nameOfType cx dom + scases <- CM.mapM (encodeCase ftypes sn) cases + -- TODO: default + case arg of + Nothing -> slambda v <$> pure (Scala.DataMatch $ Scala.Data_Match (sname v) scases) <*> findSdom + Just a -> do + sa <- encodeTerm a + return $ Scala.DataMatch $ Scala.Data_Match sa scases + where + encodeCase ftypes sn f@(Field fname fterm) = do + -- dom <- findDomain (termMeta fterm) -- Option #1: use type inference + let dom = Y.fromJust $ M.lookup fname ftypes -- Option #2: look up the union type + let patArgs = if dom == Types.unit then [] else [svar v] + -- Note: PatExtract has the right syntax, though this may or may not be the Scalameta-intended way to use it + let pat = Scala.PatExtract $ Scala.Pat_Extract (sname $ qualifyUnionFieldName "MATCHED." sn fname) patArgs + body <- encodeTerm $ applyVar fterm v + return $ Scala.Case pat Nothing body + where + v = Name "y" + applyVar fterm avar@(Name v) = case stripTerm fterm of + TermFunction (FunctionLambda (Lambda v1 _ body)) -> if isFreeIn v1 body + then body + else substituteVariable v1 avar body + _ -> apply fterm (var v) + where + findSdom = Just <$> (findDomain >>= encodeType) + findDomain = do + cx <- getState + r <- getType meta + case r of + Nothing -> fail "expected a typed term" + Just t -> domainOf t + where + domainOf t = case stripType t of + TypeFunction (FunctionType dom _) -> pure dom + _ -> fail $ "expected a function type, but found " ++ show t + +encodeLiteral :: Literal -> Flow Graph Scala.Lit +encodeLiteral av = case av of + LiteralBoolean b -> pure $ Scala.LitBoolean b + LiteralFloat fv -> case fv of + FloatValueFloat32 f -> pure $ Scala.LitFloat f + FloatValueFloat64 f -> pure $ Scala.LitDouble f + _ -> unexpected "floating-point number" $ show fv + LiteralInteger iv -> case iv of + IntegerValueInt16 i -> pure $ Scala.LitShort $ fromIntegral i + IntegerValueInt32 i -> pure $ Scala.LitInt i + IntegerValueInt64 i -> pure $ Scala.LitLong $ fromIntegral i + IntegerValueUint8 i -> pure $ Scala.LitByte $ fromIntegral i + _ -> unexpected "integer" $ show iv + LiteralString s -> pure $ Scala.LitString s + _ -> unexpected "literal value" $ show av + +encodeTerm :: Term -> Flow Graph Scala.Data +encodeTerm term = case stripTerm term of + TermApplication (Application fun arg) -> case stripTerm fun of + TermFunction f -> case f of + FunctionElimination e -> case e of + EliminationWrap name -> fallback + EliminationOptional c -> fallback + EliminationRecord (Projection _ (Name fname)) -> do + sarg <- encodeTerm arg + return $ Scala.DataRef $ Scala.Data_RefSelect $ Scala.Data_Select sarg + (Scala.Data_Name $ Scala.PredefString fname) + EliminationUnion _ -> do + cx <- getState + encodeFunction (termAnnotationInternal fun) f (Just arg) + _ -> fallback + _ -> fallback + where + fallback = sapply <$> encodeTerm fun <*> ((: []) <$> encodeTerm arg) + TermFunction f -> do + cx <- getState + encodeFunction (termAnnotationInternal term) f Nothing + TermList els -> sapply (sname "Seq") <$> CM.mapM encodeTerm els + TermLiteral v -> Scala.DataLit <$> encodeLiteral v + TermMap m -> sapply (sname "Map") <$> CM.mapM toPair (M.toList m) + where + toPair (k, v) = sassign <$> encodeTerm k <*> encodeTerm v + TermWrap (WrappedTerm _ term') -> encodeTerm term' + TermOptional m -> case m of + Nothing -> pure $ sname "None" + Just t -> (\s -> sapply (sname "Some") [s]) <$> encodeTerm t + TermRecord (Record name fields) -> do + let n = scalaTypeName False name + args <- CM.mapM encodeTerm (fieldTerm <$> fields) + return $ sapply (sname n) args + TermSet s -> sapply (sname "Set") <$> CM.mapM encodeTerm (S.toList s) + TermUnion (Injection sn (Field fn ft)) -> do + let lhs = sname $ qualifyUnionFieldName "UNION." (Just sn) fn + args <- case stripTerm ft of + TermRecord (Record _ []) -> pure [] + _ -> do + arg <- encodeTerm ft + return [arg] + return $ sapply lhs args + TermVariable (Name v) -> pure $ sname v + _ -> fail $ "unexpected term: " ++ show term + + +encodeType :: Type -> Flow Graph Scala.Type +encodeType t = case stripType t of + TypeFunction (FunctionType dom cod) -> do + sdom <- encodeType dom + scod <- encodeType cod + return $ Scala.TypeFunctionType $ Scala.Type_FunctionTypeFunction $ Scala.Type_Function [sdom] scod + TypeList lt -> stapply1 <$> pure (stref "Seq") <*> encodeType lt + TypeLiteral lt -> case lt of +-- TypeBinary -> + LiteralTypeBoolean -> pure $ stref "Boolean" + LiteralTypeFloat ft -> case ft of +-- FloatTypeBigfloat -> + FloatTypeFloat32 -> pure $ stref "Float" + FloatTypeFloat64 -> pure $ stref "Double" + LiteralTypeInteger it -> case it of +-- IntegerTypeBigint -> +-- IntegerTypeInt8 -> + IntegerTypeInt16 -> pure $ stref "Short" + IntegerTypeInt32 -> pure $ stref "Int" + IntegerTypeInt64 -> pure $ stref "Long" + IntegerTypeUint8 -> pure $ stref "Byte" +-- IntegerTypeUint16 -> +-- IntegerTypeUint32 -> +-- IntegerTypeUint64 -> + LiteralTypeString -> pure $ stref "String" + TypeMap (MapType kt vt) -> stapply2 <$> pure (stref "Map") <*> encodeType kt <*> encodeType vt + TypeOptional ot -> stapply1 <$> pure (stref "Option") <*> encodeType ot +-- TypeRecord sfields -> + TypeSet st -> stapply1 <$> pure (stref "Set") <*> encodeType st +-- TypeUnion sfields -> + TypeLambda (LambdaType v body) -> do + sbody <- encodeType body + return $ Scala.TypeLambda $ Scala.Type_Lambda [stparam v] sbody +-- TypeVariable name -> pure $ stref $ scalaTypeName True name + TypeVariable (Name v) -> pure $ Scala.TypeVar $ Scala.Type_Var $ Scala.Type_Name v + _ -> fail $ "can't encode unsupported type in Scala: " ++ show t + +encodeUntypedTerm :: Term -> Flow Graph Scala.Data +encodeUntypedTerm term = inferTermType term >>= encodeTerm diff --git a/src/main/haskell/Hydra/Ext/Scala/Language.hs b/src/main/haskell/Hydra/Ext/Scala/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Scala/Language.hs @@ -0,0 +1,71 @@ +module Hydra.Ext.Scala.Language where + +import Hydra.Kernel + +import qualified Data.Set as S + + +scalaLanguage :: Language +scalaLanguage = Language (LanguageName "hydra/ext/scala") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.fromList eliminationVariants, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBoolean, + LiteralVariantFloat, + LiteralVariantInteger, + LiteralVariantString], + languageConstraintsFloatTypes = S.fromList [ + -- Bigfloat is excluded for now + FloatTypeFloat32, + FloatTypeFloat64], + languageConstraintsFunctionVariants = S.fromList functionVariants, + languageConstraintsIntegerTypes = S.fromList [ + IntegerTypeBigint, + IntegerTypeInt16, + IntegerTypeInt32, + IntegerTypeInt64, + IntegerTypeUint8], + languageConstraintsTermVariants = S.fromList [ + TermVariantApplication, + TermVariantFunction, + TermVariantList, + TermVariantLiteral, + TermVariantMap, + TermVariantOptional, + TermVariantRecord, + TermVariantSet, + TermVariantUnion, + TermVariantVariable, + TermVariantWrap], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantAnnotated, + TypeVariantFunction, + TypeVariantList, + TypeVariantLiteral, + TypeVariantMap, + TypeVariantOptional, + TypeVariantRecord, + TypeVariantSet, + TypeVariantUnion, + TypeVariantLambda, + TypeVariantVariable, + TypeVariantWrap], + languageConstraintsTypes = const True } + +reservedWords :: S.Set [Char] +reservedWords = S.fromList $ keywords ++ classNames + where + -- Classes in the Scala Standard Library 2.13.8 + -- Note: numbered class names like Function1, Product16, and the names of exception/error classes are omitted, + -- as they are unlikely to occur by chance. + classNames = [ + "Any", "AnyVal", "App", "Array", "Boolean", "Byte", "Char", "Console", "DelayedInit", "Double", "DummyExplicit", + "Dynamic", "Enumeration", "Equals", "Float", "Function", "Int", "Long", "MatchError", "None", + "Nothing", "Null", "Option", "PartialFunction", "Predef", "Product", "Proxy", + "SerialVersionUID", "Short", "Singleton", "Some", "Specializable", "StringContext", + "Symbol", "Unit", "ValueOf"] + -- Not an official or comprehensive list; taken from https://www.geeksforgeeks.org/scala-keywords + keywords = [ + "abstract", "case", "catch", "class", "def", "do", "else", "extends", "false", "final", "finally", "for", + "forSome", "if", "implicit", "import", "lazy", "match", "new", "null", "object", "override", "package", "private", + "protected", "return", "sealed", "super", "this", "throw", "trait", "true", "try", "type", "val", "var", "while", + "with", "yield"] diff --git a/src/main/haskell/Hydra/Ext/Scala/Prepare.hs b/src/main/haskell/Hydra/Ext/Scala/Prepare.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Scala/Prepare.hs @@ -0,0 +1,64 @@ +module Hydra.Ext.Scala.Prepare ( + prepareType, +) where + +import Hydra.Kernel +import qualified Hydra.Dsl.Types as Types + +import qualified Data.Set as S + + +prepareLiteralType :: LiteralType -> (LiteralType, Literal -> Literal, S.Set String) +prepareLiteralType at = case at of + LiteralTypeBinary -> subst LiteralTypeString + "binary strings" "character strings" + $ \(LiteralBinary v) -> LiteralString v + LiteralTypeFloat ft -> (LiteralTypeFloat rtyp, \(LiteralFloat v) -> LiteralFloat $ rep v, msgs) + where + (rtyp, rep, msgs) = prepareFloatType ft + LiteralTypeInteger it -> (LiteralTypeInteger rtyp, \(LiteralInteger v) -> LiteralInteger $ rep v, msgs) + where + (rtyp, rep, msgs) = prepareIntegerType it + _ -> same at + +prepareFloatType :: FloatType -> (FloatType, FloatValue -> FloatValue, S.Set String) +prepareFloatType ft = case ft of + FloatTypeBigfloat -> subst FloatTypeFloat64 + "arbitrary-precision floating-point numbers" "64-bit floating-point numbers (doubles)" + $ \(FloatValueBigfloat v) -> FloatValueFloat64 v + _ -> same ft + +prepareIntegerType :: IntegerType -> (IntegerType, IntegerValue -> IntegerValue, S.Set String) +prepareIntegerType it = case it of + IntegerTypeBigint -> subst IntegerTypeInt64 + "arbitrary-precision integers" "64-bit integers" + $ \(IntegerValueBigint v) -> IntegerValueInt64 $ fromIntegral v + IntegerTypeUint8 -> subst IntegerTypeInt8 + "unsigned 8-bit integers" "signed 8-bit integers" + $ \(IntegerValueUint8 v) -> IntegerValueInt8 $ fromIntegral v + IntegerTypeUint32 -> subst IntegerTypeInt32 + "unsigned 32-bit integers" "signed 32-bit integers" + $ \(IntegerValueUint32 v) -> IntegerValueInt32 $ fromIntegral v + IntegerTypeUint64 -> subst IntegerTypeInt64 + "unsigned 64-bit integers" "signed 64-bit integers" + $ \(IntegerValueUint64 v) -> IntegerValueInt64 $ fromIntegral v + _ -> same it + +prepareType :: Graph -> Type -> (Type, Term -> Term, S.Set String) +prepareType cx typ = case stripType typ of + TypeLiteral at -> (Types.literal rtyp, \(TermLiteral av) -> TermLiteral $ rep av, msgs) + where + (rtyp, rep, msgs) = prepareLiteralType at +-- TypeFunction (FunctionType dom cod) -> +-- TypeList lt -> +-- TypeMap (MapType kt vt) -> +-- TypeWrap name -> +-- TypeRecord fields -> +-- TypeSet st -> +-- TypeUnion fields -> + +same :: a -> (a, b -> b, S.Set c) +same x = (x, id, S.empty) + +subst :: a -> [Char] -> [Char] -> b -> (a, b, S.Set [Char]) +subst t from to r = (t, r, S.fromList ["replace " ++ from ++ " with " ++ to]) diff --git a/src/main/haskell/Hydra/Ext/Scala/Serde.hs b/src/main/haskell/Hydra/Ext/Scala/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Scala/Serde.hs @@ -0,0 +1,139 @@ +module Hydra.Ext.Scala.Serde where + +import Hydra.Ast +import Hydra.Tools.Serialization +import qualified Hydra.Lib.Literals as Literals +import qualified Hydra.Ext.Scala.Meta as Scala + +import qualified Data.List as L +import qualified Data.Maybe as Y + + +dotOp :: Op +dotOp = Op (Symbol ".") (Padding WsNone WsNone) (Precedence 0) AssociativityLeft + +functionArrowOp :: Op +functionArrowOp = op "=>" (negate 1) AssociativityRight + +matchOp :: Op +matchOp = Op (Symbol "match") (Padding WsSpace $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone + +writeCase :: Scala.Case -> Expr +writeCase (Scala.Case pat _ term) = spaceSep [cst "case", writePat pat, cst "=>", writeTerm term] + +writeDefn :: Scala.Defn -> Expr +writeDefn def = case def of + Scala.DefnDef (Scala.Defn_Def _ name tparams [params] scod body) -> spaceSep [ + cst "def", nameAndParams, cst "=", writeTerm body] + where + nameAndParams = noSep $ Y.catMaybes [ + Just $ writeData_Name name, + if L.null tparams then Nothing else Just $ bracketList inlineStyle (writeType_Param <$> tparams), + Just $ parenList False (writeData_Param <$> params), + fmap (\t -> spaceSep [cst ":", writeType t]) scod] + Scala.DefnVal (Scala.Defn_Val _ [Scala.PatVar (Scala.Pat_Var (Scala.Data_Name (Scala.PredefString name)))] typ term) -> spaceSep [ + cst "val", nameAndType, cst "=", writeTerm term] + where + nameAndType = Y.maybe (cst name) (\t -> spaceSep [cst $ name ++ ":", writeType t]) typ + +writeImportExportStat :: Scala.ImportExportStat -> Expr +writeImportExportStat ie = case ie of + Scala.ImportExportStatImport (Scala.Import importers) -> newlineSep (writeImporter <$> importers) +-- Scala.ImportExportStatExport exp -> + +writeImporter :: Scala.Importer -> Expr +writeImporter (Scala.Importer (Scala.Data_RefName (Scala.Data_Name (Scala.PredefString ref))) importees) = spaceSep [ + cst "import", noSep [cst ref, forImportees importees]] + where + forImportee it = cst $ case it of + Scala.ImporteeWildcard -> "*" + Scala.ImporteeName (Scala.Importee_Name (Scala.NameValue name)) -> name + forImportees its = if L.null its + then cst "" + else if L.length its == 1 + then noSep [cst ".", forImportee $ L.head its] + else noSep [cst ".", curlyBracesList Nothing inlineStyle (forImportee <$> its)] +writeLit :: Scala.Lit -> Expr +writeLit lit = case lit of +-- Scala.LitNull + Scala.LitInt i -> cst $ Literals.showInt32 i +-- Scala.LitDouble Double +-- Scala.LitFloat Float +-- Scala.LitByte Integer +-- Scala.LitShort Integer +-- Scala.LitChar Integer +-- Scala.LitLong Int64 + Scala.LitBoolean b -> cst $ if b then "true" else "false" + Scala.LitUnit -> cst "()" + Scala.LitString s -> cst $ Literals.showString s +-- Scala.LitSymbol sym -> + _ -> cst $ Literals.showString $ "TODO:literal:" ++ show lit + +writeName :: Scala.Name -> Expr +writeName name = case name of + Scala.NameValue s -> cst s + +writePat :: Scala.Pat -> Expr +writePat pat = case pat of + Scala.PatExtract (Scala.Pat_Extract fun args) -> noSep [writeTerm fun, parenList False (writePat <$> args)] + Scala.PatVar (Scala.Pat_Var tname) -> writeData_Name tname + +writePkg :: Scala.Pkg -> Expr +writePkg (Scala.Pkg name _ stats) = doubleNewlineSep $ package:(writeStat <$> stats) + where + package = spaceSep [cst "package", writeData_Name name] + +writeStat :: Scala.Stat -> Expr +writeStat stat = case stat of +-- Scala.StatTerm Term -> +-- Scala.StatDecl Decl -> + Scala.StatDefn def -> writeDefn def + Scala.StatImportExport ie -> writeImportExportStat ie + +writeTerm :: Scala.Data -> Expr +writeTerm term = case term of + Scala.DataLit lit -> writeLit lit + Scala.DataRef ref -> writeData_Ref ref + Scala.DataApply (Scala.Data_Apply fun args) -> noSep [writeTerm fun, parenList False (writeTerm <$> args)] + Scala.DataAssign assign -> cst ">ASSIGN" + Scala.DataTuple (Scala.Data_Tuple args) -> parenList False (writeTerm <$> args) + Scala.DataMatch (Scala.Data_Match expr cases) -> ifx matchOp (writeTerm expr) $ newlineSep (writeCase <$> cases) + Scala.DataFunctionData ft -> writeData_FunctionData ft + +writeData_FunctionData :: Scala.Data_FunctionData -> Expr +writeData_FunctionData ft = case ft of + Scala.Data_FunctionDataFunction (Scala.Data_Function params body) -> + spaceSep [parenList False (writeData_Param <$> params), cst "=>", writeTerm body] + +writeData_Name :: Scala.Data_Name -> Expr +writeData_Name (Scala.Data_Name (Scala.PredefString name)) = cst name + +writeData_Param :: Scala.Data_Param -> Expr +writeData_Param (Scala.Data_Param _ name stype _) = noSep $ Y.catMaybes [ + Just $ writeName name, + fmap (\t -> spaceSep [cst ":", writeType t]) stype] + +writeData_Ref :: Scala.Data_Ref -> Expr +writeData_Ref ref = case ref of + Scala.Data_RefName name -> writeData_Name name + Scala.Data_RefSelect sel -> writeData_Select sel + +writeData_Select :: Scala.Data_Select -> Expr +writeData_Select (Scala.Data_Select arg name) = ifx dotOp (writeTerm arg) (writeTerm proj) + where + proj = Scala.DataRef $ Scala.Data_RefName name + +writeType :: Scala.Type -> Expr +writeType typ = case typ of + Scala.TypeRef (Scala.Type_RefName name) -> writeType_Name name + Scala.TypeApply (Scala.Type_Apply fun args) -> noSep [writeType fun, bracketList inlineStyle (writeType <$> args)] + Scala.TypeFunctionType (Scala.Type_FunctionTypeFunction (Scala.Type_Function [dom] cod)) -> ifx functionArrowOp (writeType dom) (writeType cod) + Scala.TypeLambda (Scala.Type_Lambda params body) -> noSep [writeType body, bracketList inlineStyle (writeType_Param <$> params)] + Scala.TypeVar (Scala.Type_Var name) -> writeType_Name name + _ -> cst $ "UNKNOWN TYPE: " ++ show typ + +writeType_Name :: Scala.Type_Name -> Expr +writeType_Name (Scala.Type_Name name) = cst name + +writeType_Param :: Scala.Type_Param -> Expr +writeType_Param (Scala.Type_Param [] n [] [] [] []) = writeName n diff --git a/src/main/haskell/Hydra/Ext/Scala/Utils.hs b/src/main/haskell/Hydra/Ext/Scala/Utils.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Scala/Utils.hs @@ -0,0 +1,68 @@ +module Hydra.Ext.Scala.Utils where + +import Hydra.Kernel +import qualified Hydra.Ext.Scala.Meta as Scala +import qualified Hydra.Lib.Strings as Strings +import Hydra.Ext.Scala.Language + +import qualified Data.List as L +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +nameOfType :: Graph -> Type -> Y.Maybe Name +nameOfType cx t = case stripType t of + TypeVariable name -> Just name + TypeLambda (LambdaType _ body) -> nameOfType cx body + _ -> Nothing + +qualifyUnionFieldName :: String -> Y.Maybe Name -> Name -> String +qualifyUnionFieldName dlft sname (Name fname) = (Y.maybe dlft (\n -> scalaTypeName True n ++ ".") sname) ++ fname + +scalaTypeName :: Bool -> Name -> String +scalaTypeName qualify name@(Name n) = if qualify || S.member local reservedWords + then L.intercalate "." $ Strings.splitOn "/" n + else local + where + local = localNameOfLazy name + +sapply :: Scala.Data -> [Scala.Data] -> Scala.Data +sapply fun args = Scala.DataApply $ Scala.Data_Apply fun args + +sassign :: Scala.Data -> Scala.Data -> Scala.Data +sassign lhs rhs = Scala.DataAssign $ Scala.Data_Assign lhs rhs + +slambda :: String -> Scala.Data -> Y.Maybe Scala.Type -> Scala.Data +slambda v body sdom = Scala.DataFunctionData $ Scala.Data_FunctionDataFunction + $ Scala.Data_Function [Scala.Data_Param mods name sdom def] body + where + mods = [] + name = Scala.NameValue v + def = Nothing + +sname :: String -> Scala.Data +sname = Scala.DataRef . Scala.Data_RefName . Scala.Data_Name . Scala.PredefString + +sprim :: Name -> Scala.Data +sprim name = sname $ prefix ++ "." ++ qualifiedNameLocal qname + where + qname = qualifyNameLazy name + prefix = L.last $ Strings.splitOn "/" $ unNamespace $ Y.fromJust $ qualifiedNameNamespace qname + +stapply :: Scala.Type -> [Scala.Type] -> Scala.Type +stapply t args = Scala.TypeApply $ Scala.Type_Apply t args + +stapply1 :: Scala.Type -> Scala.Type -> Scala.Type +stapply1 t1 t2 = stapply t1 [t2] + +stapply2 :: Scala.Type -> Scala.Type -> Scala.Type -> Scala.Type +stapply2 t1 t2 t3 = stapply t1 [t2, t3] + +stparam :: Name -> Scala.Type_Param +stparam (Name v) = Scala.Type_Param [] (Scala.NameValue v) [] [] [] [] + +stref :: String -> Scala.Type +stref = Scala.TypeRef . Scala.Type_RefName . Scala.Type_Name + +svar :: Name -> Scala.Pat +svar (Name v) = (Scala.PatVar . Scala.Pat_Var . Scala.Data_Name . Scala.PredefString) v diff --git a/src/main/haskell/Hydra/Ext/Shacl/Coder.hs b/src/main/haskell/Hydra/Ext/Shacl/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Shacl/Coder.hs @@ -0,0 +1,197 @@ +module Hydra.Ext.Shacl.Coder where + +import Hydra.Kernel +import Hydra.Ext.Rdf.Utils +import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Rdf +import qualified Hydra.Ext.Org.W3.Shacl.Model as Shacl +import qualified Hydra.Dsl.Literals as Literals +import qualified Hydra.Dsl.Expect as Expect +import qualified Hydra.Dsl.Terms as Terms + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +shaclCoder :: Module -> Flow Graph (Shacl.ShapesGraph, Graph -> Flow Graph Rdf.Graph) +shaclCoder mod = do + g <- getState + -- Note: untested since deprecation of element schemas + typeEls <- CM.filterM (isType g) $ moduleElements mod + shapes <- CM.mapM toShape typeEls + let sg = Shacl.ShapesGraph $ S.fromList shapes + let termFlow = \g -> do + fail "not implemented" + return (sg, termFlow) + where + isType g el = do + typ <- requireTermType $ elementData el + return $ stripType typ == TypeVariable _Type + toShape el = do + typ <- coreDecodeType $ elementData el + common <- encodeType typ + return $ Shacl.Definition (elementIri el) $ Shacl.ShapeNode $ Shacl.NodeShape common + +common :: [Shacl.CommonConstraint] -> Shacl.CommonProperties +common constraints = defaultCommonProperties { + Shacl.commonPropertiesConstraints = S.fromList constraints} + +defaultCommonProperties :: Shacl.CommonProperties +defaultCommonProperties = Shacl.CommonProperties { + Shacl.commonPropertiesConstraints = S.empty, + Shacl.commonPropertiesDeactivated = Nothing, + Shacl.commonPropertiesMessage = emptyLangStrings, + Shacl.commonPropertiesSeverity = Shacl.SeverityInfo, + Shacl.commonPropertiesTargetClass = S.empty, + Shacl.commonPropertiesTargetNode = S.empty, + Shacl.commonPropertiesTargetObjectsOf = S.empty, + Shacl.commonPropertiesTargetSubjectsOf = S.empty} + +elementIri :: Element -> Rdf.Iri +elementIri = nameToIri . elementName + +encodeField :: Name -> Rdf.Resource -> Field -> Flow Graph [Rdf.Triple] +encodeField rname subject field = do + node <- nextBlankNode + descs <- encodeTerm node (fieldTerm field) + return $ triplesOf descs ++ + forObjects subject (propertyIri rname $ fieldName field) (subjectsOf descs) + +encodeFieldType :: Name -> Maybe Integer -> FieldType -> Flow Graph (Shacl.Definition Shacl.PropertyShape) +encodeFieldType rname order (FieldType fname ft) = do + shape <- forType (Just 1) (Just 1) ft + return $ Shacl.Definition iri shape + where + iri = propertyIri rname fname + forType mn mx t = case stripType t of + TypeOptional ot -> forType (Just 0) mx ot + TypeSet st -> forType mn Nothing st + _ -> do + cp <- encodeType t + let baseProp = property iri + return $ baseProp { + Shacl.propertyShapeCommon = cp, + Shacl.propertyShapeConstraints = S.fromList $ Y.catMaybes [ + Shacl.PropertyShapeConstraintMinCount <$> mn, + Shacl.PropertyShapeConstraintMaxCount <$> mx], + Shacl.propertyShapeOrder = order} + +encodeLiteralType :: LiteralType -> Shacl.CommonProperties +encodeLiteralType lt = case lt of + LiteralTypeBinary -> xsd "base64Binary" + LiteralTypeBoolean -> xsd "boolean" + LiteralTypeFloat ft -> case ft of + FloatTypeBigfloat -> xsd "decimal" + FloatTypeFloat32 -> xsd "float" + FloatTypeFloat64 -> xsd "double" + LiteralTypeInteger it -> case it of + IntegerTypeBigint -> xsd "integer" + IntegerTypeInt8 -> xsd "byte" + IntegerTypeInt16 -> xsd "short" + IntegerTypeInt32 -> xsd "int" + IntegerTypeInt64 -> xsd "long" + IntegerTypeUint8 -> xsd "unsignedByte" + IntegerTypeUint16 -> xsd "unsignedShort" + IntegerTypeUint32 -> xsd "unsignedInt" + IntegerTypeUint64 -> xsd "unsignedLong" + LiteralTypeString -> xsd "string" + where + xsd local = common [Shacl.CommonConstraintDatatype $ xmlSchemaDatatypeIri local] + +encodeTerm :: Rdf.Resource -> Term -> Flow Graph [Rdf.Description] +encodeTerm subject term = case term of + TermAnnotated (AnnotatedTerm inner ann) -> encodeTerm subject inner -- TODO: extract an rdfs:comment + TermList terms -> encodeList subject terms + where + encodeList subj terms = if L.null terms + then pure [emptyDescription $ (Rdf.NodeIri $ rdfIri "nil")] + else do + node <- nextBlankNode + fdescs <- encodeTerm node $ L.head terms + let firstTriples = triplesOf fdescs ++ + forObjects subj (rdfIri "first") (subjectsOf fdescs) + next <- nextBlankNode + rdescs <- encodeList next $ L.tail terms + let restTriples = triplesOf rdescs ++ + forObjects subj (rdfIri "rest") (subjectsOf rdescs) + return [Rdf.Description (resourceToNode subj) (Rdf.Graph $ S.fromList $ firstTriples ++ restTriples)] + TermLiteral lit -> do + node <- Rdf.NodeLiteral <$> encodeLiteral lit + return [emptyDescription node] + TermMap m -> do + triples <- L.concat <$> (CM.mapM (forKeyVal subject) $ M.toList m) + return [Rdf.Description (resourceToNode subject) $ Rdf.Graph $ S.fromList triples] + where + forKeyVal subj (k, v) = do + -- Note: only string-valued keys are supported + ks <- Expect.string $ stripTerm k + node <- nextBlankNode + descs <- encodeTerm node v + let pred = keyIri ks + let objs = subjectsOf descs + let triples = forObjects subj pred objs + return $ triples ++ triplesOf descs + TermWrap (WrappedTerm name inner) -> do + descs <- encodeTerm subject inner + return $ (withType name $ L.head descs):(L.tail descs) + TermOptional mterm -> case mterm of + Nothing -> pure [] + Just inner -> encodeTerm subject inner + TermRecord (Record rname fields) -> do + tripless <- CM.mapM (encodeField rname subject) fields + return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList $ L.concat tripless)] + TermSet terms -> L.concat <$> CM.mapM encodeEl (S.toList terms) + where + encodeEl term = do + node <- nextBlankNode + encodeTerm node term + TermUnion (Injection rname field) -> do + triples <- encodeField rname subject field + return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList triples)] + _ -> unexpected "RDF-compatible term" $ show term + +encodeType :: Type -> Flow Graph Shacl.CommonProperties +encodeType typ = case stripType typ of + TypeList _ -> any + TypeLiteral lt -> pure $ encodeLiteralType lt + TypeMap _ -> any + TypeWrap name -> any -- TODO: include name + TypeRecord (RowType rname fields) -> do + props <- CM.zipWithM (encodeFieldType rname) (Just <$> [0..]) fields + return $ common [Shacl.CommonConstraintProperty $ S.fromList (Shacl.ReferenceDefinition <$> props)] + TypeSet _ -> any + TypeUnion (RowType rname fields) -> do + props <- CM.mapM (encodeFieldType rname Nothing) fields + let shapes = (Shacl.ReferenceAnonymous . toShape) <$> props + return $ common [Shacl.CommonConstraintXone $ S.fromList shapes] + where + toShape prop = node [Shacl.CommonConstraintProperty $ S.fromList [Shacl.ReferenceDefinition prop]] + _ -> unexpected "type" $ show typ + where + -- SHACL's built-in vocabulary is less expressive than Hydra's type system, so for now, SHACL validation simply ends + -- when inexpressible types are encountered. However, certain constructs such as lists can be validated using + -- secondary structures. For example, see shsh:ListShape in the SHACL documentation. TODO: explore these constructions. + any = pure $ common [] + +node :: [Shacl.CommonConstraint] -> Shacl.Shape +node = Shacl.ShapeNode . Shacl.NodeShape . common + +property :: Rdf.Iri -> Shacl.PropertyShape +property iri = Shacl.PropertyShape { + Shacl.propertyShapeCommon = defaultCommonProperties, + Shacl.propertyShapeConstraints = S.empty, + Shacl.propertyShapeDefaultValue = Nothing, + Shacl.propertyShapeDescription = emptyLangStrings, + Shacl.propertyShapeName = emptyLangStrings, + Shacl.propertyShapeOrder = Nothing, + Shacl.propertyShapePath = iri} + +withType :: Name -> Rdf.Description -> Rdf.Description +withType name (Rdf.Description subj (Rdf.Graph triples)) = Rdf.Description subj (Rdf.Graph $ S.insert triple triples) + where + subjRes = case subj of + Rdf.NodeIri iri -> Rdf.ResourceIri iri + Rdf.NodeBnode bnode -> Rdf.ResourceBnode bnode + triple = Rdf.Triple subjRes (rdfIri "type") (Rdf.NodeIri $ nameToIri name) diff --git a/src/main/haskell/Hydra/Ext/Shacl/Language.hs b/src/main/haskell/Hydra/Ext/Shacl/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Shacl/Language.hs @@ -0,0 +1,34 @@ +module Hydra.Ext.Shacl.Language where + +import Hydra.Kernel + +import qualified Data.Set as S + + +shaclLanguage :: Language +shaclLanguage = Language (LanguageName "hydra/ext/shacl") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.empty, + languageConstraintsLiteralVariants = S.fromList literalVariants, + languageConstraintsFloatTypes = S.fromList floatTypes, + languageConstraintsFunctionVariants = S.empty, + languageConstraintsIntegerTypes = S.fromList integerTypes, + languageConstraintsTermVariants = S.fromList [ + TermVariantList, + TermVariantLiteral, + TermVariantMap, + TermVariantWrap, + TermVariantOptional, + TermVariantRecord, + TermVariantSet, + TermVariantUnion], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantAnnotated, + TypeVariantList, + TypeVariantLiteral, + TypeVariantMap, + TypeVariantWrap, + TypeVariantOptional, + TypeVariantRecord, + TypeVariantSet, + TypeVariantUnion], + languageConstraintsTypes = const True } diff --git a/src/main/haskell/Hydra/Ext/Yaml/Coder.hs b/src/main/haskell/Hydra/Ext/Yaml/Coder.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Yaml/Coder.hs @@ -0,0 +1,116 @@ +module Hydra.Ext.Yaml.Coder (yamlCoder) where + +import Hydra.Kernel +import Hydra.TermAdapters +import Hydra.Ext.Yaml.Language +import Hydra.AdapterUtils +import qualified Hydra.Ext.Org.Yaml.Model as YM +import qualified Hydra.Dsl.Terms as Terms + +import qualified Control.Monad as CM +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +literalCoder :: LiteralType -> Flow (Graph) (Coder (Graph) (Graph) Literal YM.Scalar) +literalCoder at = pure $ case at of + LiteralTypeBoolean -> Coder { + coderEncode = \(LiteralBoolean b) -> pure $ YM.ScalarBool b, + coderDecode = \s -> case s of + YM.ScalarBool b -> pure $ LiteralBoolean b + _ -> unexpected "boolean" $ show s} + LiteralTypeFloat _ -> Coder { + coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ YM.ScalarFloat f, + coderDecode = \s -> case s of + YM.ScalarFloat f -> pure $ LiteralFloat $ FloatValueBigfloat f + _ -> unexpected "floating-point value" $ show s} + LiteralTypeInteger _ -> Coder { + coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ YM.ScalarInt i, + coderDecode = \s -> case s of + YM.ScalarInt i -> pure $ LiteralInteger $ IntegerValueBigint i + _ -> unexpected "integer" $ show s} + LiteralTypeString -> Coder { + coderEncode = \(LiteralString s) -> pure $ YM.ScalarStr s, + coderDecode = \s -> case s of + YM.ScalarStr s' -> pure $ LiteralString s' + _ -> unexpected "string" $ show s} + +recordCoder :: RowType -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node) +recordCoder rt = do + coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt) + return $ Coder (encode coders) (decode coders) + where + encode coders term = case stripTerm term of + TermRecord (Record _ fields) -> YM.NodeMapping . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields + where + encodeField (ft, coder) (Field (Name fn) fv) = case (fieldTypeType ft, fv) of + (TypeOptional _, TermOptional Nothing) -> pure Nothing + _ -> Just <$> ((,) <$> pure (yamlString fn) <*> coderEncode coder fv) + _ -> unexpected "record" $ show term + decode coders n = case n of + YM.NodeMapping m -> Terms.record (rowTypeTypeName rt) <$> + CM.mapM (decodeField m) coders -- Note: unknown fields are ignored + where + decodeField a (FieldType fname@(Name fn) ft, coder) = do + v <- coderDecode coder $ Y.fromMaybe yamlNull $ M.lookup (yamlString fn) m + return $ Field fname v + _ -> unexpected "mapping" $ show n + getCoder coders fname = Y.maybe error pure $ M.lookup fname coders + where + error = fail $ "no such field: " ++ fname + +termCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node) +termCoder typ = case stripType typ of + TypeLiteral at -> do + ac <- literalCoder at + return Coder { + coderEncode = \t -> case t of + TermLiteral av -> YM.NodeScalar <$> coderEncode ac av + _ -> unexpected "literal" $ show t, + coderDecode = \n -> case n of + YM.NodeScalar s -> Terms.literal <$> coderDecode ac s + _ -> unexpected "scalar node" $ show n} + TypeList lt -> do + lc <- termCoder lt + return Coder { + coderEncode = \t -> case t of + TermList els -> YM.NodeSequence <$> CM.mapM (coderEncode lc) els + _ -> unexpected "list" $ show t, + coderDecode = \n -> case n of + YM.NodeSequence nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes + _ -> unexpected "sequence" $ show n} + TypeOptional ot -> do + oc <- termCoder ot + return Coder { + coderEncode = \t -> case t of + TermOptional el -> Y.maybe (pure yamlNull) (coderEncode oc) el + _ -> unexpected "optional" $ show t, + coderDecode = \n -> case n of + YM.NodeScalar YM.ScalarNull -> pure $ Terms.optional Nothing + _ -> Terms.optional . Just <$> coderDecode oc n} + TypeMap (MapType kt vt) -> do + kc <- termCoder kt + vc <- termCoder vt + let encodeEntry (k, v) = (,) <$> coderEncode kc k <*> coderEncode vc v + let decodeEntry (k, v) = (,) <$> coderDecode kc k <*> coderDecode vc v + return Coder { + coderEncode = \t -> case t of + TermMap m -> YM.NodeMapping . M.fromList <$> CM.mapM encodeEntry (M.toList m) + _ -> unexpected "term" $ show t, + coderDecode = \n -> case n of + YM.NodeMapping m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m) + _ -> unexpected "mapping" $ show n} + TypeRecord rt -> recordCoder rt + _ -> fail $ "unsupported type variant: " ++ show (typeVariant typ) + +yamlCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node) +yamlCoder typ = do + adapter <- languageAdapter yamlLanguage typ + coder <- termCoder $ adapterTarget adapter + return $ composeCoders (adapterCoder adapter) coder + +yamlNull :: YM.Node +yamlNull = YM.NodeScalar YM.ScalarNull + +yamlString :: String -> YM.Node +yamlString = YM.NodeScalar . YM.ScalarStr diff --git a/src/main/haskell/Hydra/Ext/Yaml/Language.hs b/src/main/haskell/Hydra/Ext/Yaml/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Yaml/Language.hs @@ -0,0 +1,26 @@ +module Hydra.Ext.Yaml.Language where + +import Hydra.Kernel + +import qualified Data.Set as S + + +yamlLanguage :: Language +yamlLanguage = Language (LanguageName "hydra/ext/yaml") $ LanguageConstraints { + languageConstraintsEliminationVariants = S.empty, + languageConstraintsLiteralVariants = S.fromList [ + LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString], + languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat], + languageConstraintsFunctionVariants = S.empty, + languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint], + languageConstraintsTermVariants = S.fromList [ + TermVariantLiteral, + TermVariantList, + TermVariantMap, + TermVariantOptional, + TermVariantRecord], + languageConstraintsTypeVariants = S.fromList [ + TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantOptional, TypeVariantRecord], + languageConstraintsTypes = \typ -> case stripType typ of + TypeOptional (TypeOptional _) -> False + _ -> True } diff --git a/src/main/haskell/Hydra/Ext/Yaml/Modules.hs b/src/main/haskell/Hydra/Ext/Yaml/Modules.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Yaml/Modules.hs @@ -0,0 +1,39 @@ +module Hydra.Ext.Yaml.Modules (moduleToYaml) where + +import Hydra.Kernel +import Hydra.Adapters +import Hydra.Ext.Yaml.Serde +import Hydra.Ext.Yaml.Language +import qualified Hydra.Ext.Org.Yaml.Model as YM +import qualified Hydra.Dsl.Types as Types + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M + + +constructModule :: + Module + -> M.Map (Type) (Coder (Graph) (Graph) (Term) YM.Node) + -> [(Element, TypedTerm)] + -> Flow (Graph) YM.Node +constructModule mod coders pairs = do + keyvals <- withTrace "encoding terms" (CM.mapM toYaml pairs) + return $ YM.NodeMapping $ M.fromList keyvals + where + toYaml (el, (TypedTerm term typ)) = withTrace ("element " ++ unName (elementName el)) $ do + encode <- case M.lookup typ coders of + Nothing -> fail $ "no coder found for type " ++ show typ + Just coder -> pure $ coderEncode coder + node <- encode term + return (YM.NodeScalar $ YM.ScalarStr $ localNameOf $ elementName el, node) + ns = unNamespace $ moduleNamespace mod + localNameOf name = L.drop (1 + L.length ns) $ unName name + +moduleToYaml :: Module -> Flow (Graph) (M.Map FilePath String) +moduleToYaml mod = withTrace ("print module " ++ (unNamespace $ moduleNamespace mod)) $ do + node <- transformModule yamlLanguage encodeTerm constructModule mod + return $ M.fromList [(path, hydraYamlToString node)] + where + path = namespaceToFilePath False (FileExtension "yaml") $ moduleNamespace mod + encodeTerm _ = fail $ "only type definitions are expected in this mapping to YAML" diff --git a/src/main/haskell/Hydra/Ext/Yaml/Serde.hs b/src/main/haskell/Hydra/Ext/Yaml/Serde.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Ext/Yaml/Serde.hs @@ -0,0 +1,80 @@ +module Hydra.Ext.Yaml.Serde where + +import Hydra.Kernel +import Hydra.Ext.Yaml.Coder +import Hydra.Tools.Bytestrings +import qualified Hydra.Ext.Org.Yaml.Model as YM + +import qualified Data.ByteString.Lazy as BS +import qualified Control.Monad as CM +import qualified Data.YAML as DY +import qualified Data.YAML.Event as DYE +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.ByteString.Lazy.Char8 as LB + + +bytesToHsYaml :: BS.ByteString -> Flow (Graph) (DY.Node DY.Pos) +bytesToHsYaml bs = case DY.decodeNode bs of + Left (pos, msg) -> fail $ "YAML parser failure at " ++ show pos ++ ": " ++ msg + Right docs -> if L.null docs + then fail "no YAML document" + else if L.length docs > 1 + then fail "multiple YAML documents" + else case L.head docs of + (DY.Doc node) -> pure node + +bytesToHydraYaml :: BS.ByteString -> Flow (Graph) YM.Node +bytesToHydraYaml = bytesToHsYaml CM.>=> hsYamlToHydraYaml + +hsYamlToBytes :: DY.Node () -> BS.ByteString +hsYamlToBytes node = DY.encodeNode [DY.Doc node] + +hsYamlToHydraYaml :: DY.Node x -> Flow (Graph) YM.Node +hsYamlToHydraYaml hs = case hs of + DY.Scalar _ s -> YM.NodeScalar <$> case s of + DY.SNull -> pure YM.ScalarNull + DY.SBool b -> pure $ YM.ScalarBool b + DY.SFloat f -> pure $ YM.ScalarFloat f + DY.SInt i -> pure $ YM.ScalarInt i + DY.SStr t -> pure $ YM.ScalarStr $ T.unpack t + DY.SUnknown _ _ -> fail "YAML unknown scalars are unsupported" + DY.Mapping _ _ m -> YM.NodeMapping . M.fromList <$> CM.mapM mapPair (M.toList m) + where + mapPair (k, v) = (,) <$> hsYamlToHydraYaml k <*> hsYamlToHydraYaml v + DY.Sequence _ _ s -> YM.NodeSequence <$> CM.mapM hsYamlToHydraYaml s + DY.Anchor {} -> fail "YAML anchors are unsupported" + +hydraYamlToBytes :: YM.Node -> BS.ByteString +hydraYamlToBytes = hsYamlToBytes . hydraYamlToHsYaml + +hydraYamlToHsYaml :: YM.Node -> DY.Node () +hydraYamlToHsYaml hy = case hy of + YM.NodeMapping m -> DY.Mapping () DYE.untagged $ M.fromList $ mapPair <$> M.toList m + where + mapPair (k, v) = (,) (hydraYamlToHsYaml k) (hydraYamlToHsYaml v) + YM.NodeScalar s -> DY.Scalar () $ case s of + YM.ScalarBool b -> DY.SBool b + YM.ScalarFloat f -> DY.SFloat f + YM.ScalarInt i -> DY.SInt i + YM.ScalarNull -> DY.SNull + YM.ScalarStr s -> DY.SStr $ T.pack s + YM.NodeSequence s -> DY.Sequence () DYE.untagged $ hydraYamlToHsYaml <$> s + +hydraYamlToString :: YM.Node -> String +hydraYamlToString = bytesToString . hydraYamlToBytes + +yamlByteStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) BS.ByteString) +yamlByteStringCoder typ = do + coder <- yamlCoder typ + return Coder { + coderEncode = fmap hydraYamlToBytes . coderEncode coder, + coderDecode = bytesToHydraYaml CM.>=> coderDecode coder} + +yamlStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) String) +yamlStringCoder typ = do + serde <- yamlByteStringCoder typ + return Coder { + coderEncode = fmap LB.unpack . coderEncode serde, + coderDecode = coderDecode serde . LB.pack} diff --git a/src/main/haskell/Hydra/Flows.hs b/src/main/haskell/Hydra/Flows.hs --- a/src/main/haskell/Hydra/Flows.hs +++ b/src/main/haskell/Hydra/Flows.hs @@ -3,10 +3,16 @@ module Hydra.Flows where import Hydra.Kernel +import qualified Hydra.Lib.Flows as Flows import qualified Control.Monad as CM import qualified System.IO as IO + +fromEither :: Show e => Either e a -> Flow c a +fromEither x = case x of + Left e -> Flows.fail $ show e + Right a -> return a fromFlowIo :: s -> Flow s a -> IO.IO a fromFlowIo cx f = case mv of diff --git a/src/main/haskell/Hydra/Inference.hs b/src/main/haskell/Hydra/Inference.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Inference.hs +++ /dev/null @@ -1,140 +0,0 @@ --- | Entry point for Hydra type inference, which is a variation on on Hindley-Milner - -module Hydra.Inference ( - annotateTypedTerms, - inferGraphTypes, - inferType, - inferTypeScheme, - inferTypeAndConstraints, - Constraint, -) where - -import Hydra.Compute -import Hydra.Core -import Hydra.CoreEncoding -import Hydra.Graph -import Hydra.Lexical -import Hydra.Mantle -import Hydra.Annotations -import Hydra.Rewriting -import Hydra.Substitution -import Hydra.Unification -import Hydra.Rules -import Hydra.Tier1 -import Hydra.Tier2 -import Hydra.Tools.Sorting -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -annotateElements :: Graph -> [Element] -> Flow Graph [Element] -annotateElements g sortedEls = withInferenceContext $ do - iels' <- annotate sortedEls ([]) - let iels = fst <$> iels' - let constraints = snd <$> iels' - - -- Note: inference occurs over the entire graph at once, - -- but unification and substitution occur within elements in isolation - subst <- withGraphContext $ withSchemaContext $ CM.mapM solveConstraints constraints - return $ L.zipWith rewriteElement subst iels - where - -- Note: the following defaults to user-provided type annotations where provided. - -- In the future, we should trust unification to perform this defaulting, and not override the inferred type. - rewriteElement subst el = el { elementData = setTermType (Just typ) term1 } - where - term0 = elementData el - term1 = rewriteDataType (substituteInType subst) term0 - typ = Y.fromMaybe (termType term1) $ getTermType term0 - - annotate :: [Element] -> [(Element, [Constraint])] -> Flow InferenceContext [(Element, [Constraint])] - annotate original annotated = case original of - [] -> pure $ L.reverse annotated - (el:r) -> do - (iel, c1) <- inferElementType el - withBinding (elementName el) (termTypeScheme $ elementData iel) $ annotate r ((iel, c1):annotated) - -annotateTypedTerms :: Term -> Flow Graph Term -annotateTypedTerms term0 = do - (term1, _) <- inferTypeAndConstraints term0 - return term1 - -inferElementType :: Element -> Flow InferenceContext (Element, [Constraint]) -inferElementType el = withTrace ("infer type of " ++ unName (elementName el)) $ do - (iterm, c) <- infer $ elementData el - return (el {elementData = iterm}, c) - -inferGraphTypes :: Flow Graph Graph -inferGraphTypes = getState >>= annotateGraph - where - annotateGraph g = withTrace ("infer graph types") $ do - sorted <- sortGraphElements g - els <- sortGraphElements g >>= annotateElements g - return g {graphElements = M.fromList (toPair <$> els)} - where - toPair el = (elementName el, el) - --- TODO: deprecated -inferType :: Term -> Flow Graph Type -inferType term = typeSchemeType <$> inferTypeScheme term - --- TODO: deprecated --- | Solve for the top-level type of an expression in a given environment -inferTypeAndConstraints :: Term -> Flow Graph (Term, TypeScheme) -inferTypeAndConstraints term = withTrace ("infer type") $ withInferenceContext $ do - (iterm, constraints) <- infer term - subst <- withGraphContext $ withSchemaContext $ solveConstraints constraints - let term2 = rewriteDataType (substituteInType subst) iterm --- let typ = Y.fromMaybe (termType term2) $ getTermType term --- return (setTermType (Just typ) term2, closeOver $ termType term2) - return (term2, closeOver $ termType term2) - where - -- | Canonicalize and return the polymorphic top-level type. - closeOver = normalizeScheme . generalize M.empty . reduceType - --- TODO: deprecated -inferTypeScheme :: Term -> Flow Graph TypeScheme -inferTypeScheme term = snd <$> inferTypeAndConstraints term - -rewriteDataType :: (Type -> Type) -> Term -> Term -rewriteDataType f = rewriteTerm ff id - where - ff recurse term = case recurse term of - TermTyped (TypedTerm term1 type1) -> TermTyped $ TypedTerm term1 (f type1) - t -> t - -sortGraphElements :: Graph -> Flow Graph [Element] -sortGraphElements g = do - let annotated = S.fromList $ Y.catMaybes (ifAnnotated <$> M.elems els) - adjList <- CM.mapM (toAdj annotated) $ M.elems els - case topologicalSort adjList of - Left comps -> fail $ "cyclical dependency not resolved through annotations: " ++ L.intercalate ", " (unName <$> L.head comps) - Right names -> return $ Y.catMaybes ((\n -> M.lookup n els) <$> names) - where - els = graphElements g - ifAnnotated el = case (getTermType $ elementData el) of - Nothing -> Nothing - Just _ -> Just $ elementName el - toAdj annotated el = do - let deps = L.filter isNotAnnotated $ L.filter isElName $ S.toList $ freeVariablesInTerm $ elementData el - - return (elementName el, deps) - where - -- Ignore free variables which are not valid element references - isElName name = M.member name els - -- No need for an inference dependency on an element which is already annotated with a type - isNotAnnotated name = not $ S.member name annotated - -withInferenceContext flow = do - g <- getState - let env = initialEnv g - withState (InferenceContext g env) flow - where - initialEnv g = M.fromList $ Y.catMaybes (toPair <$> (M.elems $ graphElements g)) - where - toPair el = (\t -> (elementName el, monotype t)) <$> (getTermType $ elementData el) diff --git a/src/main/haskell/Hydra/Inference/AlgorithmW.hs b/src/main/haskell/Hydra/Inference/AlgorithmW.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Inference/AlgorithmW.hs @@ -0,0 +1,835 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverlappingInstances #-} + +-- Implementation of Hindley Milner algorithm W +-- to system F translation by Ryan Wisnesky, with extensions for Hydra by Joshua Shinavier +-- License: Apache 2.0 https://www.apache.org/licenses/LICENSE-2.0 + +module Hydra.Inference.AlgorithmW where + +import Hydra.Minimal + +import Prelude +import Control.Monad.Except +import Control.Monad.State +import Data.List (nub) +import Debug.Trace + + +natType = TyLit $ LiteralTypeInteger IntegerTypeInt32 +constNeg = Const $ TypedPrim $ TypedPrimitive (Name "hydra/lib/math.neg") $ Forall [] $ TyFn natType natType +-- Note: Hydra has no built-in pred or succ functions, but neg has the expected type +constPred = constNeg +constSucc = constNeg +nat = Const . Lit . int32 +str = Const . Lit . string + +-- A typed primitive corresponds to the Hydra primitive of the same name +data TypedPrimitive = TypedPrimitive Name TypSch deriving (Eq) + + +------------------------ +-- STLC + +type Var = String + +data Prim + = Lit Literal + | TypedPrim TypedPrimitive + | If0 + | Fst | Snd | Pair | TT + | Nil | Cons | FoldList + | FF | Inl | Inr | Case | Con Var | Fold Var + deriving Eq + +instance Show Prim where + show (Lit l) = show l + show (TypedPrim (TypedPrimitive name _)) = unName name ++ "()" + show FoldList = "fold" + show Fst = "fst" + show Snd = "snd" + show Nil = "nil" + show Cons = "cons" + show TT = "tt" + show FF = "ff" + show Inl = "inl" + show Inr = "inr" + show Case = "case" + show If0 = "if0" + show Pair = "pair" + show (Con n) = n + show (Fold n) = "fold_" ++ n + +data Expr = Const Prim + | Var Var + | Tuple [Expr] + | Proj Int Int Expr + | Inj Int Int Expr + | Case' Expr [Expr] + | App Expr Expr + | Abs Var Expr + | Letrec [(Var, Expr)] Expr + deriving (Eq) + +instance Show Expr where + show (Case' t ts) = "case " ++ show t ++ " of " ++ x ++ " end" + where x = foldl (\p q -> p ++ "\n\t\t" ++ q) "" $ map show ts + show (Proj i j e) = show e ++ "." ++ show i ++ " (arity " ++ show j ++ ")" + show (Inj i j e) = "inj " ++ show i ++ " (arity " ++ show j ++ ") " ++ show e + show (Tuple ts) = "<" ++ show (map show ts) ++ ">" + show (Const p) = show p + show (Var v) = v + show (App (App (App a' a) b) b') = "(" ++ show a' ++ " " ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")" + show (App (App a b) b') = "(" ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")" + show (App a b) = "(" ++ show a ++ " " ++ show b ++ ")" + show (Abs a b) = "(\\" ++ a ++ ". " ++ show b ++ ")" + show (Letrec ab c) = "letrec " ++ d ++ show c + where d = foldr (\(p, q) r -> p ++ " = " ++ show q ++ " \n\t\t" ++ r) "in " ab + +data MTy = TyVar Var + | TyLit LiteralType + | TyList MTy + | TyFn MTy MTy + | TyProd MTy MTy + | TySum MTy MTy + | TyUnit + | TyVoid + | TyTuple [MTy] + | TyVariant [MTy] + | TyCon Var [MTy] + deriving (Eq) + +instance Show MTy where + show (TyLit lt) = case lt of + LiteralTypeInteger it -> drop (length "IntegerType") $ show it + LiteralTypeFloat ft -> drop (length "FloatType") $ show ft + _ -> drop (length "LiteralType") $ show lt + show (TyTuple ts) = "(Tuple " ++ show (map show ts) ++ ")" + show (TyVariant ts) = "(Variant " ++ show (map show ts) ++ ")" + show (TyVar v) = v + show (TyList t) = "(List " ++ (show t) ++ ")" + show (TyFn t1 t2) = "(" ++ show t1 ++ " -> " ++ show t2 ++ ")" + show (TyProd t1 t2) = "(" ++ show t1 ++ " * " ++ show t2 ++ ")" + show (TySum t1 t2) = "(" ++ show t1 ++ " + " ++ show t2 ++ ")" + show TyUnit = "Unit" + show TyVoid = "Void" + show (TyCon c ts) = c ++ " " ++ ts' + where ts' = foldr (\p r -> show p ++ "" ++ r) "" ts + +instance Show TypSch where + show (Forall [] t) = show t + show (Forall x t) = "forall " ++ d ++ show t + where d = foldr (\p q -> p ++ " " ++ q) ", " x + +data TypSch = Forall [Var] MTy + deriving Eq + + +type ADTs = [(Var, [Var], [(Var, [MTy])])] + + + + +------------------------ +-- System F + +data FExpr = FConst Prim + | FVar Var + | FTuple [FExpr] + | FProj Int FExpr + | FInj Int [FTy] FExpr + | FCase FExpr FTy [FExpr] + | FApp FExpr FExpr + | FAbs Var FTy FExpr + | FTyApp FExpr [FTy] + | FTyAbs [Var] FExpr + | FLetrec [(Var, FTy, FExpr)] FExpr + deriving (Eq) + +instance Show FExpr where + show (FCase t t' []) = "ff " ++ show t ++ " " ++ show t' ++ " " + show (FCase t t' ts) = "case " ++ show t ++ " of " ++ show (map show ts) ++ " end" + show (FProj i e) = show e ++ "." ++ show i + show (FInj i j e) = "inj " ++ show i ++ " (arity " ++ show j ++ ") " ++ show e + show (FTuple es) = "<" ++ show (map show es) ++ ">" + show (FConst p) = show p + show (FVar v) = v + show (FTyApp e t) = "(" ++ show e ++ " " ++ show t ++ ")" + show (FApp (FApp (FApp a' a) b) b') = "(" ++ show a' ++ " " ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")" + show (FApp (FApp a b) b') = "(" ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")" + show (FApp a b) = "(" ++ show a ++ " " ++ show b ++ ")" + show (FAbs a t b) = "(\\" ++ a ++ ":" ++ show t ++ ". " ++ show b ++ ")" + show (FLetrec ab c) = "letrecs " ++ d ++ show c + where d = foldr (\(p, t, q) r -> p ++ ":" ++ show t ++ " = " ++ show q ++ " \n\t\t" ++ r) "in " ab + show (FTyAbs ab c) = "(/\\" ++ d ++ show c ++ ")" + where d = foldr (\p r -> p ++ " " ++ r) ". " ab + +data FTy = FTyVar Var + | FTyLit LiteralType + | FTyList FTy + | FTyFn FTy FTy + | FTyProd FTy FTy + | FTySum FTy FTy + | FTyUnit + | FTyVoid + | FTyTuple [FTy] + | FTyVariant [FTy] + | FTyCon Var [FTy] + | FForall [Var] FTy + deriving (Eq) + +instance Show FTy where + show (FTyLit lt) = show $ TyLit lt + show (FTyVariant ts) = "(Variant " ++ show (map show ts) ++ ")" + show (FTyTuple ts) = "(Tuple " ++ show (map show ts) ++ ")" + show (FTyVar v) = v + show (FTyList t) = "(List " ++ (show t) ++ ")" + show (FTyFn t1 t2) = "(" ++ show t1 ++ " -> " ++ show t2 ++ ")" + show (FTyProd t1 t2) = "(" ++ show t1 ++ " * " ++ show t2 ++ ")" + show (FTySum t1 t2) = "(" ++ show t1 ++ " + " ++ show t2 ++ ")" + show FTyUnit = "Unit" + show FTyVoid = "Void" + show (FForall x t) = "(forall " ++ d ++ show t ++ ")" + where d = foldr (\p q -> p ++ " " ++ q) ", " x + show (FTyCon c ts) = c ++ " " ++ ts' + where ts' = foldr (\p r -> show p ++ "" ++ r) " " ts + +mTyToFTy :: MTy -> FTy +mTyToFTy (TyVar v) = FTyVar v +mTyToFTy (TyLit lt) = FTyLit lt +mTyToFTy TyUnit = FTyUnit +mTyToFTy TyVoid = FTyVoid +mTyToFTy (TyList x) = FTyList $ mTyToFTy x +mTyToFTy (TyFn x y) = FTyFn (mTyToFTy x) (mTyToFTy y) +mTyToFTy (TyProd x y) = FTyProd (mTyToFTy x) (mTyToFTy y) +mTyToFTy (TySum x y) = FTySum (mTyToFTy x) (mTyToFTy y) +mTyToFTy (TyTuple ts) = FTyTuple (map mTyToFTy ts) +mTyToFTy (TyVariant ts) = FTyVariant (map mTyToFTy ts) +mTyToFTy (TyCon c ts) = FTyCon c $ map mTyToFTy ts + +tyToFTy :: TypSch -> FTy +tyToFTy (Forall [] t) = mTyToFTy t +tyToFTy (Forall vs t) = FForall vs (mTyToFTy t) + +-------------------- +-- Contexts + +type Ctx = [(Var, TypSch)] + +class Vars a where + vars :: a -> [Var] + +instance Vars Ctx where + vars [] = [] + vars ((v,t):l) = vars t ++ vars l + +instance Vars TypSch where + vars (Forall vs t) = filter (\v -> not $ elem v vs) (vars t) + +instance Vars MTy where + vars (TyVar v) = [v] + vars (TyLit _) = [] + vars (TyList t) = vars t + vars (TyFn t1 t2) = vars t1 ++ vars t2 + vars TyUnit = [] + vars TyVoid = [] + vars (TyProd t1 t2) = vars t1 ++ vars t2 + vars (TySum t1 t2) = vars t1 ++ vars t2 + vars (TyTuple []) = [] + vars (TyTuple (a:b)) = vars a ++ vars (TyTuple b) + vars (TyVariant []) = [] + vars (TyVariant (a:b)) = vars a ++ vars (TyVariant b) + vars (TyCon _ x) = vars $ TyVariant x --cheat + +replaceTCon :: MTy -> MTy -> MTy -> MTy +replaceTCon u s (TyVar x) = TyVar x +replaceTCon u s (TyLit l) = TyLit l +replaceTCon u s (TyList t) = TyList $ replaceTCon u s t +replaceTCon u s (TyFn t1 t2) = TyFn (replaceTCon u s t1) (replaceTCon u s t2) +replaceTCon u s TyUnit = TyUnit +replaceTCon u s TyVoid = TyVoid +replaceTCon u s (TyProd t1 t2) = TyProd (replaceTCon u s t1) (replaceTCon u s t2) +replaceTCon u s (TySum t1 t2) = TySum (replaceTCon u s t1) (replaceTCon u s t2) +replaceTCon u s (TyTuple []) = TyTuple [] +replaceTCon u s (TyTuple (a:b)) = TyTuple $ (replaceTCon u s a):(map (replaceTCon u s) b) +replaceTCon u s (TyVariant []) = TyVariant [] +replaceTCon u s (TyVariant (a:b)) = TyVariant $ (replaceTCon u s a):(map (replaceTCon u s) b) +replaceTCon u s (TyCon t' ts) | TyCon t' ts == u = s + | otherwise = TyCon t' $ map (replaceTCon u s) ts + +primTy :: ADTs -> Prim -> Either String TypSch +primTy _ (Lit l) = Right $ Forall [] $ TyLit $ literalType l +primTy _ (TypedPrim (TypedPrimitive _ forall)) = Right forall +primTy [] (Con n) = throwError $ n ++ " not found " +primTy ((a,t,[]):tl) (Con n) = primTy tl $ Con n +primTy ((a,t,(c,ts):cs):tl) (Con n) | c == n = return $ Forall t (ts' ts $ TyCon a $ map TyVar t) + | otherwise = primTy ((a,t,cs):tl) $ Con n + where ts' [] x = x + ts' (p:q) x = TyFn p $ ts' q x +primTy [] (Fold n) = throwError $ n ++ " not found " +primTy ((a,t,cs):tl) (Fold n) | a == n = return $ Forall ("r":t) $ elimTy + | otherwise = primTy tl $ Fold n + where elimTy = TyFn (TyCon a $ map TyVar t) $ replaceTCon (TyCon a $ map TyVar t) (TyVar "r") (ts' cs) + ts' [] = TyVar "r" + ts' ((_,ts):q) = TyFn (ts'' ts) $ ts' q + ts'' [] = TyCon a $ map TyVar t + ts'' (a:b) = TyFn a $ ts'' b +primTy _ Fst = return $ Forall ["x", "y"] $ (TyProd (TyVar "x") (TyVar "y")) `TyFn` (TyVar "x") +primTy _ Snd = return $ Forall ["x", "y"] $ (TyProd (TyVar "x") (TyVar "y")) `TyFn` (TyVar "y") +primTy _ Nil = return $ Forall ["t"] $ TyList (TyVar "t") +primTy _ Cons = return $ Forall ["t"] $ TyFn (TyVar "t") (TyFn (TyList (TyVar "t")) (TyList (TyVar "t"))) +primTy _ TT = return $ Forall [] TyUnit +primTy _ FF = return $ Forall ["t"] $ TyFn TyVoid (TyVar "t") +primTy _ Inl = return $ Forall ["x", "y"] $ (TyVar "x") `TyFn` (TyProd (TyVar "x") (TyVar "y")) +primTy _ Inr = return $ Forall ["x", "y"] $ (TyVar "y") `TyFn` (TyProd (TyVar "x") (TyVar "y")) +primTy _ Pair = return $ Forall ["xx", "yy"] $ (TyFn (TyVar "xx") (TyFn (TyVar "yy") (TyProd (TyVar "xx") (TyVar "yy")))) +primTy _ If0 = return $ Forall [] $ natType `TyFn` (natType `TyFn` (natType `TyFn` natType)) +primTy _ FoldList = return $ Forall ["a", "b"] $ p `TyFn` ((TyVar "b") `TyFn` ((TyList $ TyVar "a") `TyFn` (TyVar "b"))) + where p = TyVar "b" `TyFn` (TyVar "a" `TyFn` TyVar "b") +primTy _ Case = return $ Forall ["x", "y", "z"] $ (TySum (TyVar "x") (TyVar "y")) `TyFn` (l `TyFn` (r `TyFn` (TyVar "z"))) + where l = (TyVar "x") `TyFn` (TyVar "z") + r = (TyVar "y") `TyFn` (TyVar "z") + + +----------------------------- +-- Substitution + +type Subst = [(Var, MTy)] + +idSubst :: Subst +idSubst = [] + +o :: Subst -> Subst -> Subst +o f g = addExtra ++ map h g + where h (v, g') = (v, subst f g') + addExtra = filter (\(v,f')-> case lookup v g of + Just y -> False + Nothing -> True) f + +class Substable a where + subst :: Subst -> a -> a + +instance Substable MTy where + subst f (TyLit lt) = TyLit lt + subst f (TyVariant ts) = TyVariant $ map (subst f) ts + subst f (TyTuple ts) = TyTuple $ map (subst f) ts + subst f TyUnit = TyUnit + subst f TyVoid = TyVoid + subst f (TyList t) = TyList $ subst f t + subst f (TyFn t1 t2) = TyFn (subst f t1) (subst f t2) + subst f (TyProd t1 t2) = TyProd (subst f t1) (subst f t2) + subst f (TySum t1 t2) = TySum (subst f t1) (subst f t2) + subst f (TyVar v) = case lookup v f of + Nothing -> TyVar v + Just y -> y + subst f (TyCon v ts) = TyCon v $ map (subst f) ts + +instance Substable FTy where + subst f (FTyLit lt) = FTyLit lt + subst f (FTyVariant ts) = FTyVariant $ map (subst f) ts + subst f (FTyTuple ts) = FTyTuple $ map (subst f) ts + subst f FTyUnit = FTyUnit + subst f FTyVoid = FTyVoid + subst f (FTyList t) = FTyList $ subst f t + subst f (FTyFn t1 t2) = FTyFn (subst f t1) (subst f t2) + subst f (FTyProd t1 t2) = FTyProd (subst f t1) (subst f t2) + subst f (FTySum t1 t2) = FTySum (subst f t1) (subst f t2) + subst f (FTyVar v) = case lookup v f of + Nothing -> FTyVar v + Just y -> mTyToFTy y + subst f (FForall vs t) = FForall vs $ subst phi' t + where phi' = filter (\(v,f')-> not (elem v vs)) f + subst f (FTyCon v ts) = FTyCon v $ map (subst f) ts + +instance Substable TypSch where + subst f (Forall vs t) = Forall vs $ subst f' t + where f' = filter (\(v,t')-> not $ elem v vs) f + +instance Substable Ctx where + subst phi g = map (\(k,v)->(k, subst phi v)) g + +instance Substable FExpr where + subst phi (FInj i js e) = FInj i (map (subst phi) js) $ subst phi e + subst phi (FProj i e) = FProj i $ subst phi e + subst phi (FTuple es) = FTuple $ map (subst phi) es + subst phi (FCase e t es) = FCase (subst phi e) (subst phi t) $ map (subst phi) es + subst phi (FConst p) = FConst p + subst phi (FVar p) = FVar p + subst phi (FApp p q) = FApp (subst phi p) (subst phi q) + subst phi (FAbs p t q) = FAbs p (subst phi t) (subst phi q) + subst phi (FTyApp p q) = FTyApp (subst phi p) (map (subst phi) q) + subst phi (FTyAbs vs p) = FTyAbs vs (subst phi' p) + where phi' = filter (\(v,f')-> not (elem v vs)) phi + subst phi (FLetrec vs p) = FLetrec (map (\(k,t,v)->(k,subst phi t, subst phi v)) vs) (subst phi p) + +subst' :: [(Var,FTy)] -> FTy -> FTy +subst' f (FTyLit lt) = FTyLit lt +subst' f (FTyTuple ts) = FTyTuple $ (map $ subst' f) ts +subst' f (FTyVariant ts) = FTyVariant $ (map $ subst' f) ts +subst' f FTyUnit = FTyUnit +subst' f FTyVoid = FTyVoid +subst' f (FTyList t) = FTyList $ subst' f t +subst' f (FTyFn t1 t2) = FTyFn (subst' f t1) (subst' f t2) +subst' f (FTyProd t1 t2) = FTyProd (subst' f t1) (subst' f t2) +subst' f (FTySum t1 t2) = FTySum (subst' f t1) (subst' f t2) +subst' f (FTyVar v) = case lookup v f of + Nothing -> FTyVar v + Just y -> y +subst' f (FForall vs t) = FForall vs $ subst' f' t + where f' = filter (\(v,f')-> not (elem v vs)) f +subst' f (FTyCon v ts) = FTyCon v $ map (subst' f) ts + +instance Show Ctx where + show [] = "" + show ((k,v):t) = k ++ ":" ++ show v ++ " " ++ show t + +------------------------------------ +-- Type checking for F + +open :: [Var] -> [FTy] -> FTy -> Either String FTy +open vs ts e | length vs == length ts = return $ subst' (zip vs ts) e + | otherwise = throwError "Cannot open" + +typeOf :: ADTs -> [Var] -> [(Var,FTy)] -> FExpr -> Either String FTy +typeOf adts tvs g (FCase e r es) = do { ts <- mapM (typeOf adts tvs g) es + ; t <- typeOf adts tvs g e + ; case t of + FTyVariant ts' -> if length ts == length ts' + then do { mapM f $ zip ts ts' + ; return r } + else throwError $ "bad number of cases " + z -> throwError $ show z ++ " is not a variant"} + where f ((FTyFn a b), exp) | a == exp && b == r = return () +typeOf adts tvs g (FInj i ts e) = do { t <- typeOf adts tvs g e + ; if i >= length ts + then throwError $ "bad inj index " ++ show i ++ " on " ++ show e + else if ts !! i == t + then return $ FTyVariant ts + else throwError $ "injection type mismatch " ++ show (FInj i ts e) ++ ", " ++ show (ts !! i) ++ " <> " ++ show t } +typeOf adts tvs g (FProj i e) = do { t <- typeOf adts tvs g e + ; case t of + FTyTuple ts -> if i >= length ts + then throwError $ "bad proj index " ++ show i ++ " on " ++ show e + else return $ ts !! i + z -> throwError $ show z ++ " is not a tuple type" } +typeOf adts tvs g (FTuple es) = do { ts <- mapM (typeOf adts tvs g) es + ; return $ FTyTuple ts } +typeOf adts tvs g (FVar x) = case lookup x g of + Nothing -> throwError $ "unbound var: " ++ x + Just y -> return y +typeOf adts tvs g (FConst p) = do { t <- primTy adts p ; return $ tyToFTy t } +typeOf adts tvs g (FApp a b) = do { t1 <- typeOf adts tvs g a + ; t2 <- typeOf adts tvs g b + ; case t1 of + FTyFn p q -> if p == t2 + then return q + else throwError $ "In " ++ (show $ FApp a b) ++ " expected " ++ show p ++ " given " ++ show t2 + v -> throwError $ "In " ++ show (FApp a b) ++ " not a fn type: " ++ show v } +typeOf adts tvs g (FAbs x t e) = do { t1 <- typeOf adts tvs ((x,t):g) e + ; return $ t `FTyFn` t1 } +typeOf adts tvs g (FTyAbs vs e) = do { t1 <- typeOf adts (vs++tvs) g e + ; return $ FForall vs t1 } +typeOf adts tvs g (FTyApp e ts) = do { t1 <- typeOf adts tvs g e + ; case t1 of + FForall vs t -> open vs ts t + v -> throwError $ "not a forall type: " ++ show v } +typeOf adts tvs g (FLetrec es e) = do { let g' = map (\(k,t,e)->(k,t)) es + ; est <- mapM (\(_,_,v)->typeOf adts tvs (g'++g) v) es + ; if est == (snd $ unzip g') + then typeOf adts tvs g' e + else throwError $ "Disagree: " ++ show est ++ " and " ++ (show $ snd $ unzip g') } + + +----------------------------- +-- Unification + +mgu :: MTy -> MTy -> E Subst +mgu (TyLit lt1) (TyLit lt2) = if lt1 == lt2 + then return [] + else throwError $ "Cannot unify literal types " ++ show lt1 ++ " and " ++ show lt2 +mgu (TyVariant ts1) (TyVariant ts2) | length ts1 == length ts2 = mgu' ts1 ts2 + | otherwise = throwError $ "cannot unify " ++ show ts1 ++ " with " ++ show ts2 +mgu (TyTuple ts1) (TyTuple ts2) | length ts1 == length ts2 = mgu' ts1 ts2 + | otherwise = throwError $ "cannot unify " ++ show ts1 ++ " with " ++ show ts2 +mgu (TyList a) (TyList b) = mgu a b +mgu TyUnit TyUnit = return [] +mgu TyVoid TyVoid = return [] +mgu (TyCon a as) (TyCon b bs) | a == b && length as == length bs = mgu' as bs + | otherwise = throwError $ "cannot unify " ++ show a ++ " with " ++ show b +mgu (TyProd a b) (TyProd a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s } +mgu (TySum a b) (TySum a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s } +mgu (TyFn a b) (TyFn a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s } +mgu (TyVar a) (TyVar b) | a == b = return [] +mgu (TyVar a) b = do { occurs a b; return [(a, b)] } +mgu a (TyVar b) = mgu (TyVar b) a +mgu a b = throwError $ "cannot unify " ++ show a ++ " with " ++ show b + +mgu' :: [MTy] -> [MTy] -> E Subst +mgu' [] [] = return idSubst +mgu' (a:as) (b:bs) = do { f <- mgu a b; s <- mgu' (map (subst f) as) (map (subst f) bs); return $ s `o` f } + +occurs :: Var -> MTy -> E () +occurs v (TyLit _) = return () +occurs v (TyCon _ ts) = mapM_ (occurs v) ts +occurs v (TyTuple ts) = mapM_ (occurs v) ts +occurs v (TyVariant ts) = mapM_ (occurs v) ts +occurs v (TyList l) = occurs v l +occurs v TyUnit = return () +occurs v TyVoid = return () +occurs v (TyFn a b) = do { occurs v a; occurs v b } +occurs v (TyProd a b) = do { occurs v a; occurs v b } +occurs v (TySum a b) = do { occurs v a; occurs v b } +occurs v (TyVar v') | v == v' = throwError $ "occurs check failed" + | otherwise = return () + +----------------------------- +-- Algorithm W + +type E = ExceptT String (State ([String],Integer)) +type M a = E (Subst, a) + +log0 :: Int -> String -> E () +log0 i x = do { (l, s) <- get; put ((x'++x):l, s); } + where x' = foldl (\p q -> "\t" ++ p) "" [0..i] + +fresh :: E MTy +fresh = do { (l,s) <- get; put (l, s + 1); return $ TyVar $ "v" ++ show s } + +inst :: TypSch -> E (MTy,[MTy]) +inst (Forall vs ty) = do { vs' <- mapM (\_->fresh) vs; return $ (subst (zip vs vs') ty, vs') } + +gen :: Ctx -> MTy -> (TypSch, [Var]) +gen g t = (Forall vs t , vs) + where vs = nub $ filter (\v -> not $ elem v (vars g)) (vars t) + +fTyApp x [] = x +fTyApp x y = FTyApp x y + +fTyAbs [] x = x +fTyAbs x y = FTyAbs x y + +replace [] _ = [] +replace (_:xs) (0,a) = a:xs +replace (x:xs) (n,a) = + if n < 0 + then (x:xs) + else x: replace xs (n-1,a) + +checkAgainstF :: ADTs -> Ctx -> MTy -> FExpr -> E () +checkAgainstF adts g t e = case (typeOf adts [] g' e) of + Left err -> throwError $ "\t" ++ "err: " ++ err + Right tt -> if tt == mTyToFTy t + then return () + else throwError $ show g ++ "|- " ++ show e ++ ": " ++ show tt ++ " != " ++ show t + where g' = map (\(k,v)->(k, tyToFTy v)) g + +w :: Int -> ADTs -> Ctx -> Expr -> M (MTy, FExpr) +w l adts g (Case' e es') = do { t <- fresh + ; bs' <- mapM (\_->fresh) es' + ; let bs = map (\k-> TyFn k t) bs' + ; (phi , (ts, es)) <- w' (l+1) g es' + ; m1 <- mgu' bs ts + ; (phi', (t', e')) <- w (l+1) adts (subst (m1 `o` phi) g) e + ; m2 <- mgu (subst (m1 `o` phi) t') (subst (m1 `o` phi' `o` phi) $ TyVariant bs') + ; let ret = FCase (subst (m2 ) e') (mTyToFTy ret_t) (map (subst $ m2 `o` phi' `o` m1) es) + ret_t = subst ret_subst t + ret_subst = m2 `o` phi' `o` m1 `o` phi + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } + where w' l g [] = return (idSubst, ([], [])) + w' l g (e:tl) = do { (u,(u', j)) <- w l adts g e + ; (r,(r', h)) <- w' l (subst u g ) tl + ; return (r `o` u, ((subst r u'):r', (subst r j):h)) } +w l adts g (Inj i j e) = do { + ; (s0, (t0, a)) <- w (l+1) adts g e + ; t'' <- mapM (\_->fresh) [1..j] + ; let t' = replace t'' (i, t0) + ; let ret = FInj i (map (mTyToFTy) t') a + ret_t = TyVariant t' + ret_subst = s0 + ; log0 l $ "INJ " ++ show (subst ret_subst g) ++ "|- " ++ (show $ ret) ++ " : " ++ show ret_t + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } +w l adts g (Proj i j e) = do { + ; (s0, (t0, a)) <- w (l+1) adts g e + ; t' <- mapM (\_->fresh) [1..j] + ; s2 <- t0 `mgu` (TyTuple t') + ; let ret = FProj i (subst s2 a) + ret_t = subst s2 (t' !! i) + ret_subst = s2 `o` s0 + ; log0 l $ "PROJ " ++ show (subst ret_subst g) ++ "|- " ++ (show $ ret) ++ " : " ++ show ret_t + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } +w l adts g (Tuple es') = do { (phi, (ts, es)) <- w' (l+1) g es' + ; let ret = FTuple es + ret_t = TyTuple ts + ret_subst = phi + ; log0 l $ "TUPLE " ++ show (subst ret_subst g) ++ "|- " ++ (show $ ret) ++ " : " ++ show ret_t + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } + where w' l g [] = return (idSubst, ([], [])) + w' l g (e:tl) = do { (u,(u', j)) <- w l adts g e + ; (r,(r', h)) <- w' l (subst u g ) tl + ; return (r `o` u, ((subst r u'):r', (subst r j):h)) } +w l adts g (Const p) = do { case primTy adts p of + Left er -> throwError er + Right t -> do { (ret_t, vs) <- inst t + ; let ret = fTyApp (FConst p) $ map mTyToFTy vs + ; log0 l $ "CONST " ++ show g ++ "|- " ++ show ret ++ " : " ++ show ret_t + ; checkAgainstF adts g ret_t ret + ; return (idSubst, (ret_t, ret)) } } +w l adts g (Var x) = case lookup x g of + Nothing -> throwError $ "Unknown var: " ++ (show x) + Just s -> do { (ret_t, vs) <- inst s + ; let ret = fTyApp (FVar x) $ map mTyToFTy vs + ; log0 l $ "VAR " ++ show g ++ "|- " ++ show ret ++ " : " ++ show ret_t + ; checkAgainstF adts g ret_t ret + ; return (idSubst, (ret_t, ret)) } +w l adts g (App e0 e1) = do { + ; (s0, (t0, a)) <- w (l+1) adts g e0 + ; (s1, (t1, b)) <- w (l+1) adts (subst s0 g) e1 + ; t' <- fresh + ; s2 <- (subst s1 t0) `mgu` (t1 `TyFn` t') + ; let ret = FApp (subst (s2 `o` s1) a) (subst s2 b) + ret_t = subst s2 t' + ret_subst = s2 `o` (s1 `o` s0); + ; log0 l $ "APP " ++ show (subst ret_subst g) ++ "|- " ++ show ret ++ " : " ++ show ret_t + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } +w l adts g (Abs x e) = do { + ; t <- fresh + ; (ret_subst, (t', a)) <- w (l+1) adts ((x, (Forall [] t)):g) e + ; let ret = FAbs x (mTyToFTy $ subst ret_subst t) a + ret_t = TyFn (subst ret_subst t) t' + ; log0 l $ "ABS " ++ show (subst ret_subst g) ++ "|- \\" ++ x ++ ". " ++ show ret ++ " : " ++ show ret_t + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } +w l adts g (Letrec xe0 e1) = do { + ; t0s <- mapM (\(k,v) -> do { f <- fresh; return (k, f) }) xe0 + ; let g' = map (\(k,v) -> (k, Forall [] v)) t0s ++ g + ; (s0, (ts,e0XS)) <- w' (l+1) g' xe0 + ; s' <- mgu' (map (\(_,v) -> subst s0 v) t0s) ts + ; let g'' = subst (s' `o` s0) g' + g''' = map (\(k,t) -> (k, fst $ gen g (subst s' t))) $ zip (fst $ unzip xe0) ts + ; (s1, (t',e1X)) <- w (l+1) adts (g''') e1 + ; let g''X = map (\(k,t) -> (k, gen g (subst (s') t))) $ zip (fst $ unzip xe0) ts + e0Xs = map (subst (s1 `o` s')) e0XS + mmm = map (\((x,(ww,ww2)),e0X)->(x, (fTyApp (FVar x) $ map FTyVar ww2))) $ zip g''X e0Xs + e0X's = map (\((x,(ww,ww2)),e0X)->(x,ww,ww2, subst'' mmm e0X)) $ zip g''X e0Xs + e0X''s = map (\(x,ww,ww2,e) -> (x,ww,ww2,fTyAbs ww2 e)) e0X's + bs = map (\(x,ww,ww2,e0X'') -> (x, subst s1 $ tyToFTy ww, subst (s' `o` s1) e0X'')) e0X''s + ret = FLetrec bs e1X + ret_t = t' + ret_subst = s1 `o` s' `o` s0 + ; log0 l $ "LETREC " ++ show (subst ret_subst g) ++ "|- " ++ show ret ++ " : " ++ show ret_t + ; checkAgainstF adts (subst ret_subst g) ret_t ret + ; return (ret_subst, (ret_t, ret)) } + where w' l g [] = return (idSubst, ([], [])) + w' l g ((k,v):tl) = do { (u,(u', j)) <- w l adts g v + ; (r,(r', h)) <- w' l (subst u g ) tl + ; return (r `o` u, ((subst r u'):r', (subst r j):h)) } + + +subst'' :: [(Var, FExpr)] -> FExpr -> FExpr +subst'' phi (FTuple es) = FTuple $ map (subst'' phi) es +subst'' phi (FConst c) = FConst c +subst'' phi (FVar v') = case lookup v' phi of + Just y -> y + Nothing -> FVar v' +subst'' phi (FApp a b) = FApp (subst'' phi a) (subst'' phi b) +subst'' phi (FAbs v' a b) = FAbs v' a $ subst'' phi' b + where phi' = filter (\(k,v) -> not (k == v')) phi +subst'' phi (FTyApp a ts) = FTyApp (subst'' phi a) ts +subst'' phi (FTyAbs vs a) = FTyAbs vs $ subst'' phi a +subst'' phi (FLetrec es e) = FLetrec (map (\(k,t,f)->(k,t,subst'' phi' f)) es) (subst'' phi' e) + where phi' = filter (\(k,v) -> not (elem k ns)) phi + (ns,ts,es') = unzip3 es + +---------------------------------------- +-- Main + +theAdts = theAdtsJosh ++ [("List", ["t"], [("Nil", []), ("Cons", [TyVar "t", TyCon "List" [TyVar "t"]])])] + +theAdtsJosh = [("LatLon1", [], [("MkLatLon1", [natType, natType])]), + ("LatLon2", [], [("MkLatLon2", [natType, natType])])] +{-- data LatLon1 = MkLatOn1 Nat Nat where lat1 (MkLatLon1 a) = a and lon1 (MkLatLon1 b) = b and also data LatLon2 = MkLatOn2 Nat Nat where lat2 (MkLatLon2 a ) = a and lon2 (MkLatLon2 b) = --} + +testJoshAdt = Letrec [("lat1", lat1)] body + where body = App (App (Const $ Con "MkLatLon1") (nat 0)) (nat 1) + lat1 = Abs "z" $ App (App (Const $ Fold "LatLon1") (Var "z")) $ Abs "p" $ Abs "q" $ (Var "p") + +testJoshAdt' = Letrec [("lat1", lat1)] $ App (Var "lat1") body + where body = App (App (Const $ Con "MkLatLon1") (nat 0)) (nat 1) + lat1 = Abs "z" $ App (App (Const $ Fold "LatLon1") (Var "z")) $ Abs "p" $ Abs "q" $ (Var "p") + +tests = [testJoshAdt, testJoshAdt'] -- testVariant2, testTuple2, testVariant, testTuple, test_j_0, test_j_0' , testJ, test4, testk, testC, testA, test0, test1, testB, test2, test3a, test5, test6] + +testk = Letrec [("f", f), ("g", g)] b + where b = Tuple [(Var "f"), (Var "g")] + f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x") + g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0) + +testJ = letrec' "f" i b + where i = Abs "x" (Var "x") + b = Var "f" + +testAdt = Abs "z" $ App (App (App (Const $ Fold "List") $ Var "z") (Const $ Con "Nil")) (Const $ Con "Cons") + +testOne t = do { putStrLn $ "Untyped input: " + ; putStrLn $ "\t" ++ show t + ; let out = runState (runExceptT (w 0 theAdts [] t)) ([],0) + ; case fst out of + Left e -> do { putStrLn $ "\t" ++ "err: " ++ e + ; putStrLn $ "\nLog:" + ; mapM_ (putStrLn) $ reverse $ fst $ snd out } + Right (s, (ty, f)) -> do { putStrLn $ "\nType inferred by Hindley-Milner: " + ; putStrLn $ "\t" ++ show ty + ; putStrLn "\nSystem F translation: " + ; putStrLn $ "\t" ++ show f + -- ; putStrLn "\nLog: " + -- ; mapM_ (putStrLn) $ reverse $ fst $ snd out + } + ; putStrLn "" + ; putStrLn "------------------------" + ; putStrLn "" } + +main = mapM testOne tests + +letrec' x e f = Letrec [(x,e)] f + +testVariant :: Expr +testVariant = Abs "z" $ Case' (Var "z") [f,g] + where f = Abs "x" {-- $ Inj 0 2 --} $ Var "x" + g = Abs "y" {-- $ Inj 1 2 --} $ Var "y" + -- t = Variant [f, g] + +testVariant2 :: Expr +testVariant2 = Abs "z" $ Case' (Var "z") [f,g] + where f = Abs "x" $ Inj 0 2 $ Var "x" + g = Abs "y" $ Inj 1 2 $ Var "y" + -- t = Variant [f, g] + +testTuple2 :: Expr +testTuple2 = Abs "z" $ Tuple [(Proj 0 2 $ Var "z"), (Proj 1 2 $ Var "z")] + +testTuple :: Expr +testTuple = Letrec [("t", t)] $ Tuple [Proj 1 2 $ Var "t", Proj 0 2 $ Var "t"] + where f = str "alice" + g = nat 0 + t = Tuple [f, g] + + +testA :: Expr +testA = letrec' "f" ( (Abs "x" (Var "x"))) $ App (Var "f") (nat 0) + where sng0 = App (Var "sng") (nat 0) + sngAlice = App (Var "sng") (str "alice") + body = (Var "sng") + +test0 :: Expr +test0 = letrec' "f" (App (Abs "x" (Var "x")) (nat 0)) (Var "f") + where sng0 = App (Var "sng") (nat 0) + sngAlice = App (Var "sng") (str "alice") + + +testB :: Expr +testB = letrec' "sng" (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil))) body + where + body = (Var "sng") + +test1 :: Expr +test1 = letrec' "sng" (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil))) body + where sng0 = App (Var "sng") (nat 0) + sngAlice = App (Var "sng") (str "alice") + body = App (App (Const Pair) sng0) sngAlice + +test2 :: Expr +test2 = letrec' "+" (Abs "x" $ Abs "y" $ recCall) twoPlusOne + where + recCall = App constSucc $ App (App (Var "+") (App constPred (Var "x"))) (Var "y") + ifz x y z = App (App (App (Const If0) x) y) z + twoPlusOne = App (App (Var "+") two) one + two = App constSucc one + one = App constSucc (nat 0) + +testC :: Expr +testC = letrec' "+" (Abs "x" $ Abs "y" $ recCall) $ twoPlusOne + where + recCall = App constSucc $ App (App (Var "+") (App constPred (Var "x"))) ( (Var "y")) + ifz x y z = App (App (App (Const If0) x) y) z + twoPlusOne = App (App (Var "+") two) one + two = App constSucc one + one = App constSucc (nat 0) + +test3 :: Expr +test3 = letrec' "f" f x + where x = (Var "f") + f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x") + +test3a :: Expr +test3a = Letrec [("f", f), ("g", g)] x + where x = App (App (Const $ Pair) (Var "f")) (Var "g") + f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x") + g = Abs "xx" $ Abs "yy" $ App (App (Var "g") (nat 0)) (Var "xx") + +test4 :: Expr +test4 = Letrec [("f", f), ("g", g)] b + where b = App (App (Const Pair) (Var "f")) (Var "g") + f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x") + g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0) + +test5 :: Expr +test5 = Letrec [("f", f), ("g", g)] b + where b = App (App (Const Pair) (Var "f")) (Var "g") + f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (nat 0) + g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0) + + +test6 :: Expr +test6 = Letrec [("f", f), ("g", g)] b + where b = App (App (Const Pair) (Var "f")) (Var "g") + f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x") + g = Abs "u" $ Abs "v" $ App (App (Var "f") (nat 0)) (nat 0) + + +x @@ y = App x y +zero = nat 0 + +test_j_o_haskell = f + where + sng = \x -> [x] + f = \x y -> (sng x, sng y): [] + g = \x y -> f 0 y + +-- @joshsh's additional test cases +test_j_0 :: Expr +test_j_0 = Letrec [("singleton", singleton), ("f", f), ("g", g)] $ Var "f" + where + singleton = Abs "x" $ Const Cons @@ Var "x" @@ Const Nil + f = Abs "x" $ Abs "y" $ Const Cons + @@ (Const Pair + @@ (Var "singleton" @@ Var "x") + @@ (Var "singleton" @@ Var "y")) + @@ (Var "g" @@ Var "x" @@ Var "y") + g = Abs "x" $ Abs "y" $ Var "f" @@ zero @@ Var "y" + +test_j_0' :: Expr +test_j_0' = Letrec [("singleton", singleton)] $ + Letrec [("f", f), ("g", g)] $ Var "f" + where + singleton = Abs "x" $ Const Cons @@ Var "x" @@ Const Nil + f = Abs "x" $ Abs "y" $ Const Cons + @@ (Const Pair + @@ (Var "singleton" @@ Var "x") + @@ (Var "singleton" @@ Var "y")) + @@ (Var "g" @@ Var "x" @@ Var "y") + g = Abs "x" $ Abs "y" $ Var "f" @@ zero @@ Var "y" + +--test_j_0 :: Expr +--test_j_0 = Let "id" i $ f + --where + -- i = Abs "z" $ Var "z" + -- f = Abs "p0" $ + -- (Const Pair) + -- @@ (Var "id" @@ Var "p0") + -- @@ (Var "p0") diff --git a/src/main/haskell/Hydra/Inference/AlgorithmWBridge.hs b/src/main/haskell/Hydra/Inference/AlgorithmWBridge.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Inference/AlgorithmWBridge.hs @@ -0,0 +1,274 @@ +-- | Wrapper for @wisnesky's Algorithm W implementation which makes it into an alternative inferencer for Hydra + +module Hydra.Inference.AlgorithmWBridge where + +import Hydra.Inference.AlgorithmW + +import qualified Hydra.Core as Core +import qualified Hydra.Graph as Graph +import qualified Hydra.Dsl.Literals as Literals +import qualified Hydra.Dsl.LiteralTypes as LiteralTypes +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types +import Hydra.Sources.Libraries +import Hydra.Basics +import Hydra.Strip +import Hydra.Tier1 +import Hydra.Coders +import Hydra.Inference.Substitution +import Hydra.Rewriting + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Control.Monad as CM + +import Control.Monad.Except +import Control.Monad.State + + +-- A minimal Hydra graph container for use in these translation functions +data HydraContext = HydraContext (M.Map Core.Name Graph.Primitive) + +---------------------------------------- + +-- | Find all of the bound variables in the type annotations within a System F term. +-- This function considers the types in "typed terms" (term:type), domain types on lambdas (\v:type.term), +-- and also type abstractions (/\v.term) to provide bound type variables. +boundTypeVariablesInSystemFTerm :: Core.Term -> [Core.Name] +boundTypeVariablesInSystemFTerm = L.nub . foldOverTerm TraversalOrderPost addTypeVars [] + where + addTypeVars vars term = typeVarsIn term ++ vars + typeVarsIn term = case term of + Core.TermFunction (Core.FunctionLambda (Core.Lambda _ (Just typ) _)) -> boundVariablesInTypeOrdered typ + Core.TermTypeAbstraction (Core.TypeAbstraction v _) -> [v] + Core.TermTyped (Core.TypedTerm term typ) -> boundVariablesInTypeOrdered typ + _ -> [] + +boundTypeVariablesInTermOrdered :: Core.Term -> [Core.Name] +boundTypeVariablesInTermOrdered = L.nub . foldOverTerm TraversalOrderPre fld [] + where + fld vars term = case term of + Core.TermTyped (Core.TypedTerm _ typ) -> variablesInTypeOrdered False typ ++ vars + _ -> vars + +-- | Finds all of the universal type variables in a type expression, in the order in which they appear. +-- Note: this function assumes that there are no shadowed type variables, as in (forall a. forall a. a) +-- TODO: redundant with variablesInTypeOrdered +boundVariablesInTypeOrdered :: Core.Type -> [Core.Name] +boundVariablesInTypeOrdered typ = case typ of + Core.TypeLambda (Core.LambdaType var body) -> var:(boundVariablesInTypeOrdered body) + t -> L.concat (boundVariablesInTypeOrdered <$> subtypes t) + +-- | Replace arbitrary bound type variables like v, a, v_12 with the systematic type variables t0, t1, t2, ... +-- following a canonical ordering in the term. +-- This function assumes that the bound variables do not also appear free in the type expressions of the term, +-- which in Hydra is made less likely by using the unusual naming convention tv_0, tv_1, etc. for temporary variables. +normalizeBoundTypeVariablesInSystemFTerm :: Core.Term -> Core.Term +normalizeBoundTypeVariablesInSystemFTerm term = replaceTypeVariablesInSystemFTerm subst term + where + actualVars = boundTypeVariablesInSystemFTerm term + subst = M.fromList $ L.zip actualVars normalVariables + +replaceTypeVariables :: M.Map Core.Name Core.Name -> Core.Type -> Core.Type +replaceTypeVariables subst = rewriteType $ \recurse t -> case recurse t of + Core.TypeVariable v -> Core.TypeVariable $ replace v + Core.TypeLambda (Core.LambdaType v body) -> Core.TypeLambda $ Core.LambdaType (replace v) body + t1 -> t1 + where + replace v = M.findWithDefault v v subst + +-- Note: this will replace all occurrences, regardless of boundness or shadowing +replaceTypeVariablesInSystemFTerm :: M.Map Core.Name Core.Name -> Core.Term -> Core.Term +replaceTypeVariablesInSystemFTerm subst = rewriteTerm $ \recurse term -> + case recurse term of + Core.TermFunction (Core.FunctionLambda (Core.Lambda v (Just mt) body)) -> + Core.TermFunction $ Core.FunctionLambda $ Core.Lambda v (Just mt2) body + where + mt2 = replaceTypeVariables subst mt + Core.TermTypeAbstraction (Core.TypeAbstraction v body) -> Core.TermTypeAbstraction $ Core.TypeAbstraction v2 body + where + v2 = M.findWithDefault v v subst + Core.TermTyped (Core.TypedTerm term typ) -> Core.TermTyped $ Core.TypedTerm term (replaceTypeVariables subst typ) + t -> t + +-- | Find the variables (both bound and free) in a type expression, following a preorder traversal of the expression. +variablesInTypeOrdered :: Bool -> Core.Type -> [Core.Name] +variablesInTypeOrdered onlyBound = L.nub . vars -- Note: we rely on the fact that 'nub' keeps the first occurrence + where + vars t = case t of + Core.TypeLambda (Core.LambdaType v body) -> v:(vars body) + Core.TypeVariable v -> if onlyBound then [] else [v] + _ -> L.concat (vars <$> subtypes t) + +---------------------------------------- + +-- Note: no support for @wisnesky's Prim constructors other than PrimStr, PrimNat, Cons, and Nil +hydraTermToStlc :: HydraContext -> Core.Term -> Either String Expr +hydraTermToStlc context term = case term of + Core.TermApplication (Core.Application t1 t2) -> App <$> toStlc t1 <*> toStlc t2 + Core.TermFunction f -> case f of + Core.FunctionLambda (Core.Lambda (Core.Name v) _ body) -> Abs <$> pure v <*> toStlc body + Core.FunctionPrimitive name -> do + prim <- case M.lookup name prims of + Nothing -> Left $ "no such primitive: " ++ Core.unName name + Just p -> Right p + ts <- hydraTypeSchemeToStlc $ Graph.primitiveType prim + return $ Const $ TypedPrim $ TypedPrimitive name ts + Core.TermLet (Core.Let bindings env) -> Letrec <$> CM.mapM bindingToStlc bindings <*> toStlc env + where + bindingToStlc (Core.LetBinding (Core.Name v) term _) = do + s <- toStlc term + return (v, s) + Core.TermList els -> do + sels <- CM.mapM toStlc els + return $ foldr (\el acc -> App (App (Const Cons) el) acc) (Const Nil) sels + Core.TermLiteral lit -> pure $ Const $ Lit lit + Core.TermProduct els -> Tuple <$> (CM.mapM toStlc els) + Core.TermVariable (Core.Name v) -> pure $ Var v + _ -> Left $ "Unsupported term: " ++ show term + where + HydraContext prims = context + toStlc = hydraTermToStlc context + pair a b = App (App (Const Pair) a) b + +hydraTypeSchemeToStlc :: Core.TypeScheme -> Either String TypSch +hydraTypeSchemeToStlc (Core.TypeScheme vars body) = do + sbody <- toStlc body + return $ Forall (Core.unName <$> vars) sbody + where + toStlc typ = case stripType typ of + Core.TypeFunction (Core.FunctionType dom cod) -> TyFn <$> toStlc dom <*> toStlc cod + Core.TypeList et -> TyList <$> toStlc et + Core.TypeLiteral lt -> pure $ TyLit lt +-- TypeMap MapType | +-- TypeOptional Type | + Core.TypeProduct types -> TyTuple <$> (CM.mapM toStlc types) +-- TypeRecord RowType | +-- TypeSet Type | +-- TypeStream Type | + Core.TypeSum types -> if L.length types == 0 + then pure TyVoid + else if L.length types == 1 + then Left $ "unary sums are not yet supported" + else do + stypes <- CM.mapM toStlc types + let rev = L.reverse stypes + return $ L.foldl (\a e -> TySum e a) (TySum (rev !! 1) (rev !! 0)) $ L.drop 2 rev +-- TypeUnion RowType | + Core.TypeVariable name -> pure $ TyVar $ Core.unName name +-- TypeWrap (Nominal Type) + _ -> Left $ "unsupported type: " ++ show typ + + +-- hydraTypeToTypeScheme :: Core.Type -> Either String TypSch +-- hydraTypeToTypeScheme typ = do +-- let (boundVars, baseType) = splitBoundVars [] typ +-- ty <- toStlc baseType +-- return $ Forall (Core.unName <$> boundVars) ty +-- where +-- splitBoundVars vars typ = case stripType typ of +-- Core.TypeLambda (Core.LambdaType v body) -> (v:vars', typ') +-- where +-- (vars', typ') = splitBoundVars vars body +-- _ -> (vars, typ) + +systemFExprToHydra :: FExpr -> Either String Core.Term +systemFExprToHydra expr = case expr of + FConst prim -> case prim of + Lit lit -> pure $ Core.TermLiteral lit + TypedPrim (TypedPrimitive name _) -> pure $ Core.TermFunction $ Core.FunctionPrimitive name + Nil -> pure $ Core.TermList [] + _ -> Left $ "Unsupported primitive: " ++ show prim + -- Note: other prims are unsupported + FVar v -> pure $ Core.TermVariable $ Core.Name v + FApp e1 e2 -> case e1 of + FApp (FTyApp (FConst Cons) _) hd -> do + els <- CM.mapM systemFExprToHydra (hd:(gather e2)) + return $ Core.TermList els -- TODO: include inferred type + where + gather e = case e of + FTyApp (FConst Nil) _ -> [] + FApp (FApp (FTyApp (FConst Cons) _) hd) tl -> hd:(gather tl) + FTyApp (FConst Pair) _ -> do +-- els <- CM.mapM systemFExprToHydra (gather expr) + els <- pure [] + return $ Core.TermProduct els -- TODO: include inferred type + where + gather e = case e of + FApp (FApp (FTyApp (FConst Pair) _) el) arg -> el:(gather arg) + _ -> [e] + _ -> Core.TermApplication <$> (Core.Application <$> systemFExprToHydra e1 <*> systemFExprToHydra e2) + FAbs v dom e -> do + term <- systemFExprToHydra e + hdom <- Core.typeSchemeType <$> systemFTypeToHydra dom + return $ Core.TermFunction $ Core.FunctionLambda (Core.Lambda (Core.Name v) (Just hdom) term) + FTyAbs params body -> do + hbody <- systemFExprToHydra body + return $ L.foldl (\t v -> Core.TermTypeAbstraction $ Core.TypeAbstraction (Core.Name v) t) hbody $ L.reverse params + FTyApp fun args -> do + hfun <- systemFExprToHydra fun + hargs <- CM.mapM (\t -> Core.typeSchemeType <$> systemFTypeToHydra t) args + return $ L.foldl (\t a -> Core.TermTypeApplication $ Core.TypedTerm t a) hfun $ L.reverse hargs + FLetrec bindings env -> Core.TermLet <$> + (Core.Let <$> CM.mapM bindingToHydra bindings <*> systemFExprToHydra env) + where + bindingToHydra (v, ty, term) = do + hterm <- systemFExprToHydra term + hts <- systemFTypeToHydra ty + return $ Core.LetBinding (Core.Name v) hterm $ Just hts + FTuple els -> Core.TermProduct <$> (CM.mapM systemFExprToHydra els) + FInj i types e -> Core.TermSum <$> (Core.Sum i (L.length types) <$> systemFExprToHydra e) + +systemFTypeToHydra :: FTy -> Either String Core.TypeScheme +systemFTypeToHydra ty = case ty of + FForall vars body -> Core.TypeScheme (Core.Name <$> vars) <$> toHydra body + _ -> Core.TypeScheme [] <$> toHydra ty + where + toHydra ty = case ty of + FTyVar v -> pure $ Core.TypeVariable $ Core.Name v + FTyLit lt -> pure $ Core.TypeLiteral lt + FTyList lt -> Core.TypeList <$> toHydra lt + FTyFn dom cod -> Core.TypeFunction <$> (Core.FunctionType <$> toHydra dom <*> toHydra cod) + FTyProd t1 t2 -> Core.TypeProduct <$> CM.mapM toHydra (t1:(componentsTypesOf t2)) + where + componentsTypesOf t = case t of + FTyProd t1 t2 -> t1:(componentsTypesOf t2) + _ -> [t] + FTySum t1 t2 -> Core.TypeSum <$> CM.mapM toHydra (t1:(componentsTypesOf t2)) + where + componentsTypesOf t = case t of + FTySum t1 t2 -> t1:(componentsTypesOf t2) + _ -> [t] + FTyUnit -> pure $ Core.TypeProduct [] + FTyVoid -> pure $ Core.TypeSum [] + FTyTuple tys -> Core.TypeProduct <$> (CM.mapM toHydra tys) + FTyVariant tys -> Core.TypeSum <$> (CM.mapM toHydra tys) + +inferWithAlgorithmW :: HydraContext -> Core.Term -> IO Core.Term +inferWithAlgorithmW context term = do + stlc <- case hydraTermToStlc context (wrap term) of + Left err -> fail err + Right t -> return t + (fexpr, _) <- inferExpr stlc + case systemFExprToHydra fexpr of + Left err -> fail err + Right t -> normalizeBoundTypeVariablesInSystemFTerm <$> unwrap t + where + sFieldName = Core.Name "tempVar" + wrap term = Core.TermLet $ Core.Let ([Core.LetBinding sFieldName term Nothing]) $ + Core.TermLiteral $ Core.LiteralString "tempEnvironment" + unwrap term = case term of + Core.TermLet (Core.Let bindings _) -> case bindings of + [(Core.LetBinding fname t _)] -> if fname == sFieldName + then pure t + else fail "expected let binding matching input" + _ -> fail "expected let bindings" + +inferExpr :: Expr -> IO (FExpr, FTy) +inferExpr t = case (fst $ runState (runExceptT (w 0 [] [] t)) ([],0)) of + Left e -> fail $ "inference error: " ++ e + Right (_, (ty, f)) -> case (typeOf [] [] [] f) of + Left err -> fail $ "type error: " ++ err + Right tt -> if tt == mTyToFTy ty + then return (f, tt) + else fail "no match" diff --git a/src/main/haskell/Hydra/Inference/AltInference.hs b/src/main/haskell/Hydra/Inference/AltInference.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Inference/AltInference.hs @@ -0,0 +1,518 @@ +module Hydra.Inference.AltInference where + +import Hydra.Basics +import Hydra.Core +import Hydra.Compute +import Hydra.Mantle +import qualified Hydra.Flows as F +import qualified Hydra.Tier1 as Tier1 +import qualified Hydra.Lib.Flows as Flows +import qualified Hydra.Dsl.Types as Types + +import qualified Data.List as L +import qualified Data.Map as M + + +-------------------------------------------------------------------------------- +-- Graphs + +showType :: Type -> String +showType (TypeFunction (FunctionType dom cod)) = "(" ++ showType dom ++ "→" ++ showType cod ++ ")" +showType (TypeList etyp) = "[" ++ showType etyp ++ "]" +showType (TypeLiteral lit) = show lit +showType (TypeMap (MapType keyTyp valTyp)) = "map<" ++ showType keyTyp ++ "," ++ showType valTyp ++ ">" +showType (TypeProduct types) = "(" ++ (L.intercalate "," (fmap showType types)) ++ ")" +showType (TypeVariable (Name name)) = name + +showTypeScheme :: TypeScheme -> String +showTypeScheme (TypeScheme vars body) = "∀[" ++ (L.intercalate "," (fmap (\(Name name) -> name) vars)) ++ "]." ++ showType body + +showConstraint :: TypeConstraint -> String +showConstraint (TypeConstraint ltyp rtyp _) = showType ltyp ++ "≡" ++ showType rtyp + +-------------------------------------------------------------------------------- +-- Unification + +type UnificationContext = Maybe String + +data SUnificationError + = SUnificationErrorCannotUnify Type Type UnificationContext + | SUnificationErrorOccursCheckFailed Name Type UnificationContext + deriving (Eq, Ord, Show) + +sOccursIn :: Name -> Type -> Bool +sOccursIn var typ = case typ of + TypeFunction (FunctionType domTyp codTyp) -> sOccursIn var domTyp || sOccursIn var codTyp + TypeList etyp -> sOccursIn var etyp + TypeLiteral _ -> False + TypeMap (MapType keyTyp valTyp) -> sOccursIn var keyTyp || sOccursIn var valTyp + TypeProduct types -> any (sOccursIn var) types + TypeVariable name -> var == name + +-- sComposeSubst :: SSubst -> SSubst -> SSubst +-- sComposeSubst s1 s2 = ... + +{- +Robinson's algorithm, following https://www.cs.cornell.edu/courses/cs6110/2017sp/lectures/lec23.pdf +Specifically this is an implementation of the following rules: + * Unify({(x, t)} ∪ E) = {t/x} Unify(E{t/x}) if x ∉ FV(t) + * Unify(∅) = I (the identity substitution x ↦ x) + * Unify({(x, x)} ∪ E) = Unify(E) + * Unify({(f(s1, ..., sn), f(t1, ..., tn))} ∪ E) = Unify({(s1, t1), ..., (sn, tn)} ∪ E) +-} +uUnify :: [TypeConstraint] -> Either SUnificationError SSubst +-- uUnify = L.foldl helper sEmptySubst +-- where +-- helper s (TypeConstraint t1 t2 ctx) = case t1 of +-- TypeVariable v1 -> case t2 of +-- TypeVariable v2 -> if v1 == v2 +-- then Right s +-- else uBind v1 t2 +-- _ -> unifyVar s v1 t2 +-- _ -> case t2 of +-- TypeVariable v2 -> unifyVar v2 t1 +-- _ -> unifyOther s t1 t2 +-- unifyVar s v t = if sOccursIn v t -- TODO: expensive occurs check +-- then Left $ SUnificationErrorOccursCheckFailed v t ctx +-- else Right $ M.singleton v t +-- unifyOther s t1 t2 = ... +uUnify constraints = case constraints of + [] -> Right sEmptySubst + ((TypeConstraint t1 t2 ctx):rest) -> case t1 of + TypeVariable v1 -> case t2 of + TypeVariable v2 -> if v1 == v2 + then uUnify rest + else uBind v1 t2 + _ -> uBind v1 t2 + _ -> case t2 of + TypeVariable v2 -> uBind v2 t1 + _ -> uUnifyOther t1 t2 + where + -- TODO: this occurs check is expensive; consider delaying it until the time of substitution + uBind v t = if sOccursIn v t + then Left $ SUnificationErrorOccursCheckFailed v t ctx + else case uUnify (L.map (uSubstInConstraint v t) rest) of + Left err -> Left err + Right subst -> Right $ SSubst $ M.union (M.singleton v $ sSubstituteTypeVariables subst t) $ sUnSubst subst + uUnifyOther t1 t2 = case t1 of + TypeFunction (FunctionType dom1 cod1) -> case t2 of + TypeFunction (FunctionType dom2 cod2) -> uUnify $ [ + (TypeConstraint dom1 dom2 ctx), (TypeConstraint cod1 cod2 ctx)] ++ rest + _ -> cannotUnify + TypeList l1 -> case t2 of + TypeList l2 -> uUnify $ [(TypeConstraint l1 l2 ctx)] ++ rest + _ -> cannotUnify + TypeLiteral lit1 -> case t2 of + TypeLiteral lit2 -> if lit1 == lit2 + then uUnify rest + else cannotUnify + _ -> cannotUnify + TypeMap (MapType key1 val1) -> case t2 of + TypeMap (MapType key2 val2) -> uUnify $ [ + (TypeConstraint key1 key2 ctx), (TypeConstraint val1 val2 ctx)] ++ rest + _ -> cannotUnify + TypeProduct types1 -> case t2 of + TypeProduct types2 -> if L.length types1 /= L.length types2 + then cannotUnify + else uUnify $ L.zipWith (\t1 t2 -> TypeConstraint t1 t2 ctx) types1 types2 ++ rest + _ -> cannotUnify + where + cannotUnify = Left $ SUnificationErrorCannotUnify t1 t2 ctx + +-- TODO: substituting one variable at a time is inefficient +uSubst :: Name -> Type -> Type -> Type +uSubst v t typ = case typ of + TypeFunction (FunctionType dom cod) -> TypeFunction $ FunctionType (uSubst v t dom) (uSubst v t cod) + TypeList etyp -> TypeList $ uSubst v t etyp + TypeLiteral _ -> typ + TypeMap (MapType key val) -> TypeMap $ MapType (uSubst v t key) (uSubst v t val) + TypeProduct types -> TypeProduct $ fmap (uSubst v t) types + TypeVariable name -> if name == v then t else typ + +uSubstInConstraint :: Name -> Type -> TypeConstraint -> TypeConstraint +uSubstInConstraint v t (TypeConstraint t1 t2 ctx) = TypeConstraint (uSubst v t t1) (uSubst v t t2) ctx + +-------------------------------------------------------------------------------- +-- Substitution + +data SSubst = SSubst { sUnSubst :: M.Map Name Type } + +instance Show SSubst where + show (SSubst subst) = "{" ++ L.intercalate ", " (fmap (\((Name k), v) -> k ++ ": " ++ showType v) $ M.toList subst) ++ "}" + +sEmptySubst = SSubst M.empty + +sSubstituteTypeVariables :: SSubst -> Type -> Type +sSubstituteTypeVariables subst typ = case typ of + TypeFunction (FunctionType dom cod) -> TypeFunction $ + FunctionType (sSubstituteTypeVariables subst dom) (sSubstituteTypeVariables subst cod) + TypeList etyp -> TypeList $ sSubstituteTypeVariables subst etyp + TypeLiteral _ -> typ + TypeMap (MapType key val) -> TypeMap $ + MapType (sSubstituteTypeVariables subst key) (sSubstituteTypeVariables subst val) + TypeProduct types -> TypeProduct $ fmap (sSubstituteTypeVariables subst) types + TypeVariable name -> case M.lookup name (sUnSubst subst) of + Just styp -> styp + Nothing -> typ + +-- TODO: remove unused bound type variables +sSubstituteTypeVariablesInScheme :: SSubst -> TypeScheme -> TypeScheme +sSubstituteTypeVariablesInScheme subst (TypeScheme vars typ) = TypeScheme vars $ sSubstituteTypeVariables subst typ + + +-------------------------------------------------------------------------------- +-- Inference + +data SInferenceContext + = SInferenceContext { + sInferenceContextLexicon :: M.Map Name TypeScheme, + sInferenceContextVariableCount :: Int, + sInferenceContextTypingEnvironment :: M.Map Name TypeScheme} + deriving (Eq, Ord, Show) + +data SInferenceResult + = SInferenceResult { + sInferenceResultScheme :: TypeScheme, + sInferenceResultConstraints :: [TypeConstraint]} + deriving (Eq, Ord) +instance Show SInferenceResult where + show (SInferenceResult scheme constraints) = "{type= " ++ showTypeScheme scheme ++ ", constraints= " ++ show constraints ++ "}" + +sInferType :: Term -> Flow SInferenceContext TypeScheme +sInferType term = Flows.bind (sInferTypeInternal term) unifyAndSubst + where + unifyAndSubst :: SInferenceResult -> Flow SInferenceContext TypeScheme + unifyAndSubst result = Flows.bind (F.fromEither $ uUnify $ sInferenceResultConstraints result) doSubst + where + doSubst :: SSubst -> Flow SInferenceContext TypeScheme + doSubst subst = sInstantiateAndNormalize $ sSubstituteTypeVariablesInScheme subst $ sInferenceResultScheme result + +sInferTypeInternal :: Term -> Flow SInferenceContext SInferenceResult +sInferTypeInternal term = case term of + + TermApplication (Application lterm rterm) -> Flows.bind sNewVar withVar1 + where + withVar1 dom = Flows.bind sNewVar withVar2 + where + withVar2 cod = Flows.bind (sInferTypeInternal lterm) withLeft + where + withLeft lresult = Flows.bind (sInferTypeInternal rterm) withRight + where + withRight rresult = Flows.pure $ SInferenceResult (TypeScheme tvars $ TypeVariable cod) $ [ + TypeConstraint (Types.function (TypeVariable dom) (TypeVariable cod)) ltyp ctx, + TypeConstraint (TypeVariable dom) rtyp ctx] + ++ sInferenceResultConstraints lresult ++ sInferenceResultConstraints rresult + where + ctx = Just "application" + ltyp = typeSchemeType $ sInferenceResultScheme lresult + rtyp = typeSchemeType $ sInferenceResultScheme rresult + tvars = typeSchemeVariables (sInferenceResultScheme lresult) ++ typeSchemeVariables (sInferenceResultScheme rresult) + + TermFunction (FunctionLambda (Lambda var _ body)) -> Flows.bind sNewVar withVar + where + withVar tvar = sWithTypeBinding var (Types.mono $ TypeVariable tvar) $ Flows.map withBodyType (sInferTypeInternal body) + where + -- TODO: prove that tvar will never appear in vars + withBodyType (SInferenceResult (TypeScheme vars t) constraints) + = SInferenceResult (TypeScheme (tvar:vars) $ Types.function (TypeVariable tvar) t) constraints + + -- TODO: propagate rawValueVars and envVars into the final result, possibly after substitution + -- TODO: recursive and mutually recursive let + TermLet (Let bindings env) -> if L.length bindings > 2 + then sInferTypeInternal $ TermLet (Let [L.head bindings] $ TermLet $ Let (L.tail bindings) env) + else forSingleBinding $ L.head bindings + where + forSingleBinding (LetBinding key value _) = Flows.bind sNewVar withVar + where + -- Create a temporary type variable for the binding + withVar var = sWithTypeBinding key (Types.mono $ TypeVariable var) $ + Flows.bind (sInferTypeInternal value) withValueType + where + -- Unify and substitute over the value constraints + -- TODO: save the substitution and pass it along, instead of the original set of constraints + withValueType (SInferenceResult rawValueScheme valueConstraints) = Flows.bind (F.fromEither $ uUnify kvConstraints) afterUnification + where + rawValueVars = typeSchemeVariables rawValueScheme + kvConstraints = keyConstraint:valueConstraints + keyConstraint = TypeConstraint (TypeVariable var) (typeSchemeType rawValueScheme) $ Just "let binding" + -- Now update the type binding to use the inferred type + afterUnification subst = sWithTypeBinding key valueScheme + $ Flows.map withEnvType (sInferTypeInternal env) + where + valueScheme = sSubstituteTypeVariablesInScheme subst rawValueScheme + withEnvType (SInferenceResult envScheme envConstraints) = SInferenceResult envScheme constraints + where + constraints = kvConstraints ++ envConstraints + envVars = typeSchemeVariables envScheme + + TermList els -> Flows.bind sNewVar withVar + where + withVar tvar = if L.null els + then Flows.pure $ yield (TypeScheme [tvar] $ Types.list $ TypeVariable tvar) [] + else Flows.map fromResults (Flows.sequence (sInferTypeInternal <$> els)) + where + fromResults results = yield (TypeScheme vars $ Types.list $ TypeVariable tvar) constraints + where + uctx = Just "list element" + constraints = cinner ++ couter + cinner = L.concat (sInferenceResultConstraints <$> results) + couter = fmap (\t -> TypeConstraint (TypeVariable tvar) t uctx) types + types = typeSchemeType . sInferenceResultScheme <$> results + vars = L.concat (typeSchemeVariables . sInferenceResultScheme <$> results) + + TermLiteral lit -> Flows.pure $ yieldWithoutConstraints $ Types.mono $ TypeLiteral $ literalType lit + + TermMap m -> Flows.bind sNewVar withKeyVar + where + withKeyVar kvar = Flows.bind sNewVar withValueVar + where + withValueVar vvar = if M.null m + then Flows.pure $ yield (TypeScheme [kvar, vvar] $ Types.map (TypeVariable kvar) (TypeVariable vvar)) [] + else Flows.map withResults (Flows.sequence $ fmap fromPair $ M.toList m) + where + fromPair (k, v) = Flows.bind (sInferTypeInternal k) withKeyType + where + withKeyType (SInferenceResult (TypeScheme kvars kt) kconstraints) = Flows.map withValueType (sInferTypeInternal v) + where + withValueType (SInferenceResult (TypeScheme vvars vt) vconstraints) + = (kvars ++ vvars, + [TypeConstraint (TypeVariable kvar) kt $ Just "map key", + TypeConstraint (TypeVariable vvar) vt $ Just "map value"] + ++ kconstraints ++ vconstraints) + withResults pairs = yield (TypeScheme (L.concat (fst <$> pairs)) $ Types.map (TypeVariable kvar) (TypeVariable vvar)) $ + L.concat (snd <$> pairs) + + TermFunction (FunctionPrimitive name) -> Flow $ \ctx t -> case M.lookup name (sInferenceContextLexicon ctx) of + Just scheme -> unFlow (Flows.map withoutConstraints $ sInstantiate scheme) ctx t + Nothing -> unFlow (Flows.fail $ "No such primitive: " ++ unName name) ctx t + + TermProduct els -> if L.null els + then Flows.pure $ yield (Types.mono $ Types.product []) [] + else Flows.map fromResults (Flows.sequence (sInferTypeInternal <$> els)) + where + fromResults results = yield (TypeScheme tvars $ TypeProduct tbodies) constraints + where + tvars = L.concat $ typeSchemeVariables . sInferenceResultScheme <$> results + tbodies = typeSchemeType . sInferenceResultScheme <$> results + constraints = L.concat $ sInferenceResultConstraints <$> results + + TermVariable var -> Flow $ \ctx t -> case M.lookup var (sInferenceContextTypingEnvironment ctx) of + Just scheme -> unFlow (Flows.map withoutConstraints $ sInstantiate scheme) ctx t + Nothing -> unFlow (Flows.fail $ "Variable not bound to type: " ++ unName var) ctx t + + where + unsupported = Flows.fail "Not yet supported" + yield = SInferenceResult + yieldWithoutConstraints scheme = yield scheme [] + withoutConstraints scheme = SInferenceResult scheme [] + +sInstantiate :: TypeScheme -> Flow SInferenceContext TypeScheme +sInstantiate scheme = Flows.map doSubst (sNewVars $ L.length oldVars) + where + doSubst newVars = TypeScheme newVars $ sSubstituteTypeVariables subst $ typeSchemeType scheme + where + subst = SSubst $ M.fromList $ L.zip oldVars (TypeVariable <$> newVars) + oldVars = L.intersect (L.nub $ typeSchemeVariables scheme) (sFreeTypeVariables $ typeSchemeType scheme) + +sInstantiateAndNormalize :: TypeScheme -> Flow SInferenceContext TypeScheme +sInstantiateAndNormalize scheme = Flows.map sNormalizeTypeVariables (sInstantiate scheme) + +sFreeTypeVariables :: Type -> [Name] +sFreeTypeVariables typ = case typ of + TypeFunction (FunctionType dom cod) -> L.nub $ sFreeTypeVariables dom ++ sFreeTypeVariables cod + TypeList t -> sFreeTypeVariables t + TypeLiteral _ -> [] + TypeMap (MapType k v) -> L.nub $ sFreeTypeVariables k ++ sFreeTypeVariables v + TypeProduct types -> L.nub $ L.concat $ sFreeTypeVariables <$> types + TypeVariable name -> [name] + +sNormalizeTypeVariables :: TypeScheme -> TypeScheme +sNormalizeTypeVariables scheme = TypeScheme newVars $ sSubstituteTypeVariables subst $ typeSchemeType scheme + where + normalVariables = (\n -> Name $ "t" ++ show n) <$> [0..] + oldVars = typeSchemeVariables scheme + newVars = L.take (L.length oldVars) normalVariables + subst =SSubst $ M.fromList $ L.zip oldVars (TypeVariable <$> newVars) + +sNewVar :: Flow SInferenceContext Name +sNewVar = Flows.map L.head (sNewVars 1) + +sNewVars :: Int -> Flow SInferenceContext [Name] +sNewVars n = Flow helper + where + helper ctx t = FlowState value ctx' t + where + value = Just ((\n -> Name $ "t" ++ show n) <$> (L.take n [(sInferenceContextVariableCount ctx)..])) + ctx' = ctx {sInferenceContextVariableCount = n + sInferenceContextVariableCount ctx} + +sVarScheme :: Name -> TypeScheme +sVarScheme v = TypeScheme [v] $ TypeVariable v + +-- | Temporarily add a (term variable, type scheme) to the typing environment +sWithTypeBinding :: Name -> TypeScheme -> Flow SInferenceContext a -> Flow SInferenceContext a +sWithTypeBinding name scheme f = Flow helper + where + helper ctx0 t0 = FlowState e ctx3 t1 + where + env = sInferenceContextTypingEnvironment ctx0 + ctx1 = ctx0 {sInferenceContextTypingEnvironment = M.insert name scheme env} + FlowState e ctx2 t1 = unFlow f ctx1 t0 + ctx3 = ctx2 {sInferenceContextTypingEnvironment = env} + + +-------------------------------------------------------------------------------- +-- Testing + +_app l r = TermApplication $ Application l r +_int = TermLiteral . LiteralInteger . IntegerValueInt32 +_lambda v b = TermFunction $ FunctionLambda $ Lambda (Name v) Nothing b +_list = TermList +_map = TermMap +_pair l r = TermProduct [l, r] +_str = TermLiteral . LiteralString +_var = TermVariable . Name + +(@@) :: Term -> Term -> Term +f @@ x = TermApplication $ Application f x + +infixr 0 >: +(>:) :: String -> Term -> (Name, Term) +n >: t = (Name n, t) + +int32 = TermLiteral . LiteralInteger . IntegerValueInt32 +lambda v b = TermFunction $ FunctionLambda $ Lambda (Name v) Nothing b +list = TermList +map = TermMap +pair l r = TermProduct [l, r] +string = TermLiteral . LiteralString +var = TermVariable . Name +with env bindings = L.foldl (\e (k, v) -> TermLet $ Let [LetBinding k v Nothing] e) env bindings + + + + +infixr 0 === +(===) :: Type -> Type -> TypeConstraint +t1 === t2 = TypeConstraint t1 t2 $ Just "some context" + + +_add = TermFunction $ FunctionPrimitive $ Name "add" +primPred = TermFunction $ FunctionPrimitive $ Name "primPred" +primSucc = TermFunction $ FunctionPrimitive $ Name "primSucc" + +_unify t1 t2 = uUnify [TypeConstraint t1 t2 $ Just "ctx"] + +sTestLexicon = M.fromList [ + (Name "add", Types.mono $ Types.function Types.int32 Types.int32), + (Name "primPred", Types.mono $ Types.function Types.int32 Types.int32), + (Name "primSucc", Types.mono $ Types.function Types.int32 Types.int32)] + +sInitialContext = SInferenceContext sTestLexicon 0 M.empty + +_infer term = flowStateValue $ unFlow (sInferType term) sInitialContext Tier1.emptyTrace + +_inferRaw term = flowStateValue $ unFlow (sInferTypeInternal term) sInitialContext Tier1.emptyTrace + +_instantiate scheme = flowStateValue $ unFlow (sInstantiate scheme) sInitialContext Tier1.emptyTrace + +_con t1 t2 = TypeConstraint t1 t2 $ Just "ctx" + + + +{- + +---------------------------------------- +-- Unification + +_unify (Types.var "a") (Types.var "b") +_unify (Types.var "a") (Types.list $ Types.var "b") + +_unify (Types.var "a") Types.int32 + +_unify (Types.list Types.string) (Types.list $ Types.var "a") + +_unify (Types.map (Types.var "a") Types.int32) (Types.map Types.string (Types.var "b")) + +sUnifyAll [Types.var "t1" === Types.var "t0", Types.var "t1" === Types.int32] + +-- Failure cases + +_unify Types.string Types.int32 + +_unify (Types.var "a") (Types.list $ Types.var "a") + +ctx = Just "ctx" +uUnify [(TypeConstraint (Types.var "t1") (Types.var "t0") ctx), (TypeConstraint (Types.var "t1") Types.int32 ctx)] + + +---------------------------------------- +-- Inference + +_infer $ _str "hello" + +_infer _add + +_infer $ _list [_add] + +_infer $ _lambda "x" $ _int 42 + +_infer $ _list [_int 42] + + + + +_inferRaw (_list [_int 42]) + + + +:module +import Hydra.NewInference + +-- System F cases +_inferRaw (lambda "x" $ var "x") -- (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.var "t0")) +_inferRaw (int32 32 `with` ["foo">: lambda "x" $ var "x"]) -- (Types.mono Types.int32) +_inferRaw ((var "f" @@ int32 0) `with` ["f">: lambda "x" $ var "x"]) -- (Types.mono Types.int32) +_inferRaw (var "f" `with` ["f">: (lambda "x" $ var "x") @@ int32 0]) -- (Types.mono Types.int32) +_inferRaw (lambda "x" $ list [var "x"]) -- (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0"))) +_inferRaw (var "sng" `with` ["sng">: lambda "x" $ list [var "x"]]) -- (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0"))) +_inferRaw ((var "+" @@ (primSucc @@ (primSucc @@ int32 0)) @@ (primSucc @@ int32 0)) `with` ["+">: lambda "x" $ lambda "y" (primSucc @@ (var "+" @@ (primPred @@ var "x") @@ var "y"))]) -- (Types.mono Types.int32) +_inferRaw (var "f" `with` ["f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")]) -- (Types.poly ["t0"] $ Types.function Types.int32 (Types.function Types.int32 (Types.var "t0"))) + + + +_inferRaw (var "f" `with` ["f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")]) -- (Types.poly ["t0"] $ Types.function Types.int32 (Types.function Types.int32 (Types.var "t0"))) + + + +:set +m + +constraints = [ + _con (Types.function (Types.var "t5") (Types.var "t6")) (Types.var "t0"), + _con (Types.var "t5") Types.int32, + _con (Types.function (Types.var "t3") (Types.var "t4")) (Types.var "t6"), + _con (Types.var "t3") (Types.var "t1"), + _con (Types.var "t0") (Types.function (Types.var "t1") (Types.function (Types.var "t2") (Types.var "t4")))] + +uUnify constraints + + + + +_inferRaw (_lambda "x" $ _list [_var "x", _int 42]) + +_inferRaw (_lambda "y" (_a (_lambda "x" $ _list [_var "x"]) (_var "y"))) + + + + +_inferRaw (var "sng" `with` ["sng">: lambda "x" $ list [var "x"]]) + + +---------------------------------------- +-- Instantiation + +sInstantiate (Types.poly ["t0", "t1"] $ Types.function (Types.var "t1") (Types.var "t1")) sInitialContext + + + +-} diff --git a/src/main/haskell/Hydra/Inference/Inference.hs b/src/main/haskell/Hydra/Inference/Inference.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Inference/Inference.hs @@ -0,0 +1,140 @@ +-- | Entry point for Hydra type inference, which is a variation on on Hindley-Milner + +module Hydra.Inference.Inference ( + inferTermType, + inferGraphTypes, + inferredTypeOf, + inferTypeScheme, + inferTypeAndConstraints, + withInferenceContext, +) where + +import Hydra.Compute +import Hydra.Core +import Hydra.CoreEncoding +import Hydra.Graph +import Hydra.Lexical +import Hydra.Mantle +import Hydra.Annotations +import Hydra.Rewriting +import Hydra.Inference.Substitution +import Hydra.Unification +import Hydra.Inference.Rules +import Hydra.Tier1 +import Hydra.Tier2 +import Hydra.Tools.Sorting +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +annotateElements :: Graph -> [Element] -> Flow Graph [Element] +annotateElements g sortedEls = withInferenceContext $ do + iels' <- annotate sortedEls ([]) + let iels = fst <$> iels' + let constraints = snd <$> iels' + + -- Note: inference occurs over the entire graph at once, + -- but unification and substitution occur within elements in isolation + subst <- withSchemaContext $ CM.mapM solveConstraints constraints + return $ L.zipWith rewriteElement subst iels + where + -- Note: the following defaults to user-provided type annotations where provided. + -- In the future, we should trust unification to perform this defaulting, and not override the inferred type. + rewriteElement subst el = el { elementData = setTermType (Just typ) term1 } + where + term0 = elementData el + term1 = rewriteDataType (substituteInType subst) term0 + typ = Y.fromMaybe (termType term1) $ getTermType term0 + + annotate :: [Element] -> [(Element, [TypeConstraint])] -> Flow Graph [(Element, [TypeConstraint])] + annotate original annotated = case original of + [] -> pure $ L.reverse annotated + (el:r) -> do + (Inferred iel t c1) <- inferElementType el + withBinding (elementName el) (monotype t) $ annotate r ((iel, c1):annotated) + +inferTermType :: Term -> Flow Graph Term +inferTermType term0 = do + (term1, _) <- inferTypeAndConstraints term0 + return term1 + +inferElementType :: Element -> Flow Graph (Inferred Element) +inferElementType el = withTrace ("infer type of " ++ unName (elementName el)) $ do + (Inferred iterm t c) <- infer $ elementData el + return (Inferred (el {elementData = iterm}) t c) + +inferGraphTypes :: Flow Graph Graph +inferGraphTypes = getState >>= annotateGraph + where + annotateGraph g = withTrace ("infer graph types") $ do + sorted <- sortGraphElements g + els <- sortGraphElements g >>= annotateElements g + return g {graphElements = M.fromList (toPair <$> els)} + where + toPair el = (elementName el, el) + +-- TODO: deprecated +inferredTypeOf :: Term -> Flow Graph Type +inferredTypeOf term = typeSchemeType <$> inferTypeScheme term + +-- TODO: deprecated +-- | Solve for the top-level type of an expression in a given environment +inferTypeAndConstraints :: Term -> Flow Graph (Term, TypeScheme) +inferTypeAndConstraints term = withTrace ("infer type") $ withInferenceContext $ do + (Inferred iterm _ constraints) <- infer term + subst <- withSchemaContext $ solveConstraints constraints + let term2 = rewriteDataType (substituteInType subst) iterm +-- let typ = Y.fromMaybe (termType term2) $ getTermType term +-- return (setTermType (Just typ) term2, closeOver $ termType term2) + return (term2, closeOver $ termType term2) + where + -- | Canonicalize and return the polymorphic top-level type. + closeOver = normalizeScheme . generalize M.empty . reduceType + +-- TODO: deprecated +inferTypeScheme :: Term -> Flow Graph TypeScheme +inferTypeScheme term = snd <$> inferTypeAndConstraints term + +rewriteDataType :: (Type -> Type) -> Term -> Term +rewriteDataType f = rewriteTerm ff + where + ff recurse term = case recurse term of + TermTyped (TypedTerm term1 type1) -> TermTyped $ TypedTerm term1 (f type1) + t -> t + +sortGraphElements :: Graph -> Flow Graph [Element] +sortGraphElements g = do + let annotated = S.fromList $ Y.catMaybes (ifAnnotated <$> M.elems els) + adjList <- CM.mapM (toAdj annotated) $ M.elems els + case topologicalSort adjList of + Left comps -> fail $ "cyclical dependency not resolved through annotations: " ++ L.intercalate ", " (unName <$> L.head comps) + Right names -> return $ Y.catMaybes ((\n -> M.lookup n els) <$> names) + where + els = graphElements g + ifAnnotated el = case (getTermType $ elementData el) of + Nothing -> Nothing + Just _ -> Just $ elementName el + toAdj annotated el = do + let deps = L.filter isNotAnnotated $ L.filter isElName $ S.toList $ freeVariablesInTerm $ elementData el + + return (elementName el, deps) + where + -- Ignore free variables which are not valid element references + isElName name = M.member name els + -- No need for an inference dependency on an element which is already annotated with a type + isNotAnnotated name = not $ S.member name annotated + +withInferenceContext flow = do + g <- getState + let env = initialEnv g + withState (g {graphTypes = env}) flow + where + initialEnv g = M.fromList $ Y.catMaybes (toPair <$> (M.elems $ graphElements g)) + where + toPair el = (\t -> (elementName el, monotype t)) <$> (getTermType $ elementData el) diff --git a/src/main/haskell/Hydra/Inference/Rules.hs b/src/main/haskell/Hydra/Inference/Rules.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Inference/Rules.hs @@ -0,0 +1,346 @@ +-- | Inference rules + +module Hydra.Inference.Rules where + +import Hydra.Basics +import Hydra.Strip +import Hydra.Compute +import Hydra.Core +import Hydra.Schemas +import Hydra.CoreEncoding +import Hydra.Graph +import Hydra.Lexical +import Hydra.Mantle +import Hydra.Rewriting +import Hydra.Inference.Substitution +import Hydra.Unification +import Hydra.Tools.Debug +import Hydra.Annotations +import Hydra.Tier1 +import Hydra.Tier2 +import qualified Hydra.Dsl.Types as Types + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +data Inferred a = Inferred { + -- The original term, possibly annotated with the inferred type + inferredObject :: a, + -- The inferred type + inferredType :: Type, + -- Any constraints introduced by the inference process + inferredConstraints :: [TypeConstraint] +} deriving Show + +key_vcount = Name "vcount" + +constraint :: Type -> Type -> TypeConstraint +constraint t1 t2 = TypeConstraint t1 t2 Nothing + +fieldType :: Field -> FieldType +fieldType (Field fname term) = FieldType fname $ termType term + +findMatchingField :: Name -> [FieldType] -> Flow Graph FieldType +findMatchingField fname sfields = case L.filter (\f -> fieldTypeName f == fname) sfields of + [] -> fail $ "no such field: " ++ unName fname + (h:_) -> return h + +freshName :: Flow Graph Name +freshName = normalVariable <$> nextCount key_vcount + +freshVariableType :: Flow Graph Type +freshVariableType = TypeVariable <$> freshName + +generalize :: M.Map Name TypeScheme -> Type -> TypeScheme +generalize env t = TypeScheme vars t + where + vars = S.toList $ S.difference + (freeVariablesInType t) + (L.foldr (S.union . freeVariablesInScheme) S.empty $ M.elems env) + +infer :: Term -> Flow Graph (Inferred Term) +infer term = withTrace ("infer for " ++ show (termVariant term)) $ case term of + TermAnnotated (AnnotatedTerm term1 ann) -> do + (Inferred term2 typ constraints) <- infer term1 + return (Inferred (TermAnnotated $ AnnotatedTerm term2 ann) typ constraints) + + TermApplication (Application fun arg) -> do + (Inferred ifun ityp funconst) <- infer fun + (Inferred iarg atyp argconst) <- infer arg + cod <- freshVariableType + let constraints = funconst ++ argconst ++ [constraint ityp $ Types.function atyp cod] + yield (TermApplication $ Application ifun iarg) cod constraints + + TermFunction f -> case f of + + FunctionElimination e -> case e of + + EliminationList fun -> do + a <- freshVariableType + b <- freshVariableType + let expected = Types.functionN [b, a, b] + (Inferred i t c) <- infer fun + let elim = Types.functionN [b, Types.list a, b] + yieldElimination (EliminationList i) elim (c ++ [constraint expected t]) + + EliminationOptional (OptionalCases n j) -> do + dom <- freshVariableType + cod <- freshVariableType + (Inferred ni nt nconst) <- infer n + (Inferred ji jt jconst) <- infer j + let t = Types.function (Types.optional dom) cod + let constraints = nconst ++ jconst + ++ [constraint cod nt, constraint (Types.function dom cod) jt] + yieldElimination (EliminationOptional $ OptionalCases ni ji) t constraints + + EliminationProduct (TupleProjection arity idx) -> do + types <- CM.replicateM arity freshVariableType + let cod = types !! idx + let t = Types.function (Types.product types) cod + yieldElimination (EliminationProduct $ TupleProjection arity idx) t [] + + EliminationRecord (Projection name fname) -> do + rt <- requireRecordType name + sfield <- findMatchingField fname (rowTypeFields rt) + yieldElimination (EliminationRecord $ Projection name fname) + (Types.function (TypeRecord rt) $ fieldTypeType sfield) [] + + EliminationUnion (CaseStatement tname def cases) -> do + -- Default value + (idef, dfltConstraints) <- case def of + Nothing -> pure (Nothing, []) + Just d -> do + (Inferred i _ c) <- infer d + return (Just i, c) + + -- Cases + icases' <- CM.mapM inferFieldType cases + let icases = inferredObject <$> icases' + let casesconst = inferredConstraints <$> icases' + let icasesMap = fieldMap icases + rt <- requireUnionType tname + let sfields = fieldTypeMap $ rowTypeFields rt + checkCasesAgainstSchema tname icasesMap sfields + let pairMap = productOfMaps icasesMap sfields + + cod <- freshVariableType + let outerConstraints = (\(d, s) -> constraint (termType d) $ Types.function s cod) <$> M.elems pairMap + let innerConstraints = dfltConstraints ++ L.concat casesconst + + yieldElimination (EliminationUnion (CaseStatement tname idef icases)) + (Types.function (TypeUnion rt) cod) + (innerConstraints ++ outerConstraints) + where + checkCasesAgainstSchema tname icases sfields = if M.null diff + then pure () + else fail $ "case(s) in case statement which do not exist in type " ++ unName tname ++ ": " + ++ L.intercalate ", " (unName <$> M.keys diff) + where + diff = M.difference icases sfields + + EliminationWrap name -> do + typ <- requireWrappedType name + yieldElimination (EliminationWrap name) (Types.function (TypeWrap $ WrappedType name typ) typ) [] + + FunctionLambda (Lambda v _ body) -> do + tv <- freshVariableType + (Inferred i t iconst) <- withBinding v (monotype tv) $ infer body + yieldFunction (FunctionLambda $ Lambda v (Just tv) i) (Types.function tv t) iconst + + FunctionPrimitive name -> do + ts <- (typeOfPrimitive name) >>= instantiate + -- TODO: propagate the entire type scheme, not only the body + yieldFunction (FunctionPrimitive name) (typeSchemeType ts) [] + + TermLet lt -> inferLet lt + + TermList els -> do + v <- freshVariableType + if L.null els + then yield (TermList []) (Types.list v) [] + else do + iels' <- CM.mapM infer els + let iels = inferredObject <$> iels' + let elsconst = inferredConstraints <$> iels' + let co = (\e -> constraint v $ termType e) <$> iels + let ci = L.concat elsconst + yield (TermList iels) (Types.list v) (co ++ ci) + + TermLiteral l -> yield (TermLiteral l) (Types.literal $ literalType l) [] + + TermMap m -> do + kv <- freshVariableType + vv <- freshVariableType + if M.null m + then yield (TermMap M.empty) (Types.map kv vv) [] + else do + triples <- CM.mapM toTriple $ M.toList m + let pairs = (\(k, v, _) -> (k, v)) <$> triples + let co = L.concat ((\(k, v, c) -> c ++ [constraint kv $ termType k, constraint vv $ termType v]) <$> triples) + yield (TermMap $ M.fromList pairs) (Types.map kv vv) co + where + toTriple (k, v) = do + (Inferred ik _ kc) <- infer k + (Inferred iv _ vc) <- infer v + return (ik, iv, kc ++ vc) + + TermOptional m -> do + v <- freshVariableType + case m of + Nothing -> yield (TermOptional Nothing) (Types.optional v) [] + Just e -> do + (Inferred i t ci) <- infer e + yield (TermOptional $ Just i) (Types.optional v) ((constraint v t):ci) + + TermProduct tuple -> do + is' <- CM.mapM infer tuple + let is = inferredObject <$> is' + let co = L.concat (inferredConstraints <$> is') + yield (TermProduct is) (TypeProduct $ fmap termType is) co + + TermRecord (Record n fields) -> do + rt <- requireRecordType n + ifields' <- CM.mapM inferFieldType fields + let ifields = inferredObject <$> ifields' + let ci = L.concat (inferredConstraints <$> ifields') + let irt = TypeRecord $ RowType n (fieldType <$> ifields) + yield (TermRecord $ Record n ifields) irt ((constraint irt $ TypeRecord rt):ci) + + TermSet els -> do + v <- freshVariableType + if S.null els + then yield (TermSet S.empty) (Types.set v) [] + else do + iels' <- CM.mapM infer $ S.toList els + let iels = inferredObject <$> iels' + let co = (\e -> (constraint v $ termType e)) <$> iels + let ci = L.concat (inferredConstraints <$> iels') + yield (TermSet $ S.fromList iels) (Types.set v) (co ++ ci) + + TermSum (Sum i s trm) -> do + (Inferred it t co) <- infer trm + types <- CM.sequence (varOrTerm t <$> [0..(s-1)]) + yield (TermSum $ Sum i s it) (TypeSum types) co + where + varOrTerm t j = if i == j + then pure t + else freshVariableType + + TermTyped (TypedTerm term1 typ) -> do + (Inferred i t c) <- infer term1 + return $ Inferred (setTermType (Just typ) i) typ $ c ++ [constraint typ t] + + TermUnion (Injection n field) -> do + rt <- requireUnionType n + sfield <- findMatchingField (fieldName field) (rowTypeFields rt) + (Inferred ifield t ci) <- inferFieldType field + let co = constraint t $ fieldTypeType sfield + + yield (TermUnion $ Injection n ifield) (TypeUnion rt) (co:ci) + + TermVariable v -> do + ts <- requireName v + -- TODO: propagate the entire type scheme, not only the body + yield (TermVariable v) (typeSchemeType ts) [] + + TermWrap (WrappedTerm name term1) -> do + typ <- requireWrappedType name + (Inferred i t ci) <- infer term1 + yield (TermWrap $ WrappedTerm name i) (TypeWrap $ WrappedType name typ) (ci ++ [constraint typ t]) + +inferFieldType :: Field -> Flow Graph (Inferred Field) +inferFieldType (Field fname term) = do + (Inferred i t c) <- infer term + return (Inferred (Field fname i) t c) + +inferLet :: Let -> Flow Graph (Inferred Term) +inferLet (Let bindings env) = withTrace ("let(" ++ L.intercalate "," (unName . letBindingName <$> bindings) ++ ")") $ do + state0 <- getState + let e = preExtendEnv bindings $ graphTypes state0 + let state1 = state0 {graphTypes = e} + withState state1 $ do + -- TODO: perform a topological sort on the bindings; this process should be unified with that of elements in a graph + + -- Infer types of bindings in the pre-extended environment + ivalues' <- CM.mapM infer (letBindingTerm <$> bindings) + let ivalues = inferredObject <$> ivalues' + let ibindings = L.zipWith (\(LetBinding k v t) i -> LetBinding k i t) bindings ivalues + let bc = L.concat (inferredConstraints <$> ivalues') + + let tbindings = M.fromList $ fmap (\(LetBinding k i t) -> (k, termTypeScheme i)) ibindings + (Inferred ienv t cenv) <- withBindings tbindings $ infer env + + yield (TermLet $ Let ibindings ienv) t (bc ++ cenv) + where + -- Add any manual type annotations for the bindings to the environment, enabling type inference over recursive definitions + preExtendEnv bindings e = foldl addPair e bindings + where + addPair e (LetBinding name term _) = case typeOfTerm term of + Nothing -> e + Just typ -> M.insert name (monotype typ) e + +instantiate :: TypeScheme -> Flow Graph TypeScheme +instantiate (TypeScheme vars t) = do + vars1 <- mapM (const freshName) vars + return $ TypeScheme vars1 $ substituteInType (M.fromList $ L.zip vars (TypeVariable <$> vars1)) t + +monotype :: Type -> TypeScheme +monotype typ = TypeScheme [] typ + +productOfMaps :: Ord k => M.Map k l -> M.Map k r -> M.Map k (l, r) +productOfMaps ml mr = M.fromList $ Y.catMaybes (toPair <$> M.toList mr) + where + toPair (k, vr) = (\vl -> (k, (vl, vr))) <$> M.lookup k ml + +reduceType :: Type -> Type +reduceType t = t -- betaReduceType cx t + +requireName :: Name -> Flow Graph TypeScheme +requireName v = do + env <- graphTypes <$> getState + case M.lookup v env of + Nothing -> fail $ "variable not bound in environment: " ++ unName v ++ ". Environment: " + ++ L.intercalate ", " (unName <$> M.keys env) + Just s -> instantiate s + +termType :: Term -> Type +termType term = case stripTerm term of + (TermTyped (TypedTerm _ typ)) -> typ + +-- TODO: limited and temporary +termTypeScheme :: Term -> TypeScheme +termTypeScheme = monotype . termType + +typeOfPrimitive :: Name -> Flow Graph TypeScheme +typeOfPrimitive name = primitiveType <$> requirePrimitive name + +typeOfTerm :: Term -> Maybe Type +typeOfTerm term = case term of + TermAnnotated (AnnotatedTerm term1 _) -> typeOfTerm term1 + TermTyped (TypedTerm term1 typ) -> Just typ + _ -> Nothing + +withBinding :: Name -> TypeScheme -> Flow Graph x -> Flow Graph x +withBinding n ts = withEnvironment (M.insert n ts) + +withBindings :: M.Map Name TypeScheme -> Flow Graph x -> Flow Graph x +withBindings bindings = withEnvironment (\e -> M.union bindings e) + +withEnvironment :: (M.Map Name TypeScheme -> M.Map Name TypeScheme) -> Flow Graph x -> Flow Graph x +withEnvironment m flow = do + g <- getState + withState (g {graphTypes = m (graphTypes g)}) flow + +yield :: Term -> Type -> [TypeConstraint] -> Flow Graph (Inferred Term) +yield term typ constraints = do + return (Inferred (TermTyped $ TypedTerm term typ) typ constraints) + +yieldFunction :: Function -> Type -> [TypeConstraint] -> Flow Graph (Inferred Term) +yieldFunction fun = yield (TermFunction fun) + +yieldElimination :: Elimination -> Type -> [TypeConstraint] -> Flow Graph (Inferred Term) +yieldElimination e = yield (TermFunction $ FunctionElimination e) diff --git a/src/main/haskell/Hydra/Inference/Substitution.hs b/src/main/haskell/Hydra/Inference/Substitution.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Inference/Substitution.hs @@ -0,0 +1,80 @@ +-- | Variable substitution and normalization of type expressions +module Hydra.Inference.Substitution where + +import Hydra.Core +import Hydra.Mantle +import Hydra.Rewriting +import Hydra.Tier1 +import Hydra.Dsl.Types as Types + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +type Subst = M.Map Name (Type) + +composeSubst :: Subst -> Subst -> Subst +composeSubst s1 s2 = M.union s1 $ M.map (substituteInType s1) s2 + +normalVariables :: [Name] +normalVariables = normalVariable <$> [0..] + +-- | Type variable naming convention follows Haskell: t0, t1, etc. +normalVariable :: Int -> Name +normalVariable i = Name $ "t" ++ show i + +normalizeScheme :: TypeScheme -> TypeScheme +normalizeScheme ts@(TypeScheme _ body) = TypeScheme (fmap snd ord) (normalizeType body) + where + ord = L.zip (S.toList $ freeVariablesInType body) normalVariables + + normalizeFieldType (FieldType fname typ) = FieldType fname $ normalizeType typ + + normalizeType typ = case typ of + TypeApplication (ApplicationType lhs rhs) -> TypeApplication (ApplicationType (normalizeType lhs) (normalizeType rhs)) + TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated (AnnotatedType (normalizeType t) ann) + TypeFunction (FunctionType dom cod) -> function (normalizeType dom) (normalizeType cod) + TypeList t -> list $ normalizeType t + TypeLiteral _ -> typ + TypeMap (MapType kt vt) -> Types.map (normalizeType kt) (normalizeType vt) + TypeOptional t -> optional $ normalizeType t + TypeProduct types -> TypeProduct (normalizeType <$> types) + TypeRecord (RowType n fields) -> TypeRecord $ RowType n (normalizeFieldType <$> fields) + TypeSet t -> set $ normalizeType t + TypeSum types -> TypeSum (normalizeType <$> types) + TypeUnion (RowType n fields) -> TypeUnion $ RowType n (normalizeFieldType <$> fields) + TypeLambda (LambdaType (Name v) t) -> TypeLambda (LambdaType (Name v) $ normalizeType t) + TypeVariable v -> case Prelude.lookup v ord of + Just (Name v1) -> var v1 + Nothing -> error $ "type variable " ++ show v ++ " not in signature of type scheme: " ++ show ts + TypeWrap _ -> typ + +substituteInScheme :: M.Map Name (Type) -> TypeScheme -> TypeScheme +substituteInScheme s (TypeScheme as t) = TypeScheme as $ substituteInType s' t + where + s' = L.foldr M.delete s as + +substituteInType :: M.Map Name (Type) -> Type -> Type +substituteInType s typ = case typ of + TypeApplication (ApplicationType lhs rhs) -> TypeApplication (ApplicationType (subst lhs) (subst rhs)) + TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated (AnnotatedType (subst t) ann) + TypeFunction (FunctionType dom cod) -> function (subst dom) (subst cod) + TypeList t -> list $ subst t + TypeLiteral _ -> typ + TypeMap (MapType kt vt) -> Types.map (subst kt) (subst vt) + TypeOptional t -> optional $ subst t + TypeProduct types -> TypeProduct (subst <$> types) + TypeRecord (RowType n fields) -> TypeRecord $ RowType n (substField <$> fields) + TypeSet t -> set $ subst t + TypeSum types -> TypeSum (subst <$> types) + TypeUnion (RowType n fields) -> TypeUnion $ RowType n (substField <$> fields) + TypeLambda (LambdaType var@(Name v) body) -> if Y.isNothing (M.lookup var s) + then TypeLambda (LambdaType (Name v) (subst body)) + else typ + TypeVariable a -> M.findWithDefault typ a s + TypeWrap _ -> typ -- because we do not allow names to be bound to types with free variables + where + subst = substituteInType s + substField (FieldType fname t) = FieldType fname $ subst t diff --git a/src/main/haskell/Hydra/Kernel.hs b/src/main/haskell/Hydra/Kernel.hs --- a/src/main/haskell/Hydra/Kernel.hs +++ b/src/main/haskell/Hydra/Kernel.hs @@ -15,7 +15,7 @@ module Hydra.CoreLanguage, module Hydra.Extras, module Hydra.Graph, - module Hydra.Inference, + module Hydra.Inference.Inference, module Hydra.Annotations, module Hydra.Lexical, module Hydra.LiteralAdapters, @@ -27,6 +27,7 @@ module Hydra.Query, module Hydra.Reduction, module Hydra.Rewriting, + module Hydra.Schemas, module Hydra.Strip, module Hydra.TermAdapters, module Hydra.Tier1, @@ -53,7 +54,7 @@ import Hydra.CoreLanguage import Hydra.Extras import Hydra.Graph -import Hydra.Inference +import Hydra.Inference.Inference import Hydra.Annotations import Hydra.Lexical import Hydra.LiteralAdapters @@ -65,6 +66,7 @@ import Hydra.Query import Hydra.Reduction import Hydra.Rewriting +import Hydra.Schemas import Hydra.Strip import Hydra.TermAdapters import Hydra.Tier1 diff --git a/src/main/haskell/Hydra/Langs/Avro/Coder.hs b/src/main/haskell/Hydra/Langs/Avro/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Avro/Coder.hs +++ /dev/null @@ -1,389 +0,0 @@ -module Hydra.Langs.Avro.Coder ( - AvroEnvironment(..), - AvroHydraAdapter(..), - AvroQualifiedName(..), - avroHydraAdapter, - emptyAvroEnvironment, -) where - -import Hydra.Kernel -import Hydra.Langs.Json.Eliminate -import qualified Hydra.Lib.Strings as Strings -import qualified Hydra.Dsl.Expect as Expect -import qualified Hydra.Dsl.Types as Types -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Langs.Avro.Schema as Avro -import qualified Hydra.Json as Json - -import qualified Text.Read as TR -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -data AvroEnvironment = AvroEnvironment { - avroEnvironmentNamedAdapters :: M.Map AvroQualifiedName AvroHydraAdapter, - avroEnvironmentNamespace :: Maybe String, - avroEnvironmentElements :: M.Map Name Element} -- note: only used in the term coders -type AvroHydraAdapter = Adapter AvroEnvironment AvroEnvironment Avro.Schema Type Json.Value Term - -data AvroQualifiedName = AvroQualifiedName (Maybe String) String deriving (Eq, Ord, Show) - -data ForeignKey = ForeignKey Name (String -> Name) - -data PrimaryKey = PrimaryKey Name (String -> Name) - -emptyAvroEnvironment = AvroEnvironment M.empty Nothing M.empty - -avro_foreignKey = "@foreignKey" -avro_primaryKey = "@primaryKey" - -avroHydraAdapter :: Avro.Schema -> Flow AvroEnvironment AvroHydraAdapter -avroHydraAdapter schema = case schema of - Avro.SchemaArray (Avro.Array s) -> do - ad <- avroHydraAdapter s - let coder = Coder { - coderEncode = \(Json.ValueArray vals) -> Terms.list <$> (CM.mapM (coderEncode $ adapterCoder ad) vals), - coderDecode = \(TermList vals) -> Json.ValueArray <$> (CM.mapM (coderDecode $ adapterCoder ad) vals)} - return $ Adapter (adapterIsLossy ad) schema (Types.list $ adapterTarget ad) coder - Avro.SchemaMap (Avro.Map_ s) -> do - ad <- avroHydraAdapter s - let pairToHydra (k, v) = do - v' <- coderEncode (adapterCoder ad) v - return (Terms.string k, v') - let coder = Coder { - coderEncode = \(Json.ValueObject m) -> Terms.map . M.fromList <$> (CM.mapM pairToHydra $ M.toList m), - coderDecode = \m -> Json.ValueObject <$> Expect.map Expect.string (coderDecode (adapterCoder ad)) m} - return $ Adapter (adapterIsLossy ad) schema (Types.map Types.string $ adapterTarget ad) coder - Avro.SchemaNamed n -> do - let ns = Avro.namedNamespace n - env <- getState - - let manns = namedAnnotationsToCore n - let ann = if M.null manns then Nothing else (Just manns) - - let lastNs = avroEnvironmentNamespace env - let nextNs = Y.maybe lastNs Just ns - putState $ env {avroEnvironmentNamespace = nextNs} - - let qname = AvroQualifiedName nextNs (Avro.namedName n) - let hydraName = avroNameToHydraName qname - - -- Note: if a named type is redefined (an illegal state for which the Avro spec does not provide a resolution), - -- we just take the first definition and ignore the second. - ad <- case getAvroHydraAdapter qname env of - Just ad -> fail $ "Avro named type defined more than once: " ++ show qname - Nothing -> do - ad <- case Avro.namedType n of - Avro.NamedTypeEnum (Avro.Enum_ syms mdefault) -> simpleAdapter typ encode decode -- TODO: use default value - where - typ = TypeUnion (RowType hydraName Nothing $ toField <$> syms) - where - toField s = FieldType (Name s) Types.unit - encode (Json.ValueString s) = pure $ TermUnion (Injection hydraName $ Field (Name s) Terms.unit) - -- Note: we simply trust that data coming from the Hydra side is correct - decode (TermUnion (Injection _ (Field fn _))) = return $ Json.ValueString $ unName fn - Avro.NamedTypeFixed (Avro.Fixed size) -> simpleAdapter Types.binary encode decode - where - encode (Json.ValueString s) = pure $ Terms.binary s - decode term = Json.ValueString <$> Expect.binary term - Avro.NamedTypeRecord r -> do - let avroFields = Avro.recordFields r - adaptersByFieldName <- M.fromList <$> (CM.mapM prepareField avroFields) - pk <- findPrimaryKeyField qname avroFields - -- TODO: Nothing values for optional fields - let encodePair (k, v) = case M.lookup k adaptersByFieldName of - Nothing -> fail $ "unrecognized field for " ++ showQname qname ++ ": " ++ show k - Just (f, ad) -> do - v' <- coderEncode (adapterCoder ad) v - return $ Field (Name k) v' - let decodeField (Field (Name k) v) = case M.lookup k adaptersByFieldName of - Nothing -> fail $ "unrecognized field for " ++ showQname qname ++ ": " ++ show k - Just (f, ad) -> do - v' <- coderDecode (adapterCoder ad) v - return (k, v') - let lossy = L.foldl (\b (_, ad) -> b || adapterIsLossy ad) False $ M.elems adaptersByFieldName - let hfields = toHydraField <$> M.elems adaptersByFieldName - let target = TypeRecord $ RowType hydraName Nothing hfields - let coder = Coder { - -- Note: the order of the fields is changed - coderEncode = \(Json.ValueObject m) -> do - fields <- CM.mapM encodePair $ M.toList m - let term = TermRecord $ Record hydraName fields - addElement term target pk fields - return term, - coderDecode = \(TermRecord (Record _ fields)) -> Json.ValueObject . M.fromList <$> (CM.mapM decodeField fields)} - return $ Adapter lossy schema target coder - where - toHydraField (f, ad) = FieldType (Name $ Avro.fieldName f) $ adapterTarget ad - env <- getState - putState $ putAvroHydraAdapter qname ad env - return $ annotate ann ad - - env2 <- getState - putState $ env2 {avroEnvironmentNamespace = lastNs} - return ad - where - addElement term typ pk fields = case pk of - Nothing -> pure () - Just (PrimaryKey fname constr) -> case L.filter isPkField fields of - [] -> pure () - [field] -> do - s <- termToString $ fieldTerm field - let name = constr s - let el = Element name term - env <- getState - putState $ env {avroEnvironmentElements = M.insert name el (avroEnvironmentElements env)} - return () - _ -> fail $ "multiple fields named " ++ unName fname - where - isPkField field = fieldName field == fname - findPrimaryKeyField qname avroFields = do - keys <- Y.catMaybes <$> CM.mapM primaryKey avroFields - case keys of - [] -> pure Nothing - [k] -> pure $ Just k - _ -> fail $ "multiple primary key fields for " ++ show qname - prepareField f = do - fk <- foreignKey f - - let manns = fieldAnnotationsToCore f - let ann = if M.null manns then Nothing else (Just manns) - - ad <- case fk of - Nothing -> avroHydraAdapter $ Avro.fieldType f - Just (ForeignKey name constr) -> do - ad <- avroHydraAdapter $ Avro.fieldType f - let decodeTerm = \(TermVariable name) -> do -- TODO: not symmetrical - term <- stringToTerm (adapterTarget ad) $ unName name - coderDecode (adapterCoder ad) term - let encodeValue v = do - s <- coderEncode (adapterCoder ad) v >>= termToString - return $ TermVariable $ constr s - -- Support three special cases of foreign key types: plain, optional, and list - case stripType (adapterTarget ad) of - TypeOptional (TypeLiteral lit) -> forTypeAndCoder ad (Types.optional elTyp) coder - where - coder = Coder { - coderEncode = \json -> (TermOptional . Just) <$> encodeValue json, - coderDecode = decodeTerm} - TypeList (TypeLiteral lit) -> forTypeAndCoder ad (Types.list elTyp) coder - where - coder = Coder { - coderEncode = \json -> TermList <$> (expectArray json >>= CM.mapM encodeValue), - coderDecode = decodeTerm} - TypeLiteral lit -> forTypeAndCoder ad elTyp coder - where - coder = Coder { - coderEncode = encodeValue, - coderDecode = decodeTerm} - _ -> fail $ "unsupported type annotated as foreign key: " ++ (show $ typeVariant $ adapterTarget ad) - where - forTypeAndCoder ad typ coder = pure $ Adapter (adapterIsLossy ad) (Avro.fieldType f) typ coder - elTyp = TypeVariable name - return (Avro.fieldName f, (f, annotate ann ad)) - Avro.SchemaPrimitive p -> case p of - Avro.PrimitiveNull -> simpleAdapter Types.unit encode decode - where - encode (Json.ValueString s) = pure $ Terms.string s - decode term = Json.ValueString <$> Expect.string term - Avro.PrimitiveBoolean -> simpleAdapter Types.boolean encode decode - where - encode (Json.ValueBoolean b) = pure $ Terms.boolean b - decode term = Json.ValueBoolean <$> Expect.boolean term - Avro.PrimitiveInt -> simpleAdapter Types.int32 encode decode - where - encode (Json.ValueNumber d) = pure $ Terms.int32 $ doubleToInt d - decode term = Json.ValueNumber . fromIntegral <$> Expect.int32 term - Avro.PrimitiveLong -> simpleAdapter Types.int64 encode decode - where - encode (Json.ValueNumber d) = pure $ Terms.int64 $ doubleToInt d - decode term = Json.ValueNumber . fromIntegral <$> Expect.int64 term - Avro.PrimitiveFloat -> simpleAdapter Types.float32 encode decode - where - encode (Json.ValueNumber d) = pure $ Terms.float32 $ realToFrac d - decode term = Json.ValueNumber . realToFrac <$> Expect.float32 term - Avro.PrimitiveDouble -> simpleAdapter Types.float64 encode decode - where - encode (Json.ValueNumber d) = pure $ Terms.float64 d - decode term = Json.ValueNumber <$> Expect.float64 term - Avro.PrimitiveBytes -> simpleAdapter Types.binary encode decode - where - encode (Json.ValueString s) = pure $ Terms.binary s - decode term = Json.ValueString <$> Expect.binary term - Avro.PrimitiveString -> simpleAdapter Types.string encode decode - where - encode (Json.ValueString s) = pure $ Terms.string s - decode term = Json.ValueString <$> Expect.string term - where - doubleToInt d = if d < 0 then ceiling d else floor d - Avro.SchemaReference name -> do - env <- getState - let qname = parseAvroName (avroEnvironmentNamespace env) name - case getAvroHydraAdapter qname env of - Nothing -> fail $ "Referenced Avro type has not been defined: " ++ show qname - ++ ". Defined types: " ++ show (M.keys $ avroEnvironmentNamedAdapters env) - Just ad -> pure ad - Avro.SchemaUnion (Avro.Union schemas) -> if L.length nonNulls > 1 - then fail $ "general-purpose unions are not yet supported: " ++ show schema - else if L.null nonNulls - then fail $ "cannot generate the empty type" - else if hasNull - then forOptional $ L.head nonNulls - else do - ad <- avroHydraAdapter $ L.head nonNulls - return $ Adapter (adapterIsLossy ad) schema (adapterTarget ad) (adapterCoder ad) - where - hasNull = (not . L.null . L.filter isNull) schemas - nonNulls = L.filter (not . isNull) schemas - isNull schema = case schema of - Avro.SchemaPrimitive Avro.PrimitiveNull -> True - _ -> False - forOptional s = do - ad <- avroHydraAdapter s - let coder = Coder { - coderDecode = \(TermOptional ot) -> case ot of - Nothing -> pure $ Json.ValueNull - Just term -> coderDecode (adapterCoder ad) term, - coderEncode = \v -> case v of - Json.ValueNull -> pure $ TermOptional Nothing - _ -> TermOptional . Just <$> coderEncode (adapterCoder ad) v} - return $ Adapter (adapterIsLossy ad) schema (Types.optional $ adapterTarget ad) coder - where - simpleAdapter typ encode decode = pure $ Adapter False schema typ $ Coder encode decode - annotate ann ad = case ann of - Nothing -> ad - Just n -> ad {adapterTarget = Types.annot n (adapterTarget ad)} - -avroNameToHydraName :: AvroQualifiedName -> Name -avroNameToHydraName (AvroQualifiedName mns local) = unqualifyName $ QualifiedName (Namespace <$> mns) local - --- TODO: use me (for encoding annotations for which the type is not know) or lose me --- A more robust solution would use jsonCoder together with an expected type -encodeAnnotationValue :: Json.Value -> Term -encodeAnnotationValue v = case v of - Json.ValueArray vals -> Terms.list (encodeAnnotationValue <$> vals) - Json.ValueBoolean b -> Terms.boolean b - Json.ValueNull -> Terms.product [] - Json.ValueNumber d -> Terms.float64 d - -- Note: JSON objects are untyped maps, not records, in that fields are unordered - Json.ValueObject m -> Terms.map $ M.fromList (toEntry <$> M.toList m) - where - toEntry (k, v) = (Terms.string k, encodeAnnotationValue v) - Json.ValueString s -> Terms.string s - -fieldAnnotationsToCore :: Avro.Field -> M.Map String Term -fieldAnnotationsToCore f = M.fromList (toCore <$> (M.toList $ Avro.fieldAnnotations f)) - where - toCore (k, v) = (k, encodeAnnotationValue v) - -namedAnnotationsToCore :: Avro.Named -> M.Map String Term -namedAnnotationsToCore n = M.fromList (toCore <$> (M.toList $ Avro.namedAnnotations n)) - where - toCore (k, v) = (k, encodeAnnotationValue v) - -getAvroHydraAdapter :: AvroQualifiedName -> AvroEnvironment -> Y.Maybe AvroHydraAdapter -getAvroHydraAdapter qname = M.lookup qname . avroEnvironmentNamedAdapters - -foreignKey :: Avro.Field -> Flow s (Maybe ForeignKey) -foreignKey f = case M.lookup avro_foreignKey (Avro.fieldAnnotations f) of - Nothing -> pure Nothing - Just v -> do - m <- expectObject v - tname <- Name <$> requireString "type" m - pattern <- optString "pattern" m - let constr = case pattern of - Nothing -> Name - Just pat -> patternToNameConstructor pat - return $ Just $ ForeignKey tname constr - -patternToNameConstructor :: String -> String -> Name -patternToNameConstructor pat = \s -> Name $ L.intercalate s $ Strings.splitOn "${}" pat - -primaryKey :: Avro.Field -> Flow s (Maybe PrimaryKey) -primaryKey f = do - case M.lookup avro_primaryKey $ Avro.fieldAnnotations f of - Nothing -> pure Nothing - Just v -> do - s <- expectString v - return $ Just $ PrimaryKey (Name $ Avro.fieldName f) $ patternToNameConstructor s - -parseAvroName :: Maybe String -> String -> AvroQualifiedName -parseAvroName mns name = case L.reverse $ Strings.splitOn "." name of - [local] -> AvroQualifiedName mns local - (local:rest) -> AvroQualifiedName (Just $ L.intercalate "." $ L.reverse rest) local - -putAvroHydraAdapter :: AvroQualifiedName -> AvroHydraAdapter -> AvroEnvironment -> AvroEnvironment -putAvroHydraAdapter qname ad env = env {avroEnvironmentNamedAdapters = M.insert qname ad $ avroEnvironmentNamedAdapters env} - -rewriteAvroSchemaM :: ((Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema -rewriteAvroSchemaM f = rewrite fsub f - where - fsub recurse schema = case schema of - Avro.SchemaArray (Avro.Array els) -> Avro.SchemaArray <$> (Avro.Array <$> recurse els) - Avro.SchemaMap (Avro.Map_ vschema) -> Avro.SchemaMap <$> (Avro.Map_ <$> recurse vschema) - Avro.SchemaNamed n -> do - nt <- case Avro.namedType n of - Avro.NamedTypeRecord (Avro.Record fields) -> Avro.NamedTypeRecord <$> (Avro.Record <$> (CM.mapM forField fields)) - t -> pure t - return $ Avro.SchemaNamed $ n {Avro.namedType = nt} - Avro.SchemaUnion (Avro.Union schemas) -> Avro.SchemaUnion <$> (Avro.Union <$> (CM.mapM recurse schemas)) - _ -> pure schema - where - forField f = do - t <- recurse $ Avro.fieldType f - return f {Avro.fieldType = t} - -jsonToString :: Json.Value -> Flow s String -jsonToString v = case v of - Json.ValueBoolean b -> pure $ if b then "true" else "false" - Json.ValueString s -> pure s - Json.ValueNumber d -> pure $ if fromIntegral (round d) == d - then show (round d) - else show d - _ -> unexpected "string, number, or boolean" $ show v - -showQname :: AvroQualifiedName -> String -showQname (AvroQualifiedName mns local) = (Y.maybe "" (\ns -> ns ++ ".") mns) ++ local - -stringToTerm :: Type -> String -> Flow s Term -stringToTerm typ s = case stripType typ of - TypeLiteral lt -> TermLiteral <$> case lt of - LiteralTypeBoolean -> LiteralBoolean <$> doRead s - LiteralTypeInteger it -> LiteralInteger <$> case it of - IntegerTypeBigint -> IntegerValueBigint <$> doRead s - IntegerTypeInt8 -> IntegerValueInt8 <$> doRead s - IntegerTypeInt16 -> IntegerValueInt16 <$> doRead s - IntegerTypeInt32 -> IntegerValueInt32 <$> doRead s - IntegerTypeInt64 -> IntegerValueInt64 <$> doRead s - IntegerTypeUint8 -> IntegerValueUint8 <$> doRead s - IntegerTypeUint16 -> IntegerValueUint16 <$> doRead s - IntegerTypeUint32 -> IntegerValueUint32 <$> doRead s - IntegerTypeUint64 -> IntegerValueUint64 <$> doRead s - LiteralTypeString -> LiteralString <$> pure s - _ -> unexpected "literal type" $ show lt - where - doRead s = case TR.readEither s of - Left msg -> fail $ "failed to read value: " ++ msg - Right term -> pure term - -termToString :: Term -> Flow s String -termToString term = case stripTerm term of - TermLiteral l -> case l of - LiteralBoolean b -> pure $ show b - LiteralInteger iv -> pure $ case iv of - IntegerValueBigint i -> show i - IntegerValueInt8 i -> show i - IntegerValueInt16 i -> show i - IntegerValueInt32 i -> show i - IntegerValueInt64 i -> show i - IntegerValueUint8 i -> show i - IntegerValueUint16 i -> show i - IntegerValueUint32 i -> show i - IntegerValueUint64 i -> show i - LiteralString s -> pure s - _ -> unexpected "boolean, integer, or string" $ show l - TermOptional (Just term') -> termToString term' - _ -> unexpected "literal value" $ show term diff --git a/src/main/haskell/Hydra/Langs/Avro/Language.hs b/src/main/haskell/Hydra/Langs/Avro/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Avro/Language.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Hydra.Langs.Avro.Language where - -import Hydra.Kernel - -import qualified Data.Set as S - - -avroLanguage :: Language -avroLanguage = Language (LanguageName "hydra/langs/avro") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.empty, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBinary, LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString], - languageConstraintsFloatTypes = S.fromList [FloatTypeFloat32, FloatTypeFloat64], - languageConstraintsFunctionVariants = S.empty, - languageConstraintsIntegerTypes = S.fromList [IntegerTypeInt32, IntegerTypeInt64], - languageConstraintsTermVariants = S.fromList [ - TermVariantList, - TermVariantLiteral, - TermVariantMap, - TermVariantOptional, - TermVariantRecord], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantAnnotated, - TypeVariantList, - TypeVariantLiteral, - TypeVariantMap, - TypeVariantWrap, - TypeVariantOptional, - TypeVariantRecord], - languageConstraintsTypes = \typ -> case stripType typ of - TypeOptional (TypeOptional _) -> False - _ -> True } diff --git a/src/main/haskell/Hydra/Langs/Avro/SchemaJson.hs b/src/main/haskell/Hydra/Langs/Avro/SchemaJson.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Avro/SchemaJson.hs +++ /dev/null @@ -1,166 +0,0 @@ -module Hydra.Langs.Avro.SchemaJson where - -import Hydra.Kernel -import Hydra.Langs.Json.Serde -import Hydra.Langs.Json.Eliminate -import qualified Hydra.Langs.Avro.Schema as Avro -import qualified Hydra.Json as Json - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -avro_aliases = "aliases" -avro_array = "array" -avro_ascending = "ascending" -avro_boolean = "boolean" -avro_bytes = "bytes" -avro_default = "default" -avro_descending = "descending" -avro_doc = "doc" -avro_double = "double" -avro_enum = "enum" -avro_fields = "fields" -avro_fixed = "fixed" -avro_float = "float" -avro_ignore = "ignore" -avro_int = "int" -avro_items = "items" -avro_long = "long" -avro_map = "map" -avro_name = "name" -avro_namespace = "namespace" -avro_null = "null" -avro_order = "order" -avro_record = "record" -avro_size = "size" -avro_string = "string" -avro_symbols = "symbols" -avro_type = "type" -avro_values = "values" - -avroSchemaJsonCoder :: Coder s s Avro.Schema Json.Value -avroSchemaJsonCoder = Coder { - coderEncode = \schema -> fail "not implemented", - coderDecode = decodeNamedSchema} - -avroSchemaStringCoder :: Coder s s Avro.Schema String -avroSchemaStringCoder = Coder { - coderEncode = \schema -> jsonValueToString <$> coderEncode avroSchemaJsonCoder schema, - coderDecode = \s -> do - json <- case stringToJsonValue s of - Left msg -> fail $ "failed to parse JSON: " ++ msg - Right j -> pure j - coderDecode avroSchemaJsonCoder json} - -decodeAliases :: M.Map String Json.Value -> Flow s (Maybe [String]) -decodeAliases m = do - aliasesJson <- optArray avro_aliases m - case aliasesJson of - Nothing -> pure Nothing - Just a -> Just <$> CM.mapM expectString a - -decodeEnum :: M.Map String Json.Value -> Flow s Avro.NamedType -decodeEnum m = do - symbolsJson <- requireArray avro_symbols m - symbols <- CM.mapM expectString symbolsJson - dflt <- optString avro_default m - return $ Avro.NamedTypeEnum $ Avro.Enum_ symbols dflt - -decodeField :: M.Map String Json.Value -> Flow s Avro.Field -decodeField m = do - fname <- requireString avro_name m - doc <- optString avro_doc m - typ <- require avro_type m >>= decodeSchema - let dflt = opt avro_default m - order <- case opt avro_order m of - Nothing -> pure Nothing - Just o -> Just <$> (expectString o >>= decodeOrder) - aliases <- decodeAliases m - let anns = getAnnotations m - return $ Avro.Field fname doc typ dflt order aliases anns - -decodeFixed :: M.Map String Json.Value -> Flow s Avro.NamedType -decodeFixed m = do - size <- doubleToInt <$> requireNumber avro_size m - return $ Avro.NamedTypeFixed $ Avro.Fixed size - where - doubleToInt d = if d < 0 then ceiling d else floor d - -decodeNamedSchema :: Json.Value -> Flow s Avro.Schema -decodeNamedSchema value = do - m <- expectObject value - name <- requireString avro_name m - ns <- optString avro_namespace m - typ <- requireString avro_type m - nt <- case M.lookup typ decoders of - Nothing -> unexpected "Avro type" $ show typ - Just d -> d m - aliases <- decodeAliases m - doc <- optString avro_doc m - let anns = getAnnotations m - return $ Avro.SchemaNamed $ Avro.Named name ns aliases doc nt anns - where - decoders = M.fromList [ - (avro_enum, decodeEnum), - (avro_fixed, decodeFixed), - (avro_record, decodeRecord)] - -decodeOrder :: String -> Flow s Avro.Order -decodeOrder o = case M.lookup o orderMap of - Nothing -> unexpected "ordering" $ show o - Just order -> pure order - where - orderMap = M.fromList [ - (avro_ascending, Avro.OrderAscending), - (avro_descending, Avro.OrderDescending), - (avro_ignore, Avro.OrderIgnore)] - -decodeRecord :: M.Map String Json.Value -> Flow s Avro.NamedType -decodeRecord m = do - fields <- requireArray avro_fields m >>= CM.mapM expectObject >>= CM.mapM decodeField - return $ Avro.NamedTypeRecord $ Avro.Record fields - -decodeSchema :: Json.Value -> Flow s Avro.Schema -decodeSchema v = case v of - Json.ValueArray els -> Avro.SchemaUnion <$> (Avro.Union <$> (CM.mapM decodeSchema els)) - Json.ValueObject m -> do - typ <- requireString avro_type m - case M.lookup typ decoders of - Nothing -> unexpected "\"array\" or \"map\"" $ show typ - Just d -> d m - where - decoders = M.fromList [ - (avro_array, \m -> do - items <- require avro_items m >>= decodeSchema - return $ Avro.SchemaArray $ Avro.Array items), - (avro_enum, \m -> decodeNamedSchema $ Json.ValueObject m), - (avro_fixed, \m -> decodeNamedSchema $ Json.ValueObject m), - (avro_map, \m -> do - values <- require avro_values m >>= decodeSchema - return $ Avro.SchemaMap $ Avro.Map_ values), - (avro_record, \m -> decodeNamedSchema $ Json.ValueObject m)] - Json.ValueString s -> pure $ case M.lookup s schemas of - Just prim -> Avro.SchemaPrimitive prim - Nothing -> Avro.SchemaReference s - where - schemas = M.fromList [ - (avro_boolean, Avro.PrimitiveBoolean), - (avro_bytes, Avro.PrimitiveBytes), - (avro_double, Avro.PrimitiveDouble), - (avro_float, Avro.PrimitiveFloat), - (avro_int, Avro.PrimitiveInt), - (avro_long, Avro.PrimitiveLong), - (avro_null, Avro.PrimitiveNull), - (avro_string, Avro.PrimitiveString)] - Json.ValueNull -> pure $ Avro.SchemaPrimitive $ Avro.PrimitiveNull - _ -> unexpected "JSON array, object, or string" $ show v - -getAnnotations :: M.Map String Json.Value -> M.Map String Json.Value -getAnnotations = M.fromList . Y.catMaybes . fmap toPair . M.toList - where - toPair (k, v) = if L.take 1 k == "@" - then Just (L.drop 1 k, v) - else Nothing diff --git a/src/main/haskell/Hydra/Langs/Graphql/Coder.hs b/src/main/haskell/Hydra/Langs/Graphql/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Graphql/Coder.hs +++ /dev/null @@ -1,164 +0,0 @@ -module Hydra.Langs.Graphql.Coder (moduleToGraphql) where - -import Hydra.Kernel -import Hydra.Langs.Graphql.Language -import Hydra.Langs.Graphql.Serde -import qualified Hydra.Langs.Graphql.Syntax as G -import Hydra.Tools.Serialization -import Hydra.Tools.Formatting - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -type Prefixes = M.Map Namespace String - -moduleToGraphql :: Module -> Flow (Graph) (M.Map FilePath String) -moduleToGraphql mod = do - files <- moduleToGraphqlSchemas mod - return $ M.fromList (mapPair <$> M.toList files) - where - mapPair (path, sf) = (path, printExpr $ parenthesize $ exprDocument sf) - -moduleToGraphqlSchemas :: Module -> Flow (Graph) (M.Map FilePath G.Document) -moduleToGraphqlSchemas mod = transformModule graphqlLanguage encodeTerm constructModule mod - -constructModule :: Module - -> M.Map (Type) (Coder (Graph) (Graph) (Term) ()) - -> [(Element, TypedTerm)] - -> Flow (Graph) (M.Map FilePath G.Document) -constructModule mod coders pairs = do - -- Gather all dependencies because GraphQL does not support imports (in a standard way) - withDeps <- elementsWithDependencies $ fst <$> pairs - -- Qualify the names of dependencies with prefixes, so as to avoid name collisions - let prefixes = findPrefixes withDeps - -- Elements to GraphQL type definitions - tdefs <- CM.mapM (toTypeDef prefixes) withDeps - let doc = G.Document $ (G.DefinitionTypeSystem . G.TypeSystemDefinitionOrExtensionDefinition . G.TypeSystemDefinitionType) <$> tdefs - return $ M.fromList [(filePath, doc)] - where - filePath = namespaceToFilePath False (FileExtension "graphql") (moduleNamespace mod) - findPrefixes els = M.fromList $ toPair <$> namespaces - where - namespaces = L.nub $ (Y.fromJust . namespaceOfEager . elementName) <$> els - toPair ns = (ns, if ns == moduleNamespace mod then "" else (sanitizeWithUnderscores S.empty (unNamespace ns)) ++ "_") - toTypeDef prefixes el = do - typ <- requireTermType (elementData el) - if isType typ - then coreDecodeType (elementData el) >>= encodeNamedType prefixes el - else fail $ "mapping of non-type elements to GraphQL is not yet supported: " ++ unName (elementName el) - -descriptionFromType :: Type -> Flow (Graph) (Maybe G.Description) -descriptionFromType typ = do - mval <- getTypeDescription typ - return $ G.Description . G.StringValue <$> mval - -encodeEnumFieldType :: FieldType -> Flow (Graph) G.EnumValueDefinition -encodeEnumFieldType ft = do - desc <- descriptionFromType $ fieldTypeType ft - return G.EnumValueDefinition { - G.enumValueDefinitionDescription = desc, - G.enumValueDefinitionEnumValue = encodeEnumFieldName $ fieldTypeName ft, - G.enumValueDefinitionDirectives = Nothing} - -encodeEnumFieldName :: Name -> G.EnumValue -encodeEnumFieldName = G.EnumValue . G.Name . sanitize . unName - -encodeFieldName :: Name -> G.Name -encodeFieldName = G.Name . sanitize . unName - -encodeFieldType :: Prefixes -> FieldType -> Flow (Graph) G.FieldDefinition -encodeFieldType prefixes ft = do - gtype <- encodeType prefixes $ fieldTypeType ft - desc <- descriptionFromType $ fieldTypeType ft - return G.FieldDefinition { - G.fieldDefinitionDescription = desc, - G.fieldDefinitionName = encodeFieldName $ fieldTypeName ft, - G.fieldDefinitionArgumentsDefinition = Nothing, - G.fieldDefinitionType = gtype, - G.fieldDefinitionDirectives = Nothing} - -encodeLiteralType :: LiteralType -> Flow (Graph) G.NamedType -encodeLiteralType lt = G.NamedType . G.Name <$> case lt of - LiteralTypeBoolean -> pure "Boolean" - LiteralTypeFloat ft -> case ft of - FloatTypeFloat64 -> pure "Float" - _ -> unexpected "64-bit float type" $ show ft - LiteralTypeInteger it -> case it of - IntegerTypeInt32 -> pure "Int" - _ -> unexpected "32-bit signed integer type" $ show it - LiteralTypeString -> pure "String" - _ -> unexpected "GraphQL-compatible literal type" $ show lt - -encodeNamedType :: Prefixes -> Element -> Type -> Flow (Graph) G.TypeDefinition -encodeNamedType prefixes el typ = do - g <- getState - let cx = AdapterContext g graphqlLanguage M.empty - ad <- withState cx $ termAdapter typ - case stripType (adapterTarget ad) of - TypeRecord rt -> do - gfields <- CM.mapM (encodeFieldType prefixes) $ rowTypeFields rt - desc <- descriptionFromType typ - return $ G.TypeDefinitionObject $ G.ObjectTypeDefinition { - G.objectTypeDefinitionDescription = desc, - G.objectTypeDefinitionName = encodeTypeName prefixes $ elementName el, - G.objectTypeDefinitionImplementsInterfaces = Nothing, - G.objectTypeDefinitionDirectives = Nothing, - G.objectTypeDefinitionFieldsDefinition = Just $ G.FieldsDefinition gfields} - TypeUnion rt -> do - values <- CM.mapM encodeEnumFieldType $ rowTypeFields rt - desc <- descriptionFromType typ - return $ G.TypeDefinitionEnum $ G.EnumTypeDefinition { - G.enumTypeDefinitionDescription = desc, - G.enumTypeDefinitionName = encodeTypeName prefixes $ elementName el, - G.enumTypeDefinitionDirectives = Nothing, - G.enumTypeDefinitionEnumValuesDefinition = Just $ G.EnumValuesDefinition values} - TypeList _ -> wrapAsRecord - TypeLiteral _ -> wrapAsRecord - TypeVariable _ -> wrapAsRecord - t -> unexpected "record or union type" $ show t - where - wrapAsRecord = encodeNamedType prefixes el $ TypeRecord $ RowType (elementName el) Nothing [ - FieldType (Name "value") typ] - -encodeTerm :: Term -> Flow (Graph) () -encodeTerm term = fail "not yet implemented" - -encodeType :: Prefixes -> Type -> Flow (Graph) G.Type -encodeType prefixes typ = case stripType typ of - TypeOptional et -> case stripType et of - TypeList et -> G.TypeList . G.ListType <$> encodeType prefixes et - TypeLiteral lt -> G.TypeNamed <$> encodeLiteralType lt - TypeRecord rt -> forRowType rt - TypeUnion rt -> forRowType rt --- TypeWrap name -> forName name - TypeVariable name -> forName name - t -> unexpected "GraphQL-compatible type" $ show t - where - forName = pure . G.TypeNamed . G.NamedType . encodeTypeName prefixes - forRowType = forName . rowTypeTypeName - t -> G.TypeNonNull <$> nonnull t - where - nonnull t = case stripType t of - TypeList et -> G.NonNullTypeList . G.ListType <$> encodeType prefixes et - TypeLiteral lt -> G.NonNullTypeNamed <$> encodeLiteralType lt - TypeRecord rt -> forRowType rt - TypeUnion rt -> forRowType rt - TypeVariable name -> forName name --- TypeWrap name -> forName name - _ -> unexpected "GraphQL-compatible non-null type" $ show t - where - forName = pure . G.NonNullTypeNamed . G.NamedType . encodeTypeName prefixes - forRowType = forName . rowTypeTypeName - -encodeTypeName :: Prefixes -> Name -> G.Name -encodeTypeName prefixes name = G.Name $ (prefix ++ sanitize local) - where - prefix = Y.fromMaybe "UNKNOWN" $ M.lookup ns prefixes - QualifiedName (Just ns) local = qualifyNameEager name - -sanitize :: String -> String -sanitize = sanitizeWithUnderscores graphqlReservedWords diff --git a/src/main/haskell/Hydra/Langs/Graphql/Language.hs b/src/main/haskell/Hydra/Langs/Graphql/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Graphql/Language.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Hydra.Langs.Graphql.Language where - -import Hydra.Kernel - -import qualified Data.List as L -import qualified Data.Set as S - - -graphqlLanguage :: Language -graphqlLanguage = Language (LanguageName "hydra/langs/graphql") $ LanguageConstraints { - -- Note: this language is for schemas and data only; support for queries may be added later - languageConstraintsEliminationVariants = S.empty, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBoolean, -- Boolean - LiteralVariantFloat, -- Float - LiteralVariantInteger, -- Int - LiteralVariantString], -- String - languageConstraintsFloatTypes = S.fromList [ - FloatTypeFloat64], -- Float - languageConstraintsFunctionVariants = S.empty, - languageConstraintsIntegerTypes = S.fromList [ - IntegerTypeInt32], -- Int - languageConstraintsTermVariants = S.fromList [ - TermVariantList, - TermVariantLiteral, - TermVariantOptional, - TermVariantRecord, - TermVariantUnion], -- Unions are supported only in the form of enums - languageConstraintsTypeVariants = S.fromList [ - TypeVariantList, - TypeVariantLiteral, - TypeVariantWrap, - TypeVariantOptional, - TypeVariantRecord, - TypeVariantUnion, -- Unions are supported only in the form of enums - TypeVariantVariable], - languageConstraintsTypes = \typ -> case stripType typ of - -- If it is a union type, make sure it can be treated as an enum. - TypeUnion rt -> L.foldl (\b f -> b && isEnumField f) True $ rowTypeFields rt - where - isUnitType t = case stripType t of - TypeRecord (RowType name _ fields) -> L.null fields || name == _Unit - _ -> False - isEnumField = isUnitType . fieldTypeType - TypeOptional et -> case stripType et of - TypeOptional _ -> False -- No encoding for optionals within optionals - _ -> True - _ -> True} - -graphqlReservedWords :: S.Set String -graphqlReservedWords = S.fromList ["true", "false"] diff --git a/src/main/haskell/Hydra/Langs/Graphql/Serde.hs b/src/main/haskell/Hydra/Langs/Graphql/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Graphql/Serde.hs +++ /dev/null @@ -1,106 +0,0 @@ -module Hydra.Langs.Graphql.Serde (exprDocument) where - -import Hydra.Tools.Serialization -import Hydra.Tools.Formatting -import qualified Hydra.Ast as CT -import qualified Hydra.Langs.Graphql.Syntax as G - -import qualified Data.List as L -import qualified Data.Maybe as Y - - -commentDelim = cst "\"\"\"" :: CT.Expr - -exprDefinition :: G.Definition -> CT.Expr -exprDefinition def = case def of - G.DefinitionExecutable _ -> unsup def - G.DefinitionTypeSystem de -> exprTypeSystemDefinitionOrExtension de - -exprDescription :: G.Description -> CT.Expr -exprDescription desc = newlineSep [ - commentDelim, - cst $ G.unStringValue $ G.unDescription desc, - commentDelim] - -exprDocument :: G.Document -> CT.Expr -exprDocument d = doubleNewlineSep (exprDefinition <$> G.unDocument d) - -exprEnumTypeDefinition :: G.EnumTypeDefinition -> CT.Expr -exprEnumTypeDefinition def = withDescription (G.enumTypeDefinitionDescription def) $ - spaceSep [cst "enum", exprName (G.enumTypeDefinitionName def), - curlyBracesList Nothing fullBlockStyle valuesExpr] - where - valuesExpr = case G.enumTypeDefinitionEnumValuesDefinition def of - Nothing -> [] - Just values -> exprEnumValueDefinition <$> G.unEnumValuesDefinition values - -exprEnumValue :: G.EnumValue -> CT.Expr -exprEnumValue = exprName . G.unEnumValue - -exprEnumValueDefinition :: G.EnumValueDefinition -> CT.Expr -exprEnumValueDefinition def = withDescription (G.enumValueDefinitionDescription def) $ - exprEnumValue $ G.enumValueDefinitionEnumValue def - -exprFieldDefinition :: G.FieldDefinition -> CT.Expr -exprFieldDefinition def = withDescription (G.fieldDefinitionDescription def) $ - spaceSep [namePart, typePart] - where - namePart = noSep[exprName (G.fieldDefinitionName def), cst ":"] - typePart = exprType $ G.fieldDefinitionType def - -exprListType :: G.ListType -> CT.Expr -exprListType lt = noSep[cst "[", exprType $ G.unListType lt, cst "]"] - -exprName :: G.Name -> CT.Expr -exprName = cst . G.unName - -exprNamedType :: G.NamedType -> CT.Expr -exprNamedType = exprName . G.unNamedType - -exprNonNullType :: G.NonNullType -> CT.Expr -exprNonNullType nnt = noSep [typeExpr, cst "!"] - where - typeExpr = case nnt of - G.NonNullTypeNamed nt -> exprNamedType nt - G.NonNullTypeList lt -> exprListType lt - -exprObjectTypeDefinition :: G.ObjectTypeDefinition -> CT.Expr -exprObjectTypeDefinition def = withDescription (G.objectTypeDefinitionDescription def) $ - spaceSep [cst "type", exprName (G.objectTypeDefinitionName def), - curlyBracesList Nothing fullBlockStyle fieldsExpr] - where - fieldsExpr = case G.objectTypeDefinitionFieldsDefinition def of - Nothing -> [] - Just fields -> exprFieldDefinition <$> G.unFieldsDefinition fields - -exprType :: G.Type -> CT.Expr -exprType typ = case typ of - G.TypeNamed nt -> exprNamedType nt - G.TypeList lt -> exprListType lt - G.TypeNonNull nnt -> exprNonNullType nnt - -exprTypeDefinition :: G.TypeDefinition -> CT.Expr -exprTypeDefinition def = case def of - G.TypeDefinitionScalar _ -> unsup def - G.TypeDefinitionObject od -> exprObjectTypeDefinition od - G.TypeDefinitionInterface _ -> unsup def - G.TypeDefinitionUnion _ -> unsup def - G.TypeDefinitionEnum ed -> exprEnumTypeDefinition ed - G.TypeDefinitionInputObject _ -> unsup def - -exprTypeSystemDefinition :: G.TypeSystemDefinition -> CT.Expr -exprTypeSystemDefinition def = case def of - G.TypeSystemDefinitionSchema _ -> unsup def - G.TypeSystemDefinitionType dt -> exprTypeDefinition dt - G.TypeSystemDefinitionDirective _ -> unsup def - -exprTypeSystemDefinitionOrExtension :: G.TypeSystemDefinitionOrExtension -> CT.Expr -exprTypeSystemDefinitionOrExtension de = case de of - G.TypeSystemDefinitionOrExtensionDefinition d -> exprTypeSystemDefinition d - G.TypeSystemDefinitionOrExtensionExtension _ -> unsup de - -unsup :: Show x => x -> CT.Expr -unsup obj = cst $ "Unsupported: " ++ show obj - -withDescription :: Maybe G.Description -> CT.Expr -> CT.Expr -withDescription mdesc expr = newlineSep $ Y.catMaybes [exprDescription <$> mdesc, Y.Just expr] diff --git a/src/main/haskell/Hydra/Langs/Haskell/Coder.hs b/src/main/haskell/Hydra/Langs/Haskell/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Haskell/Coder.hs +++ /dev/null @@ -1,373 +0,0 @@ -module Hydra.Langs.Haskell.Coder (moduleToHaskell) where - -import Hydra.Kernel -import Hydra.Adapters -import Hydra.Langs.Haskell.Language -import Hydra.Langs.Haskell.Utils -import Hydra.Dsl.Terms -import Hydra.Tools.Serialization -import Hydra.Langs.Haskell.Serde -import Hydra.Langs.Haskell.Settings -import qualified Hydra.Langs.Haskell.Ast as H -import qualified Hydra.Lib.Strings as Strings -import qualified Hydra.Dsl.Types as Types -import Hydra.Lib.Io - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y -import Hydra.Rewriting (removeTypeAnnotations, removeTermAnnotations) - - -adaptTypeToHaskellAndEncode :: Namespaces -> Type -> Flow Graph H.Type -adaptTypeToHaskellAndEncode namespaces = adaptAndEncodeType haskellLanguage (encodeType namespaces) - -constantDecls :: Graph -> Namespaces -> Name -> Type -> [H.DeclarationWithComments] -constantDecls g namespaces name@(Name nm) typ = if useCoreImport - then toDecl (Name "hydra/core.Name") nameDecl:(toDecl (Name "hydra/core.Name") <$> fieldDecls) - else [] - where - lname = localNameOfEager name - toDecl n (k, v) = H.DeclarationWithComments decl Nothing - where - decl = H.DeclarationValueBinding $ H.ValueBindingSimple $ H.ValueBinding_Simple pat rhs Nothing - pat = applicationPattern (simpleName k) [] - rhs = H.RightHandSide $ H.ExpressionApplication $ H.Expression_Application - (H.ExpressionVariable $ elementReference namespaces n) - (H.ExpressionLiteral $ H.LiteralString v) - nameDecl = ("_" ++ lname, nm) - fieldsOf t = case stripType t of - TypeRecord rt -> rowTypeFields rt - TypeUnion rt -> rowTypeFields rt - _ -> [] - fieldDecls = toConstant <$> fieldsOf (snd $ unpackLambdaType g typ) - toConstant (FieldType (Name fname) _) = ("_" ++ lname ++ "_" ++ fname, fname) - -constructModule :: Namespaces - -> Module - -> M.Map Type (Coder Graph Graph Term H.Expression) - -> [(Element, TypedTerm)] -> Flow Graph H.Module -constructModule namespaces mod coders pairs = do - g <- getState - decls <- L.concat <$> CM.mapM (createDeclarations g) pairs - let mc = moduleDescription mod - return $ H.Module (Just $ H.ModuleHead mc (importName $ h $ moduleNamespace mod) []) imports decls - where - h (Namespace name) = name - - createDeclarations g pair@(el, TypedTerm term typ) = do - if isType typ - then toTypeDeclarations namespaces el term - else do - d <- toDataDeclaration coders namespaces pair - return [d] - - importName name = H.ModuleName $ L.intercalate "." (capitalize <$> Strings.splitOn "/" name) - imports = domainImports ++ standardImports - where - domainImports = toImport <$> M.toList (namespacesMapping namespaces) - where - toImport (Namespace name, alias) = H.Import True (importName name) (Just alias) Nothing - standardImports = toImport <$> [ - ("Data.Int", Nothing), - ("Data.List", Just "L"), - ("Data.Map", Just "M"), - ("Data.Set", Just "S")] - where - toImport (name, alias) = H.Import False (H.ModuleName name) (H.ModuleName <$> alias) Nothing - -encodeFunction :: Namespaces -> Function -> Flow Graph H.Expression -encodeFunction namespaces fun = case fun of - FunctionElimination e -> case e of - EliminationList fun -> do - let lhs = hsvar "L.foldl" - rhs <- encodeTerm namespaces fun - return $ hsapp lhs rhs - EliminationWrap name -> pure $ H.ExpressionVariable $ elementReference namespaces $ - qname (Y.fromJust $ namespaceOfEager name) $ newtypeAccessorName name - EliminationOptional (OptionalCases nothing just) -> do - nothingRhs <- H.CaseRhs <$> encodeTerm namespaces nothing - let nothingAlt = H.Alternative (H.PatternName $ rawName "Nothing") nothingRhs Nothing - justAlt <- do - -- Note: some of the following could be brought together with FunctionCases - v0 <- (\i -> "v" ++ show i) <$> nextCount "haskellVar" - let rhsTerm = simplifyTerm $ apply just (var v0) - let v1 = if S.member (Name v0) $ freeVariablesInTerm rhsTerm then v0 else ignoredVariable - let lhs = applicationPattern (rawName "Just") [H.PatternName $ rawName v1] - rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm - return $ H.Alternative lhs rhs Nothing - return $ hslambda "x" $ H.ExpressionCase $ H.Expression_Case (hsvar "x") [nothingAlt, justAlt] - EliminationProduct (TupleProjection arity idx) -> if arity == 2 - then return $ hsvar $ if idx == 0 then "fst" else "snd" - else fail "Eliminations for tuples of arity > 2 are not supported yet in the Haskell coder" - EliminationRecord (Projection dn fname) -> return $ H.ExpressionVariable $ recordFieldReference namespaces dn fname - EliminationUnion (CaseStatement dn def fields) -> hslambda "x" <$> caseExpr -- note: could use a lambda case here - where - caseExpr = do - rt <- withSchemaContext $ requireUnionType False dn - let fieldMap = M.fromList $ (\f -> (fieldTypeName f, f)) <$> rowTypeFields rt - ecases <- CM.mapM (toAlt fieldMap) fields - dcases <- case def of - Nothing -> pure [] - Just d -> do - cs <- H.CaseRhs <$> encodeTerm namespaces d - let lhs = H.PatternName $ rawName ignoredVariable - return [H.Alternative lhs cs Nothing] - return $ H.ExpressionCase $ H.Expression_Case (hsvar "x") $ ecases ++ dcases - toAlt fieldMap (Field fn fun') = do - v0 <- (\i -> "v" ++ show i) <$> nextCount "haskellVar" - let raw = apply fun' (var v0) - let rhsTerm = simplifyTerm raw - let v1 = if isFreeIn (Name v0) rhsTerm then ignoredVariable else v0 - let hname = unionFieldReference namespaces dn fn - args <- case M.lookup fn fieldMap of - Just (FieldType _ ft) -> case stripType ft of - TypeRecord (RowType _ Nothing []) -> pure [] - _ -> pure [H.PatternName $ rawName v1] - Nothing -> fail $ "field " ++ show fn ++ " not found in " ++ show dn - let lhs = applicationPattern hname args - rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm - return $ H.Alternative lhs rhs Nothing - FunctionLambda (Lambda (Name v) body) -> hslambda v <$> encodeTerm namespaces body - FunctionPrimitive name -> pure $ H.ExpressionVariable $ hsPrimitiveReference name - -encodeLiteral :: Literal -> Flow Graph H.Expression -encodeLiteral av = case av of - LiteralBoolean b -> pure $ hsvar $ if b then "True" else "False" - LiteralFloat fv -> case fv of - FloatValueFloat32 f -> pure $ hslit $ H.LiteralFloat f - FloatValueFloat64 f -> pure $ hslit $ H.LiteralDouble f - _ -> unexpected "floating-point number" $ show fv - LiteralInteger iv -> case iv of - IntegerValueBigint i -> pure $ hslit $ H.LiteralInteger i - IntegerValueInt32 i -> pure $ hslit $ H.LiteralInt i - _ -> unexpected "integer" $ show iv - LiteralString s -> pure $ hslit $ H.LiteralString s - _ -> unexpected "literal value" $ show av - -encodeTerm :: Namespaces -> Term -> Flow Graph H.Expression -encodeTerm namespaces term = do - case fullyStripTerm term of - TermApplication (Application fun arg) -> hsapp <$> encode fun <*> encode arg - TermFunction f -> encodeFunction namespaces f - TermLet (Let bindings env) -> do - hbindings <- CM.mapM encodeBinding bindings - hinner <- encode env - return $ H.ExpressionLet $ H.Expression_Let hbindings hinner - where - encodeBinding (LetBinding name term _) = do - let hname = simpleName $ unName name - hexpr <- encode term - return $ H.LocalBindingValue $ simpleValueBinding hname hexpr Nothing - TermList els -> H.ExpressionList <$> CM.mapM encode els - TermLiteral v -> encodeLiteral v - TermWrap (WrappedTerm tname term') -> if newtypesNotTypedefs - then hsapp <$> pure (H.ExpressionVariable $ elementReference namespaces tname) <*> encode term' - else encode term' - TermOptional m -> case m of - Nothing -> pure $ hsvar "Nothing" - Just t -> hsapp (hsvar "Just") <$> encode t - TermProduct terms -> H.ExpressionTuple <$> (CM.mapM encode terms) - TermRecord (Record sname fields) -> do - if L.null fields -- TODO: too permissive; not all empty record types are the unit type - then pure $ H.ExpressionTuple [] - else do - let typeName = elementReference namespaces sname - updates <- CM.mapM toFieldUpdate fields - return $ H.ExpressionConstructRecord $ H.Expression_ConstructRecord typeName updates - where - toFieldUpdate (Field fn ft) = H.FieldUpdate (recordFieldReference namespaces sname fn) <$> encode ft - TermUnion (Injection sname (Field fn ft)) -> do - let lhs = H.ExpressionVariable $ unionFieldReference namespaces sname fn - case fullyStripTerm ft of - TermRecord (Record _ []) -> pure lhs - _ -> hsapp lhs <$> encode ft - TermVariable name -> pure $ H.ExpressionVariable $ elementReference namespaces name --pure $ hsvar v - t -> fail $ "unexpected term: " ++ show t - where - encode = encodeTerm namespaces - -encodeType :: Namespaces -> Type -> Flow Graph H.Type -encodeType namespaces typ = withTrace "encode type" $ case stripType typ of - TypeApplication (ApplicationType lhs rhs) -> toTypeApplication <$> CM.sequence [encode lhs, encode rhs] - TypeFunction (FunctionType dom cod) -> H.TypeFunction <$> (H.Type_Function <$> encode dom <*> encode cod) - TypeLambda (LambdaType (Name v) body) -> toTypeApplication <$> CM.sequence [ - encode body, - pure $ H.TypeVariable $ simpleName v] - TypeList lt -> H.TypeList <$> encode lt - TypeLiteral lt -> H.TypeVariable . rawName <$> case lt of - LiteralTypeBoolean -> pure "Bool" - LiteralTypeFloat ft -> case ft of - FloatTypeFloat32 -> pure "Float" - FloatTypeFloat64 -> pure "Double" - FloatTypeBigfloat -> pure "Double" -- TODO: type adapter should prevent this --- _ -> fail $ "unexpected floating-point type: " ++ show ft - LiteralTypeInteger it -> case it of - IntegerTypeBigint -> pure "Integer" - IntegerTypeInt8 -> pure "Int8" - IntegerTypeInt16 -> pure "Int16" - IntegerTypeInt32 -> pure "Int" - IntegerTypeInt64 -> pure "Int64" - _ -> fail $ "unexpected integer type: " ++ show it - LiteralTypeString -> pure "String" - _ -> fail $ "unexpected literal type: " ++ show lt - TypeMap (MapType kt vt) -> toTypeApplication <$> CM.sequence [ - pure $ H.TypeVariable $ rawName "Map", - encode kt, - encode vt] - TypeOptional ot -> toTypeApplication <$> CM.sequence [ - pure $ H.TypeVariable $ rawName "Maybe", - encode ot] - TypeProduct types -> H.TypeTuple <$> (CM.mapM encode types) - TypeRecord rt -> case rowTypeFields rt of - [] -> pure $ H.TypeTuple [] -- TODO: too permissive; not all empty record types are the unit type - _ -> ref $ rowTypeTypeName rt - TypeSet st -> toTypeApplication <$> CM.sequence [ - pure $ H.TypeVariable $ rawName "Set", - encode st] - TypeUnion rt -> ref $ rowTypeTypeName rt - TypeVariable v -> ref v - TypeWrap (WrappedType name _) -> ref name - _ -> fail $ "unexpected type: " ++ show typ - where - encode = encodeType namespaces - ref name = pure $ H.TypeVariable $ elementReference namespaces name - -encodeTypeWithClassAssertions :: Namespaces -> M.Map Name (S.Set TypeClass) -> Type -> Flow Graph H.Type -encodeTypeWithClassAssertions namespaces classes typ = withTrace "encode with assertions" $ do - htyp <- adaptTypeToHaskellAndEncode namespaces typ - if L.null assertPairs - then pure htyp - else do - let encoded = encodeAssertion <$> assertPairs - let hassert = if L.length encoded > 1 then L.head encoded else H.AssertionTuple encoded - return $ H.TypeCtx $ H.Type_Context hassert htyp - where - encodeAssertion (name, cls) = H.AssertionClass $ H.Assertion_Class hname [htype] - where - hname = rawName $ case cls of - TypeClassEquality -> "Eq" - TypeClassOrdering -> "Ord" - htype = H.TypeVariable $ rawName $ unName name -- TODO: sanitization - - assertPairs = L.concat (toPairs <$> M.toList classes) - where - toPairs (name, cls) = toPair <$> S.toList cls - where - toPair c = (name, c) - -moduleToHaskellModule :: Module -> Flow Graph H.Module -moduleToHaskellModule mod = do - namespaces <- namespacesForModule mod - transformModule haskellLanguage (encodeTerm namespaces) (constructModule namespaces) mod - -moduleToHaskell :: Module -> Flow Graph (M.Map FilePath String) -moduleToHaskell mod = do - hsmod <- moduleToHaskellModule mod - let s = printExpr $ parenthesize $ toTree hsmod - return $ M.fromList [(namespaceToFilePath True (FileExtension "hs") $ moduleNamespace mod, s)] - -toDataDeclaration :: M.Map Type (Coder Graph Graph Term H.Expression) -> Namespaces - -> (Element, TypedTerm) -> Flow Graph H.DeclarationWithComments -toDataDeclaration coders namespaces (el, TypedTerm term typ) = do - comments <- getTermDescription term - toDecl comments hname term coder Nothing - where - coder = Y.fromJust $ M.lookup typ coders - hname = simpleName $ localNameOfEager $ elementName el - - rewriteValueBinding vb = case vb of - H.ValueBindingSimple (H.ValueBinding_Simple (H.PatternApplication (H.Pattern_Application name args)) rhs bindings) -> case rhs of - H.RightHandSide (H.ExpressionLambda (H.Expression_Lambda vars body)) -> rewriteValueBinding $ - H.ValueBindingSimple $ H.ValueBinding_Simple - (applicationPattern name (args ++ vars)) (H.RightHandSide body) bindings - _ -> vb - - toDecl comments hname term coder bindings = case fullyStripTerm term of - TermLet (Let lbindings env) -> do - -- A "let" constant cannot be predicted in advance, so we infer its type and construct a coder on the fly - -- This makes program code with "let" terms more expensive to transform than simple data. - ts <- (CM.mapM inferType (letBindingTerm <$> lbindings)) - coders <- CM.mapM (constructCoder haskellLanguage (encodeTerm namespaces)) ts - let hnames = simpleName <$> (unName . letBindingName <$> lbindings) - hterms <- CM.zipWithM coderEncode coders (letBindingTerm <$> lbindings) - - let hbindings = L.zipWith toBinding hnames hterms - toDecl comments hname env coder (Just $ H.LocalBindings hbindings) - where - toBinding hname' hterm' = H.LocalBindingValue $ simpleValueBinding hname' hterm' Nothing - _ -> do - hterm <- coderEncode coder term - let vb = simpleValueBinding hname hterm bindings - classes <- getTypeClasses typ - htype <- encodeTypeWithClassAssertions namespaces classes typ - let decl = H.DeclarationTypedBinding $ H.TypedBinding (H.TypeSignature hname htype) (rewriteValueBinding vb) - return $ H.DeclarationWithComments decl comments - -toTypeDeclarations :: Namespaces -> Element -> Term -> Flow Graph [H.DeclarationWithComments] -toTypeDeclarations namespaces el term = withTrace ("type element " ++ unName (elementName el)) $ do - g <- getState - let lname = localNameOfEager $ elementName el - let hname = simpleName lname - t <- coreDecodeType term - - isSer <- isSerializable el - let deriv = H.Deriving $ if isSer - then rawName <$> ["Eq", "Ord", "Read", "Show"] - else [] - let (vars, t') = unpackLambdaType g t - let hd = declHead hname $ L.reverse vars - decl <- case stripType t' of - TypeRecord rt -> do - cons <- recordCons lname $ rowTypeFields rt - return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordData [] hd [cons] [deriv] - TypeUnion rt -> do - cons <- CM.mapM (unionCons lname) $ rowTypeFields rt - return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordData [] hd cons [deriv] - TypeWrap (WrappedType tname wt) -> do - cons <- newtypeCons el wt - return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv] - _ -> if newtypesNotTypedefs - then do - cons <- newtypeCons el t' - return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv] - else do - htype <- adaptTypeToHaskellAndEncode namespaces t - return $ H.DeclarationType (H.TypeDeclaration hd htype) - comments <- getTermDescription term - return $ [H.DeclarationWithComments decl comments] ++ constantDecls g namespaces (elementName el) t - where - declHead name vars = case vars of - [] -> H.DeclarationHeadSimple name - ((Name h):rest) -> H.DeclarationHeadApplication $ - H.DeclarationHead_Application (declHead name rest) (H.Variable $ simpleName h) - - newtypeCons el typ = do - let hname = simpleName $ newtypeAccessorName $ elementName el - htype <- adaptTypeToHaskellAndEncode namespaces typ - comments <- getTypeDescription typ - let hfield = H.FieldWithComments (H.Field hname htype) comments - return $ H.ConstructorWithComments - (H.ConstructorRecord $ H.Constructor_Record (simpleName $ localNameOfEager $ elementName el) [hfield]) Nothing - - recordCons lname fields = do - hFields <- CM.mapM toField fields - return $ H.ConstructorWithComments (H.ConstructorRecord $ H.Constructor_Record (simpleName lname) hFields) Nothing - where - toField (FieldType (Name fname) ftype) = do - let hname = simpleName $ decapitalize lname ++ capitalize fname - htype <- adaptTypeToHaskellAndEncode namespaces ftype - comments <- getTypeDescription ftype - return $ H.FieldWithComments (H.Field hname htype) comments - - unionCons lname (FieldType (Name fname) ftype) = do - comments <- getTypeDescription ftype - let nm = capitalize lname ++ capitalize fname - typeList <- if stripType ftype == Types.unit - then pure [] - else do - htype <- adaptTypeToHaskellAndEncode namespaces ftype - return [htype] - return $ H.ConstructorWithComments (H.ConstructorOrdinary $ H.Constructor_Ordinary (simpleName nm) typeList) comments diff --git a/src/main/haskell/Hydra/Langs/Haskell/Language.hs b/src/main/haskell/Hydra/Langs/Haskell/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Haskell/Language.hs +++ /dev/null @@ -1,77 +0,0 @@ -module Hydra.Langs.Haskell.Language where - -import Hydra.Kernel - -import qualified Data.Set as S - - -haskellLanguage :: Language -haskellLanguage = Language (LanguageName "hydra/langs/haskell") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.fromList eliminationVariants, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBoolean, - LiteralVariantFloat, - LiteralVariantInteger, - LiteralVariantString], - languageConstraintsFloatTypes = S.fromList [ - -- Bigfloat is excluded for now - FloatTypeFloat32, -- Float - FloatTypeFloat64], -- Double - languageConstraintsFunctionVariants = S.fromList functionVariants, - languageConstraintsIntegerTypes = S.fromList [ - IntegerTypeBigint, -- Integer - IntegerTypeInt8, -- Int8 - IntegerTypeInt16, -- Int16 - IntegerTypeInt32, -- Int - IntegerTypeInt64], -- Int64 - languageConstraintsTermVariants = S.fromList [ - TermVariantApplication, - TermVariantFunction, - TermVariantLet, - TermVariantList, - TermVariantLiteral, - TermVariantMap, - TermVariantOptional, - TermVariantProduct, - TermVariantRecord, - TermVariantSet, - TermVariantUnion, - TermVariantVariable, - TermVariantWrap], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantAnnotated, - TypeVariantApplication, - TypeVariantFunction, - TypeVariantLambda, - TypeVariantList, - TypeVariantLiteral, - TypeVariantMap, - TypeVariantOptional, - TypeVariantProduct, - TypeVariantRecord, - TypeVariantSet, - TypeVariantUnion, - TypeVariantVariable, - TypeVariantWrap], - languageConstraintsTypes = const True } - -reservedWords :: S.Set String -reservedWords = S.fromList $ preludeSymbols ++ extSymbols - where - -- See: https://www.haskell.org/onlinereport/standard-prelude.html - -- List created on 2022-06-01. Symbols not containing at least one alphanumeric character are excluded. - preludeSymbols = [ - "Bool", "Bounded", "Char", "Double", "EQ", "Either", "Enum", "Eq", "False", "Float", "Floating", "Fractional", - "Functor", "GT", "IO", "Int", "Integer", "Integral", "Just", "LT", "Left", "Maybe", "Monad", "Nothing", "Num", - "Ord", "Ordering", "Rational", "Real", "RealFloat", "RealFrac", "Right", "String", "True", "abs", "acos", "acosh", - "asTypeOf", "asin", "asinh", "atan", "atan2", "atanh", "ceiling", "compare", "const", "cos", "cosh", "curry", - "decodeFloat", "div", "divMod", "either", "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo", - "enumFromTo", "error", "even", "exp", "exponent", "fail", "flip", "floatDigits", "floatRadix", "floatRange", - "floor", "fmap", "fromEnum", "fromInteger", "fromIntegral", "fromRational", "fst", "gcd", "id", "isDenormalized", - "isIEEE", "isInfinite", "isNaN", "isNegativeZero", "lcm", "log", "logBase", "mapM", "mapM_", "max", "maxBound", - "maybe", "min", "minBound", "mod", "negate", "not", "odd", "otherwise", "pi", "pred", "properFraction", "quot", - "quotRem", "realToFrac", "recip", "rem", "return", "round", "scaleFloat", "seq", "sequence", "sequence_", - "significand", "signum", "sin", "sinh", "snd", "sqrt", "subtract", "succ", "tan", "tanh", "toEnum", "toInteger", - "toRational", "truncate", "uncurry", "undefined", "until"] - -- Additional symbols which need to be reserved, as the Haskell coder uses them in their unqualified form - extSymbols = ["Map", "Set"] diff --git a/src/main/haskell/Hydra/Langs/Haskell/Operators.hs b/src/main/haskell/Hydra/Langs/Haskell/Operators.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Haskell/Operators.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Hydra.Langs.Haskell.Operators where - -import Hydra.Ast -import Hydra.Tools.Serialization - - -andOp = op "&&" 3 AssociativityRight :: Op -apOp = op "<*>" 4 AssociativityLeft :: Op -appOp = Op (Symbol "") (Padding WsNone WsSpace) (Precedence 0) AssociativityLeft :: Op -- No source -applyOp = op "$" 0 AssociativityRight :: Op -arrowOp = op "->" (negate 1) AssociativityRight :: Op -assertOp = op "=>" 0 AssociativityNone :: Op -- No source ---assignOp = op "<-" -bindOp = op ">>=" 1 AssociativityLeft :: Op -caseOp = op "->" 0 AssociativityNone :: Op -- No source -composeOp = op "." 9 AssociativityLeft :: Op -concatOp = op "++" 5 AssociativityRight :: Op -consOp = op ":" 5 AssociativityRight :: Op -defineOp = op "=" 0 AssociativityNone :: Op -- No source -diamondOp = op "<>" 6 AssociativityRight :: Op -divOp = op "`div`" 7 AssociativityLeft :: Op -divideOp = op "/" 7 AssociativityLeft :: Op -elemOp = op "`elem`" 4 AssociativityNone :: Op -equalOp = op "==" 4 AssociativityNone :: Op -fmapOp = op "<$>" 4 AssociativityLeft :: Op -gtOp = op ">" 4 AssociativityNone :: Op -gteOp = op ">=" 4 AssociativityNone :: Op -indexOp = op "!!" 9 AssociativityLeft :: Op -lambdaOp = op "->" (negate 1) AssociativityRight :: Op -- No source -ltOp = op "<" 4 AssociativityNone :: Op -lteOp = op ">=" 4 AssociativityNone :: Op -minusOp = op "-" 6 AssociativityBoth :: Op -- Originally: AssociativityLeft -modOp = op "`mod`" 7 AssociativityLeft :: Op -multOp = op "*" 7 AssociativityBoth :: Op -- Originally: AssociativityLeft -neqOp = op "/=" 4 AssociativityNone :: Op -notElemOp = op "`notElem`" 4 AssociativityNone :: Op -orOp = op "||" 2 AssociativityRight :: Op -plusOp = op "+" 6 AssociativityBoth :: Op -- Originally: AssociativityLeft -quotOp = op "`quot`" 7 AssociativityLeft :: Op -remOp = op "`rem`" 7 AssociativityLeft :: Op ---suchThatOp = op "|" -typeOp = op "::" 0 AssociativityNone :: Op -- No source diff --git a/src/main/haskell/Hydra/Langs/Haskell/Serde.hs b/src/main/haskell/Hydra/Langs/Haskell/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Haskell/Serde.hs +++ /dev/null @@ -1,241 +0,0 @@ --- | Haskell operator precendence and associativity are drawn from: --- https://self-learning-java-tutorial.blogspot.com/2016/04/haskell-operator-precedence.html --- Other operators were investigated using GHCi, e.g. ":info (->)" --- Operator names are drawn (loosely) from: --- https://stackoverflow.com/questions/7746894/are-there-pronounceable-names-for-common-haskell-operators - -module Hydra.Langs.Haskell.Serde where - -import Hydra.Ast -import Hydra.Tools.Serialization -import Hydra.Langs.Haskell.Operators -import qualified Hydra.Langs.Haskell.Ast as H - -import qualified Data.Char as C -import qualified Data.List as L -import qualified Data.Maybe as Y - - -class ToTree a where - toTree :: a -> Expr - -instance ToTree H.Alternative where - toTree (H.Alternative pat rhs _) = ifx caseOp (toTree pat) (toTree rhs) - -instance ToTree H.Assertion where - toTree sert = case sert of - H.AssertionClass cls -> toTree cls - H.AssertionTuple serts -> parenList False (toTree <$> serts) - -instance ToTree H.Assertion_Class where - toTree (H.Assertion_Class name types) = spaceSep [toTree name, commaSep halfBlockStyle (toTree <$> types)] - -instance ToTree H.CaseRhs where - toTree (H.CaseRhs expr) = toTree expr - -instance ToTree H.Constructor where - toTree cons = case cons of - H.ConstructorOrdinary (H.Constructor_Ordinary name types) -> spaceSep [ - toTree name, - spaceSep (toTree <$> types)] - H.ConstructorRecord (H.Constructor_Record name fields) -> spaceSep [ - toTree name, - curlyBracesList Nothing halfBlockStyle (toTree <$> fields)] - -instance ToTree H.ConstructorWithComments where - toTree (H.ConstructorWithComments body mc) = case mc of - Nothing -> toTree body - Just c -> newlineSep [cst $ toHaskellComments c, toTree body] - -instance ToTree H.DataDeclaration_Keyword where - toTree kw = case kw of - H.DataDeclaration_KeywordData -> cst "data" - H.DataDeclaration_KeywordNewtype -> cst "newtype" - -instance ToTree H.Declaration where - toTree decl = case decl of - H.DeclarationData (H.DataDeclaration kw _ hd cons deriv) -> indentBlock $ - [spaceSep [toTree kw, toTree hd, cst "="], constructors] - ++ if L.null derivCat then [] else [spaceSep [cst "deriving", parenList False (toTree <$> derivCat)]] - where - derivCat = L.concat $ h <$> deriv - where - h (H.Deriving names) = names - constructors = orSep halfBlockStyle (toTree <$> cons) - H.DeclarationType (H.TypeDeclaration hd typ) -> spaceSep [cst "type", toTree hd, cst "=", toTree typ] - H.DeclarationValueBinding vb -> toTree vb - H.DeclarationTypedBinding (H.TypedBinding (H.TypeSignature name htype) vb) -> newlineSep [ -- TODO: local bindings - ifx typeOp (toTree name) (toTree htype), - toTree vb] - -instance ToTree H.DeclarationHead where - toTree hd = case hd of - H.DeclarationHeadApplication (H.DeclarationHead_Application fun op) -> spaceSep [toTree fun, toTree op] --- H.DeclarationHeadParens ... -> - H.DeclarationHeadSimple name -> toTree name - -instance ToTree H.DeclarationWithComments where - toTree (H.DeclarationWithComments body mc) = case mc of - Nothing -> toTree body - Just c -> newlineSep [cst $ toHaskellComments c, toTree body] - -instance ToTree H.Expression where - toTree expr = case expr of - H.ExpressionApplication app -> toTree app - H.ExpressionCase cases -> toTree cases - H.ExpressionConstructRecord r -> toTree r - H.ExpressionDo statements -> indentBlock $ [cst "do"] ++ (toTree <$> statements) - H.ExpressionIf ifte -> toTree ifte - -- H.ExpressionInfixApplication Term_InfixApplication - H.ExpressionLiteral lit -> toTree lit - -- Note: the need for extra parens may point to an operator precedence issue - H.ExpressionLambda lam -> parenthesize $ toTree lam - -- H.ExpressionLeftSection Term_Section - H.ExpressionLet (H.Expression_Let bindings inner) -> indentBlock [ - cst "", - spaceSep [cst "let", customIndentBlock " " (encodeBinding <$> bindings)], - spaceSep [cst "in", toTree inner]] - where - -- Note: indentation should depend on the length of the pattern - encodeBinding = indentSubsequentLines " " . toTree - H.ExpressionList exprs -> bracketList halfBlockStyle $ toTree <$> exprs - H.ExpressionParens expr' -> parenthesize $ toTree expr' - -- H.ExpressionPrefixApplication Term_PrefixApplication - -- H.ExpressionRightSection Term_Section - H.ExpressionTuple exprs -> parenList False $ toTree <$> exprs - -- H.ExpressionTypeSignature Term_TypeSignature - -- H.ExpressionUpdateRecord Term_UpdateRecord - H.ExpressionVariable name -> toTree name - -instance ToTree H.Expression_Application where - toTree (H.Expression_Application fun arg) = ifx appOp (toTree fun) (toTree arg) - -instance ToTree H.Expression_Case where - toTree (H.Expression_Case cs alts) = ifx ofOp lhs rhs - where - lhs = spaceSep [cst "case", toTree cs] - rhs = newlineSep (toTree <$> alts) - ofOp = Op (Symbol "of") (Padding WsSpace $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone - -instance ToTree H.Expression_ConstructRecord where - toTree (H.Expression_ConstructRecord name updates) = spaceSep [toTree name, brackets curlyBraces halfBlockStyle body] - where - body = commaSep halfBlockStyle (fromUpdate <$> updates) - fromUpdate (H.FieldUpdate fn val) = ifx defineOp (toTree fn) (toTree val) - -instance ToTree H.Expression_If where - toTree (H.Expression_If eif ethen eelse) = ifx ifOp (spaceSep [cst "if", toTree eif]) body - where - ifOp = Op (Symbol "") (Padding WsNone $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone - body = newlineSep [spaceSep [cst "then", toTree ethen], spaceSep [cst "else", toTree eelse]] - -instance ToTree H.Expression_Lambda where - toTree (H.Expression_Lambda bindings inner) = ifx lambdaOp (prefix "\\" head) body - where - head = spaceSep (toTree <$> bindings) - body = toTree inner - -instance ToTree H.Field where - toTree (H.Field name typ) = spaceSep [toTree name, cst "::", toTree typ] - -instance ToTree H.FieldWithComments where - toTree (H.FieldWithComments field mc) = case mc of - Nothing -> toTree field - Just c -> newlineSep [cst $ toHaskellComments c, toTree field] - -instance ToTree H.Import where - toTree (H.Import qual (H.ModuleName name) mod _) = spaceSep $ Y.catMaybes [ - Just $ cst "import", - if qual then Just (cst "qualified") else Nothing, - Just $ cst name, - (\(H.ModuleName m) -> cst $ "as " ++ m) <$> mod] - -instance ToTree H.Literal where - toTree lit = cst $ case lit of - H.LiteralChar c -> show $ C.chr $ fromIntegral c - H.LiteralDouble d -> if d < 0 then "(0" ++ show d ++ ")" else show d - H.LiteralFloat f -> if f < 0 then "(0" ++ show f ++ ")" else show f - H.LiteralInt i -> if i < 0 then "(0" ++ show i ++ ")" else show i - H.LiteralInteger i -> show i - H.LiteralString s -> show s - -instance ToTree H.LocalBinding where - toTree binding = case binding of - H.LocalBindingSignature ts -> toTree ts - H.LocalBindingValue vb -> toTree vb - -instance ToTree H.Module where - toTree (H.Module mh imports decls) = doubleNewlineSep $ - headerLine ++ importLines ++ declLines - where - headerLine = Y.maybe [] (\h -> [toTree h]) mh - declLines = toTree <$> decls - importLines = [newlineSep $ toTree <$> imports | not (L.null imports)] - -instance ToTree H.Name where - toTree name = cst $ case name of - H.NameImplicit qn -> "?" ++ writeQualifiedName qn - H.NameNormal qn -> writeQualifiedName qn - H.NameParens qn -> "(" ++ writeQualifiedName qn ++ ")" - -instance ToTree H.ModuleHead where - toTree (H.ModuleHead mc (H.ModuleName mname) _) = case mc of - Nothing -> head - Just c -> newlineSep [cst $ toHaskellComments c, cst "", head] - where - head = spaceSep [cst "module", cst mname, cst "where"] - -instance ToTree H.Pattern where - toTree pat = case pat of - H.PatternApplication app -> toTree app --- H.PatternAs (H.Pattern_As ) -> - H.PatternList pats -> bracketList halfBlockStyle $ toTree <$> pats - H.PatternLiteral lit -> toTree lit - H.PatternName name -> toTree name - H.PatternParens pat -> parenthesize $ toTree pat --- H.PatternRecord (H.Pattern_Record ) -> - H.PatternTuple pats -> parenList False $ toTree <$> pats --- H.PatternTyped (H.Pattern_Typed ) -> - H.PatternWildcard -> cst "_" - -instance ToTree H.Pattern_Application where - toTree (H.Pattern_Application name pats) = spaceSep $ toTree name:(toTree <$> pats) - -instance ToTree H.RightHandSide where - toTree (H.RightHandSide expr) = toTree expr - -instance ToTree H.Statement where - toTree (H.Statement expr) = toTree expr - -instance ToTree H.Type where - toTree htype = case htype of - H.TypeApplication (H.Type_Application lhs rhs) -> ifx appOp (toTree lhs) (toTree rhs) - H.TypeCtx (H.Type_Context ctx typ) -> ifx assertOp (toTree ctx) (toTree typ) - H.TypeFunction (H.Type_Function dom cod) -> ifx arrowOp (toTree dom) (toTree cod) --- H.TypeInfix Type_Infix - H.TypeList htype -> bracketList inlineStyle [toTree htype] --- H.TypeParens Type - H.TypeTuple types -> parenList False $ toTree <$> types - H.TypeVariable name -> toTree name - -instance ToTree H.TypeSignature where - toTree (H.TypeSignature name typ) = spaceSep [toTree name, cst "::", toTree typ] - -instance ToTree H.ValueBinding where - toTree vb = case vb of - H.ValueBindingSimple (H.ValueBinding_Simple pat rhs local) -> case local of - Nothing -> body - Just (H.LocalBindings bindings) -> indentBlock [body, indentBlock $ [cst "where"] ++ (toTree <$> bindings)] - where - body = ifx defineOp (toTree pat) (toTree rhs) - -instance ToTree H.Variable where - toTree (H.Variable v) = toTree v - -toHaskellComments :: String -> String -toHaskellComments c = L.intercalate "\n" $ ("-- | " ++) <$> L.lines c - -writeQualifiedName :: H.QualifiedName -> String -writeQualifiedName (H.QualifiedName qualifiers unqual) = L.intercalate "." $ (h <$> qualifiers) ++ [h unqual] - where - h (H.NamePart part) = part diff --git a/src/main/haskell/Hydra/Langs/Haskell/Settings.hs b/src/main/haskell/Hydra/Langs/Haskell/Settings.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Haskell/Settings.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Hydra.Langs.Haskell.Settings where - -newtypesNotTypedefs :: Bool -newtypesNotTypedefs = True - -useCoreImport :: Bool -useCoreImport = True diff --git a/src/main/haskell/Hydra/Langs/Haskell/Utils.hs b/src/main/haskell/Hydra/Langs/Haskell/Utils.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Haskell/Utils.hs +++ /dev/null @@ -1,109 +0,0 @@ -module Hydra.Langs.Haskell.Utils where - -import Hydra.Kernel -import Hydra.Langs.Haskell.Language -import qualified Hydra.Langs.Haskell.Ast as H -import qualified Hydra.Lib.Strings as Strings - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S - - -data Namespaces = Namespaces { - namespacesFocus :: (Namespace, H.ModuleName), - namespacesMapping :: M.Map Namespace H.ModuleName} deriving Show - -applicationPattern name args = H.PatternApplication $ H.Pattern_Application name args - -elementReference :: Namespaces -> Name -> H.Name -elementReference (Namespaces (gname, H.ModuleName gmod) namespaces) name = case (qualifiedNameNamespace qname) of - Nothing -> simpleName local - Just ns -> case M.lookup ns namespaces of - Nothing -> simpleName local - Just (H.ModuleName a) -> if ns == gname - then simpleName escLocal - else rawName $ a ++ "." ++ escLocal - where - qname = qualifyNameEager name - local = qualifiedNameLocal qname - escLocal = sanitizeHaskellName local - simple = simpleName $ qualifiedNameLocal qname - -hsapp :: H.Expression -> H.Expression -> H.Expression -hsapp l r = H.ExpressionApplication $ H.Expression_Application l r - -hslambda :: String -> H.Expression -> H.Expression -hslambda v rhs = H.ExpressionLambda (H.Expression_Lambda [H.PatternName $ rawName v] rhs) - -hslit :: H.Literal -> H.Expression -hslit = H.ExpressionLiteral - -hsPrimitiveReference :: Name -> H.Name -hsPrimitiveReference name = H.NameNormal $ H.QualifiedName [prefix] $ H.NamePart local - where - QualifiedName (Just (Namespace ns)) local = qualifyNameEager name - prefix = H.NamePart $ capitalize $ L.last $ Strings.splitOn "/" ns - -hsvar :: String -> H.Expression -hsvar s = H.ExpressionVariable $ rawName s - -namespacesForModule :: Module -> Flow (Graph) Namespaces -namespacesForModule mod = do - nss <- moduleDependencyNamespaces True True True True mod - return $ Namespaces focusPair $ fst $ L.foldl addPair (M.empty, S.empty) (toPair <$> S.toList nss) - where - ns = moduleNamespace mod - focusPair = toPair ns - toModuleName (Namespace n) = H.ModuleName $ capitalize $ L.last $ Strings.splitOn "/" n - toPair name = (name, toModuleName name) - addPair (m, s) (name, alias@(H.ModuleName aliasStr)) = if S.member alias s - then addPair (m, s) (name, H.ModuleName $ aliasStr ++ "_") - else (M.insert name alias m, S.insert alias s) - -newtypeAccessorName :: Name -> String -newtypeAccessorName name = "un" ++ localNameOfEager name - -rawName :: String -> H.Name -rawName n = H.NameNormal $ H.QualifiedName [] $ H.NamePart n - -recordFieldReference :: Namespaces -> Name -> Name -> H.Name -recordFieldReference namespaces sname (Name fname) = elementReference namespaces $ - unqualifyName $ QualifiedName (qualifiedNameNamespace $ qualifyNameEager sname) nm - where - nm = decapitalize (typeNameForRecord sname) ++ capitalize fname - -sanitizeHaskellName :: String -> String -sanitizeHaskellName = sanitizeWithUnderscores reservedWords - -simpleName :: String -> H.Name -simpleName = rawName . sanitizeHaskellName - -simpleValueBinding :: H.Name -> H.Expression -> Maybe H.LocalBindings -> H.ValueBinding -simpleValueBinding hname rhs bindings = H.ValueBindingSimple $ H.ValueBinding_Simple pat (H.RightHandSide rhs) bindings - where - pat = H.PatternApplication $ H.Pattern_Application hname [] - -toTypeApplication :: [H.Type] -> H.Type -toTypeApplication = app . L.reverse - where - app l = case l of - [e] -> e - (h:r) -> H.TypeApplication $ H.Type_Application (app r) h - -typeNameForRecord :: Name -> String -typeNameForRecord (Name sname) = L.last (Strings.splitOn "." sname) - -unionFieldReference :: Namespaces -> Name -> Name -> H.Name -unionFieldReference namespaces sname (Name fname) = elementReference namespaces $ - unqualifyName $ QualifiedName ns nm - where - ns = qualifiedNameNamespace $ qualifyNameEager sname - nm = capitalize (typeNameForRecord sname) ++ capitalize fname - -unpackLambdaType :: Graph -> Type -> ([Name], Type) -unpackLambdaType cx t = case stripType t of - TypeLambda (LambdaType v tbody) -> (v:vars, t') - where - (vars, t') = unpackLambdaType cx tbody - _ -> ([], t) diff --git a/src/main/haskell/Hydra/Langs/Java/Coder.hs b/src/main/haskell/Hydra/Langs/Java/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Java/Coder.hs +++ /dev/null @@ -1,974 +0,0 @@ -module Hydra.Langs.Java.Coder ( - JavaFeatures(..), - java8Features, - moduleToJava, -) where - -import Hydra.Kernel -import Hydra.Reduction -import Hydra.Langs.Java.Utils -import Hydra.Langs.Java.Language -import Hydra.Langs.Java.Names -import Hydra.Adapters -import Hydra.Tools.Serialization -import Hydra.Langs.Java.Serde -import Hydra.Langs.Java.Settings -import Hydra.AdapterUtils -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types -import qualified Hydra.Langs.Java.Syntax as Java -import Hydra.Lib.Io - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.List.Split as LS -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y -import Data.String (String) - - -data JavaSymbolClass = JavaSymbolClassConstant | JavaSymbolClassNullaryFunction | JavaSymbolClassUnaryFunction | JavaSymbolLocalVariable - -data JavaFeatures = JavaFeatures { - supportsDiamondOperator :: Bool -} - -java8Features = JavaFeatures { - supportsDiamondOperator = False -} - -java11Features = JavaFeatures { - supportsDiamondOperator = True -} - --- For now, the supported features are hard-coded to those of Java 11, rather than being configurable. -javaFeatures = java11Features - -moduleToJava :: Module -> Flow Graph (M.Map FilePath String) -moduleToJava mod = withTrace "encode module in Java" $ do - units <- moduleToJavaCompilationUnit mod - return $ M.fromList $ forPair <$> M.toList units - where - forPair (name, unit) = (elementNameToFilePath name, printExpr $ parenthesize $ writeCompilationUnit unit) - -adaptTypeToJavaAndEncode :: Aliases -> Type -> Flow Graph Java.Type -adaptTypeToJavaAndEncode aliases = adaptAndEncodeType javaLanguage (encodeType aliases) - -addComment :: Java.ClassBodyDeclaration -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments -addComment decl field = Java.ClassBodyDeclarationWithComments decl <$> commentsFromFieldType field - -boundTypeVariables :: Type -> [Name] -boundTypeVariables typ = case typ of - TypeAnnotated (AnnotatedType typ1 _) -> boundTypeVariables typ1 - TypeLambda (LambdaType v body) -> v:(boundTypeVariables body) - _ -> [] - -classModsPublic :: [Java.ClassModifier] -classModsPublic = [Java.ClassModifierPublic] - -classifyDataReference :: Name -> Flow Graph JavaSymbolClass -classifyDataReference name = do - mel <- dereferenceElement name - case mel of - Nothing -> return JavaSymbolLocalVariable - Just el -> do - typ <- requireElementType el - return $ classifyDataTerm typ $ elementData el - -classifyDataTerm :: Type -> Term -> JavaSymbolClass -classifyDataTerm typ term = if isLambda term - then JavaSymbolClassUnaryFunction - else if hasTypeParameters || isUnsupportedVariant - then JavaSymbolClassNullaryFunction - else JavaSymbolClassConstant - where - hasTypeParameters = not $ S.null $ freeVariablesInType typ - isUnsupportedVariant = case fullyStripTerm term of - TermLet _ -> True - _ -> False - -commentsFromElement :: Element -> Flow Graph (Maybe String) -commentsFromElement = getTermDescription . elementData - -commentsFromFieldType :: FieldType -> Flow Graph (Maybe String) -commentsFromFieldType = getTypeDescription . fieldTypeType - -constructElementsInterface :: Module -> [Java.InterfaceMemberDeclaration] -> (Name, Java.CompilationUnit) -constructElementsInterface mod members = (elName, cu) - where - cu = Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) [] [decl] - pkg = javaPackageDeclaration $ moduleNamespace mod - mods = [Java.InterfaceModifierPublic] - className = elementsClassName $ moduleNamespace mod - elName = unqualifyName $ QualifiedName (Just $ moduleNamespace mod) className - body = Java.InterfaceBody members - itf = Java.TypeDeclarationInterface $ Java.InterfaceDeclarationNormalInterface $ - Java.NormalInterfaceDeclaration mods (javaTypeIdentifier className) [] [] body - decl = Java.TypeDeclarationWithComments itf $ moduleDescription mod - -constructModule :: Module - -> M.Map Type (Coder Graph Graph (Term) Java.Expression) - -> [(Element, TypedTerm)] - -> Flow Graph (M.Map Name Java.CompilationUnit) -constructModule mod coders pairs = do - let isTypePair = isType . typedTermType . snd - let typePairs = L.filter isTypePair pairs - let dataPairs = L.filter (not . isTypePair) pairs - typeUnits <- CM.mapM typeToClass typePairs - dataMembers <- CM.mapM (termToInterfaceMember coders) dataPairs - return $ M.fromList $ typeUnits ++ ([constructElementsInterface mod dataMembers | not (L.null dataMembers)]) - where - pkg = javaPackageDeclaration $ moduleNamespace mod - aliases = importAliasesForModule mod - - typeToClass pair@(el, _) = do - isSer <- isSerializable el - let imports = if isSer - then [Java.ImportDeclarationSingleType $ Java.SingleTypeImportDeclaration $ javaTypeName $ Java.Identifier "java.io.Serializable"] - else [] - decl <- declarationForType isSer aliases pair - return (elementName el, - Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) imports [decl]) - - -- Lambdas cannot (in general) be turned into top-level constants, as there is no way of declaring type parameters for constants - -- These functions must be capable of handling various combinations of let and lambda terms: - -- * Plain lambdas such as \x y -> x + y + 42 - -- * Lambdas with nested let terms, such as \x y -> let z = x + y in z + 42 - -- * Let terms with nested lambdas, such as let z = 42 in \x y -> x + y + z - termToInterfaceMember coders pair = withTrace ("element " ++ unName (elementName el)) $ do - let expanded = contractTerm $ unshadowVariables $ expandTypedLambdas $ typedTermTerm $ snd pair - case classifyDataTerm typ expanded of - JavaSymbolClassConstant -> termToConstant coders el expanded - JavaSymbolClassNullaryFunction -> termToNullaryMethod coders el expanded - JavaSymbolClassUnaryFunction -> termToUnaryMethod coders el expanded - where - el = fst pair - typ = typedTermType $ snd pair - tparams = javaTypeParametersForType typ - mname = sanitizeJavaName $ decapitalize $ localNameOfEager $ elementName el - - termToConstant coders el term = do - jtype <- Java.UnannType <$> adaptTypeToJavaAndEncode aliases typ - jterm <- coderEncode (Y.fromJust $ M.lookup typ coders) term - let mods = [] - let var = javaVariableDeclarator (javaVariableName $ elementName el) $ Just $ Java.VariableInitializerExpression jterm - return $ Java.InterfaceMemberDeclarationConstant $ Java.ConstantDeclaration mods jtype [var] - - termToNullaryMethod coders el term0 = maybeLet aliases term0 forInnerTerm - where - forInnerTerm aliases2 term stmts = do - result <- javaTypeToJavaResult <$> adaptTypeToJavaAndEncode aliases2 typ - jbody <- encodeTerm aliases2 term - let mods = [Java.InterfaceMethodModifierStatic] - let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody - return $ interfaceMethodDeclaration mods tparams mname [] result (Just $ stmts ++ [returnSt]) - - termToUnaryMethod coders el term = case stripType typ of - TypeFunction (FunctionType dom cod) -> maybeLet aliases term $ \aliases2 term2 stmts2 -> case fullyStripTerm term2 of - TermFunction (FunctionLambda (Lambda v body)) -> do - jdom <- adaptTypeToJavaAndEncode aliases2 dom - jcod <- adaptTypeToJavaAndEncode aliases2 cod - let mods = [Java.InterfaceMethodModifierStatic] - let param = javaTypeToJavaFormalParameter jdom (Name $ unName v) - let result = javaTypeToJavaResult jcod - maybeLet aliases2 body $ \aliases3 term3 stmts3 -> do - jbody <- encodeTerm aliases3 term3 - -- TODO: use coders - --jbody <- coderEncode (Y.fromJust $ M.lookup typ coders) body - let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody - return $ interfaceMethodDeclaration mods tparams mname [param] result (Just $ stmts2 ++ stmts3 ++ [returnSt]) - _ -> unexpected "function term" $ show term - _ -> unexpected "function type" $ show typ - -declarationForLambdaType :: Bool -> Aliases - -> [Java.TypeParameter] -> Name -> LambdaType -> Flow Graph Java.ClassDeclaration -declarationForLambdaType isSer aliases tparams elName (LambdaType (Name v) body) = - toClassDecl False isSer aliases (tparams ++ [param]) elName body - where - param = javaTypeParameter $ capitalize v - -declarationForRecordType :: Bool -> Bool -> Aliases -> [Java.TypeParameter] -> Name - -> [FieldType] -> Flow Graph Java.ClassDeclaration -declarationForRecordType isInner isSer aliases tparams elName fields = do - memberVars <- CM.mapM toMemberVar fields - memberVars' <- CM.zipWithM addComment memberVars fields - withMethods <- if L.length fields > 1 - then CM.mapM toWithMethod fields - else pure [] - cons <- constructor - tn <- if isInner then pure [] else do - d <- typeNameDecl aliases elName - return [d] - let bodyDecls = tn ++ memberVars' ++ (noComment <$> [cons, equalsMethod, hashCodeMethod] ++ withMethods) - return $ javaClassDeclaration aliases tparams elName classModsPublic Nothing (interfaceTypes isSer) bodyDecls - where - constructor = do - params <- CM.mapM (fieldTypeToFormalParam aliases) fields - let nullCheckStmts = fieldToNullCheckStatement <$> fields - let assignStmts = fieldToAssignStatement <$> fields - return $ makeConstructor aliases elName False params $ nullCheckStmts ++ assignStmts - - fieldToAssignStatement = Java.BlockStatementStatement . toAssignStmt . fieldTypeName - - fieldArgs = fieldNameToJavaExpression . fieldTypeName <$> fields - - toMemberVar (FieldType fname ft) = do - let mods = [Java.FieldModifierPublic, Java.FieldModifierFinal] - jt <- adaptTypeToJavaAndEncode aliases ft - let var = fieldNameToJavaVariableDeclarator fname - return $ javaMemberField mods jt var - - toWithMethod field = do - param <- fieldTypeToFormalParam aliases field - return $ methodDeclaration mods [] anns methodName [param] result (Just [nullCheck, returnStmt]) - where - anns = [] -- TODO - mods = [Java.MethodModifierPublic] - methodName = "with" ++ capitalize (unName $ fieldTypeName field) - nullCheck = fieldToNullCheckStatement field - result = referenceTypeToResult $ nameToJavaReferenceType aliases False [] elName Nothing - consId = Java.Identifier $ sanitizeJavaName $ localNameOfEager elName - returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just $ - javaConstructorCall (javaConstructorName consId Nothing) fieldArgs Nothing - - equalsMethod = methodDeclaration mods [] anns equalsMethodName [param] result $ - Just [instanceOfStmt, - castStmt, - returnAllFieldsEqual] - where - anns = [overrideAnnotation] - mods = [Java.MethodModifierPublic] - param = javaTypeToJavaFormalParameter (javaRefType [] Nothing "Object") (Name otherInstanceName) - result = javaTypeToJavaResult javaBooleanType - tmpName = "o" - - instanceOfStmt = Java.BlockStatementStatement $ Java.StatementIfThen $ - Java.IfThenStatement cond returnFalse - where - cond = javaUnaryExpressionToJavaExpression $ - Java.UnaryExpressionOther $ - Java.UnaryExpressionNotPlusMinusNot $ - javaRelationalExpressionToJavaUnaryExpression $ - javaInstanceOf other parent - where - other = javaIdentifierToJavaRelationalExpression $ javaIdentifier otherInstanceName - parent = nameToJavaReferenceType aliases False [] elName Nothing - - returnFalse = javaReturnStatement $ Just $ javaBooleanExpression False - - castStmt = variableDeclarationStatement aliases jtype id rhs - where - jtype = javaTypeFromTypeName aliases elName - id = javaIdentifier tmpName - rhs = javaCastExpressionToJavaExpression $ javaCastExpression rt var - var = javaIdentifierToJavaUnaryExpression $ Java.Identifier $ sanitizeJavaName otherInstanceName - rt = nameToJavaReferenceType aliases False [] elName Nothing - - returnAllFieldsEqual = Java.BlockStatementStatement $ javaReturnStatement $ Just $ if L.null fields - then javaBooleanExpression True - else javaConditionalAndExpressionToJavaExpression $ - Java.ConditionalAndExpression (eqClause . fieldTypeName <$> fields) - where - eqClause (Name fname) = javaPostfixExpressionToJavaInclusiveOrExpression $ - javaMethodInvocationToJavaPostfixExpression $ Java.MethodInvocation header [arg] - where - arg = javaExpressionNameToJavaExpression $ - fieldExpression (javaIdentifier tmpName) (javaIdentifier fname) - header = Java.MethodInvocation_HeaderComplex $ Java.MethodInvocation_Complex var [] (Java.Identifier equalsMethodName) - var = Java.MethodInvocation_VariantExpression $ Java.ExpressionName Nothing $ Java.Identifier $ - sanitizeJavaName fname - - hashCodeMethod = methodDeclaration mods [] anns hashCodeMethodName [] result $ Just [returnSum] - where - anns = [overrideAnnotation] - mods = [Java.MethodModifierPublic] - result = javaTypeToJavaResult javaIntType - - returnSum = Java.BlockStatementStatement $ if L.null fields - then returnZero - else javaReturnStatement $ Just $ - javaAdditiveExpressionToJavaExpression $ addExpressions $ - L.zipWith multPair multipliers (fieldTypeName <$> fields) - where - returnZero = javaReturnStatement $ Just $ javaIntExpression 0 - - multPair :: Int -> Name -> Java.MultiplicativeExpression - multPair i (Name fname) = Java.MultiplicativeExpressionTimes $ - Java.MultiplicativeExpression_Binary lhs rhs - where - lhs = Java.MultiplicativeExpressionUnary $ javaPrimaryToJavaUnaryExpression $ - javaLiteralToJavaPrimary $ javaInt i - rhs = javaPostfixExpressionToJavaUnaryExpression $ - javaMethodInvocationToJavaPostfixExpression $ - methodInvocationStatic (javaIdentifier fname) (Java.Identifier hashCodeMethodName) [] - - multipliers = L.cycle first20Primes - where - first20Primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71] - -declarationForType :: Bool -> Aliases -> (Element, TypedTerm) -> Flow Graph Java.TypeDeclarationWithComments -declarationForType isSer aliases (el, TypedTerm term _) = withTrace ("element " ++ unName (elementName el)) $ do - t <- coreDecodeType term >>= adaptType javaLanguage - cd <- toClassDecl False isSer aliases [] (elementName el) t - comments <- commentsFromElement el - return $ Java.TypeDeclarationWithComments (Java.TypeDeclarationClass cd) comments - -declarationForUnionType :: Bool -> Aliases - -> [Java.TypeParameter] -> Name -> [FieldType] -> Flow Graph Java.ClassDeclaration -declarationForUnionType isSer aliases tparams elName fields = do - variantClasses <- CM.mapM (fmap augmentVariantClass . unionFieldClass) fields - let variantDecls = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationClass <$> variantClasses - variantDecls' <- CM.zipWithM addComment variantDecls fields - let otherDecls = noComment <$> [privateConstructor, toAcceptMethod True tparams, visitor, partialVisitor] - tn <- typeNameDecl aliases elName - let bodyDecls = [tn] ++ otherDecls ++ variantDecls' - let mods = classModsPublic ++ [Java.ClassModifierAbstract] - return $ javaClassDeclaration aliases tparams elName mods Nothing (interfaceTypes isSer) bodyDecls - where - privateConstructor = makeConstructor aliases elName True [] [] - unionFieldClass (FieldType fname ftype) = do - let rtype = Types.record $ if isUnitType ftype then [] else [FieldType (Name valueFieldName) ftype] - toClassDecl True isSer aliases [] (variantClassName False elName fname) rtype - augmentVariantClass (Java.ClassDeclarationNormal cd) = Java.ClassDeclarationNormal $ cd { - Java.normalClassDeclarationModifiers = [Java.ClassModifierPublic, Java.ClassModifierStatic, Java.ClassModifierFinal], - Java.normalClassDeclarationExtends = Just $ nameToJavaClassType aliases True args elName Nothing, - Java.normalClassDeclarationParameters = tparams, - Java.normalClassDeclarationBody = newBody (Java.normalClassDeclarationBody cd)} - where - newBody (Java.ClassBody decls) = Java.ClassBody $ decls ++ [noComment $ toAcceptMethod False tparams] - args = typeParameterToTypeArgument <$> tparams - - visitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $ - Java.NormalInterfaceDeclaration mods ti vtparams extends body - where - mods = [Java.InterfaceModifierPublic] - ti = Java.TypeIdentifier $ Java.Identifier visitorName - vtparams = tparams ++ [javaTypeParameter visitorReturnParameter] - extends = [] - body = Java.InterfaceBody (toVisitMethod . fieldTypeName <$> fields) - where - toVisitMethod fname = interfaceMethodDeclaration [] [] visitMethodName [variantInstanceParam fname] resultR Nothing - - partialVisitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $ - Java.NormalInterfaceDeclaration { - Java.normalInterfaceDeclarationModifiers = [Java.InterfaceModifierPublic], - Java.normalInterfaceDeclarationIdentifier = Java.TypeIdentifier $ Java.Identifier partialVisitorName, - Java.normalInterfaceDeclarationParameters = tparams ++ [javaTypeParameter visitorReturnParameter], - Java.normalInterfaceDeclarationExtends = - [Java.InterfaceType $ javaClassType ((typeParameterToReferenceType <$> tparams) ++ [visitorTypeVariable]) Nothing visitorName], - Java.normalInterfaceDeclarationBody = Java.InterfaceBody $ otherwise:(toVisitMethod . fieldTypeName <$> fields)} - where - otherwise = interfaceMethodDeclaration defaultMod [] otherwiseMethodName [mainInstanceParam] resultR $ Just [throw] - where - typeArgs = typeParameterToTypeArgument <$> tparams - throw = Java.BlockStatementStatement $ javaThrowIllegalStateException args - where - args = [javaAdditiveExpressionToJavaExpression $ addExpressions [ - javaStringMultiplicativeExpression "Non-exhaustive patterns when matching: ", - Java.MultiplicativeExpressionUnary $ javaIdentifierToJavaUnaryExpression $ Java.Identifier "instance"]] - - toVisitMethod fname = interfaceMethodDeclaration defaultMod [] visitMethodName [variantInstanceParam fname] resultR $ - Just [returnOtherwise] - where - returnOtherwise = Java.BlockStatementStatement $ javaReturnStatement $ Just $ - javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray $ Java.PrimaryNoNewArrayMethodInvocation $ - methodInvocation Nothing (Java.Identifier otherwiseMethodName) [javaIdentifierToJavaExpression $ Java.Identifier "instance"] - - defaultMod = [Java.InterfaceMethodModifierDefault] - - resultR = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable - - typeArgs = typeParameterToTypeArgument <$> tparams - - mainInstanceParam = javaTypeToJavaFormalParameter classRef $ Name instanceName - where - classRef = javaClassTypeToJavaType $ - nameToJavaClassType aliases False typeArgs elName Nothing - - variantInstanceParam fname = javaTypeToJavaFormalParameter classRef $ Name instanceName - where - classRef = javaClassTypeToJavaType $ - nameToJavaClassType aliases False typeArgs (variantClassName False elName fname) Nothing - -elementJavaIdentifier :: Bool -> Bool -> Aliases -> Name -> Java.Identifier -elementJavaIdentifier isPrim isMethod aliases name = Java.Identifier $ if isPrim - then (qualify $ capitalize local) ++ "." ++ applyMethodName - else case ns of - Nothing -> local - Just n -> (qualify $ elementsClassName n) ++ sep ++ local - where - sep = if isMethod then "::" else "." - qualify s = Java.unIdentifier $ nameToJavaName aliases $ unqualifyName $ QualifiedName ns s - QualifiedName ns local = qualifyNameEager name - -elementNameToFilePath :: Name -> FilePath -elementNameToFilePath name = nameToFilePath False (FileExtension "java") $ unqualifyName $ QualifiedName ns (sanitizeJavaName local) - where - QualifiedName ns local = qualifyNameEager name - -elementsClassName :: Namespace -> String -elementsClassName (Namespace ns) = capitalize $ L.last $ LS.splitOn "/" ns - -encodeApplication :: Aliases -> Application -> Flow Graph Java.Expression -encodeApplication aliases app@(Application lhs rhs) = case fullyStripTerm fun of - TermFunction f -> case f of - FunctionPrimitive name -> functionCall aliases True name args - _ -> fallback - TermVariable name -> do - firstCall <- functionCall aliases False name [L.head args] - calls firstCall $ L.tail args - where - calls exp args = case args of - [] -> pure exp - (h:r) -> do - jarg <- encodeTerm aliases h - calls (apply exp jarg) r - _ -> fallback - where - (fun, args) = uncurry [] lhs rhs - where - uncurry args lhs rhs = case fullyStripTerm lhs of - TermApplication (Application lhs' rhs') -> uncurry (rhs:args) lhs' rhs' - _ -> (lhs, (rhs:args)) - - fallback = withTrace "fallback" $ do - if Y.isNothing (getTermType lhs) - -- then fail $ "app: " ++ showTerm (TermApplication app) - then fail $ "lhs: " ++ showTerm lhs - else pure () - - t <- requireTermType lhs - (dom, cod) <- case stripTypeParameters $ stripType t of - TypeFunction (FunctionType dom cod) -> pure (dom, cod) - t' -> fail $ "expected a function type on function " ++ show lhs ++ ", but found " ++ show t' - case fullyStripTerm lhs of - TermFunction f -> case f of - FunctionElimination e -> do - jarg <- encodeTerm aliases rhs - encodeElimination aliases (Just jarg) dom cod e - _ -> defaultExpression - _ -> defaultExpression - where - defaultExpression = do - -- Note: the domain type will not be used, so we just substitute the unit type - jfun <- encodeTerm aliases lhs - jarg <- encodeTerm aliases rhs - let prim = javaExpressionToJavaPrimary jfun - return $ apply jfun jarg - apply exp jarg = javaMethodInvocationToJavaExpression $ - methodInvocation (Just $ Right $ javaExpressionToJavaPrimary exp) (Java.Identifier applyMethodName) [jarg] - -encodeElimination :: Aliases -> Maybe Java.Expression -> Type -> Type -> Elimination -> Flow Graph Java.Expression -encodeElimination aliases marg dom cod elm = case elm of - EliminationOptional (OptionalCases nothing just) -> do - jnothing <- encodeTerm aliases nothing - jjust <- encodeTerm aliases just - let var = Name "m" - - let jobj = case marg of - Nothing -> Left $ javaIdentifierToJavaExpressionName $ variableToJavaIdentifier var - Just jarg -> Right $ javaExpressionToJavaPrimary jarg - let jhead = javaMethodInvocationToJavaExpression $ methodInvocation - (Just jobj) - (Java.Identifier "map") [jjust] - let jbody = javaMethodInvocationToJavaExpression $ methodInvocation - (Just $ Right $ javaExpressionToJavaPrimary jhead) - (Java.Identifier "orElse") [jnothing] - castType <- adaptTypeToJavaAndEncode aliases (TypeFunction $ FunctionType dom cod) >>= javaTypeToJavaReferenceType - return $ case marg of - Nothing -> javaCastExpressionToJavaExpression $ javaCastExpression castType $ - javaExpressionToJavaUnaryExpression $ javaLambda var jbody - Just _ -> jbody - EliminationRecord (Projection _ fname) -> do - jdomr <- adaptTypeToJavaAndEncode aliases dom >>= javaTypeToJavaReferenceType - jexp <- case marg of - Nothing -> pure $ javaLambda var jbody - where - var = Name "r" - jbody = javaExpressionNameToJavaExpression $ - fieldExpression (variableToJavaIdentifier var) (javaIdentifier $ unName fname) - Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier $ unName fname) - where - qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg - return jexp - EliminationProduct (TupleProjection arity idx) -> if arity > javaMaxTupleLength - then fail $ "Tuple eliminations of arity greater than " ++ show javaMaxTupleLength ++ " are unsupported" - else pure $ case marg of - Nothing -> javaLambda var $ accessExpr $ javaIdentifierToJavaExpression $ variableToJavaIdentifier var - where - var = Name "w" - Just jarg -> accessExpr jarg - where - accessExpr jarg = javaFieldAccessToJavaExpression $ Java.FieldAccess qual accessor - where - accessor = javaIdentifier $ "object" ++ show (idx + 1) - qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg - EliminationUnion (CaseStatement tname def fields) -> do - case marg of - Nothing -> do - g <- getState - let lhs = setTermType (Just $ Types.function (TypeVariable tname) cod) $ Terms.elimination elm - let var = "u" - encodeTerm aliases $ Terms.lambda var $ Terms.apply lhs (Terms.var var) - -- TODO: default value - Just jarg -> applyElimination jarg - where - applyElimination jarg = do - let prim = javaExpressionToJavaPrimary jarg - let consId = innerClassRef aliases tname $ case def of - Nothing -> visitorName - Just _ -> partialVisitorName - jcod <- adaptTypeToJavaAndEncode aliases cod - rt <- javaTypeToJavaReferenceType jcod - let targs = typeArgsOrDiamond $ javaTypeArgumentsForType dom ++ [Java.TypeArgumentReference rt] - otherwiseBranches <- case def of - Nothing -> pure [] - Just d -> do - b <- otherwiseBranch jcod d - return [b] - visitBranches <- CM.mapM (visitBranch jcod) fields - let body = Java.ClassBody $ otherwiseBranches ++ visitBranches - let visitor = javaConstructorCall (javaConstructorName consId $ Just targs) [] (Just body) - return $ javaMethodInvocationToJavaExpression $ - methodInvocation (Just $ Right prim) (Java.Identifier acceptMethodName) [visitor] - where - otherwiseBranch jcod d = do - targs <- javaTypeArgumentsForNamedType tname - let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True targs tname Nothing - let mods = [Java.MethodModifierPublic] - let anns = [overrideAnnotation] - let param = javaTypeToJavaFormalParameter jdom $ Name instanceName - let result = Java.ResultType $ Java.UnannType jcod - jret <- encodeTerm aliases d - let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret - return $ noComment $ methodDeclaration mods [] anns otherwiseMethodName [param] result (Just [returnStmt]) - - visitBranch jcod field = do - targs <- javaTypeArgumentsForNamedType tname - let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True targs tname (Just $ capitalize $ unName $ fieldName field) - let mods = [Java.MethodModifierPublic] - let anns = [overrideAnnotation] - let param = javaTypeToJavaFormalParameter jdom $ Name instanceName - let result = Java.ResultType $ Java.UnannType jcod - -- Note: the escaping is necessary because the instance.value field reference does not correspond to an actual Hydra projection term - let value = Terms.var ("$" ++ instanceName ++ "." ++ valueFieldName) - jret <- encodeTerm aliases $ contractTerm $ Terms.apply (fieldTerm field) value - let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret - return $ noComment $ methodDeclaration mods [] anns visitMethodName [param] result (Just [returnStmt]) - EliminationWrap name -> case marg of - Nothing -> pure $ javaLambda var jbody - where - var = Name "w" - arg = javaIdentifierToJavaExpression $ variableToJavaIdentifier var - jbody = javaConstructorCall (javaConstructorName (nameToJavaName aliases name) Nothing) [arg] Nothing - Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier valueFieldName) - where - qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg - _ -> pure $ encodeLiteral $ LiteralString $ - "Unimplemented elimination variant: " ++ show (eliminationVariant elm) -- TODO: temporary - -encodeFunction :: Aliases -> Type -> Type -> Function -> Flow Graph Java.Expression -encodeFunction aliases dom cod fun = case fun of - FunctionElimination elm -> withTrace ("elimination (" ++ show (eliminationVariant elm) ++ ")") $ do - encodeElimination aliases Nothing dom cod elm - FunctionLambda (Lambda var body) -> withTrace ("lambda " ++ unName var) $ do - lam <- toLambda var body - if needsCast body - then do - jtype <- adaptTypeToJavaAndEncode aliases (TypeFunction $ FunctionType dom cod) - rt <- javaTypeToJavaReferenceType jtype - return $ javaCastExpressionToJavaExpression $ - javaCastExpression rt (javaExpressionToJavaUnaryExpression lam) - else return lam - where - needsCast _ = True -- TODO: try to discriminate between lambdas which really need a cast, and those which do not - _ -> pure $ encodeLiteral $ LiteralString $ - "Unimplemented function variant: " ++ show (functionVariant fun) -- TODO: temporary - where - toLambda var body = maybeLet aliases body cons - where - cons aliases' term stmts = if L.null stmts - then do - jbody <- encodeTerm aliases term - return $ javaLambda var jbody - else do - jbody <- encodeTerm aliases term - return $ javaLambdaFromBlock var $ Java.Block $ stmts - ++ [Java.BlockStatementStatement $ javaReturnStatement $ Just jbody] - -encodeLiteral :: Literal -> Java.Expression -encodeLiteral lit = javaLiteralToJavaExpression $ case lit of - LiteralBoolean b -> javaBoolean b - LiteralFloat f -> Java.LiteralFloatingPoint $ Java.FloatingPointLiteral $ case f of - FloatValueFloat32 v -> realToFrac v - FloatValueFloat64 v -> v - LiteralInteger i -> case i of - IntegerValueBigint v -> integer v -- BigInteger - IntegerValueInt16 v -> integer $ fromIntegral v -- short - IntegerValueInt32 v -> integer $ fromIntegral v -- int - IntegerValueInt64 v -> integer $ fromIntegral v -- long - IntegerValueUint8 v -> integer $ fromIntegral v -- byte - IntegerValueUint16 v -> Java.LiteralCharacter $ fromIntegral v -- char - where - integer = Java.LiteralInteger . Java.IntegerLiteral - LiteralString s -> javaString s - --- Note: we use Java object types everywhere, rather than primitive types, as the latter cannot be used --- to build function types, parameterized types, etc. -encodeLiteralType :: LiteralType -> Flow Graph Java.Type -encodeLiteralType lt = case lt of - LiteralTypeBoolean -> simple "Boolean" - LiteralTypeFloat ft -> case ft of - FloatTypeFloat32 -> simple "Float" - FloatTypeFloat64 -> simple "Double" - FloatTypeBigfloat -> simple "Double" -- TODO: type adapter should prevent this --- _ -> fail $ "unexpected float type: " ++ show ft - LiteralTypeInteger it -> case it of - IntegerTypeBigint -> pure $ javaRefType [] (Just $ javaPackageName ["java", "math"]) "BigInteger" - IntegerTypeInt16 -> simple "Short" - IntegerTypeInt32 -> simple "Integer" - IntegerTypeInt64 -> simple "Long" - IntegerTypeUint8 -> simple "Byte" - IntegerTypeUint16 -> simple "Character" - _ -> fail $ "unexpected integer type: " ++ show it - LiteralTypeString -> simple "String" - _ -> fail $ "unexpected literal type: " ++ show lt - where - simple n = pure $ javaRefType [] Nothing n - -encodeNullaryConstant :: Aliases -> Type -> Function -> Flow Graph Java.Expression -encodeNullaryConstant aliases typ fun = case fun of - FunctionPrimitive name -> functionCall aliases True name [] - _ -> unexpected "nullary function" $ show fun - -encodeTerm :: Aliases -> Term -> Flow Graph Java.Expression -encodeTerm aliases term0 = encodeInternal [] term0 - where - encode = encodeTerm aliases - failAsLiteral msg = pure $ encodeLiteral $ LiteralString msg - encodeInternal anns term = case term of - TermAnnotated (AnnotatedTerm term' ann) -> encodeInternal (ann:anns) term' - - TermApplication app -> withTrace "encode application" $ encodeApplication aliases app - - TermFunction f -> withTrace ("encode function (" ++ show (functionVariant f) ++ ")") $ do - t <- requireTermType term0 - case stripType t of - TypeFunction (FunctionType dom cod) -> do - encodeFunction aliases dom cod f - _ -> encodeNullaryConstant aliases t f - - TermLet _ -> fail $ "nested let is unsupported for Java: " ++ showTerm term - - TermList els -> do - jels <- CM.mapM encode els - return $ javaMethodInvocationToJavaExpression $ - methodInvocationStatic (Java.Identifier "java.util.Arrays") (Java.Identifier "asList") jels - - TermLiteral l -> pure $ encodeLiteral l - - TermOptional mt -> case mt of - Nothing -> pure $ javaMethodInvocationToJavaExpression $ - methodInvocationStatic (Java.Identifier "hydra.util.Opt") (Java.Identifier "empty") [] - Just term1 -> do - expr <- encode term1 - return $ javaMethodInvocationToJavaExpression $ - methodInvocationStatic (Java.Identifier "hydra.util.Opt") (Java.Identifier "of") [expr] - - TermProduct terms -> do - jterms <- CM.mapM encode terms - let tupleTypeName = "hydra.util.Tuple.Tuple" ++ show (length terms) - return $ javaConstructorCall (javaConstructorName (Java.Identifier tupleTypeName) Nothing) jterms Nothing - - TermRecord (Record name fields) -> do - fieldExprs <- CM.mapM encode (fieldTerm <$> fields) - let consId = nameToJavaName aliases name - return $ javaConstructorCall (javaConstructorName consId Nothing) fieldExprs Nothing - - TermSet s -> do - jels <- CM.mapM encode $ S.toList s - let prim = javaMethodInvocationToJavaPrimary $ - methodInvocationStatic (Java.Identifier "java.util.Stream") (Java.Identifier "of") jels - let coll = javaMethodInvocationToJavaExpression $ - methodInvocationStatic (Java.Identifier "java.util.stream.Collectors") (Java.Identifier "toSet") [] - return $ javaMethodInvocationToJavaExpression $ - methodInvocation (Just $ Right prim) (Java.Identifier "collect") [coll] - - TermTyped (TypedTerm term1 _) -> encodeInternal anns term1 - - TermUnion (Injection name (Field (Name fname) v)) -> do - let (Java.Identifier typeId) = nameToJavaName aliases name - let consId = Java.Identifier $ typeId ++ "." ++ sanitizeJavaName (capitalize fname) - args <- if isUnitTerm v - then return [] - else do - ex <- encode v - return [ex] - return $ javaConstructorCall (javaConstructorName consId Nothing) args Nothing - - TermVariable name -> encodeVariable aliases name - - TermWrap (WrappedTerm tname arg) -> do - jarg <- encode arg - return $ javaConstructorCall (javaConstructorName (nameToJavaName aliases tname) Nothing) [jarg] Nothing - - _ -> failAsLiteral $ "Unimplemented term variant: " ++ show (termVariant term) - -encodeType :: Aliases -> Type -> Flow Graph Java.Type -encodeType aliases t = case stripType t of - TypeApplication (ApplicationType lhs rhs) -> do - jlhs <- encode lhs - jrhs <- encode rhs >>= javaTypeToJavaReferenceType - addJavaTypeParameter jrhs jlhs - TypeFunction (FunctionType dom cod) -> do - jdom <- encode dom >>= javaTypeToJavaReferenceType - jcod <- encode cod >>= javaTypeToJavaReferenceType - return $ javaRefType [jdom, jcod] javaUtilFunctionPackageName "Function" - TypeLambda (LambdaType (Name v) body) -> do - jbody <- encode body - addJavaTypeParameter (javaTypeVariable v) jbody - TypeList et -> do - jet <- encode et - if listsAsArrays - then toJavaArrayType jet - else do - rt <- javaTypeToJavaReferenceType jet - return $ javaRefType [rt] javaUtilPackageName "List" - TypeLiteral lt -> encodeLiteralType lt - TypeMap (MapType kt vt) -> do - jkt <- encode kt >>= javaTypeToJavaReferenceType - jvt <- encode vt >>= javaTypeToJavaReferenceType - return $ javaRefType [jkt, jvt] javaUtilPackageName "Map" - TypeProduct types -> case types of - [] -> unit - _ -> do - jtypes <- CM.mapM encode types >>= mapM javaTypeToJavaReferenceType - return $ javaRefType jtypes hydraUtilPackageName $ "Tuple.Tuple" ++ (show $ length types) - TypeRecord (RowType _Unit _ []) -> unit - TypeRecord (RowType name _ _) -> pure $ - Java.TypeReference $ nameToJavaReferenceType aliases True (javaTypeArgumentsForType t) name Nothing - TypeOptional ot -> do - jot <- encode ot >>= javaTypeToJavaReferenceType - return $ javaRefType [jot] hydraUtilPackageName "Opt" - TypeSet st -> do - jst <- encode st >>= javaTypeToJavaReferenceType - return $ javaRefType [jst] javaUtilPackageName "Set" - TypeUnion (RowType name _ _) -> pure $ - Java.TypeReference $ nameToJavaReferenceType aliases True (javaTypeArgumentsForType t) name Nothing - TypeVariable name -> forReference name - TypeWrap (WrappedType name _) -> forReference name - _ -> fail $ "can't encode unsupported type in Java: " ++ show t - where - forReference name = pure $ if isLambdaBoundVariable name - then variableReference name - else nameReference name - nameReference name = Java.TypeReference $ nameToJavaReferenceType aliases True [] name Nothing - variableReference name = Java.TypeReference $ javaTypeVariable $ unName name - encode = encodeType aliases - unit = return $ javaRefType [] javaLangPackageName "Void" - -encodeVariable :: Aliases -> Name -> Flow Graph Java.Expression -encodeVariable aliases name = if isRecursiveVariable aliases name - then return $ javaMethodInvocationToJavaExpression $ - methodInvocation (Just $ Left $ Java.ExpressionName Nothing jid) (Java.Identifier getMethodName) [] - else do - cls <- classifyDataReference name - return $ case cls of - JavaSymbolLocalVariable -> javaIdentifierToJavaExpression $ elementJavaIdentifier False False aliases name - JavaSymbolClassConstant -> javaIdentifierToJavaExpression $ elementJavaIdentifier False False aliases name - JavaSymbolClassNullaryFunction -> javaIdentifierToJavaExpression $ elementJavaIdentifier False True aliases name -- TODO - JavaSymbolClassUnaryFunction -> javaIdentifierToJavaExpression $ elementJavaIdentifier False True aliases name - where - jid = javaIdentifier $ unName name - -fieldToNullCheckStatement :: FieldType -> Java.BlockStatement -fieldToNullCheckStatement field = Java.BlockStatementStatement $ javaMethodInvocationToJavaStatement $ Java.MethodInvocation header [arg] - where - arg = javaIdentifierToJavaExpression $ fieldNameToJavaIdentifier $ fieldTypeName field - header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $ - Java.Identifier "java.util.Objects.requireNonNull" - -fieldTypeToFormalParam aliases (FieldType fname ft) = do - jt <- adaptTypeToJavaAndEncode aliases ft - return $ javaTypeToJavaFormalParameter jt fname - -functionCall :: Aliases -> Bool -> Name -> [Term] -> Flow Graph Java.Expression -functionCall aliases isPrim name args = do - jargs <- CM.mapM (encodeTerm aliases) args - if isLocalVariable name - then do - prim <- javaExpressionToJavaPrimary <$> encodeVariable aliases name - return $ javaMethodInvocationToJavaExpression $ - methodInvocation (Just $ Right prim) (Java.Identifier applyMethodName) jargs - else do - let header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $ elementJavaIdentifier isPrim False aliases name - return $ javaMethodInvocationToJavaExpression $ Java.MethodInvocation header jargs - -getCodomain :: M.Map String Term -> Flow Graph Type -getCodomain ann = functionTypeCodomain <$> getFunctionType ann - -getFunctionType :: M.Map String Term -> Flow Graph FunctionType -getFunctionType ann = do - mt <- getType ann - case mt of - Nothing -> fail "type annotation is required for function and elimination terms in Java" - Just t -> case t of - TypeFunction ft -> return ft - _ -> unexpected "function type (3)" $ show t - -innerClassRef :: Aliases -> Name -> String -> Java.Identifier -innerClassRef aliases name local = Java.Identifier $ id ++ "." ++ local - where - Java.Identifier id = nameToJavaName aliases name - -interfaceTypes :: Bool -> [Java.InterfaceType] -interfaceTypes isSer = if isSer then [javaSerializableType] else [] - where - javaSerializableType = Java.InterfaceType $ - Java.ClassType [] Java.ClassTypeQualifierNone (javaTypeIdentifier "Serializable") [] - -isLambdaBoundVariable :: Name -> Bool -isLambdaBoundVariable (Name v) = L.length v <= 4 - -isLocalVariable :: Name -> Bool -isLocalVariable name = Y.isNothing $ qualifiedNameNamespace $ qualifyNameEager name - -isRecursiveVariable :: Aliases -> Name -> Bool -isRecursiveVariable aliases name = S.member name (aliasesRecursiveVars aliases) - -javaTypeArgumentsForNamedType :: Name -> Flow Graph [Java.TypeArgument] -javaTypeArgumentsForNamedType tname = do - params <- javaTypeParametersForType <$> requireType tname - return $ typeParameterToTypeArgument <$> params - -javaTypeArgumentsForType :: Type -> [Java.TypeArgument] -javaTypeArgumentsForType typ = L.reverse (typeParameterToTypeArgument <$> javaTypeParametersForType typ) - --- Note: this is somewhat of a hack; it compensates for the irregular way in which type parameters are currently used. --- When this irregularity is resolved, a better approach will be to simply pick up type parameters from type applications. -javaTypeParametersForType :: Type -> [Java.TypeParameter] -javaTypeParametersForType typ = toParam <$> vars - where - toParam (Name v) = Java.TypeParameter [] (javaTypeIdentifier $ capitalize v) Nothing - vars = L.nub $ boundVars typ ++ freeVars - boundVars t = case stripType t of - TypeLambda (LambdaType v body) -> v:(boundVars body) - _ -> [] - freeVars = L.filter isLambdaBoundVariable $ S.toList $ freeVariablesInType typ - -maybeLet :: Aliases -> Term -> (Aliases -> Term -> [Java.BlockStatement] -> Flow Graph x) -> Flow Graph x -maybeLet aliases term cons = helper Nothing [] term - where - -- Note: let-flattening could be done at the top level for better efficiency - helper mtyp anns term = case flattenLetTerms term of - TermAnnotated (AnnotatedTerm term' ann) -> helper mtyp (ann:anns) term' - TermTyped (TypedTerm term' typ) -> helper (Just typ) anns term' - TermLet (Let bindings env) -> do - stmts <- L.concat <$> CM.mapM toDeclStatements sorted - maybeLet aliasesWithRecursive env $ \aliases' tm stmts' -> cons aliases' (reannotate mtyp anns tm) (stmts ++ stmts') - where - aliasesWithRecursive = aliases { aliasesRecursiveVars = recursiveVars } - toDeclStatements names = do - inits <- Y.catMaybes <$> CM.mapM toDeclInit names - impls <- CM.mapM toDeclStatement names - return $ inits ++ impls - - toDeclInit name = if S.member name recursiveVars - then do - -- TODO: repeated - let value = letBindingTerm $ L.head $ L.filter (\b -> letBindingName b == name) bindings - typ <- requireTermType value - jtype <- adaptTypeToJavaAndEncode aliasesWithRecursive typ - let id = variableToJavaIdentifier name - - let pkg = javaPackageName ["java", "util", "concurrent", "atomic"] - let arid = Java.Identifier "java.util.concurrent.atomic.AtomicReference" -- TODO - let aid = Java.AnnotatedIdentifier [] arid - rt <- javaTypeToJavaReferenceType jtype - let targs = typeArgsOrDiamond [Java.TypeArgumentReference rt] - let ci = Java.ClassOrInterfaceTypeToInstantiate [aid] (Just targs) - let body = javaConstructorCall ci [] Nothing - let artype = javaRefType [rt] (Just pkg) "AtomicReference" - return $ Just $ variableDeclarationStatement aliasesWithRecursive artype id body - else pure Nothing - - toDeclStatement name = do - -- TODO: repeated - let value = letBindingTerm $ L.head $ L.filter (\b -> letBindingName b == name) bindings - typ <- requireTermType value - jtype <- adaptTypeToJavaAndEncode aliasesWithRecursive typ - let id = variableToJavaIdentifier name - rhs <- encodeTerm aliasesWithRecursive value - return $ if S.member name recursiveVars - then Java.BlockStatementStatement $ javaMethodInvocationToJavaStatement $ - methodInvocation (Just $ Left $ Java.ExpressionName Nothing id) (Java.Identifier setMethodName) [rhs] - else variableDeclarationStatement aliasesWithRecursive jtype id rhs - bindingVars = S.fromList (letBindingName <$> bindings) - recursiveVars = S.fromList $ L.concat (ifRec <$> sorted) - where - ifRec names = case names of - [name] -> case M.lookup name allDeps of - Nothing -> [] - Just deps -> if S.member name deps - then [name] - else [] - _ -> names - allDeps = M.fromList (toDeps <$> bindings) - where - toDeps (LetBinding key value _) = (key, S.filter (\n -> S.member n bindingVars) $ freeVariablesInTerm value) - sorted = topologicalSortComponents (toDeps <$> M.toList allDeps) - where - toDeps (key, deps) = (key, S.toList deps) - _ -> cons aliases (reannotate mtyp anns term) [] - -moduleToJavaCompilationUnit :: Module -> Flow Graph (M.Map Name Java.CompilationUnit) -moduleToJavaCompilationUnit mod = transformModule javaLanguage encode constructModule mod - where - aliases = importAliasesForModule mod - encode = encodeTerm aliases . contractTerm - -noComment :: Java.ClassBodyDeclaration -> Java.ClassBodyDeclarationWithComments -noComment decl = Java.ClassBodyDeclarationWithComments decl Nothing - -reannotate mtyp anns term = case mtyp of - Nothing -> base - Just typ -> TermTyped (TypedTerm base typ) - where - base = reann anns term - reann anns term = case anns of - [] -> term - (h:r) -> reann r $ TermAnnotated (AnnotatedTerm term h) - -toClassDecl :: Bool -> Bool -> Aliases -> [Java.TypeParameter] - -> Name -> Type -> Flow Graph Java.ClassDeclaration -toClassDecl isInner isSer aliases tparams elName t = case stripType t of - TypeRecord rt -> declarationForRecordType isInner isSer aliases tparams elName $ rowTypeFields rt - TypeUnion rt -> declarationForUnionType isSer aliases tparams elName $ rowTypeFields rt - TypeLambda ut -> declarationForLambdaType isSer aliases tparams elName ut - TypeWrap (WrappedType tname wt) -> declarationForRecordType isInner isSer aliases tparams elName - [FieldType (Name "value") wt] - -- Other types are not supported as class declarations, so we wrap them as record types. - _ -> wrap t -- TODO: wrap and unwrap the corresponding terms as record terms. - where - wrap t' = declarationForRecordType isInner isSer aliases tparams elName [Types.field valueFieldName t'] - -toDataDeclaration :: Aliases -> (a, TypedTerm) -> Flow Graph a -toDataDeclaration aliases (el, TypedTerm term typ) = do - fail "not implemented" -- TODO - -typeArgsOrDiamond :: [Java.TypeArgument] -> Java.TypeArgumentsOrDiamond -typeArgsOrDiamond args = if supportsDiamondOperator javaFeatures - then Java.TypeArgumentsOrDiamondDiamond - else Java.TypeArgumentsOrDiamondArguments args - -typeNameDecl :: Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments -typeNameDecl aliases name = do - jt <- adaptTypeToJavaAndEncode aliases $ TypeVariable _Name - arg <- encodeTerm aliases $ Terms.string $ unName name - let init = Java.VariableInitializerExpression $ javaConstructorCall (javaConstructorName nameName Nothing) [arg] Nothing - let var = javaVariableDeclarator (Java.Identifier "NAME") (Just init) - return $ noComment $ javaMemberField mods jt var - where - mods = [Java.FieldModifierPublic, Java.FieldModifierStatic, Java.FieldModifierFinal] - nameName = nameToJavaName aliases _Name diff --git a/src/main/haskell/Hydra/Langs/Java/Names.hs b/src/main/haskell/Hydra/Langs/Java/Names.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Java/Names.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Hydra.Langs.Java.Names where - -import Hydra.Kernel - -import qualified Hydra.Langs.Java.Syntax as Java - - -acceptMethodName = "accept" :: String -applyMethodName = "apply" :: String -equalsMethodName = "equals" :: String -getMethodName = "get" :: String -hashCodeMethodName = "hashCode" :: String -instanceName = "instance" :: String -otherInstanceName = "other" :: String -otherwiseMethodName = "otherwise" :: String -partialVisitorName = "PartialVisitor" :: String -setMethodName = "set" :: String -valueFieldName = "value" :: String -visitMethodName = "visit" :: String -visitorName = "Visitor" :: String -visitorReturnParameter = "R" :: String - -javaPackageName :: [String] -> Java.PackageName -javaPackageName parts = Java.PackageName (Java.Identifier <$> parts) - -hydraCorePackageName :: Maybe Java.PackageName -hydraCorePackageName = Just $ javaPackageName ["hydra", "core"] - -hydraUtilPackageName :: Maybe Java.PackageName -hydraUtilPackageName = Just $ javaPackageName ["hydra", "util"] - -javaLangPackageName :: Maybe Java.PackageName -javaLangPackageName = Just $ javaPackageName ["java", "lang"] - -javaUtilFunctionPackageName :: Maybe Java.PackageName -javaUtilFunctionPackageName = Just $ javaPackageName ["java", "util", "function"] - -javaUtilPackageName :: Maybe Java.PackageName -javaUtilPackageName = Just $ javaPackageName ["java", "util"] diff --git a/src/main/haskell/Hydra/Langs/Java/Serde.hs b/src/main/haskell/Hydra/Langs/Java/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Java/Serde.hs +++ /dev/null @@ -1,926 +0,0 @@ -module Hydra.Langs.Java.Serde where - -import Hydra.Tools.Serialization -import qualified Hydra.Ast as CT -import qualified Hydra.Langs.Java.Syntax as Java -import Hydra.Messages - -import qualified Data.List as L -import qualified Data.Maybe as Y - - -sanitizeJavaComment :: String -> String -sanitizeJavaComment s = L.concat (fromChar <$> s) - where - fromChar c = case c of - '<' -> "<" - '>' -> ">" - _ -> [c] - -singleLineComment :: String -> CT.Expr -singleLineComment c = cst $ "// " ++ sanitizeJavaComment c - -withComments :: Maybe String -> CT.Expr -> CT.Expr -withComments mc expr = case mc of - Nothing -> expr - Just c -> newlineSep [writeComments c, expr] - where - writeComments c = cst $ "/**\n" ++ unlines (toLine <$> (lines $ sanitizeJavaComment c)) ++ " */" - where - toLine l = " * " ++ l - -writeAdditionalBound :: Java.AdditionalBound -> CT.Expr -writeAdditionalBound _ = cst "TODO:AdditionalBound" - -writeAdditiveExpression :: Java.AdditiveExpression -> CT.Expr -writeAdditiveExpression e = case e of - Java.AdditiveExpressionUnary m -> writeMultiplicativeExpression m - Java.AdditiveExpressionPlus (Java.AdditiveExpression_Binary lhs rhs) -> - infixWs "+" (writeAdditiveExpression lhs) (writeMultiplicativeExpression rhs) - Java.AdditiveExpressionMinus (Java.AdditiveExpression_Binary lhs rhs) -> - infixWs "-" (writeAdditiveExpression lhs) (writeMultiplicativeExpression rhs) - -writeAmbiguousName :: Java.AmbiguousName -> CT.Expr -writeAmbiguousName (Java.AmbiguousName parts) = dotSep (writeIdentifier <$> parts) - -writeAndExpression :: Java.AndExpression -> CT.Expr -writeAndExpression (Java.AndExpression eqs) = infixWsList "&" (writeEqualityExpression <$> eqs) - -writeAnnotatedIdentifier :: Java.AnnotatedIdentifier -> CT.Expr -writeAnnotatedIdentifier (Java.AnnotatedIdentifier anns id) = writeIdentifier id -- Note: ignoring annotations for now - -writeAnnotation :: Java.Annotation -> CT.Expr -writeAnnotation ann = case ann of - Java.AnnotationNormal n -> writeNormalAnnotation n - Java.AnnotationMarker m -> writeMarkerAnnotation m - Java.AnnotationSingleElement s -> writeSingleElementAnnotation s - -writeAnnotationTypeDeclaration :: Java.AnnotationTypeDeclaration -> CT.Expr -writeAnnotationTypeDeclaration _ = cst "TODO:AnnotationTypeDeclaration" - -writeArrayAccess :: Java.ArrayAccess -> CT.Expr -writeArrayAccess _ = cst "TODO:ArrayAccess" - -writeArrayCreationExpression :: Java.ArrayCreationExpression -> CT.Expr -writeArrayCreationExpression _ = cst "TODO:ArrayCreationExpression" - -writeArrayInitializer :: Java.ArrayInitializer -> CT.Expr -writeArrayInitializer _ = cst "TODO:ArrayInitializer" - -writeArrayType :: Java.ArrayType -> CT.Expr -writeArrayType _ = cst "TODO:ArrayType" - -writeAssertStatement :: Java.AssertStatement -> CT.Expr -writeAssertStatement _ = cst "TODO:AssertStatement" - -writeAssignment :: Java.Assignment -> CT.Expr -writeAssignment (Java.Assignment lhs op rhs) = infixWs ctop (writeLeftHandSide lhs) (writeExpression rhs) - where - ctop = case op of - Java.AssignmentOperatorSimple -> "=" - Java.AssignmentOperatorTimes -> "*=" - Java.AssignmentOperatorDiv -> "/=" - Java.AssignmentOperatorMod -> "%=" - Java.AssignmentOperatorPlus -> "+=" - Java.AssignmentOperatorMinus -> "-=" - Java.AssignmentOperatorShiftLeft -> "<<=" - Java.AssignmentOperatorShiftRight -> ">>=" - Java.AssignmentOperatorShiftRightZeroFill -> ">>>=" - Java.AssignmentOperatorAnd -> "&=" - Java.AssignmentOperatorXor -> "^=" - Java.AssignmentOperatorOr -> "|=" - -writeAssignmentExpression :: Java.AssignmentExpression -> CT.Expr -writeAssignmentExpression e = case e of - Java.AssignmentExpressionConditional c -> writeConditionalExpression c - Java.AssignmentExpressionAssignment a -> writeAssignment a - -writeBlock :: Java.Block -> CT.Expr -writeBlock (Java.Block stmts) = curlyBlock fullBlockStyle $ newlineSep (writeBlockStatement <$> stmts) - -writeBlockStatement :: Java.BlockStatement -> CT.Expr -writeBlockStatement s = case s of - Java.BlockStatementLocalVariableDeclaration d -> writeLocalVariableDeclarationStatement d - Java.BlockStatementClass cd -> writeClassDeclaration cd - Java.BlockStatementStatement s -> writeStatement s - -writeBreakStatement :: Java.BreakStatement -> CT.Expr -writeBreakStatement _ = cst "TODO:BreakStatement" - -writeCastExpression :: Java.CastExpression -> CT.Expr -writeCastExpression e = case e of - Java.CastExpressionPrimitive p -> writeCastExpression_Primitive p - Java.CastExpressionNotPlusMinus npm -> writeCastExpression_NotPlusMinus npm - Java.CastExpressionLambda l -> writeCastExpression_Lambda l - -writeCastExpression_Lambda :: Java.CastExpression_Lambda -> CT.Expr -writeCastExpression_Lambda _ = cst "TODO:CastExpression_Lambda" - -writeCastExpression_NotPlusMinus :: Java.CastExpression_NotPlusMinus -> CT.Expr -writeCastExpression_NotPlusMinus (Java.CastExpression_NotPlusMinus rb ex) = spaceSep [ - writeCastExpression_RefAndBounds rb, - writeUnaryExpression ex] - -writeCastExpression_RefAndBounds :: Java.CastExpression_RefAndBounds -> CT.Expr -writeCastExpression_RefAndBounds (Java.CastExpression_RefAndBounds rt adds) = parenList False [spaceSep $ Y.catMaybes [ - Just $ writeReferenceType rt, - if L.null adds then Nothing else Just $ spaceSep (writeAdditionalBound <$> adds)]] - -writeCastExpression_Primitive :: Java.CastExpression_Primitive -> CT.Expr -writeCastExpression_Primitive _ = cst "TODO:CastExpression_Primitive" - -writeCharacterLiteral :: Int -> CT.Expr -writeCharacterLiteral _ = cst "TODO:CharacterLiteral" - -writeClassBody :: Java.ClassBody -> CT.Expr -writeClassBody (Java.ClassBody decls) = curlyBlock fullBlockStyle $ - doubleNewlineSep (writeClassBodyDeclarationWithComments <$> decls) - -writeClassBodyDeclaration :: Java.ClassBodyDeclaration -> CT.Expr -writeClassBodyDeclaration d = case d of - Java.ClassBodyDeclarationClassMember d -> writeClassMemberDeclaration d - Java.ClassBodyDeclarationInstanceInitializer i -> writeInstanceInitializer i - Java.ClassBodyDeclarationStaticInitializer i -> writeStaticInitializer i - Java.ClassBodyDeclarationConstructorDeclaration d -> writeConstructorDeclaration d - -writeClassBodyDeclarationWithComments :: Java.ClassBodyDeclarationWithComments -> CT.Expr -writeClassBodyDeclarationWithComments (Java.ClassBodyDeclarationWithComments d mc) = withComments mc $ - writeClassBodyDeclaration d - -writeClassDeclaration :: Java.ClassDeclaration -> CT.Expr -writeClassDeclaration d = case d of - Java.ClassDeclarationNormal nd -> writeNormalClassDeclaration nd - Java.ClassDeclarationEnum ed -> writeEnumDeclaration ed - -writeClassInstanceCreationExpression :: Java.ClassInstanceCreationExpression -> CT.Expr -writeClassInstanceCreationExpression (Java.ClassInstanceCreationExpression mqual e) = case mqual of - Nothing -> writeUnqualifiedClassInstanceCreationExpression e - Just q -> dotSep [writeClassInstanceCreationExpression_Qualifier q, writeUnqualifiedClassInstanceCreationExpression e] - -writeClassInstanceCreationExpression_Qualifier :: Java.ClassInstanceCreationExpression_Qualifier -> CT.Expr -writeClassInstanceCreationExpression_Qualifier q = case q of - Java.ClassInstanceCreationExpression_QualifierExpression en -> writeExpressionName en - Java.ClassInstanceCreationExpression_QualifierPrimary p -> writePrimary p - -writeClassLiteral :: Java.ClassLiteral -> CT.Expr -writeClassLiteral _ = cst "TODO:ClassLiteral" - -writeClassMemberDeclaration :: Java.ClassMemberDeclaration -> CT.Expr -writeClassMemberDeclaration d = case d of - Java.ClassMemberDeclarationField fd -> writeFieldDeclaration fd - Java.ClassMemberDeclarationMethod md -> writeMethodDeclaration md - Java.ClassMemberDeclarationClass cd -> writeClassDeclaration cd - Java.ClassMemberDeclarationInterface id -> writeInterfaceDeclaration id - Java.ClassMemberDeclarationNone -> semi - -writeClassModifier :: Java.ClassModifier -> CT.Expr -writeClassModifier m = case m of - Java.ClassModifierAnnotation ann -> writeAnnotation ann - Java.ClassModifierPublic -> cst "public" - Java.ClassModifierProtected -> cst "protected" - Java.ClassModifierPrivate -> cst "private" - Java.ClassModifierAbstract -> cst "abstract" - Java.ClassModifierStatic -> cst "static" - Java.ClassModifierFinal -> cst "final" - Java.ClassModifierStrictfp -> cst "strictfp" - -writeClassOrInterfaceType :: Java.ClassOrInterfaceType -> CT.Expr -writeClassOrInterfaceType cit = case cit of - Java.ClassOrInterfaceTypeClass ct -> writeClassType ct - Java.ClassOrInterfaceTypeInterface it -> writeInterfaceType it - -writeClassOrInterfaceTypeToInstantiate :: Java.ClassOrInterfaceTypeToInstantiate -> CT.Expr -writeClassOrInterfaceTypeToInstantiate (Java.ClassOrInterfaceTypeToInstantiate ids margs) = - noSep $ Y.catMaybes [ - Just $ dotSep (writeAnnotatedIdentifier <$> ids), - writeTypeArgumentsOrDiamond <$> margs] - -writeClassType :: Java.ClassType -> CT.Expr -writeClassType (Java.ClassType anns qual id args) = noSep $ Y.catMaybes [ - Just $ spaceSep $ Y.catMaybes [ - if L.null anns then Nothing else Just $ commaSep inlineStyle (writeAnnotation <$> anns), - Just qualifiedId], - if L.null args then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> args)] - where - qualifiedId = case qual of - Java.ClassTypeQualifierNone -> writeTypeIdentifier id - Java.ClassTypeQualifierPackage pkg -> dotSep [writePackageName pkg, writeTypeIdentifier id] - Java.ClassTypeQualifierParent cit -> dotSep [writeClassOrInterfaceType cit, writeTypeIdentifier id] - -writeCompilationUnit :: Java.CompilationUnit -> CT.Expr -writeCompilationUnit u = case u of - Java.CompilationUnitOrdinary (Java.OrdinaryCompilationUnit mpkg imports types) -> doubleNewlineSep $ Y.catMaybes - [warning, pkgSec, importsSec, typesSec] - where - warning = Just $ singleLineComment warningAutoGeneratedFile - pkgSec = fmap writePackageDeclaration mpkg - importsSec = if L.null imports - then Nothing - else Just $ newlineSep (writeImportDeclaration <$> imports) - typesSec = if L.null types - then Nothing - else Just $ doubleNewlineSep (writeTypeDeclarationWithComments <$> types) - -writeConditionalAndExpression :: Java.ConditionalAndExpression -> CT.Expr -writeConditionalAndExpression (Java.ConditionalAndExpression ors) - = infixWsList "&&" (writeInclusiveOrExpression <$> ors) - -writeConditionalExpression :: Java.ConditionalExpression -> CT.Expr -writeConditionalExpression c = case c of - Java.ConditionalExpressionSimple co -> writeConditionalOrExpression co - Java.ConditionalExpressionTernaryCond tc -> writeConditionalExpression_TernaryCond tc - Java.ConditionalExpressionTernaryLambda tl -> writeConditionalExpression_TernaryLambda tl - -writeConditionalExpression_TernaryCond :: Java.ConditionalExpression_TernaryCond -> CT.Expr -writeConditionalExpression_TernaryCond _ = cst "TODO:ConditionalExpression_TernaryCond" - -writeConditionalExpression_TernaryLambda :: Java.ConditionalExpression_TernaryLambda -> CT.Expr -writeConditionalExpression_TernaryLambda _ = cst "TODO:ConditionalExpression_TernaryLambda" - -writeConditionalOrExpression :: Java.ConditionalOrExpression -> CT.Expr -writeConditionalOrExpression (Java.ConditionalOrExpression ands) - = infixWsList "||" (writeConditionalAndExpression <$> ands) - -writeConstantDeclaration :: Java.ConstantDeclaration -> CT.Expr -writeConstantDeclaration (Java.ConstantDeclaration mods typ vars) = suffixSemi $ spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeConstantModifier <$> mods), - Just $ writeUnannType typ, - Just $ commaSep inlineStyle (writeVariableDeclarator <$> vars)] - -writeConstantModifier :: Java.ConstantModifier -> CT.Expr -writeConstantModifier _ = cst "TODO:ConstantModifier" - -writeConstructorBody :: Java.ConstructorBody -> CT.Expr -writeConstructorBody (Java.ConstructorBody minvoc stmts) = curlyBlock fullBlockStyle $ doubleNewlineSep $ Y.catMaybes [ - writeExplicitConstructorInvocation <$> minvoc, - Just $ newlineSep (writeBlockStatement <$> stmts)] - -writeConstructorDeclaration :: Java.ConstructorDeclaration -> CT.Expr -writeConstructorDeclaration (Java.ConstructorDeclaration mods cons mthrows body) = spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeConstructorModifier <$> mods), - Just $ writeConstructorDeclarator cons, - writeThrows <$> mthrows, - Just $ writeConstructorBody body] - -writeConstructorDeclarator :: Java.ConstructorDeclarator -> CT.Expr -writeConstructorDeclarator (Java.ConstructorDeclarator tparams name mrecparam fparams) = spaceSep $ Y.catMaybes [ - if L.null tparams then Nothing else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams), - Just $ writeSimpleTypeName name, - writeReceiverParameter <$> mrecparam, - Just $ parenList False (writeFormalParameter <$> fparams)] - -writeConstructorModifier :: Java.ConstructorModifier -> CT.Expr -writeConstructorModifier m = case m of - Java.ConstructorModifierAnnotation ann -> writeAnnotation ann - Java.ConstructorModifierPublic -> cst "public" - Java.ConstructorModifierProtected -> cst "protected" - Java.ConstructorModifierPrivate -> cst "private" - -writeContinueStatement :: Java.ContinueStatement -> CT.Expr -writeContinueStatement _ = cst "TODO:ContinueStatement" - -writeDims :: Java.Dims -> CT.Expr -writeDims (Java.Dims anns) = noSep (write <$> anns) - where - write _ = cst "[]" -- Note: ignoring annotations on dimensions for now - -writeDoStatement :: Java.DoStatement -> CT.Expr -writeDoStatement _ = cst "TODO:DoStatement" - -writeElementValue :: Java.ElementValue -> CT.Expr -writeElementValue ev = case ev of - Java.ElementValueConditionalExpression c -> writeConditionalExpression c - Java.ElementValueElementValueArrayInitializer (Java.ElementValueArrayInitializer values) -> - commaSep inlineStyle (writeElementValue <$> values) - Java.ElementValueAnnotation ann -> writeAnnotation ann - -writeElementValuePair :: Java.ElementValuePair -> CT.Expr -writeElementValuePair (Java.ElementValuePair k v) = infixWs "=" (writeIdentifier k) (writeElementValue v) - -writeEmptyStatement :: Java.EmptyStatement -> CT.Expr -writeEmptyStatement _ = semi - -writeEnumDeclaration :: Java.EnumDeclaration -> CT.Expr -writeEnumDeclaration _ = cst "TODO:EnumDeclaration" - -writeEqualityExpression :: Java.EqualityExpression -> CT.Expr -writeEqualityExpression e = case e of - Java.EqualityExpressionUnary r -> writeRelationalExpression r - Java.EqualityExpressionEqual (Java.EqualityExpression_Binary lhs rhs) -> - infixWs "==" (writeEqualityExpression lhs) (writeRelationalExpression rhs) - Java.EqualityExpressionNotEqual (Java.EqualityExpression_Binary lhs rhs) -> - infixWs "!=" (writeEqualityExpression lhs) (writeRelationalExpression rhs) - -writeExclusiveOrExpression :: Java.ExclusiveOrExpression -> CT.Expr -writeExclusiveOrExpression (Java.ExclusiveOrExpression ands) = infixWsList "^" (writeAndExpression <$> ands) - -writeExplicitConstructorInvocation :: Java.ExplicitConstructorInvocation -> CT.Expr -writeExplicitConstructorInvocation _ = cst "TODO:ExplicitConstructorInvocation" - -writeExpression :: Java.Expression -> CT.Expr -writeExpression e = case e of - Java.ExpressionLambda l -> writeLambdaExpression l - Java.ExpressionAssignment a -> writeAssignmentExpression a - -writeExpressionName :: Java.ExpressionName -> CT.Expr -writeExpressionName (Java.ExpressionName mqual id) = dotSep $ Y.catMaybes [ - writeAmbiguousName <$> mqual, - Just $ writeIdentifier id] - -writeExpressionStatement :: Java.ExpressionStatement -> CT.Expr -writeExpressionStatement (Java.ExpressionStatement stmt) = suffixSemi $ writeStatementExpression stmt - -writeFieldAccess :: Java.FieldAccess -> CT.Expr -writeFieldAccess (Java.FieldAccess qual id) = dotSep $ case qual of - Java.FieldAccess_QualifierPrimary p -> [writePrimary p, writeIdentifier id] - Java.FieldAccess_QualifierSuper -> [cst "super", writeIdentifier id] - Java.FieldAccess_QualifierTyped tn -> [writeTypeName tn, cst "super", writeIdentifier id] - -writeFieldDeclaration :: Java.FieldDeclaration -> CT.Expr -writeFieldDeclaration (Java.FieldDeclaration mods typ vars) = suffixSemi $ spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeFieldModifier <$> mods), - Just $ writeUnannType typ, - Just $ commaSep inlineStyle (writeVariableDeclarator <$> vars)] - -writeFieldModifier :: Java.FieldModifier -> CT.Expr -writeFieldModifier m = case m of - Java.FieldModifierAnnotation ann -> writeAnnotation ann - Java.FieldModifierPublic -> cst "public" - Java.FieldModifierProtected -> cst "protected" - Java.FieldModifierPrivate -> cst "private" - Java.FieldModifierStatic -> cst "static" - Java.FieldModifierFinal -> cst "final" - Java.FieldModifierTransient -> cst "transient" - Java.FieldModifierVolatile -> cst "volatile" - -writeFloatingPointLiteral :: Java.FloatingPointLiteral -> CT.Expr -writeFloatingPointLiteral _ = cst "TODO:FloatingPointLiteral" - -writeFloatingPointType :: Java.FloatingPointType -> CT.Expr -writeFloatingPointType _ = cst "TODO:FloatingPointType" - -writeForStatement :: Java.ForStatement -> CT.Expr -writeForStatement _ = cst "TODO:ForStatement" - -writeFormalParameter :: Java.FormalParameter -> CT.Expr -writeFormalParameter p = case p of - Java.FormalParameterSimple s -> writeFormalParameter_Simple s - Java.FormalParameterVariableArity v -> writeVariableArityParameter v - -writeFormalParameter_Simple :: Java.FormalParameter_Simple -> CT.Expr -writeFormalParameter_Simple (Java.FormalParameter_Simple mods typ id) = spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeVariableModifier <$> mods), - Just $ writeUnannType typ, - Just $ writeVariableDeclaratorId id] - -writeIdentifier :: Java.Identifier -> CT.Expr -writeIdentifier (Java.Identifier s) = cst s - -writeIfThenStatement :: Java.IfThenStatement -> CT.Expr -writeIfThenStatement (Java.IfThenStatement cond thn) = spaceSep [ - cst "if", - parenList False [writeExpression cond], - writeBlock (Java.Block [Java.BlockStatementStatement thn])] - -writeIfThenElseStatement :: Java.IfThenElseStatement -> CT.Expr -writeIfThenElseStatement _ = cst "TODO:IfThenElseStatement" - -writeImportDeclaration :: Java.ImportDeclaration -> CT.Expr -writeImportDeclaration imp = case imp of - Java.ImportDeclarationSingleType (Java.SingleTypeImportDeclaration tn) -> suffixSemi $ - spaceSep [cst "import", writeTypeName tn] - Java.ImportDeclarationTypeImportOnDemand d -> cst "TODO:ImportDeclarationTypeImportOnDemand" - Java.ImportDeclarationSingleStaticImport d -> cst "TODO:ImportDeclarationSingleStaticImport" - Java.ImportDeclarationStaticImportOnDemand d -> cst "TODO:ImportDeclarationStaticImportOnDemand" - -writeInclusiveOrExpression :: Java.InclusiveOrExpression -> CT.Expr -writeInclusiveOrExpression (Java.InclusiveOrExpression ors) - = infixWsList "|" (writeExclusiveOrExpression <$> ors) - -writeInstanceInitializer :: Java.InstanceInitializer -> CT.Expr -writeInstanceInitializer _ = cst "TODO:InstanceInitializer" - -writeIntegerLiteral :: Java.IntegerLiteral -> CT.Expr -writeIntegerLiteral (Java.IntegerLiteral i) = cst $ show i - -writeIntegralType :: Java.IntegralType -> CT.Expr -writeIntegralType t = cst $ case t of - Java.IntegralTypeByte -> "byte" - Java.IntegralTypeShort -> "short" - Java.IntegralTypeInt -> "int" - Java.IntegralTypeLong -> "long" - Java.IntegralTypeChar -> "char" - -writeInterfaceBody :: Java.InterfaceBody -> CT.Expr -writeInterfaceBody (Java.InterfaceBody decls) = curlyBlock fullBlockStyle $ doubleNewlineSep - (writeInterfaceMemberDeclaration <$> decls) - -writeInterfaceDeclaration :: Java.InterfaceDeclaration -> CT.Expr -writeInterfaceDeclaration d = case d of - Java.InterfaceDeclarationNormalInterface n -> writeNormalInterfaceDeclaration n - Java.InterfaceDeclarationAnnotationType a -> writeAnnotationTypeDeclaration a - -writeInterfaceMemberDeclaration :: Java.InterfaceMemberDeclaration -> CT.Expr -writeInterfaceMemberDeclaration d = case d of - Java.InterfaceMemberDeclarationConstant c -> writeConstantDeclaration c - Java.InterfaceMemberDeclarationInterfaceMethod im -> writeInterfaceMethodDeclaration im - Java.InterfaceMemberDeclarationClass cd -> writeClassDeclaration cd - Java.InterfaceMemberDeclarationInterface id -> writeInterfaceDeclaration id - -writeInterfaceMethodDeclaration :: Java.InterfaceMethodDeclaration -> CT.Expr -writeInterfaceMethodDeclaration (Java.InterfaceMethodDeclaration mods header body) = spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeInterfaceMethodModifier <$> mods), - Just $ writeMethodHeader header, - Just $ writeMethodBody body] - -writeInterfaceMethodModifier :: Java.InterfaceMethodModifier -> CT.Expr -writeInterfaceMethodModifier m = case m of - Java.InterfaceMethodModifierAnnotation a -> writeAnnotation a - Java.InterfaceMethodModifierPublic -> cst "public" - Java.InterfaceMethodModifierPrivate -> cst "private" - Java.InterfaceMethodModifierAbstract -> cst "abstract" - Java.InterfaceMethodModifierDefault -> cst "default" - Java.InterfaceMethodModifierStatic -> cst "static" - Java.InterfaceMethodModifierStrictfp -> cst "strictfp" - -writeInterfaceModifier :: Java.InterfaceModifier -> CT.Expr -writeInterfaceModifier m = case m of - Java.InterfaceModifierAnnotation a -> writeAnnotation a - Java.InterfaceModifierPublic -> cst "public" - Java.InterfaceModifierProtected -> cst "protected" - Java.InterfaceModifierPrivate -> cst "private" - Java.InterfaceModifierAbstract -> cst "abstract" - Java.InterfaceModifierStatic -> cst "static" - Java.InterfaceModifierStrictfb -> cst "strictfb" - -writeInterfaceType :: Java.InterfaceType -> CT.Expr -writeInterfaceType (Java.InterfaceType ct) = writeClassType ct - -writeLabeledStatement :: Java.LabeledStatement -> CT.Expr -writeLabeledStatement _ = cst "TODO:LabeledStatement" - -writeLambdaBody :: Java.LambdaBody -> CT.Expr -writeLambdaBody b = case b of - Java.LambdaBodyExpression e -> writeExpression e - Java.LambdaBodyBlock b -> writeBlock b - -writeLambdaExpression :: Java.LambdaExpression -> CT.Expr -writeLambdaExpression (Java.LambdaExpression params body) = - infixWs "->" (writeLambdaParameters params) (writeLambdaBody body) - -writeLambdaParameters :: Java.LambdaParameters -> CT.Expr -writeLambdaParameters p = case p of - Java.LambdaParametersTuple l -> parenList False (writeLambdaParameters <$> l) - Java.LambdaParametersSingle id -> writeIdentifier id - -writeLeftHandSide :: Java.LeftHandSide -> CT.Expr -writeLeftHandSide lhs = case lhs of - Java.LeftHandSideExpressionName en -> writeExpressionName en - Java.LeftHandSideFieldAccess fa -> writeFieldAccess fa - Java.LeftHandSideArrayAccess aa -> writeArrayAccess aa - -writeLiteral :: Java.Literal -> CT.Expr -writeLiteral l = case l of - Java.LiteralNull -> cst "null" - Java.LiteralInteger il -> writeIntegerLiteral il - Java.LiteralFloatingPoint fl -> writeFloatingPointLiteral fl - Java.LiteralBoolean b -> cst $ if b then "true" else "false" - Java.LiteralCharacter c -> writeCharacterLiteral c - Java.LiteralString sl -> writeStringLiteral sl - -writeLocalVariableDeclaration :: Java.LocalVariableDeclaration -> CT.Expr -writeLocalVariableDeclaration (Java.LocalVariableDeclaration mods t decls) = spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeVariableModifier <$> mods), - Just $ writeLocalName t, - Just $ commaSep inlineStyle (writeVariableDeclarator <$> decls)] - -writeLocalVariableDeclarationStatement :: Java.LocalVariableDeclarationStatement -> CT.Expr -writeLocalVariableDeclarationStatement (Java.LocalVariableDeclarationStatement d) = suffixSemi $ writeLocalVariableDeclaration d - -writeLocalName :: Java.LocalVariableType -> CT.Expr -writeLocalName t = case t of - Java.LocalVariableTypeType ut -> writeUnannType ut - Java.LocalVariableTypeVar -> cst "var" - -writeMarkerAnnotation :: Java.MarkerAnnotation -> CT.Expr -writeMarkerAnnotation (Java.MarkerAnnotation tname) = prefixAt $ writeTypeName tname - -writeMethodBody :: Java.MethodBody -> CT.Expr -writeMethodBody b = case b of - Java.MethodBodyBlock block -> writeBlock block - Java.MethodBodyNone -> semi - -writeMethodDeclaration :: Java.MethodDeclaration -> CT.Expr -writeMethodDeclaration (Java.MethodDeclaration anns mods header body) = newlineSep $ Y.catMaybes [ - if L.null anns then Nothing else Just $ newlineSep (writeAnnotation <$> anns), - Just headerAndBody] - where - headerAndBody = spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeMethodModifier <$> mods), - Just $ writeMethodHeader header, - Just $ writeMethodBody body] - -writeMethodDeclarator :: Java.MethodDeclarator -> CT.Expr -writeMethodDeclarator (Java.MethodDeclarator id rparam params) = noSep [ - writeIdentifier id, - -- Note: ignoring receiver param for now - parenList False (writeFormalParameter <$> params)] - -writeMethodHeader :: Java.MethodHeader -> CT.Expr -writeMethodHeader (Java.MethodHeader params result decl mthrows) = spaceSep $ Y.catMaybes [ - if L.null params then Nothing else Just $ angleBracesList inlineStyle (writeTypeParameter <$> params), - Just $ writeResult result, - Just $ writeMethodDeclarator decl, - writeThrows <$> mthrows] - -writeMethodInvocation :: Java.MethodInvocation -> CT.Expr -writeMethodInvocation (Java.MethodInvocation header args) = noSep [headerSec, argSec] - where - argSec = parenList True (writeExpression <$> args) - headerSec = case header of - Java.MethodInvocation_HeaderSimple mname -> writeMethodName mname - Java.MethodInvocation_HeaderComplex (Java.MethodInvocation_Complex var targs id) -> case var of - Java.MethodInvocation_VariantType tname -> dotSep [writeTypeName tname, idSec] - Java.MethodInvocation_VariantExpression en -> dotSep [writeExpressionName en, idSec] - Java.MethodInvocation_VariantPrimary p -> dotSep [writePrimary p, idSec] - Java.MethodInvocation_VariantSuper -> dotSep [super, idSec] - Java.MethodInvocation_VariantTypeSuper tname -> dotSep [writeTypeName tname, super, idSec] - where - super = cst "super" - idSec = noSep $ Y.catMaybes [ - if L.null targs then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> targs), - Just $ writeIdentifier id] - -writeMethodModifier :: Java.MethodModifier -> CT.Expr -writeMethodModifier m = case m of - Java.MethodModifierAnnotation ann -> writeAnnotation ann - Java.MethodModifierPublic -> cst "public" - Java.MethodModifierProtected -> cst "protected" - Java.MethodModifierPrivate -> cst "private" - Java.MethodModifierAbstract -> cst "abstract" - Java.MethodModifierFinal -> cst "final" - Java.MethodModifierSynchronized -> cst "synchronized" - Java.MethodModifierNative -> cst "native" - Java.MethodModifierStrictfb -> cst "strictfb" - -writeMethodName :: Java.MethodName -> CT.Expr -writeMethodName (Java.MethodName id) = writeIdentifier id - -writeMethodReference :: Java.MethodReference -> CT.Expr -writeMethodReference _ = cst "TODO:MethodReference" - -writeMultiplicativeExpression :: Java.MultiplicativeExpression -> CT.Expr -writeMultiplicativeExpression e = case e of - Java.MultiplicativeExpressionUnary u -> writeUnaryExpression u - Java.MultiplicativeExpressionTimes (Java.MultiplicativeExpression_Binary lhs rhs) -> - infixWs "*" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs) - Java.MultiplicativeExpressionDivide (Java.MultiplicativeExpression_Binary lhs rhs) -> - infixWs "/" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs) - Java.MultiplicativeExpressionMod (Java.MultiplicativeExpression_Binary lhs rhs) -> - infixWs "%" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs) - -writeNormalAnnotation :: Java.NormalAnnotation -> CT.Expr -writeNormalAnnotation (Java.NormalAnnotation tname pairs) = prefixAt $ noSep [ - writeTypeName tname, - commaSep inlineStyle (writeElementValuePair <$> pairs)] - -writeNormalClassDeclaration :: Java.NormalClassDeclaration -> CT.Expr -writeNormalClassDeclaration (Java.NormalClassDeclaration mods id tparams msuperc superi body) = - spaceSep $ Y.catMaybes [modSec, classSec, idSec, extendsSec, implementsSec, bodySec] - where - modSec = if L.null mods - then Nothing - else Just $ spaceSep (writeClassModifier <$> mods) - classSec = Just $ cst "class" - idSec = Just $ noSep $ Y.catMaybes [Just $ writeTypeIdentifier id, params] - where - params = if L.null tparams - then Nothing - else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams) - extendsSec = fmap (\c -> spaceSep [cst "extends", writeClassType c]) msuperc - implementsSec = if L.null superi - then Nothing - else Just $ spaceSep [cst "implements", commaSep inlineStyle (writeInterfaceType <$> superi)] - bodySec = Just $ writeClassBody body - -writeNormalInterfaceDeclaration :: Java.NormalInterfaceDeclaration -> CT.Expr -writeNormalInterfaceDeclaration (Java.NormalInterfaceDeclaration mods id tparams extends body) = - spaceSep $ Y.catMaybes [modSec, classSec, idSec, extendsSec, bodySec] - where - modSec = if L.null mods - then Nothing - else Just $ spaceSep (writeInterfaceModifier <$> mods) - classSec = Just $ cst "interface" - idSec = Just $ noSep $ Y.catMaybes [Just $ writeTypeIdentifier id, params] - where - params = if L.null tparams - then Nothing - else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams) - extendsSec = if L.null extends then Nothing else Just $ - spaceSep [cst "extends", commaSep inlineStyle (writeInterfaceType <$> extends)] - bodySec = Just $ writeInterfaceBody body - -writeNumericType :: Java.NumericType -> CT.Expr -writeNumericType nt = case nt of - Java.NumericTypeIntegral it -> writeIntegralType it - Java.NumericTypeFloatingPoint ft -> writeFloatingPointType ft - -writePackageDeclaration :: Java.PackageDeclaration -> CT.Expr -writePackageDeclaration (Java.PackageDeclaration mods ids) = suffixSemi $ spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writePackageModifier <$> mods), - Just $ spaceSep [cst "package", cst $ L.intercalate "." (Java.unIdentifier <$> ids)]] - -writePackageName :: Java.PackageName -> CT.Expr -writePackageName (Java.PackageName ids) = dotSep (writeIdentifier <$> ids) - -writePackageOrTypeName :: Java.PackageOrTypeName -> CT.Expr -writePackageOrTypeName (Java.PackageOrTypeName ids) = dotSep (writeIdentifier <$> ids) - -writePackageModifier :: Java.PackageModifier -> CT.Expr -writePackageModifier (Java.PackageModifier ann) = writeAnnotation ann - -writePostDecrementExpression :: Java.PostDecrementExpression -> CT.Expr -writePostDecrementExpression _ = cst "TODO:PostDecrementExpression" - -writePostIncrementExpression :: Java.PostIncrementExpression -> CT.Expr -writePostIncrementExpression _ = cst "TODO:PostIncrementExpression" - -writePostfixExpression :: Java.PostfixExpression -> CT.Expr -writePostfixExpression e = case e of - Java.PostfixExpressionPrimary p -> writePrimary p - Java.PostfixExpressionName en -> writeExpressionName en - Java.PostfixExpressionPostIncrement pi -> writePostIncrementExpression pi - Java.PostfixExpressionPostDecrement pd -> writePostDecrementExpression pd - -writePreDecrementExpression:: Java.PreDecrementExpression -> CT.Expr -writePreDecrementExpression _ = cst "TODO:PreDecrementExpression" - -writePreIncrementExpression :: Java.PreIncrementExpression -> CT.Expr -writePreIncrementExpression _ = cst "TODO:PreIncrementExpression" - -writePrimary :: Java.Primary -> CT.Expr -writePrimary p = case p of - Java.PrimaryNoNewArray n -> writePrimaryNoNewArray n - Java.PrimaryArrayCreation a -> writeArrayCreationExpression a - -writePrimaryNoNewArray :: Java.PrimaryNoNewArray -> CT.Expr -writePrimaryNoNewArray p = case p of - Java.PrimaryNoNewArrayLiteral l -> writeLiteral l - Java.PrimaryNoNewArrayClassLiteral cl -> writeClassLiteral cl - Java.PrimaryNoNewArrayThis -> cst "this" - Java.PrimaryNoNewArrayDotThis n -> dotSep [writeTypeName n, cst "this"] - Java.PrimaryNoNewArrayParens e -> parenList False [writeExpression e] - Java.PrimaryNoNewArrayClassInstance ci -> writeClassInstanceCreationExpression ci - Java.PrimaryNoNewArrayFieldAccess fa -> writeFieldAccess fa - Java.PrimaryNoNewArrayArrayAccess aa -> writeArrayAccess aa - Java.PrimaryNoNewArrayMethodInvocation mi -> writeMethodInvocation mi - Java.PrimaryNoNewArrayMethodReference mr -> writeMethodReference mr - -writePrimitiveType :: Java.PrimitiveType -> CT.Expr -writePrimitiveType pt = case pt of - Java.PrimitiveTypeNumeric nt -> writeNumericType nt - Java.PrimitiveTypeBoolean -> cst "boolean" - -writePrimitiveTypeWithAnnotations :: Java.PrimitiveTypeWithAnnotations -> CT.Expr -writePrimitiveTypeWithAnnotations (Java.PrimitiveTypeWithAnnotations pt anns) = spaceSep $ Y.catMaybes [ - if L.null anns then Nothing else Just $ spaceSep (writeAnnotation <$> anns), - Just $ writePrimitiveType pt] - -writeReceiverParameter :: Java.ReceiverParameter -> CT.Expr -writeReceiverParameter _ = cst "TODO:ReceiverParameter" - -writeReferenceType :: Java.ReferenceType -> CT.Expr -writeReferenceType rt = case rt of - Java.ReferenceTypeClassOrInterface cit -> writeClassOrInterfaceType cit - Java.ReferenceTypeVariable v -> writeName v - Java.ReferenceTypeArray at -> writeArrayType at - -writeRelationalExpression :: Java.RelationalExpression -> CT.Expr -writeRelationalExpression e = case e of - Java.RelationalExpressionSimple s -> writeShiftExpression s - Java.RelationalExpressionLessThan lt -> writeRelationalExpression_LessThan lt - Java.RelationalExpressionGreaterThan gt -> writeRelationalExpression_GreaterThan gt - Java.RelationalExpressionLessThanEqual lte -> writeRelationalExpression_LessThanEqual lte - Java.RelationalExpressionGreaterThanEqual gte -> writeRelationalExpression_GreaterThanEqual gte - Java.RelationalExpressionInstanceof i -> writeRelationalExpression_InstanceOf i - -writeRelationalExpression_GreaterThan :: Java.RelationalExpression_GreaterThan -> CT.Expr -writeRelationalExpression_GreaterThan _ = cst "TODO:RelationalExpression_GreaterThan" - -writeRelationalExpression_GreaterThanEqual :: Java.RelationalExpression_GreaterThanEqual -> CT.Expr -writeRelationalExpression_GreaterThanEqual _ = cst "TODO:RelationalExpression_GreaterThanEqual" - -writeRelationalExpression_InstanceOf :: Java.RelationalExpression_InstanceOf -> CT.Expr -writeRelationalExpression_InstanceOf (Java.RelationalExpression_InstanceOf lhs rhs) = - infixWs "instanceof" (writeRelationalExpression lhs) (writeReferenceType rhs) - -writeRelationalExpression_LessThan :: Java.RelationalExpression_LessThan -> CT.Expr -writeRelationalExpression_LessThan _ = cst "TODO:RelationalExpression_LessThan" - -writeRelationalExpression_LessThanEqual :: Java.RelationalExpression_LessThanEqual -> CT.Expr -writeRelationalExpression_LessThanEqual _ = cst "TODO:RelationalExpression_LessThanEqual" - -writeResult :: Java.Result -> CT.Expr -writeResult r = case r of - Java.ResultType t -> writeUnannType t - Java.ResultVoid -> cst "void" - -writeReturnStatement :: Java.ReturnStatement -> CT.Expr -writeReturnStatement (Java.ReturnStatement mex) = suffixSemi $ spaceSep $ Y.catMaybes [ - Just $ cst "return", - writeExpression <$> mex] - -writeShiftExpression :: Java.ShiftExpression -> CT.Expr -writeShiftExpression e = case e of - Java.ShiftExpressionUnary a -> writeAdditiveExpression a - Java.ShiftExpressionShiftLeft (Java.ShiftExpression_Binary lhs rhs) -> - infixWs "<<" (writeShiftExpression lhs) (writeAdditiveExpression rhs) - Java.ShiftExpressionShiftRight (Java.ShiftExpression_Binary lhs rhs) -> - infixWs ">>" (writeShiftExpression lhs) (writeAdditiveExpression rhs) - Java.ShiftExpressionShiftRightZeroFill (Java.ShiftExpression_Binary lhs rhs) -> - infixWs ">>>" (writeShiftExpression lhs) (writeAdditiveExpression rhs) - -writeSimpleTypeName :: Java.SimpleTypeName -> CT.Expr -writeSimpleTypeName (Java.SimpleTypeName tid) = writeTypeIdentifier tid - -writeSingleElementAnnotation :: Java.SingleElementAnnotation -> CT.Expr -writeSingleElementAnnotation (Java.SingleElementAnnotation tname mv) = case mv of - Nothing -> writeMarkerAnnotation (Java.MarkerAnnotation tname) - Just v -> prefixAt $ noSep [writeTypeName tname, parenList False [writeElementValue v]] - -writeStatement :: Java.Statement -> CT.Expr -writeStatement s = case s of - Java.StatementWithoutTrailing s -> writeStatementWithoutTrailingSubstatement s - Java.StatementLabeled l -> writeLabeledStatement l - Java.StatementIfThen it -> writeIfThenStatement it - Java.StatementIfThenElse ite -> writeIfThenElseStatement ite - Java.StatementWhile w -> writeWhileStatement w - Java.StatementFor f -> writeForStatement f - -writeStatementExpression :: Java.StatementExpression -> CT.Expr -writeStatementExpression e = case e of - Java.StatementExpressionAssignment ass -> writeAssignment ass - Java.StatementExpressionPreIncrement pi -> writePreIncrementExpression pi - Java.StatementExpressionPreDecrement pd -> writePreDecrementExpression pd - Java.StatementExpressionPostIncrement pi -> writePostIncrementExpression pi - Java.StatementExpressionPostDecrement pd -> writePostDecrementExpression pd - Java.StatementExpressionMethodInvocation m -> writeMethodInvocation m - Java.StatementExpressionClassInstanceCreation cic -> writeClassInstanceCreationExpression cic - -writeStatementWithoutTrailingSubstatement :: Java.StatementWithoutTrailingSubstatement -> CT.Expr -writeStatementWithoutTrailingSubstatement s = case s of - Java.StatementWithoutTrailingSubstatementBlock b -> writeBlock b - Java.StatementWithoutTrailingSubstatementEmpty e -> writeEmptyStatement e - Java.StatementWithoutTrailingSubstatementExpression e -> writeExpressionStatement e - Java.StatementWithoutTrailingSubstatementAssert a -> writeAssertStatement a - Java.StatementWithoutTrailingSubstatementSwitch s -> writeSwitchStatement s - Java.StatementWithoutTrailingSubstatementDo d -> writeDoStatement d - Java.StatementWithoutTrailingSubstatementBreak b -> writeBreakStatement b - Java.StatementWithoutTrailingSubstatementContinue c -> writeContinueStatement c - Java.StatementWithoutTrailingSubstatementReturn r -> writeReturnStatement r - Java.StatementWithoutTrailingSubstatementSynchronized s -> writeSynchronizedStatement s - Java.StatementWithoutTrailingSubstatementThrow t -> writeThrowStatement t - Java.StatementWithoutTrailingSubstatementTry t -> writeTryStatement t - -writeStaticInitializer :: Java.StaticInitializer -> CT.Expr -writeStaticInitializer _ = cst "TODO:StaticInitializer" - -writeStringLiteral :: Java.StringLiteral -> CT.Expr -writeStringLiteral (Java.StringLiteral s) = cst $ show s - -writeSwitchStatement :: Java.SwitchStatement -> CT.Expr -writeSwitchStatement _ = cst "TODO:SwitchStatement" - -writeSynchronizedStatement :: Java.SynchronizedStatement -> CT.Expr -writeSynchronizedStatement _ = cst "TODO:SynchronizedStatement" - -writeThrowStatement :: Java.ThrowStatement -> CT.Expr -writeThrowStatement (Java.ThrowStatement ex) = suffixSemi $ spaceSep [cst "throw", writeExpression ex] - -writeThrows :: Java.Throws -> CT.Expr -writeThrows _ = cst "TODO:Throws" - -writeTryStatement :: Java.TryStatement -> CT.Expr -writeTryStatement _ = cst "TODO:TryStatement" - -writeType :: Java.Type -> CT.Expr -writeType t = case t of - Java.TypePrimitive pt -> writePrimitiveTypeWithAnnotations pt - Java.TypeReference rt -> writeReferenceType rt - -writeTypeArgument :: Java.TypeArgument -> CT.Expr -writeTypeArgument a = case a of - Java.TypeArgumentReference rt -> writeReferenceType rt - Java.TypeArgumentWildcard w -> writeWildcard w - -writeTypeArgumentsOrDiamond :: Java.TypeArgumentsOrDiamond -> CT.Expr -writeTypeArgumentsOrDiamond targs = case targs of - Java.TypeArgumentsOrDiamondArguments args -> angleBracesList inlineStyle (writeTypeArgument <$> args) - Java.TypeArgumentsOrDiamondDiamond -> cst "<>" - -writeTypeBound :: Java.TypeBound -> CT.Expr -writeTypeBound _ = cst "TODO:TypeBound" - -writeTypeDeclaration :: Java.TypeDeclaration -> CT.Expr -writeTypeDeclaration d = case d of - Java.TypeDeclarationClass d -> writeClassDeclaration d - Java.TypeDeclarationInterface d -> writeInterfaceDeclaration d - Java.TypeDeclarationNone -> semi - -writeTypeDeclarationWithComments :: Java.TypeDeclarationWithComments -> CT.Expr -writeTypeDeclarationWithComments (Java.TypeDeclarationWithComments d mc) = withComments mc $ writeTypeDeclaration d - -writeTypeIdentifier :: Java.TypeIdentifier -> CT.Expr -writeTypeIdentifier (Java.TypeIdentifier id) = writeIdentifier id - -writeTypeName :: Java.TypeName -> CT.Expr -writeTypeName (Java.TypeName id mqual) = dotSep $ Y.catMaybes [ - writePackageOrTypeName <$> mqual, - Just $ writeTypeIdentifier id] - -writeTypeParameter :: Java.TypeParameter -> CT.Expr -writeTypeParameter (Java.TypeParameter mods id bound) = spaceSep $ Y.catMaybes [ - if L.null mods then Nothing else Just $ spaceSep (writeTypeParameterModifier <$> mods), - Just $ writeTypeIdentifier id, - fmap (\b -> spaceSep [cst "extends", writeTypeBound b]) bound] - -writeTypeParameterModifier :: Java.TypeParameterModifier -> CT.Expr -writeTypeParameterModifier (Java.TypeParameterModifier ann) = writeAnnotation ann - -writeName :: Java.TypeVariable -> CT.Expr -writeName (Java.TypeVariable anns id) = spaceSep $ Y.catMaybes [ - if L.null anns then Nothing else Just $ spaceSep (writeAnnotation <$> anns), - Just $ writeTypeIdentifier id] - -writeUnannType :: Java.UnannType -> CT.Expr -writeUnannType (Java.UnannType t) = writeType t - -writeUnaryExpression :: Java.UnaryExpression -> CT.Expr -writeUnaryExpression e = case e of - Java.UnaryExpressionPreIncrement pi -> writePreIncrementExpression pi - Java.UnaryExpressionPreDecrement pd -> writePreDecrementExpression pd - Java.UnaryExpressionPlus p -> spaceSep [cst "+", writeUnaryExpression p] - Java.UnaryExpressionMinus m -> spaceSep [cst "-", writeUnaryExpression m] - Java.UnaryExpressionOther o -> writeUnaryExpressionNotPlusMinus o - -writeUnaryExpressionNotPlusMinus :: Java.UnaryExpressionNotPlusMinus -> CT.Expr -writeUnaryExpressionNotPlusMinus e = case e of - Java.UnaryExpressionNotPlusMinusPostfix p -> writePostfixExpression p - Java.UnaryExpressionNotPlusMinusTilde u -> spaceSep [cst "~", writeUnaryExpression u] - Java.UnaryExpressionNotPlusMinusNot u -> noSep [cst "!", writeUnaryExpression u] - Java.UnaryExpressionNotPlusMinusCast c -> writeCastExpression c - -writeUnqualifiedClassInstanceCreationExpression :: Java.UnqualifiedClassInstanceCreationExpression -> CT.Expr -writeUnqualifiedClassInstanceCreationExpression (Java.UnqualifiedClassInstanceCreationExpression targs cit args mbody) - = spaceSep $ Y.catMaybes [ - Just $ cst "new", - if L.null targs then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> targs), - Just $ noSep [writeClassOrInterfaceTypeToInstantiate cit, parenList False (writeExpression <$> args)], - writeClassBody <$> mbody] - -writeVariableArityParameter :: Java.VariableArityParameter -> CT.Expr -writeVariableArityParameter _ = cst "TODO:VariableArityParameter" - -writeVariableDeclarator :: Java.VariableDeclarator -> CT.Expr -writeVariableDeclarator (Java.VariableDeclarator id minit) = - Y.maybe idSec (infixWs "=" idSec . writeVariableInitializer) minit - where - idSec = writeVariableDeclaratorId id - -writeVariableDeclaratorId :: Java.VariableDeclaratorId -> CT.Expr -writeVariableDeclaratorId (Java.VariableDeclaratorId id mdims) = noSep $ Y.catMaybes [ - Just $ writeIdentifier id, - writeDims <$> mdims] - -writeVariableInitializer :: Java.VariableInitializer -> CT.Expr -writeVariableInitializer i = case i of - Java.VariableInitializerExpression e -> writeExpression e - Java.VariableInitializerArrayInitializer ai -> writeArrayInitializer ai - -writeVariableModifier :: Java.VariableModifier -> CT.Expr -writeVariableModifier m = case m of - Java.VariableModifierAnnotation ann -> writeAnnotation ann - Java.VariableModifierFinal -> cst "final" - -writeWhileStatement :: Java.WhileStatement -> CT.Expr -writeWhileStatement _ = cst "TODO:WhileStatement" - -writeWildcard :: Java.Wildcard -> CT.Expr -writeWildcard (Java.Wildcard anns mbounds) = spaceSep $ Y.catMaybes [ - if L.null anns then Nothing else Just $ commaSep inlineStyle (writeAnnotation <$> anns), - Just $ cst "*", - writeWildcardBounds <$> mbounds] - -writeWildcardBounds :: Java.WildcardBounds -> CT.Expr -writeWildcardBounds b = case b of - Java.WildcardBoundsExtends rt -> spaceSep [cst "extends", writeReferenceType rt] - Java.WildcardBoundsSuper rt -> spaceSep [cst "super", writeReferenceType rt] - -prefixAt :: CT.Expr -> CT.Expr -prefixAt e = noSep [cst "@", e] - -semi :: CT.Expr -semi = cst ";" - -suffixSemi :: CT.Expr -> CT.Expr -suffixSemi e = noSep [e, semi] diff --git a/src/main/haskell/Hydra/Langs/Java/Settings.hs b/src/main/haskell/Hydra/Langs/Java/Settings.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Java/Settings.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Hydra.Langs.Java.Settings where - -listsAsArrays :: Bool -listsAsArrays = False diff --git a/src/main/haskell/Hydra/Langs/Java/Utils.hs b/src/main/haskell/Hydra/Langs/Java/Utils.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Java/Utils.hs +++ /dev/null @@ -1,556 +0,0 @@ -module Hydra.Langs.Java.Utils where - -import Hydra.Kernel -import Hydra.Langs.Java.Language -import Hydra.Langs.Java.Names -import qualified Hydra.Langs.Java.Syntax as Java -import qualified Hydra.Lib.Strings as Strings - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -type PackageMap = M.Map Namespace Java.PackageName - -data Aliases = Aliases { - aliasesCurrentNamespace :: Namespace, - aliasesPackages :: PackageMap, - aliasesRecursiveVars :: S.Set Name } deriving Show - -addExpressions :: [Java.MultiplicativeExpression] -> Java.AdditiveExpression -addExpressions exprs = L.foldl add (Java.AdditiveExpressionUnary $ L.head exprs) $ L.tail exprs - where - add ae me = Java.AdditiveExpressionPlus $ Java.AdditiveExpression_Binary ae me - -addJavaTypeParameter :: Java.ReferenceType -> Java.Type -> Flow (Graph) Java.Type -addJavaTypeParameter rt t = case t of - Java.TypeReference rt1 -> case rt1 of - Java.ReferenceTypeClassOrInterface cit -> case cit of - Java.ClassOrInterfaceTypeClass (Java.ClassType anns qual id args) -> pure $ - Java.TypeReference $ Java.ReferenceTypeClassOrInterface $ - Java.ClassOrInterfaceTypeClass $ Java.ClassType anns qual id (args ++ [Java.TypeArgumentReference rt]) - _ -> fail $ "expected a Java class type. Found: " ++ show cit - Java.ReferenceTypeVariable tv -> pure $ javaTypeVariableToType tv - _ -> fail $ "expected a Java class or interface type, or a variable. Found: " ++ show rt - _ -> fail $ "expected a reference type. Found: " ++ show t - -fieldExpression :: Java.Identifier -> Java.Identifier -> Java.ExpressionName -fieldExpression varId fieldId = Java.ExpressionName (Just $ Java.AmbiguousName [varId]) fieldId - -fieldNameToJavaExpression :: Name -> Java.Expression -fieldNameToJavaExpression fname = javaPostfixExpressionToJavaExpression $ - Java.PostfixExpressionName $ Java.ExpressionName Nothing (fieldNameToJavaIdentifier fname) - -fieldNameToJavaIdentifier :: Name -> Java.Identifier -fieldNameToJavaIdentifier (Name name) = javaIdentifier name - -fieldNameToJavaVariableDeclarator :: Name -> Java.VariableDeclarator -fieldNameToJavaVariableDeclarator (Name n) = javaVariableDeclarator (javaIdentifier n) Nothing - -fieldNameToJavaVariableDeclaratorId :: Name -> Java.VariableDeclaratorId -fieldNameToJavaVariableDeclaratorId (Name n) = javaVariableDeclaratorId $ javaIdentifier n - -importAliasesForModule :: Module -> Aliases -importAliasesForModule mod = Aliases (moduleNamespace mod) M.empty S.empty - -interfaceMethodDeclaration :: [Java.InterfaceMethodModifier] -> [Java.TypeParameter] -> String -> [Java.FormalParameter] - -> Java.Result -> Maybe [Java.BlockStatement] -> Java.InterfaceMemberDeclaration -interfaceMethodDeclaration mods tparams methodName params result stmts = Java.InterfaceMemberDeclarationInterfaceMethod $ - Java.InterfaceMethodDeclaration mods header body - where - header = javaMethodHeader tparams methodName params result - body = javaMethodBody stmts - -isEscaped :: String -> Bool -isEscaped s = L.head s == '$' - -javaAdditiveExpressionToJavaExpression :: Java.AdditiveExpression -> Java.Expression -javaAdditiveExpressionToJavaExpression = javaRelationalExpressionToJavaExpression . - Java.RelationalExpressionSimple . Java.ShiftExpressionUnary - -javaAssignmentStatement :: Java.LeftHandSide -> Java.Expression -> Java.Statement -javaAssignmentStatement lhs rhs = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementExpression $ - Java.ExpressionStatement $ Java.StatementExpressionAssignment ass - where - ass = Java.Assignment lhs Java.AssignmentOperatorSimple rhs - -javaBoolean :: Bool -> Java.Literal -javaBoolean = Java.LiteralBoolean - -javaBooleanExpression :: Bool -> Java.Expression -javaBooleanExpression = javaPrimaryToJavaExpression . javaLiteralToJavaPrimary . javaBoolean - -javaBooleanType :: Java.Type -javaBooleanType = javaPrimitiveTypeToJavaType Java.PrimitiveTypeBoolean - -javaCastExpression :: Java.ReferenceType -> Java.UnaryExpression -> Java.CastExpression -javaCastExpression rt expr = Java.CastExpressionNotPlusMinus $ Java.CastExpression_NotPlusMinus rb expr - where - rb = Java.CastExpression_RefAndBounds rt [] - -javaCastExpressionToJavaExpression :: Java.CastExpression -> Java.Expression -javaCastExpressionToJavaExpression = javaUnaryExpressionToJavaExpression . Java.UnaryExpressionOther . - Java.UnaryExpressionNotPlusMinusCast - -javaClassDeclaration :: Aliases -> [Java.TypeParameter] -> Name -> [Java.ClassModifier] - -> Maybe Name -> [Java.InterfaceType] -> [Java.ClassBodyDeclarationWithComments] -> Java.ClassDeclaration -javaClassDeclaration aliases tparams elName mods supname impls bodyDecls = Java.ClassDeclarationNormal $ Java.NormalClassDeclaration { - Java.normalClassDeclarationModifiers = mods, - Java.normalClassDeclarationIdentifier = javaDeclName elName, - Java.normalClassDeclarationParameters = tparams, - Java.normalClassDeclarationExtends = fmap (\n -> nameToJavaClassType aliases True [] n Nothing) supname, - Java.normalClassDeclarationImplements = impls, - Java.normalClassDeclarationBody = Java.ClassBody bodyDecls} - -javaClassType :: [Java.ReferenceType] -> Maybe Java.PackageName -> String -> Java.ClassType -javaClassType args pkg id = Java.ClassType [] qual (javaTypeIdentifier id) targs - where - qual = maybe Java.ClassTypeQualifierNone Java.ClassTypeQualifierPackage pkg - targs = Java.TypeArgumentReference <$> args - -javaClassTypeToJavaType :: Java.ClassType -> Java.Type -javaClassTypeToJavaType = Java.TypeReference . Java.ReferenceTypeClassOrInterface . Java.ClassOrInterfaceTypeClass - -javaConditionalAndExpressionToJavaExpression :: Java.ConditionalAndExpression -> Java.Expression -javaConditionalAndExpressionToJavaExpression condAndEx = Java.ExpressionAssignment $ - Java.AssignmentExpressionConditional $ Java.ConditionalExpressionSimple $ Java.ConditionalOrExpression [condAndEx] - -javaConstructorCall :: Java.ClassOrInterfaceTypeToInstantiate -> [Java.Expression] -> Maybe Java.ClassBody -> Java.Expression -javaConstructorCall ci args mbody = javaPrimaryToJavaExpression $ - Java.PrimaryNoNewArray $ - Java.PrimaryNoNewArrayClassInstance $ - Java.ClassInstanceCreationExpression Nothing $ - Java.UnqualifiedClassInstanceCreationExpression [] ci args mbody - -javaConstructorName :: Java.Identifier -> Maybe Java.TypeArgumentsOrDiamond -> Java.ClassOrInterfaceTypeToInstantiate -javaConstructorName id targs = Java.ClassOrInterfaceTypeToInstantiate [Java.AnnotatedIdentifier [] id] targs - -javaDeclName :: Name -> Java.TypeIdentifier -javaDeclName = Java.TypeIdentifier . javaVariableName - -javaEmptyStatement :: Java.Statement -javaEmptyStatement = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementEmpty Java.EmptyStatement - -javaEqualityExpressionToJavaExpression :: Java.EqualityExpression -> Java.Expression -javaEqualityExpressionToJavaExpression eqEx = javaConditionalAndExpressionToJavaExpression $ - Java.ConditionalAndExpression [javaEqualityExpressionToJavaInclusiveOrExpression eqEx] - -javaEqualityExpressionToJavaInclusiveOrExpression :: Java.EqualityExpression -> Java.InclusiveOrExpression -javaEqualityExpressionToJavaInclusiveOrExpression eq = Java.InclusiveOrExpression [ - Java.ExclusiveOrExpression [Java.AndExpression [eq]]] - -javaEquals :: Java.EqualityExpression -> Java.RelationalExpression -> Java.EqualityExpression -javaEquals lhs rhs = Java.EqualityExpressionEqual $ Java.EqualityExpression_Binary lhs rhs - -javaEqualsNull :: Java.EqualityExpression -> Java.EqualityExpression -javaEqualsNull lhs = javaEquals lhs $ javaLiteralToJavaRelationalExpression Java.LiteralNull - -javaExpressionNameToJavaExpression :: Java.ExpressionName -> Java.Expression -javaExpressionNameToJavaExpression = javaPostfixExpressionToJavaExpression . Java.PostfixExpressionName - -javaExpressionToJavaPrimary :: Java.Expression -> Java.Primary -javaExpressionToJavaPrimary = Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayParens - -javaExpressionToJavaUnaryExpression :: Java.Expression -> Java.UnaryExpression -javaExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression . javaExpressionToJavaPrimary - -javaFieldAccessToJavaExpression :: Java.FieldAccess -> Java.Expression -javaFieldAccessToJavaExpression = javaPrimaryToJavaExpression . Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayFieldAccess - -javaIdentifier :: String -> Java.Identifier -javaIdentifier = Java.Identifier . sanitizeJavaName - -javaIdentifierToJavaExpressionName :: Java.Identifier -> Java.ExpressionName -javaIdentifierToJavaExpressionName id = Java.ExpressionName Nothing id - -javaIdentifierToJavaExpression :: Java.Identifier -> Java.Expression -javaIdentifierToJavaExpression = javaUnaryExpressionToJavaExpression . javaIdentifierToJavaUnaryExpression - -javaIdentifierToJavaRelationalExpression :: Java.Identifier -> Java.RelationalExpression -javaIdentifierToJavaRelationalExpression id = javaPostfixExpressionToJavaRelationalExpression $ - Java.PostfixExpressionName $ Java.ExpressionName Nothing id - -javaIdentifierToJavaUnaryExpression :: Java.Identifier -> Java.UnaryExpression -javaIdentifierToJavaUnaryExpression = javaRelationalExpressionToJavaUnaryExpression . javaIdentifierToJavaRelationalExpression - -javaInstanceOf :: Java.RelationalExpression -> Java.ReferenceType -> Java.RelationalExpression -javaInstanceOf lhs rhs = Java.RelationalExpressionInstanceof $ Java.RelationalExpression_InstanceOf lhs rhs - -javaInt :: Integral a => a -> Java.Literal -javaInt i = Java.LiteralInteger $ Java.IntegerLiteral $ fromIntegral i - -javaIntExpression :: Integer -> Java.Expression -javaIntExpression = javaPrimaryToJavaExpression . javaLiteralToJavaPrimary . javaInt - -javaIntType :: Java.Type -javaIntType = javaPrimitiveTypeToJavaType $ Java.PrimitiveTypeNumeric $ Java.NumericTypeIntegral Java.IntegralTypeInt - -javaInterfaceDeclarationToJavaClassBodyDeclaration :: Java.NormalInterfaceDeclaration -> Java.ClassBodyDeclaration -javaInterfaceDeclarationToJavaClassBodyDeclaration = Java.ClassBodyDeclarationClassMember . - Java.ClassMemberDeclarationInterface . Java.InterfaceDeclarationNormalInterface - -javaLambda :: Name -> Java.Expression -> Java.Expression -javaLambda var jbody = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyExpression jbody) - where - params = Java.LambdaParametersSingle $ variableToJavaIdentifier var - -javaLambdaFromBlock :: Name -> Java.Block -> Java.Expression -javaLambdaFromBlock var block = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyBlock block) - where - params = Java.LambdaParametersSingle $ variableToJavaIdentifier var - -javaLiteralToJavaRelationalExpression :: Java.Literal -> Java.RelationalExpression -javaLiteralToJavaRelationalExpression = javaMultiplicativeExpressionToJavaRelationalExpression . - javaLiteralToJavaMultiplicativeExpression - -javaLiteralToJavaExpression = javaRelationalExpressionToJavaExpression . - javaMultiplicativeExpressionToJavaRelationalExpression . - javaLiteralToJavaMultiplicativeExpression - -javaLiteralToJavaMultiplicativeExpression = Java.MultiplicativeExpressionUnary . javaPrimaryToJavaUnaryExpression . - javaLiteralToJavaPrimary - -javaLiteralToJavaPrimary :: Java.Literal -> Java.Primary -javaLiteralToJavaPrimary = Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayLiteral - -javaMemberField :: [Java.FieldModifier] -> Java.Type -> Java.VariableDeclarator -> Java.ClassBodyDeclaration -javaMemberField mods jt var = Java.ClassBodyDeclarationClassMember $ Java.ClassMemberDeclarationField $ - Java.FieldDeclaration mods (Java.UnannType jt) [var] - -javaMethodBody :: Maybe [Java.BlockStatement] -> Java.MethodBody -javaMethodBody stmts = Y.maybe Java.MethodBodyNone (Java.MethodBodyBlock . Java.Block) stmts - -javaMethodDeclarationToJavaClassBodyDeclaration :: Java.MethodDeclaration -> Java.ClassBodyDeclaration -javaMethodDeclarationToJavaClassBodyDeclaration = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationMethod - -javaMethodHeader :: [Java.TypeParameter] -> String -> [Java.FormalParameter] -> Java.Result -> Java.MethodHeader -javaMethodHeader tparams methodName params result = Java.MethodHeader tparams result decl mthrows - where - decl = Java.MethodDeclarator (Java.Identifier methodName) Nothing params - mthrows = Nothing - -javaMethodInvocationToJavaExpression :: Java.MethodInvocation -> Java.Expression -javaMethodInvocationToJavaExpression = javaPrimaryToJavaExpression . javaMethodInvocationToJavaPrimary - -javaMethodInvocationToJavaStatement :: Java.MethodInvocation -> Java.Statement -javaMethodInvocationToJavaStatement = Java.StatementWithoutTrailing . Java.StatementWithoutTrailingSubstatementExpression . - Java.ExpressionStatement . Java.StatementExpressionMethodInvocation - -javaMethodInvocationToJavaPostfixExpression :: Java.MethodInvocation -> Java.PostfixExpression -javaMethodInvocationToJavaPostfixExpression = Java.PostfixExpressionPrimary . Java.PrimaryNoNewArray . - Java.PrimaryNoNewArrayMethodInvocation - -javaMethodInvocationToJavaPrimary :: Java.MethodInvocation -> Java.Primary -javaMethodInvocationToJavaPrimary = Java.PrimaryNoNewArray . - Java.PrimaryNoNewArrayMethodInvocation - -javaMultiplicativeExpressionToJavaRelationalExpression :: Java.MultiplicativeExpression -> Java.RelationalExpression -javaMultiplicativeExpressionToJavaRelationalExpression = Java.RelationalExpressionSimple . - Java.ShiftExpressionUnary . Java.AdditiveExpressionUnary - -javaPackageDeclaration :: Namespace -> Java.PackageDeclaration -javaPackageDeclaration (Namespace name) = Java.PackageDeclaration [] (Java.Identifier <$> Strings.splitOn "/" name) - -javaPostfixExpressionToJavaEqualityExpression :: Java.PostfixExpression -> Java.EqualityExpression -javaPostfixExpressionToJavaEqualityExpression = Java.EqualityExpressionUnary . - javaUnaryExpressionToJavaRelationalExpression . Java.UnaryExpressionOther . Java.UnaryExpressionNotPlusMinusPostfix - -javaPostfixExpressionToJavaExpression :: Java.PostfixExpression -> Java.Expression -javaPostfixExpressionToJavaExpression = javaRelationalExpressionToJavaExpression . - javaPostfixExpressionToJavaRelationalExpression - -javaPostfixExpressionToJavaInclusiveOrExpression :: Java.PostfixExpression -> Java.InclusiveOrExpression -javaPostfixExpressionToJavaInclusiveOrExpression = javaEqualityExpressionToJavaInclusiveOrExpression . - javaPostfixExpressionToJavaEqualityExpression - -javaPostfixExpressionToJavaRelationalExpression :: Java.PostfixExpression -> Java.RelationalExpression -javaPostfixExpressionToJavaRelationalExpression = - javaUnaryExpressionToJavaRelationalExpression . javaPostfixExpressionToJavaUnaryExpression - -javaPostfixExpressionToJavaUnaryExpression :: Java.PostfixExpression -> Java.UnaryExpression -javaPostfixExpressionToJavaUnaryExpression = Java.UnaryExpressionOther . Java.UnaryExpressionNotPlusMinusPostfix - -javaPrimaryToJavaExpression :: Java.Primary -> Java.Expression -javaPrimaryToJavaExpression = javaPostfixExpressionToJavaExpression . Java.PostfixExpressionPrimary - -javaPrimaryToJavaUnaryExpression :: Java.Primary -> Java.UnaryExpression -javaPrimaryToJavaUnaryExpression = Java.UnaryExpressionOther . - Java.UnaryExpressionNotPlusMinusPostfix . - Java.PostfixExpressionPrimary - -javaPrimitiveTypeToJavaType :: Java.PrimitiveType -> Java.Type -javaPrimitiveTypeToJavaType pt = Java.TypePrimitive $ Java.PrimitiveTypeWithAnnotations pt [] - -javaRefType :: [Java.ReferenceType] -> Maybe Java.PackageName -> String -> Java.Type -javaRefType args pkg id = Java.TypeReference $ Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $ - javaClassType args pkg id - -javaRelationalExpressionToJavaEqualityExpression :: Java.RelationalExpression -> Java.EqualityExpression -javaRelationalExpressionToJavaEqualityExpression = Java.EqualityExpressionUnary - -javaRelationalExpressionToJavaExpression :: Java.RelationalExpression -> Java.Expression -javaRelationalExpressionToJavaExpression = javaEqualityExpressionToJavaExpression . javaRelationalExpressionToJavaEqualityExpression - -javaRelationalExpressionToJavaUnaryExpression :: Java.RelationalExpression -> Java.UnaryExpression -javaRelationalExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression . - Java.PrimaryNoNewArray . - Java.PrimaryNoNewArrayParens . - javaRelationalExpressionToJavaExpression - -javaReturnStatement :: Y.Maybe Java.Expression -> Java.Statement -javaReturnStatement = Java.StatementWithoutTrailing . Java.StatementWithoutTrailingSubstatementReturn . - Java.ReturnStatement - -javaStatementsToBlock :: [Java.Statement] -> Java.Block -javaStatementsToBlock stmts = Java.Block (Java.BlockStatementStatement <$> stmts) - -javaString :: String -> Java.Literal -javaString = Java.LiteralString . Java.StringLiteral - -javaStringMultiplicativeExpression :: String -> Java.MultiplicativeExpression -javaStringMultiplicativeExpression = javaLiteralToJavaMultiplicativeExpression . javaString - -javaThrowIllegalArgumentException :: [Java.Expression] -> Java.Statement -javaThrowIllegalArgumentException args = javaThrowStatement $ - javaConstructorCall (javaConstructorName (Java.Identifier "IllegalArgumentException") Nothing) args Nothing - -javaThrowIllegalStateException :: [Java.Expression] -> Java.Statement -javaThrowIllegalStateException args = javaThrowStatement $ - javaConstructorCall (javaConstructorName (Java.Identifier "IllegalStateException") Nothing) args Nothing - -javaThrowStatement :: Java.Expression -> Java.Statement -javaThrowStatement = Java.StatementWithoutTrailing . - Java.StatementWithoutTrailingSubstatementThrow . Java.ThrowStatement - -javaThis :: Java.Expression -javaThis = javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis - -javaTypeFromTypeName :: Aliases -> Name -> Java.Type -javaTypeFromTypeName aliases elName = javaTypeVariableToType $ Java.TypeVariable [] $ - nameToJavaTypeIdentifier aliases False elName - -javaTypeIdentifier :: String -> Java.TypeIdentifier -javaTypeIdentifier = Java.TypeIdentifier . Java.Identifier - -javaTypeIdentifierToJavaTypeArgument :: Java.TypeIdentifier -> Java.TypeArgument -javaTypeIdentifierToJavaTypeArgument id = Java.TypeArgumentReference $ Java.ReferenceTypeVariable $ Java.TypeVariable [] id - -javaTypeName :: Java.Identifier -> Java.TypeName -javaTypeName id = Java.TypeName (Java.TypeIdentifier id) Nothing - -javaTypeParameter :: String -> Java.TypeParameter -javaTypeParameter v = Java.TypeParameter [] (javaTypeIdentifier v) Nothing - -javaTypeToJavaFormalParameter :: Java.Type -> Name -> Java.FormalParameter -javaTypeToJavaFormalParameter jt fname = Java.FormalParameterSimple $ Java.FormalParameter_Simple [] argType argId - where - argType = Java.UnannType jt - argId = fieldNameToJavaVariableDeclaratorId fname - -javaTypeToJavaReferenceType :: Java.Type -> Flow (Graph) Java.ReferenceType -javaTypeToJavaReferenceType t = case t of - Java.TypeReference rt -> pure rt - _ -> fail $ "expected a Java reference type. Found: " ++ show t - -javaTypeToJavaResult :: Java.Type -> Java.Result -javaTypeToJavaResult = Java.ResultType . Java.UnannType - -javaTypeToJavaTypeArgument :: Java.Type -> Java.TypeArgument -javaTypeToJavaTypeArgument t = case t of - Java.TypeReference rt -> Java.TypeArgumentReference rt - _ -> Java.TypeArgumentWildcard $ Java.Wildcard [] Nothing -- TODO - -javaTypeVariable :: String -> Java.ReferenceType -javaTypeVariable v = Java.ReferenceTypeVariable $ Java.TypeVariable [] $ javaTypeIdentifier $ capitalize v - -javaTypeVariableToType :: Java.TypeVariable -> Java.Type -javaTypeVariableToType = Java.TypeReference . Java.ReferenceTypeVariable - -javaUnaryExpressionToJavaExpression :: Java.UnaryExpression -> Java.Expression -javaUnaryExpressionToJavaExpression = javaRelationalExpressionToJavaExpression . - javaUnaryExpressionToJavaRelationalExpression - -javaUnaryExpressionToJavaRelationalExpression :: Java.UnaryExpression -> Java.RelationalExpression -javaUnaryExpressionToJavaRelationalExpression = javaMultiplicativeExpressionToJavaRelationalExpression . - Java.MultiplicativeExpressionUnary - -javaVariableDeclarator :: Java.Identifier -> Y.Maybe Java.VariableInitializer -> Java.VariableDeclarator -javaVariableDeclarator id = Java.VariableDeclarator (javaVariableDeclaratorId id) - -javaVariableDeclaratorId :: Java.Identifier -> Java.VariableDeclaratorId -javaVariableDeclaratorId id = Java.VariableDeclaratorId id Nothing - -javaVariableName :: Name -> Java.Identifier -javaVariableName = javaIdentifier . localNameOfEager - -makeConstructor :: Aliases -> Name -> Bool -> [Java.FormalParameter] - -> [Java.BlockStatement] -> Java.ClassBodyDeclaration -makeConstructor aliases elName private params stmts = Java.ClassBodyDeclarationConstructorDeclaration $ - Java.ConstructorDeclaration mods cons Nothing body - where - nm = Java.SimpleTypeName $ nameToJavaTypeIdentifier aliases False elName - cons = Java.ConstructorDeclarator [] nm Nothing params - mods = [if private then Java.ConstructorModifierPrivate else Java.ConstructorModifierPublic] - body = Java.ConstructorBody Nothing stmts - -methodDeclaration :: [Java.MethodModifier] -> [Java.TypeParameter] -> [Java.Annotation] -> String - -> [Java.FormalParameter] -> Java.Result -> Maybe [Java.BlockStatement] -> Java.ClassBodyDeclaration -methodDeclaration mods tparams anns methodName params result stmts = - javaMethodDeclarationToJavaClassBodyDeclaration $ - Java.MethodDeclaration anns mods header body - where - header = javaMethodHeader tparams methodName params result - body = javaMethodBody stmts - -methodInvocation :: Y.Maybe (Either Java.ExpressionName Java.Primary) -> Java.Identifier -> [Java.Expression] -> Java.MethodInvocation -methodInvocation lhs methodName = Java.MethodInvocation header - where - header = case lhs of - Nothing -> Java.MethodInvocation_HeaderSimple $ Java.MethodName methodName - Just either -> Java.MethodInvocation_HeaderComplex $ Java.MethodInvocation_Complex variant targs methodName - where - targs = [] - variant = case either of - Left name -> Java.MethodInvocation_VariantExpression name - Right prim -> Java.MethodInvocation_VariantPrimary prim - -methodInvocationStatic :: Java.Identifier -> Java.Identifier -> [Java.Expression] -> Java.MethodInvocation -methodInvocationStatic self methodName = methodInvocation (Just $ Left name) methodName - where - name = Java.ExpressionName Nothing self - -nameToJavaClassType :: Aliases -> Bool -> [Java.TypeArgument] -> Name -> Maybe String -> Java.ClassType -nameToJavaClassType aliases qualify args name mlocal = Java.ClassType [] pkg id args - where - (id, pkg) = nameToQualifiedJavaName aliases qualify name mlocal - -nameToQualifiedJavaName :: Aliases -> Bool -> Name -> Maybe String -> (Java.TypeIdentifier, Java.ClassTypeQualifier) -nameToQualifiedJavaName aliases qualify name mlocal = (jid, pkg) - where - QualifiedName ns local = qualifyNameEager name - alias = case ns of - Nothing -> Nothing - Just n -> case M.lookup n (aliasesPackages aliases) of - Nothing -> Just $ javaPackageName $ Strings.splitOn "/" $ unNamespace n - Just id -> Just id - pkg = if qualify - then Y.maybe none Java.ClassTypeQualifierPackage alias - else none - none = Java.ClassTypeQualifierNone - jid = javaTypeIdentifier $ case mlocal of - Nothing -> sanitizeJavaName local - Just l -> sanitizeJavaName local ++ "." ++ sanitizeJavaName l - -nameToJavaName :: Aliases -> Name -> Java.Identifier -nameToJavaName aliases name = Java.Identifier $ if isEscaped (unName name) - then sanitizeJavaName local - else case ns of - Nothing -> local - Just gname -> case M.lookup gname (aliasesPackages aliases) of - Nothing -> fromParts $ Strings.splitOn "/" $ unNamespace gname - Just (Java.PackageName parts) -> fromParts (Java.unIdentifier <$> parts) - where - QualifiedName ns local = qualifyNameEager name - fromParts parts = L.intercalate "." $ parts ++ [sanitizeJavaName local] - -nameToJavaReferenceType :: Aliases -> Bool -> [Java.TypeArgument] -> Name -> Maybe String -> Java.ReferenceType -nameToJavaReferenceType aliases qualify args name mlocal = Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $ - nameToJavaClassType aliases qualify args name mlocal - -nameToJavaTypeIdentifier :: Aliases -> Bool -> Name -> Java.TypeIdentifier -nameToJavaTypeIdentifier aliases qualify name = fst $ nameToQualifiedJavaName aliases qualify name Nothing - -overrideAnnotation :: Java.Annotation -overrideAnnotation = Java.AnnotationMarker $ Java.MarkerAnnotation $ javaTypeName $ Java.Identifier "Override" - -referenceTypeToResult :: Java.ReferenceType -> Java.Result -referenceTypeToResult = javaTypeToJavaResult . Java.TypeReference - -sanitizeJavaName :: String -> String -sanitizeJavaName name = if isEscaped name - -- The '$' prefix allows names to be excluded from sanitization - then unescape name - else sanitizeWithUnderscores reservedWords name - -toAcceptMethod :: Bool -> [Java.TypeParameter] -> Java.ClassBodyDeclaration -toAcceptMethod abstract vtparams = methodDeclaration mods tparams anns acceptMethodName [param] result body - where - mods = [Java.MethodModifierPublic] ++ if abstract then [Java.MethodModifierAbstract] else [] - tparams = [javaTypeParameter visitorReturnParameter] - anns = if abstract - then [] - else [overrideAnnotation] - param = javaTypeToJavaFormalParameter ref (Name varName) - where - ref = javaClassTypeToJavaType $ - Java.ClassType - [] - Java.ClassTypeQualifierNone - (javaTypeIdentifier visitorName) - (typeArgs ++ [Java.TypeArgumentReference visitorTypeVariable]) - typeArgs = (Java.TypeArgumentReference . typeParameterToReferenceType) <$> vtparams - result = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable - varName = "visitor" - body = if abstract - then Nothing - else Just [Java.BlockStatementStatement $ javaReturnStatement $ Just returnExpr] - returnExpr = javaMethodInvocationToJavaExpression $ - methodInvocationStatic (Java.Identifier varName) (Java.Identifier visitMethodName) [javaThis] - -toAssignStmt :: Name -> Java.Statement -toAssignStmt fname = javaAssignmentStatement lhs rhs - where - lhs = Java.LeftHandSideFieldAccess $ thisField id - where - id = fieldNameToJavaIdentifier fname - rhs = fieldNameToJavaExpression fname - thisField = Java.FieldAccess $ Java.FieldAccess_QualifierPrimary $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis - -toJavaArrayType :: Java.Type -> Flow (Graph) Java.Type -toJavaArrayType t = Java.TypeReference . Java.ReferenceTypeArray <$> case t of - Java.TypeReference rt -> case rt of - Java.ReferenceTypeClassOrInterface cit -> pure $ - Java.ArrayType (Java.Dims [[]]) $ Java.ArrayType_VariantClassOrInterface cit - Java.ReferenceTypeArray (Java.ArrayType (Java.Dims d) v) -> pure $ - Java.ArrayType (Java.Dims $ d ++ [[]]) v - _ -> fail $ "don't know how to make Java reference type into array type: " ++ show rt - _ -> fail $ "don't know how to make Java type into array type: " ++ show t - -typeParameterToTypeArgument :: Java.TypeParameter -> Java.TypeArgument -typeParameterToTypeArgument (Java.TypeParameter _ id _) = javaTypeIdentifierToJavaTypeArgument id - -typeParameterToReferenceType :: Java.TypeParameter -> Java.ReferenceType -typeParameterToReferenceType = javaTypeVariable . unTypeParameter - -unTypeParameter :: Java.TypeParameter -> String -unTypeParameter (Java.TypeParameter [] (Java.TypeIdentifier (Java.Identifier v)) Nothing) = v - -unescape :: String -> String -unescape = L.tail - -variableDeclarationStatement :: Aliases -> Java.Type -> Java.Identifier -> Java.Expression -> Java.BlockStatement -variableDeclarationStatement aliases jtype id rhs = Java.BlockStatementLocalVariableDeclaration $ - Java.LocalVariableDeclarationStatement $ Java.LocalVariableDeclaration [] (Java.LocalVariableTypeType $ Java.UnannType jtype) [vdec] - where - vdec = javaVariableDeclarator id (Just init) - where - init = Java.VariableInitializerExpression rhs - -variableToJavaIdentifier :: Name -> Java.Identifier -variableToJavaIdentifier (Name var) = Java.Identifier $ if var == ignoredVariable - then "ignored" - else var -- TODO: escape - -variantClassName :: Bool -> Name -> Name -> Name -variantClassName qualify elName (Name fname) = unqualifyName (QualifiedName ns local1) - where - QualifiedName ns local = qualifyNameEager elName - flocal = capitalize fname - local1 = if qualify - then local ++ "." ++ flocal - else if flocal == local then flocal ++ "_" else flocal - -visitorTypeVariable :: Java.ReferenceType -visitorTypeVariable = javaTypeVariable "r" diff --git a/src/main/haskell/Hydra/Langs/Json/Coder.hs b/src/main/haskell/Hydra/Langs/Json/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Json/Coder.hs +++ /dev/null @@ -1,194 +0,0 @@ -module Hydra.Langs.Json.Coder (jsonCoder, literalJsonCoder, untypedTermToJson) where - -import Hydra.Core -import Hydra.Compute -import Hydra.Graph -import Hydra.Strip -import Hydra.Basics -import Hydra.CoreEncoding -import Hydra.Tier1 -import Hydra.Tier2 -import Hydra.Adapters -import Hydra.TermAdapters -import Hydra.Langs.Json.Language -import Hydra.Lib.Literals -import Hydra.AdapterUtils -import qualified Hydra.Json as Json -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types - -import qualified Control.Monad as CM -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -jsonCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value) -jsonCoder typ = do - adapter <- languageAdapter jsonLanguage typ - coder <- termCoder $ adapterTarget adapter - return $ composeCoders (adapterCoder adapter) coder - -literalJsonCoder :: LiteralType -> Flow Graph (Coder Graph Graph Literal Json.Value) -literalJsonCoder at = pure $ case at of - LiteralTypeBoolean -> Coder { - coderEncode = \(LiteralBoolean b) -> pure $ Json.ValueBoolean b, - coderDecode = \s -> case s of - Json.ValueBoolean b -> pure $ LiteralBoolean b - _ -> unexpected "boolean" $ show s} - LiteralTypeFloat _ -> Coder { - coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ Json.ValueNumber f, - coderDecode = \s -> case s of - Json.ValueNumber f -> pure $ LiteralFloat $ FloatValueBigfloat f - _ -> unexpected "number" $ show s} - LiteralTypeInteger _ -> Coder { - coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ Json.ValueNumber $ bigintToBigfloat i, - coderDecode = \s -> case s of - Json.ValueNumber f -> pure $ LiteralInteger $ IntegerValueBigint $ bigfloatToBigint f - _ -> unexpected "number" $ show s} - LiteralTypeString -> Coder { - coderEncode = \(LiteralString s) -> pure $ Json.ValueString s, - coderDecode = \s -> case s of - Json.ValueString s' -> pure $ LiteralString s' - _ -> unexpected "string" $ show s} - -recordCoder :: RowType -> Flow Graph (Coder Graph Graph Term Json.Value) -recordCoder rt = do - coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt) - return $ Coder (encode coders) (decode coders) - where - encode coders term = case stripTerm term of - TermRecord (Record _ fields) -> Json.ValueObject . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields - where - encodeField (ft, coder) (Field fname fv) = case (fieldTypeType ft, fv) of - (TypeOptional _, TermOptional Nothing) -> pure Nothing - _ -> Just <$> ((,) <$> pure (unName fname) <*> coderEncode coder fv) - _ -> unexpected "record" $ show term - decode coders n = case n of - Json.ValueObject m -> Terms.record (rowTypeTypeName rt) <$> CM.mapM (decodeField m) coders -- Note: unknown fields are ignored - where - decodeField a (FieldType fname _, coder) = do - v <- coderDecode coder $ Y.fromMaybe Json.ValueNull $ M.lookup (unName fname) m - return $ Field fname v - _ -> unexpected "mapping" $ show n - getCoder coders fname = Y.maybe error pure $ M.lookup fname coders - where - error = fail $ "no such field: " ++ fname - -termCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value) -termCoder typ = case stripType typ of - TypeLiteral at -> do - ac <- literalJsonCoder at - return Coder { - coderEncode = \(TermLiteral av) -> coderEncode ac av, - coderDecode = \n -> case n of - s -> Terms.literal <$> coderDecode ac s} - TypeList lt -> do - lc <- termCoder lt - return Coder { - coderEncode = \(TermList els) -> Json.ValueArray <$> CM.mapM (coderEncode lc) els, - coderDecode = \n -> case n of - Json.ValueArray nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes - _ -> unexpected "sequence" $ show n} - TypeOptional ot -> do - oc <- termCoder ot - return Coder { - coderEncode = \t -> case t of - TermOptional el -> Y.maybe (pure Json.ValueNull) (coderEncode oc) el - _ -> unexpected "optional term" $ show t, - coderDecode = \n -> case n of - Json.ValueNull -> pure $ Terms.optional Nothing - _ -> Terms.optional . Just <$> coderDecode oc n} - TypeMap (MapType kt vt) -> do - kc <- termCoder kt - vc <- termCoder vt - cx <- getState - let encodeEntry (k, v) = (,) (toString cx k) <$> coderEncode vc v - let decodeEntry (k, v) = (,) (fromString cx k) <$> coderDecode vc v - return Coder { - coderEncode = \(TermMap m) -> Json.ValueObject . M.fromList <$> CM.mapM encodeEntry (M.toList m), - coderDecode = \n -> case n of - Json.ValueObject m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m) - _ -> unexpected "mapping" $ show n} - where - toString cx v = if isStringKey cx - then case stripTerm v of - TermLiteral (LiteralString s) -> s - else show v - fromString cx s = Terms.string $ if isStringKey cx then s else read s - isStringKey cx = stripType kt == Types.string - TypeRecord rt -> recordCoder rt - TypeVariable name -> return $ Coder encode decode - where - encode term = pure $ Json.ValueString $ "variable '" ++ unName name ++ "' for: " ++ show term - decode term = fail $ "type variable " ++ unName name ++ " does not support decoding" - _ -> fail $ "unsupported type in JSON: " ++ show (typeVariant typ) - --- | A simplistic, unidirectional encoding for terms as JSON values. Not type-aware; best used for human consumption. -untypedTermToJson :: Term -> Flow s Json.Value -untypedTermToJson term = case stripTerm term of - TermApplication (Application lhs rhs) -> asRecord [ - Field _Application_function lhs, - Field _Application_argument rhs] - TermFunction f -> case f of - FunctionElimination elm -> case elm of - EliminationList term1 -> asVariant "fold" term1 - EliminationRecord (Projection _ fname) -> asVariant "project" $ TermVariable fname - _ -> unexp $ "unexpected elimination variant: " ++ show (eliminationVariant elm) - FunctionLambda (Lambda v body) -> asRecord [ - Field _Lambda_parameter $ TermVariable v, - Field _Lambda_body body] - FunctionPrimitive name -> pure $ Json.ValueString $ unName name - TermLet (Let bindings env) -> asRecord [ - Field _Let_bindings $ TermRecord $ Record (Name "") (fromBinding <$> bindings), - Field _Let_environment env] - where - fromBinding (LetBinding k v _) = Field k v - TermList terms -> Json.ValueArray <$> (CM.mapM untypedTermToJson terms) - TermLiteral lit -> pure $ case lit of - LiteralBinary s -> Json.ValueString s - LiteralBoolean b -> Json.ValueBoolean b - LiteralFloat f -> Json.ValueNumber $ floatValueToBigfloat f - LiteralInteger i -> Json.ValueNumber $ bigintToBigfloat $ integerValueToBigint i - LiteralString s -> Json.ValueString s - TermOptional mt -> case mt of - Nothing -> pure Json.ValueNull - Just t -> untypedTermToJson t - TermProduct els -> untypedTermToJson $ TermList els - TermRecord (Record _ fields) -> do - keyvals <- CM.mapM fieldToKeyval fields - return $ Json.ValueObject $ M.fromList $ Y.catMaybes keyvals - TermSet vals -> untypedTermToJson $ TermList $ S.toList vals - TermSum (Sum idx size term1) -> asRecord [ - Field _Sum_index $ TermLiteral $ LiteralInteger $ IntegerValueInt32 idx, - Field _Sum_size $ TermLiteral $ LiteralInteger $ IntegerValueInt32 size, - Field _Sum_term term1] - TermTyped (TypedTerm term1 typ) -> asRecord [ - Field _TypedTerm_term term1, - Field _TypedTerm_type $ coreEncodeType typ] - TermUnion (Injection _ field) -> if fieldTerm field == Terms.unit - then return $ Json.ValueString $ unName $ fieldName field - else do - mkeyval <- fieldToKeyval field - return $ Json.ValueObject $ M.fromList $ case mkeyval of - Nothing -> [] - Just keyval -> [keyval] - TermVariable v -> pure $ Json.ValueString $ unName v - TermWrap (WrappedTerm _ t) -> untypedTermToJson t - t -> unexp $ "unsupported term variant: " ++ show (termVariant t) --- t -> fail $ "unexpected term variant: " ++ show (termVariant t) - where - unexp msg = pure $ Json.ValueString $ "FAIL: " ++ msg - asRecord = untypedTermToJson . TermRecord . Record (Name "") - asVariant name term = untypedTermToJson $ TermUnion $ Injection (Name "") $ Field (Name name) term - fieldToKeyval f = do - mjson <- forTerm $ fieldTerm f - return $ case mjson of - Nothing -> Nothing - Just j -> Just (unName $ fieldName f, j) - where - forTerm t = case t of - TermOptional mt -> case mt of - Nothing -> pure Nothing - Just t' -> forTerm t' - t' -> Just <$> untypedTermToJson t' diff --git a/src/main/haskell/Hydra/Langs/Json/Eliminate.hs b/src/main/haskell/Hydra/Langs/Json/Eliminate.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Json/Eliminate.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Hydra.Langs.Json.Eliminate where - -import Hydra.Kernel -import qualified Hydra.Json as Json - -import qualified Data.Map as M - - -expectArray :: Json.Value -> Flow s [Json.Value] -expectArray value = case value of - Json.ValueArray els -> pure els - _ -> unexpected "JSON array" $ show value - -expectNumber :: Json.Value -> Flow s Double -expectNumber value = case value of - Json.ValueNumber d -> pure d - _ -> unexpected "JSON number" $ show value - -expectObject :: Json.Value -> Flow s (M.Map String Json.Value) -expectObject value = case value of - Json.ValueObject m -> pure m - _ -> unexpected "JSON object" $ show value - -expectString :: Json.Value -> Flow s String -expectString value = case value of - Json.ValueString s -> pure s - _ -> unexpected "JSON string" $ show value - -opt :: String -> M.Map String Json.Value -> Maybe Json.Value -opt = M.lookup - -optArray :: String -> M.Map String Json.Value -> Flow s (Maybe [Json.Value]) -optArray fname m = case opt fname m of - Nothing -> pure Nothing - Just a -> Just <$> expectArray a - -optString :: String -> M.Map String Json.Value -> Flow s (Maybe String) -optString fname m = case opt fname m of - Nothing -> pure Nothing - Just s -> Just <$> expectString s - -require :: String -> M.Map String Json.Value -> Flow s Json.Value -require fname m = case M.lookup fname m of - Nothing -> fail $ "required attribute " ++ show fname ++ " not found" - Just value -> pure value - -requireArray :: String -> M.Map String Json.Value -> Flow s [Json.Value] -requireArray fname m = require fname m >>= expectArray - -requireNumber :: String -> M.Map String Json.Value -> Flow s Double -requireNumber fname m = require fname m >>= expectNumber - -requireString :: String -> M.Map String Json.Value -> Flow s String -requireString fname m = require fname m >>= expectString diff --git a/src/main/haskell/Hydra/Langs/Json/Language.hs b/src/main/haskell/Hydra/Langs/Json/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Json/Language.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Hydra.Langs.Json.Language where - -import Hydra.Core -import Hydra.Coders -import Hydra.Strip -import Hydra.Mantle - -import qualified Data.Set as S - - -jsonLanguage :: Language -jsonLanguage = Language (LanguageName "hydra/langs/json") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.empty, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString], - languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat], - languageConstraintsFunctionVariants = S.empty, - languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint], - languageConstraintsTermVariants = S.fromList [ - TermVariantList, - TermVariantLiteral, - TermVariantMap, - TermVariantOptional, - TermVariantRecord], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantList, - TypeVariantLiteral, - TypeVariantMap, - TypeVariantOptional, - TypeVariantRecord], - languageConstraintsTypes = \typ -> case stripType typ of - TypeOptional (TypeOptional _) -> False - _ -> True } diff --git a/src/main/haskell/Hydra/Langs/Json/Serde.hs b/src/main/haskell/Hydra/Langs/Json/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Json/Serde.hs +++ /dev/null @@ -1,79 +0,0 @@ -module Hydra.Langs.Json.Serde where - -import Hydra.Core -import Hydra.Compute -import Hydra.Graph -import Hydra.Langs.Json.Coder -import Hydra.Tools.Bytestrings -import qualified Hydra.Json as Json - -import qualified Data.ByteString.Lazy as BS -import qualified Control.Monad as CM -import qualified Data.Aeson as A -import qualified Data.Aeson.KeyMap as AKM -import qualified Data.Aeson.Key as AK -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.Scientific as SC -import qualified Data.Char as C -import qualified Data.String as String - - -aesonValueToBytes :: A.Value -> BS.ByteString -aesonValueToBytes = A.encode - -aesonValueToJsonValue :: A.Value -> Json.Value -aesonValueToJsonValue v = case v of - A.Object km -> Json.ValueObject $ M.fromList (mapPair <$> AKM.toList km) - where - mapPair (k, v) = (AK.toString k, aesonValueToJsonValue v) - A.Array a -> Json.ValueArray (aesonValueToJsonValue <$> V.toList a) - A.String t -> Json.ValueString $ T.unpack t - A.Number s -> Json.ValueNumber $ SC.toRealFloat s - A.Bool b -> Json.ValueBoolean b - A.Null -> Json.ValueNull - -bytesToAesonValue :: BS.ByteString -> Either String A.Value -bytesToAesonValue = A.eitherDecode - -bytesToJsonValue :: BS.ByteString -> Either String Json.Value -bytesToJsonValue bs = aesonValueToJsonValue <$> bytesToAesonValue bs - -jsonByteStringCoder :: Type -> Flow Graph (Coder Graph Graph Term BS.ByteString) -jsonByteStringCoder typ = do - coder <- jsonCoder typ - return Coder { - coderEncode = fmap jsonValueToBytes . coderEncode coder, - coderDecode = \bs -> case bytesToJsonValue bs of - Left msg -> fail $ "JSON parsing failed: " ++ msg - Right v -> coderDecode coder v} - --- | A convenience which maps typed terms to and from pretty-printed JSON strings, as opposed to JSON objects -jsonStringCoder :: Type -> Flow Graph (Coder Graph Graph Term String) -jsonStringCoder typ = do - serde <- jsonByteStringCoder typ - return Coder { - coderEncode = fmap bytesToString . coderEncode serde, - coderDecode = coderDecode serde . stringToBytes} - -jsonValueToAesonValue :: Json.Value -> A.Value -jsonValueToAesonValue v = case v of - Json.ValueArray l -> A.Array $ V.fromList (jsonValueToAesonValue <$> l) - Json.ValueBoolean b -> A.Bool b - Json.ValueNull -> A.Null - Json.ValueNumber d -> A.Number $ SC.fromFloatDigits d - Json.ValueObject m -> A.Object $ AKM.fromList (mapPair <$> M.toList m) - where - mapPair (k, v) = (AK.fromString k, jsonValueToAesonValue v) - Json.ValueString s -> A.String $ T.pack s - -jsonValueToBytes :: Json.Value -> BS.ByteString -jsonValueToBytes = aesonValueToBytes . jsonValueToAesonValue - -jsonValueToString :: Json.Value -> String -jsonValueToString = bytesToString . jsonValueToBytes - -stringToJsonValue :: String -> Either String Json.Value -stringToJsonValue = bytesToJsonValue . stringToBytes diff --git a/src/main/haskell/Hydra/Langs/Pegasus/Coder.hs b/src/main/haskell/Hydra/Langs/Pegasus/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Pegasus/Coder.hs +++ /dev/null @@ -1,188 +0,0 @@ -module Hydra.Langs.Pegasus.Coder (moduleToPdl) where - -import Hydra.Kernel -import Hydra.TermAdapters -import Hydra.Adapters -import Hydra.Langs.Pegasus.Language -import Hydra.Tools.Serialization -import Hydra.Langs.Pegasus.Serde -import qualified Hydra.Langs.Pegasus.Pdl as PDL -import qualified Hydra.Dsl.Types as Types - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -moduleToPdl :: Module -> Flow (Graph) (M.Map FilePath String) -moduleToPdl mod = do - files <- moduleToPegasusSchemas mod - return $ M.fromList (mapPair <$> M.toList files) - where - mapPair (path, sf) = (path, printExpr $ parenthesize $ exprSchemaFile sf) - -constructModule :: - M.Map Namespace String - -> Module - -> M.Map (Type) (Coder (Graph) (Graph) (Term) ()) - -> [(Element, TypedTerm)] - -> Flow (Graph) (M.Map FilePath PDL.SchemaFile) -constructModule aliases mod coders pairs = do - sortedPairs <- case (topologicalSortElements $ fst <$> pairs) of - Left comps -> fail $ "types form a cycle (unsupported in PDL): " ++ show (L.head comps) - Right sorted -> pure $ Y.catMaybes $ fmap (\n -> M.lookup n pairByName) sorted - schemas <- CM.mapM toSchema sortedPairs - return $ M.fromList (toPair <$> schemas) - where - ns = pdlNameForModule mod - pkg = Nothing - toPair (schema, imports) = (path, PDL.SchemaFile ns pkg imports [schema]) - where - path = namespaceToFilePath False (FileExtension "pdl") (Namespace $ (unNamespace $ moduleNamespace mod) ++ "/" ++ local) - local = PDL.unName $ PDL.qualifiedNameName $ PDL.namedSchemaQualifiedName schema - - pairByName = L.foldl (\m p -> M.insert (elementName $ fst p) p m) M.empty pairs - toSchema (el, TypedTerm term typ) = do - if isType typ - then coreDecodeType term >>= typeToSchema el - else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el) - typeToSchema el typ = do - res <- encodeAdaptedType aliases typ - let ptype = case res of - Left schema -> PDL.NamedSchema_TypeTyperef schema - Right t -> t - r <- getTermDescription $ elementData el - let anns = doc r - return (PDL.NamedSchema qname ptype anns, imports) - where - qname = pdlNameForElement aliases False $ elementName el - imports = [] --- imports = L.filter isExternal (pdlNameForElement aliases True <$> deps) --- where --- deps = S.toList $ termDependencyNames False False False $ elementData el --- isExternal qn = PDL.qualifiedNameNamespace qn /= PDL.qualifiedNameNamespace qname - -moduleToPegasusSchemas :: Module -> Flow (Graph) (M.Map FilePath PDL.SchemaFile) -moduleToPegasusSchemas mod = do - aliases <- importAliasesForModule mod - transformModule pdlLanguage (encodeTerm aliases) (constructModule aliases) mod - -doc :: Y.Maybe String -> PDL.Annotations -doc s = PDL.Annotations s False - -encodeAdaptedType :: - M.Map Namespace String -> Type - -> Flow (Graph) (Either PDL.Schema PDL.NamedSchema_Type) -encodeAdaptedType aliases typ = do - g <- getState - let cx = AdapterContext g pdlLanguage M.empty - ad <- withState cx $ termAdapter typ - encodeType aliases $ adapterTarget ad - -encodeTerm :: M.Map Namespace String -> Term -> Flow (Graph) () -encodeTerm aliases term = fail "not yet implemented" - -encodeType :: M.Map Namespace String -> Type -> Flow (Graph) (Either PDL.Schema PDL.NamedSchema_Type) -encodeType aliases typ = case typ of - TypeAnnotated (AnnotatedType typ' _) -> encodeType aliases typ' - TypeList lt -> Left . PDL.SchemaArray <$> encode lt - TypeLiteral lt -> Left . PDL.SchemaPrimitive <$> case lt of - LiteralTypeBinary -> pure PDL.PrimitiveTypeBytes - LiteralTypeBoolean -> pure PDL.PrimitiveTypeBoolean - LiteralTypeFloat ft -> case ft of - FloatTypeFloat32 -> pure PDL.PrimitiveTypeFloat - FloatTypeFloat64 -> pure PDL.PrimitiveTypeDouble - _ -> unexpected "float32 or float64" $ show ft - LiteralTypeInteger it -> case it of - IntegerTypeInt32 -> pure PDL.PrimitiveTypeInt - IntegerTypeInt64 -> pure PDL.PrimitiveTypeLong - _ -> unexpected "int32 or int64" $ show it - LiteralTypeString -> pure PDL.PrimitiveTypeString - TypeMap (MapType kt vt) -> Left . PDL.SchemaMap <$> encode vt -- note: we simply assume string as a key type - TypeVariable name -> pure $ Left $ PDL.SchemaNamed $ pdlNameForElement aliases True name - TypeOptional ot -> fail $ "optionals unexpected at top level" - TypeRecord rt -> do - let includes = [] - rfields <- CM.mapM encodeRecordField $ rowTypeFields rt - return $ Right $ PDL.NamedSchema_TypeRecord $ PDL.RecordSchema rfields includes - TypeUnion rt -> if isEnum - then do - fs <- CM.mapM encodeEnumField $ rowTypeFields rt - return $ Right $ PDL.NamedSchema_TypeEnum $ PDL.EnumSchema fs - else Left . PDL.SchemaUnion . PDL.UnionSchema <$> CM.mapM encodeUnionField (rowTypeFields rt) - where - isEnum = L.foldl (\b t -> b && stripType t == Types.unit) True $ fmap fieldTypeType (rowTypeFields rt) - _ -> unexpected "PDL-supported type" $ show typ - where - encode t = case stripType t of - TypeRecord (RowType _ Nothing []) -> encode Types.int32 -- special case for the unit type - _ -> do - res <- encodeType aliases t - case res of - Left schema -> pure schema - Right _ -> fail $ "type resolved to an unsupported nested named schema: " ++ show t - encodeRecordField (FieldType (Name name) typ) = do - anns <- getAnns typ - (schema, optional) <- encodePossiblyOptionalType typ - return PDL.RecordField { - PDL.recordFieldName = PDL.FieldName name, - PDL.recordFieldValue = schema, - PDL.recordFieldOptional = optional, - PDL.recordFieldDefault = Nothing, - PDL.recordFieldAnnotations = anns} - encodeUnionField (FieldType (Name name) typ) = do - anns <- getAnns typ - (s, optional) <- encodePossiblyOptionalType typ - let schema = if optional - then PDL.SchemaUnion $ PDL.UnionSchema (simpleUnionMember <$> [PDL.SchemaNull, s]) - else s - return PDL.UnionMember { - PDL.unionMemberAlias = Just $ PDL.FieldName name, - PDL.unionMemberValue = schema, - PDL.unionMemberAnnotations = anns} - encodeEnumField (FieldType (Name name) typ) = do - anns <- getAnns typ - return PDL.EnumField { - PDL.enumFieldName = PDL.EnumFieldName $ convertCase CaseConventionCamel CaseConventionUpperSnake name, - PDL.enumFieldAnnotations = anns} - encodePossiblyOptionalType typ = case stripType typ of - TypeOptional ot -> do - t <- encode ot - return (t, True) - _ -> do - t <- encode typ - return (t, False) - getAnns typ = do - r <- getTypeDescription typ - return $ doc r - -importAliasesForModule mod = do - nss <- moduleDependencyNamespaces False True True False mod - return $ M.fromList (toPair <$> S.toList nss) - where - toPair ns = (ns, slashesToDots $ unNamespace ns) - -noAnnotations :: PDL.Annotations -noAnnotations = PDL.Annotations Nothing False - -pdlNameForElement :: M.Map Namespace String -> Bool -> Name -> PDL.QualifiedName -pdlNameForElement aliases withNs name = PDL.QualifiedName (PDL.Name local) - $ if withNs - then PDL.Namespace <$> alias - else Nothing - where - QualifiedName (Just ns) local = qualifyNameEager name - alias = M.lookup ns aliases - -pdlNameForModule :: Module -> PDL.Namespace -pdlNameForModule = PDL.Namespace . slashesToDots . h . moduleNamespace - where - h (Namespace n) = n - -simpleUnionMember :: PDL.Schema -> PDL.UnionMember -simpleUnionMember schema = PDL.UnionMember Nothing schema noAnnotations - -slashesToDots :: String -> String -slashesToDots = fmap (\c -> if c == '/' then '.' else c) diff --git a/src/main/haskell/Hydra/Langs/Pegasus/Language.hs b/src/main/haskell/Hydra/Langs/Pegasus/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Pegasus/Language.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Hydra.Langs.Pegasus.Language where - -import Hydra.Kernel - -import qualified Data.Set as S - - -pdlLanguage :: Language -pdlLanguage = Language (LanguageName "hydra/langs/pegasus/pdl") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.empty, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBinary, - LiteralVariantBoolean, - LiteralVariantFloat, - LiteralVariantInteger, - LiteralVariantString], - languageConstraintsFloatTypes = S.fromList [ - FloatTypeFloat32, - FloatTypeFloat64], - languageConstraintsFunctionVariants = S.empty, - languageConstraintsIntegerTypes = S.fromList [ - IntegerTypeInt32, - IntegerTypeInt64], - languageConstraintsTermVariants = S.fromList [ - TermVariantList, - TermVariantLiteral, - TermVariantMap, - TermVariantWrap, - TermVariantOptional, - TermVariantRecord, - TermVariantUnion], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantAnnotated, - TypeVariantList, - TypeVariantLiteral, - TypeVariantMap, - TypeVariantWrap, - TypeVariantOptional, - TypeVariantRecord, - TypeVariantUnion], - languageConstraintsTypes = const True } diff --git a/src/main/haskell/Hydra/Langs/Pegasus/Serde.hs b/src/main/haskell/Hydra/Langs/Pegasus/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Pegasus/Serde.hs +++ /dev/null @@ -1,81 +0,0 @@ -module Hydra.Langs.Pegasus.Serde where - -import Hydra.Tools.Serialization -import Hydra.Tools.Formatting -import qualified Hydra.Ast as CT -import qualified Hydra.Langs.Pegasus.Pdl as PDL - -import qualified Data.List as L -import qualified Data.Maybe as Y - - -exprAnnotations :: PDL.Annotations -> Y.Maybe CT.Expr -exprAnnotations (PDL.Annotations doc _) = cst . javaStyleComment <$> doc - -exprEnumField :: PDL.EnumField -> CT.Expr -exprEnumField (PDL.EnumField (PDL.EnumFieldName name) anns) = withAnnotations anns $ cst name - -exprImport :: PDL.QualifiedName -> CT.Expr -exprImport qn = spaceSep [cst "import", exprQualifiedName qn] - -exprNamedSchema :: PDL.NamedSchema -> CT.Expr -exprNamedSchema (PDL.NamedSchema qn t anns) = withAnnotations anns $ - case t of - PDL.NamedSchema_TypeRecord (PDL.RecordSchema fields _) -> spaceSep [cst "record", exprQualifiedName qn, - curlyBracesList Nothing fullBlockStyle (exprRecordField <$> fields)] - PDL.NamedSchema_TypeEnum (PDL.EnumSchema fields) -> spaceSep [cst "enum", exprQualifiedName qn, - curlyBracesList Nothing fullBlockStyle (exprEnumField <$> fields)] - PDL.NamedSchema_TypeTyperef schema -> spaceSep [cst "typeref", exprQualifiedName qn, cst "=", exprSchema schema] - -exprPrimitiveType :: PDL.PrimitiveType -> CT.Expr -exprPrimitiveType pt = cst $ case pt of - PDL.PrimitiveTypeBoolean -> "boolean" - PDL.PrimitiveTypeBytes -> "bytes" - PDL.PrimitiveTypeDouble -> "double" - PDL.PrimitiveTypeFloat -> "float" - PDL.PrimitiveTypeInt -> "int" - PDL.PrimitiveTypeLong -> "long" - PDL.PrimitiveTypeString -> "string" - -exprQualifiedName :: PDL.QualifiedName -> CT.Expr -exprQualifiedName (PDL.QualifiedName (PDL.Name name) ns) = cst $ L.intercalate "." $ Y.catMaybes [h <$> ns, Just name] - where - h (PDL.Namespace ns) = ns - -exprRecordField :: PDL.RecordField -> CT.Expr -exprRecordField (PDL.RecordField (PDL.FieldName name) schema optional def anns) = withAnnotations anns $ - spaceSep $ Y.catMaybes [ -- TODO: default - Just $ cst $ name ++ ":", - if optional then Just (cst "optional") else Nothing, - Just $ exprSchema schema] - -exprSchema :: PDL.Schema -> CT.Expr -exprSchema schema = case schema of - PDL.SchemaArray s -> noSep [cst "array", bracketList inlineStyle [exprSchema s]] --- PDL.SchemaFixed i -> --- PDL.SchemaInline ns -> - PDL.SchemaMap s -> noSep [cst "map", bracketList inlineStyle [cst "string", exprSchema s]] - PDL.SchemaNamed qn -> exprQualifiedName qn - PDL.SchemaNull -> cst "null" - PDL.SchemaPrimitive pt -> exprPrimitiveType pt - PDL.SchemaUnion (PDL.UnionSchema us) -> noSep [cst "union", bracketList fullBlockStyle (exprUnionMember <$> us)] - -exprSchemaFile :: PDL.SchemaFile -> CT.Expr -exprSchemaFile (PDL.SchemaFile (PDL.Namespace ns) pkg imports schemas) = doubleNewlineSep $ Y.catMaybes - [namespaceSec, packageSec, importsSec] ++ schemaSecs - where - namespaceSec = Just $ spaceSep [cst "namespace", cst ns] - packageSec = fmap (\(PDL.Package p) -> spaceSep [cst "package", cst p]) pkg - importsSec = if L.null imports - then Nothing - else Just $ newlineSep (exprImport <$> imports) - schemaSecs = exprNamedSchema <$> schemas - -exprUnionMember :: PDL.UnionMember -> CT.Expr -exprUnionMember (PDL.UnionMember alias schema anns) = withAnnotations anns $ - spaceSep $ Y.catMaybes [ - fmap (\(PDL.FieldName n) -> cst $ n ++ ":") alias, - Just $ exprSchema schema] - -withAnnotations :: PDL.Annotations -> CT.Expr -> CT.Expr -withAnnotations anns expr = newlineSep $ Y.catMaybes [exprAnnotations anns, Y.Just expr] diff --git a/src/main/haskell/Hydra/Langs/Protobuf/Coder.hs b/src/main/haskell/Hydra/Langs/Protobuf/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Protobuf/Coder.hs +++ /dev/null @@ -1,297 +0,0 @@ -module Hydra.Langs.Protobuf.Coder (moduleToProtobuf) where - -import Hydra.Kernel -import Hydra.Langs.Protobuf.Language -import qualified Hydra.Langs.Protobuf.Proto3 as P3 -import qualified Hydra.Lib.Strings as Strings -import Hydra.Langs.Protobuf.Language -import Hydra.Langs.Protobuf.Serde -import Hydra.Tools.Serialization -import qualified Hydra.Dsl.Types as Types -import Hydra.Dsl.Annotations - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Text.Read as TR -import qualified Data.Maybe as Y - --- | Note: follows the Protobuf Style Guide (https://protobuf.dev/programming-guides/style) -moduleToProtobuf :: Module -> Flow (Graph) (M.Map FilePath String) -moduleToProtobuf mod = do - files <- transformModule protobufLanguage encodeTerm constructModule mod - return $ M.fromList (mapPair <$> M.toList files) - where - mapPair (path, sf) = (path, printExpr $ parenthesize $ writeProtoFile sf) - encodeTerm _ = fail "term-level encoding is not yet supported" - --- - -javaMultipleFilesOptionName = "java_multiple_files" -javaPackageOptionName = "java_package" - -checkIsStringType :: Type -> Flow (Graph) () -checkIsStringType typ = case simplifyType typ of - TypeLiteral lt -> case lt of - LiteralTypeString -> pure () - _ -> unexpected "string type" $ show lt - TypeVariable name -> requireType name >>= checkIsStringType - _ -> unexpected "literal (string) type" $ show typ - -constructModule :: Module - -> M.Map (Type) (Coder (Graph) (Graph) (Term) ()) - -> [(Element, TypedTerm)] - -> Flow (Graph) (M.Map FilePath P3.ProtoFile) -constructModule mod@(Module ns els _ _ desc) _ pairs = do - schemaImports <- (fmap namespaceToFileReference . S.toList) <$> moduleDependencyNamespaces True False False False mod - types <- CM.mapM toType pairs - definitions <- CM.mapM toDef types - let pfile = P3.ProtoFile { - P3.protoFilePackage = namespaceToPackageName ns, - P3.protoFileImports = schemaImports ++ (wrapperImport $ snd <$> types) ++ (emptyImport $ snd <$> types), - P3.protoFileTypes = definitions, - P3.protoFileOptions = descOption:javaOptions} - return $ M.singleton path pfile - where - javaOptions = [ - P3.Option javaMultipleFilesOptionName $ P3.ValueBoolean True, - P3.Option javaPackageOptionName $ P3.ValueString $ P3.unPackageName $ namespaceToPackageName ns] - descOption = P3.Option descriptionOptionName $ P3.ValueString $ - (Y.maybe "" (\d -> d ++ "\n\n") desc) ++ warningAutoGeneratedFile - path = P3.unFileReference $ namespaceToFileReference ns - toType (el, (TypedTerm term typ)) = do - if isType typ - then do - t <- coreDecodeType term - return (el, t) - else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el) - toDef (el, typ) = adaptAndEncodeType protobufLanguage (encodeDefinition ns (elementName el)) $ flattenType typ - checkFields checkType checkFieldType types = L.foldl (||) False (hasMatches <$> types) - where - hasMatches = foldOverType TraversalOrderPre (\b t -> b || hasMatch t) False - hasMatch typ = case checkType typ of - Just b -> b - Nothing -> case typ of - TypeRecord rt -> checkRowType rt - TypeUnion rt -> checkRowType rt - _ -> False - checkRowType (RowType _ _ fields) = L.foldl (||) False (checkField <$> fields) - checkField (FieldType _ typ) = checkFieldType $ stripType typ - wrapperImport types = if checkFields (const Nothing) isOptionalScalarField types - then [P3.FileReference "google/protobuf/wrappers.proto"] - else [] - where - isOptionalScalarField typ = case typ of - TypeOptional ot -> case stripType ot of - TypeLiteral _ -> True - _ -> False - _ -> False - emptyImport types = if checkFields checkType isUnitField types - then [P3.FileReference "google/protobuf/empty.proto"] - else [] - where - checkType typ = if isEnumDefinition typ - then Just False - else Nothing - isUnitField typ = case typ of - TypeRecord (RowType name _ _) -> name == _Unit - _ -> False - -encodeDefinition :: Namespace -> Name -> Type -> Flow (Graph) P3.Definition -encodeDefinition localNs name typ = withTrace ("encoding " ++ unName name) $ do - resetCount "proto_field_index" - nextIndex - options <- findOptions typ - encode options typ - where - wrapAsRecordType t = TypeRecord $ RowType name Nothing [FieldType (Name "value") t] - encode options typ = case simplifyType typ of - TypeRecord rt -> P3.DefinitionMessage <$> encodeRecordType localNs options rt - TypeUnion rt -> if isEnumDefinition typ - then P3.DefinitionEnum <$> encodeEnumDefinition options rt - else encode options $ wrapAsRecordType $ TypeUnion rt - t -> encode options $ wrapAsRecordType t - -encodeEnumDefinition :: [P3.Option] -> RowType -> Flow (Graph) P3.EnumDefinition -encodeEnumDefinition options (RowType tname _ fields) = do - values <- CM.zipWithM encodeEnumField fields [1..] - return $ P3.EnumDefinition { - P3.enumDefinitionName = encodeTypeName tname, - P3.enumDefinitionValues = unspecifiedField:values, - P3.enumDefinitionOptions = options} - where - unspecifiedField = P3.EnumValue { - P3.enumValueName = encodeEnumValueName tname $ Name "unspecified", - P3.enumValueNumber = 0, - P3.enumValueOptions = []} - encodeEnumField (FieldType fname ftype) idx = do - opts <- findOptions ftype - return $ P3.EnumValue { - P3.enumValueName = encodeEnumValueName tname fname, - P3.enumValueNumber = idx, - P3.enumValueOptions = opts} - -encodeEnumValueName :: Name -> Name -> P3.EnumValueName -encodeEnumValueName tname fname = P3.EnumValueName (prefix ++ "_" ++ suffix) - where - prefix = convertCaseCamelToUpperSnake $ localNameOfEager tname - suffix = convertCaseCamelToUpperSnake $ unName fname - -encodeFieldName :: Bool -> Name -> P3.FieldName -encodeFieldName preserve = P3.FieldName . toPname . unName - where - toPname = if preserve - then id - else convertCaseCamelToLowerSnake - -encodeFieldType :: Namespace -> FieldType -> Flow (Graph) P3.Field -encodeFieldType localNs (FieldType fname ftype) = withTrace ("encode field " ++ show (unName fname)) $ do - options <- findOptions ftype - ft <- encodeType ftype - idx <- nextIndex - preserve <- readBooleanAnnotation key_preserveFieldName ftype - return $ P3.Field { - P3.fieldName = encodeFieldName preserve fname, - P3.fieldJsonName = Nothing, - P3.fieldType = ft, - P3.fieldNumber = idx, - P3.fieldOptions = options} - where - encodeType typ = case simplifyType typ of - TypeList lt -> do - P3.FieldTypeRepeated <$> encodeSimpleType lt - TypeMap (MapType kt vt) -> do --- checkIsStringType kt - P3.FieldTypeMap <$> encodeSimpleType vt - TypeOptional ot -> case stripType ot of - TypeLiteral lt -> P3.FieldTypeSimple <$> encodeScalarTypeWrapped lt - _ -> encodeType ot -- TODO - TypeUnion (RowType _ _ fields) -> do - pfields <- CM.mapM (encodeFieldType localNs) fields - return $ P3.FieldTypeOneof pfields - _ -> do - P3.FieldTypeSimple <$> encodeSimpleType typ - encodeSimpleType typ = case simplifyType typ of - TypeLiteral lt -> P3.SimpleTypeScalar <$> encodeScalarType lt - TypeRecord (RowType name _ _) -> if name == _Unit - then pure $ P3.SimpleTypeReference $ P3.TypeName $ "google.protobuf.Empty" - else forNominal name - TypeUnion (RowType name _ _) -> forNominal name - TypeVariable name -> forNominal name - t -> unexpected "simple type" $ show $ removeTypeAnnotations t - where - forNominal name = pure $ P3.SimpleTypeReference $ encodeTypeReference localNs name - -encodeRecordType :: Namespace -> [P3.Option] -> RowType -> Flow (Graph) P3.MessageDefinition -encodeRecordType localNs options (RowType tname _ fields) = do - pfields <- CM.mapM (encodeFieldType localNs) fields - return P3.MessageDefinition { - P3.messageDefinitionName = encodeTypeName tname, - P3.messageDefinitionFields = pfields, - P3.messageDefinitionOptions = options} - -encodeScalarType :: LiteralType -> Flow s P3.ScalarType -encodeScalarType lt = case lt of - LiteralTypeBinary -> return P3.ScalarTypeBytes - LiteralTypeBoolean -> return P3.ScalarTypeBool - LiteralTypeFloat ft -> case ft of - FloatTypeFloat32 -> return P3.ScalarTypeFloat - FloatTypeFloat64 -> return P3.ScalarTypeDouble - _ -> unexpected "32-bit or 64-bit floating-point type" $ show ft - LiteralTypeInteger it -> case it of - IntegerTypeInt32 -> return P3.ScalarTypeInt32 - IntegerTypeInt64 -> return P3.ScalarTypeInt64 - IntegerTypeUint32 -> return P3.ScalarTypeUint32 - IntegerTypeUint64 -> return P3.ScalarTypeUint64 - _ -> unexpected "32-bit or 64-bit integer type" $ show it - LiteralTypeString -> return P3.ScalarTypeString - -encodeScalarTypeWrapped :: LiteralType -> Flow s P3.SimpleType -encodeScalarTypeWrapped lt = toType <$> case lt of - LiteralTypeBinary -> return "Bytes" - LiteralTypeBoolean -> return "Bool" - LiteralTypeFloat ft -> case ft of - FloatTypeFloat32 -> return "Float" - FloatTypeFloat64 -> return "Double" - _ -> unexpected "32-bit or 64-bit floating-point type" $ show ft - LiteralTypeInteger it -> case it of - IntegerTypeInt32 -> return "Int32" - IntegerTypeInt64 -> return "Int64" - IntegerTypeUint32 -> return "UInt32" - IntegerTypeUint64 -> return "UInt64" - _ -> unexpected "32-bit or 64-bit integer type" $ show it - LiteralTypeString -> return "String" - where - toType label = P3.SimpleTypeReference $ P3.TypeName $ "google.protobuf." ++ label ++ "Value" - -encodeTypeName :: Name -> P3.TypeName -encodeTypeName = P3.TypeName . localNameOfEager - -encodeTypeReference :: Namespace -> Name -> P3.TypeName -encodeTypeReference localNs name = P3.TypeName $ if nsParts == Just localNsParts - then local - else case nsParts of - Nothing -> local - Just parts -> L.intercalate "." (parts ++ [local]) - where - QualifiedName ns local = qualifyNameEager name - nsParts = fmap (\n -> L.init $ Strings.splitOn "/" $ unNamespace n) ns - localNsParts = L.init $ Strings.splitOn "/" $ unNamespace localNs - --- Eliminate type lambdas and type applications, simply replacing type variables with the string type -flattenType :: Type -> Type -flattenType = rewriteType f id - where - f recurse typ = case typ of - TypeLambda (LambdaType v body) -> recurse $ replaceFreeName v Types.string body - TypeApplication (ApplicationType lhs _) -> recurse lhs - _ -> recurse typ - -findOptions :: Type -> Flow (Graph) [P3.Option] -findOptions typ = do - mdesc <- getTypeDescription typ - bdep <- readBooleanAnnotation key_deprecated typ - let mdescAnn = fmap (\desc -> P3.Option descriptionOptionName $ P3.ValueString desc) mdesc - let mdepAnn = if bdep then Just (P3.Option deprecatedOptionName $ P3.ValueBoolean True) else Nothing - return $ Y.catMaybes [mdescAnn, mdepAnn] - -isEnumFields :: [FieldType] -> Bool -isEnumFields fields = L.foldl (&&) True $ fmap isEnumField fields - where - isEnumField = isUnitType . simplifyType . fieldTypeType - -isEnumDefinition :: Type -> Bool -isEnumDefinition typ = case simplifyType typ of - TypeUnion (RowType _ _ fields) -> isEnumFields fields - _ -> False - -isEnumDefinitionReference :: Name -> Flow (Graph) Bool -isEnumDefinitionReference name = isEnumDefinition <$> ((elementData <$> requireElement name) >>= coreDecodeType) - -namespaceToFileReference :: Namespace -> P3.FileReference -namespaceToFileReference (Namespace ns) = P3.FileReference $ pns ++ ".proto" - where - pns = Strings.intercalate "/" (convertCaseCamelToLowerSnake <$> (Strings.splitOn "/" ns)) - -namespaceToPackageName :: Namespace -> P3.PackageName -namespaceToPackageName (Namespace ns) = P3.PackageName $ Strings.intercalate "." $ - convertCaseCamelToLowerSnake <$> (L.init $ Strings.splitOn "/" ns) - -nextIndex :: Flow s Int -nextIndex = nextCount "proto_field_index" - -readBooleanAnnotation :: String -> Type -> Flow (Graph) Bool -readBooleanAnnotation key typ = do - let ann = typeAnnotationInternal typ - case TR.readMaybe $ show ann of - Just kv -> case getAnnotation key kv of - Just _ -> return True - Nothing -> return False - Nothing -> return False - --- Note: this should probably be done in the term adapters -simplifyType :: Type -> Type -simplifyType typ = case stripType typ of - TypeWrap (WrappedType _ t) -> simplifyType t - t -> t diff --git a/src/main/haskell/Hydra/Langs/Protobuf/Serde.hs b/src/main/haskell/Hydra/Langs/Protobuf/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Protobuf/Serde.hs +++ /dev/null @@ -1,147 +0,0 @@ -module Hydra.Langs.Protobuf.Serde ( - deprecatedOptionName, - descriptionOptionName, - writeProtoFile) where - -import Hydra.Tools.Serialization -import Hydra.Tools.Formatting -import qualified Hydra.Ast as CT -import qualified Hydra.Langs.Protobuf.Proto3 as P3 - -import qualified Data.List as L -import qualified Data.Maybe as Y - - -deprecatedOptionName = "deprecated" --- A special Protobuf option for descriptions (documentation) -descriptionOptionName = "_description" - -excludeInternalOptions :: [P3.Option] -> [P3.Option] -excludeInternalOptions = L.filter (\opt -> L.head (P3.optionName opt) /= '_' ) - -protoBlock :: [CT.Expr] -> CT.Expr -protoBlock = brackets curlyBraces fullBlockStyle . doubleNewlineSep - -semi :: CT.Expr -> CT.Expr -semi e = noSep [e, cst ";"] - -optDesc :: Bool -> [P3.Option] -> CT.Expr -> CT.Expr -optDesc doubleNewline opts expr = if L.null descs - then expr - else sep [cst $ asComment (unValue $ P3.optionValue $ L.head descs), expr] - where - sep = if doubleNewline then doubleNewlineSep else newlineSep - descs = L.filter (\(P3.Option name value) -> name == descriptionOptionName) opts - asComment = L.intercalate "\n" . fmap (\s -> "// " ++ s) . lines - unValue v = case v of - P3.ValueBoolean b -> if b then "true" else "false" - P3.ValueString s -> s - -writeDefinition :: P3.Definition -> CT.Expr -writeDefinition def = case def of - P3.DefinitionEnum enum -> writeEnumDefinition enum - P3.DefinitionMessage msg -> writeMessageDefinition msg - -writeEnumDefinition :: P3.EnumDefinition -> CT.Expr -writeEnumDefinition (P3.EnumDefinition name values options) = optDesc False options $ spaceSep [ - cst "enum", - cst $ P3.unTypeName name, - protoBlock (writeEnumValue <$> values)] - -writeEnumValue :: P3.EnumValue -> CT.Expr -writeEnumValue (P3.EnumValue name number options) = optDesc False options $ semi $ spaceSep [ - cst $ P3.unEnumValueName name, - cst "=", - cst $ show number] - -writeField :: P3.Field -> CT.Expr -writeField (P3.Field name jsonName typ num options) = optDesc False options $ case typ of - P3.FieldTypeOneof fields -> spaceSep [ - cst "oneof", - cst $ P3.unFieldName name, - protoBlock (writeField <$> fields)] - _ -> semi $ spaceSep $ Y.catMaybes [ -- TODO: jsonName - Just $ writeFieldType typ, - Just $ cst $ P3.unFieldName name, - Just $ cst "=", - Just $ cst $ show num, - writeFieldOptions options] - -writeFieldOption :: P3.Option -> CT.Expr -writeFieldOption (P3.Option name value) = spaceSep [cst name, cst "=", writeValue value] - -writeFieldOptions :: [P3.Option] -> Y.Maybe CT.Expr -writeFieldOptions options0 = if L.null options - then Nothing - else Just $ bracketList inlineStyle (writeFieldOption <$> options) - where - options = excludeInternalOptions options0 - -writeFieldType :: P3.FieldType -> CT.Expr -writeFieldType ftyp = case ftyp of - P3.FieldTypeMap st -> noSep [cst "map", angleBracesList inlineStyle [cst "string", writeSimpleType st]] - P3.FieldTypeRepeated st -> spaceSep [cst "repeated", writeSimpleType st] - P3.FieldTypeSimple st -> writeSimpleType st - -writeFileOption :: P3.Option -> CT.Expr -writeFileOption (P3.Option name value) = semi $ spaceSep [cst "option", cst name, cst "=", writeValue value] - -writeFileOptions :: [P3.Option] -> Y.Maybe CT.Expr -writeFileOptions options0 = if L.null options - then Nothing - else Just $ newlineSep $ writeFileOption <$> options - where - options = excludeInternalOptions options0 - -writeImport :: P3.FileReference -> CT.Expr -writeImport (P3.FileReference path) = semi $ spaceSep [cst "import", cst $ show path] - -writeMessageDefinition :: P3.MessageDefinition -> CT.Expr -writeMessageDefinition (P3.MessageDefinition name fields options) = optDesc False options $ spaceSep [ - cst "message", - cst $ P3.unTypeName name, - protoBlock (writeField <$> fields)] - -writeProtoFile :: P3.ProtoFile -> CT.Expr -writeProtoFile (P3.ProtoFile pkg imports defs options) = optDesc True options $ doubleNewlineSep - $ Y.catMaybes [headerSec, importsSec, optionsSec, defsSec] - where - headerSec = Just $ newlineSep [ - semi $ cst "syntax = \"proto3\"", - semi $ spaceSep [cst "package", cst (P3.unPackageName pkg)]] - importsSec = if L.null imports - then Nothing - else Just $ newlineSep $ writeImport <$> imports - optionsSec = writeFileOptions options1 - defsSec = if L.null defs - then Nothing - else Just $ doubleNewlineSep $ writeDefinition <$> defs - options1 = L.filter (\(P3.Option name value) -> name /= descriptionOptionName) options - -writeScalarType :: P3.ScalarType -> CT.Expr -writeScalarType sct = cst $ case sct of - P3.ScalarTypeBool -> "bool" - P3.ScalarTypeBytes -> "bytes" - P3.ScalarTypeDouble -> "double" - P3.ScalarTypeFixed32 -> "fixed32" - P3.ScalarTypeFixed64 -> "fixed64" - P3.ScalarTypeFloat -> "float" - P3.ScalarTypeInt32 -> "int32" - P3.ScalarTypeInt64 -> "int64" - P3.ScalarTypeSfixed32 -> "sfixed32" - P3.ScalarTypeSfixed64 -> "sfixed64" - P3.ScalarTypeSint32 -> "sint32" - P3.ScalarTypeSint64 -> "sint64" - P3.ScalarTypeString -> "string" - P3.ScalarTypeUint32 -> "uint32" - P3.ScalarTypeUint64 -> "uint64" - -writeSimpleType :: P3.SimpleType -> CT.Expr -writeSimpleType st = case st of - P3.SimpleTypeReference name -> cst $ P3.unTypeName name - P3.SimpleTypeScalar sct -> writeScalarType sct - -writeValue :: P3.Value -> CT.Expr -writeValue v = cst $ case v of - P3.ValueBoolean b -> if b then "true" else "false" - P3.ValueString s -> show s diff --git a/src/main/haskell/Hydra/Langs/Rdf/Serde.hs b/src/main/haskell/Hydra/Langs/Rdf/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Rdf/Serde.hs +++ /dev/null @@ -1,81 +0,0 @@ --- | Serialize RDF using an approximation (because it does not yet support Unicode escape sequences) of the N-triples format - -module Hydra.Langs.Rdf.Serde ( - rdfGraphToNtriples, -) where - -import Hydra.Tools.Serialization -import qualified Hydra.Langs.Rdf.Syntax as Rdf -import qualified Hydra.Ast as CT - -import qualified Data.List as L -import qualified Data.Set as S - - --- IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>' --- TODO: Unicode escape sequences -escapeIriStr :: String -> String -escapeIriStr s = L.concat (esc <$> s) - where - esc c = if c >= '\128' || c <= '\32' || S.member c others - then "?" - else [c] - others = S.fromList $ "<>\"{}|^`\\" - --- STRING_LITERAL_QUOTE ::= '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"' --- TODO: Unicode escape sequences -escapeLiteralString :: String -> String -escapeLiteralString s = L.concat (esc <$> s) - where - esc c = if c >= '\128' - then "?" - else case c of - '\"' -> "\\\"" - '\\' -> "\\\\" - '\n' -> "\\n" - '\r' -> "\\r" - _ -> [c] - -rdfGraphToNtriples :: Rdf.Graph -> String -rdfGraphToNtriples = printExpr . writeGraph - -writeBlankNode :: Rdf.BlankNode -> CT.Expr -writeBlankNode bnode = noSep [cst "_:", cst $ Rdf.unBlankNode bnode] - -writeGraph :: Rdf.Graph -> CT.Expr -writeGraph g = newlineSep (writeTriple <$> (S.toList $ Rdf.unGraph g)) - -writeIri :: Rdf.Iri -> CT.Expr -writeIri iri = noSep [cst "<", cst $ escapeIriStr $ Rdf.unIri iri, cst ">"] - --- LANGTAG ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)* --- Note: we simply trust language tags to be valid -writeLanguageTag :: Rdf.LanguageTag -> CT.Expr -writeLanguageTag lang = noSep [cst "@", cst $ Rdf.unLanguageTag lang] - -writeLiteral :: Rdf.Literal -> CT.Expr -writeLiteral lit = noSep [cst lex, suffix] - where - suffix = case Rdf.literalLanguageTag lit of - Nothing -> noSep [cst "^^", writeIri dt] - Just lang -> writeLanguageTag lang - lex = "\"" ++ (escapeLiteralString $ Rdf.literalLexicalForm lit) ++ "\"" - dt = Rdf.literalDatatypeIri lit - -writeNode :: Rdf.Node -> CT.Expr -writeNode n = case n of - Rdf.NodeIri iri -> writeIri iri - Rdf.NodeBnode bnode -> writeBlankNode bnode - Rdf.NodeLiteral lit -> writeLiteral lit - -writeResource :: Rdf.Resource -> CT.Expr -writeResource r = case r of - Rdf.ResourceIri iri -> writeIri iri - Rdf.ResourceBnode bnode -> writeBlankNode bnode - -writeTriple :: Rdf.Triple -> CT.Expr -writeTriple t = spaceSep [ - writeResource $ Rdf.tripleSubject t, - writeIri $ Rdf.triplePredicate t, - writeNode $ Rdf.tripleObject t, - cst "."] diff --git a/src/main/haskell/Hydra/Langs/Rdf/Utils.hs b/src/main/haskell/Hydra/Langs/Rdf/Utils.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Rdf/Utils.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Hydra.Langs.Rdf.Utils where - -import Hydra.Kernel -import qualified Hydra.Langs.Rdf.Syntax as Rdf - -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S - - -descriptionsToGraph :: [Rdf.Description] -> Rdf.Graph -descriptionsToGraph ds = Rdf.Graph $ S.fromList $ triplesOf ds - -emptyDescription :: Rdf.Node -> Rdf.Description -emptyDescription node = Rdf.Description node emptyGraph - -emptyGraph :: Rdf.Graph -emptyGraph = Rdf.Graph S.empty - -emptyLangStrings :: Rdf.LangStrings -emptyLangStrings = Rdf.LangStrings M.empty - -encodeLiteral :: Literal -> Flow (Graph) Rdf.Literal -encodeLiteral lit = case lit of - LiteralBinary s -> fail "base 64 encoding not yet implemented" - LiteralBoolean b -> pure $ xsd (\b -> if b then "true" else "false") b "boolean" - LiteralFloat f -> pure $ case f of - FloatValueBigfloat v -> xsd show v "decimal" - FloatValueFloat32 v -> xsd show v "float" - FloatValueFloat64 v -> xsd show v "double" - LiteralInteger i -> pure $ case i of - IntegerValueBigint v -> xsd show v "integer" - IntegerValueInt8 v -> xsd show v "byte" - IntegerValueInt16 v -> xsd show v "short" - IntegerValueInt32 v -> xsd show v "int" - IntegerValueInt64 v -> xsd show v "long" - IntegerValueUint8 v -> xsd show v "unsignedByte" - IntegerValueUint16 v -> xsd show v "unsignedShort" - IntegerValueUint32 v -> xsd show v "unsignedInt" - IntegerValueUint64 v -> xsd show v "unsignedLong" - LiteralString s -> pure $ xsd id s "string" - where - -- TODO: using Haskell's built-in show function is a cheat, and may not be correct/optimal in all cases - xsd ser x local = Rdf.Literal (ser x) (xmlSchemaDatatypeIri local) Nothing - -forObjects :: Rdf.Resource -> Rdf.Iri -> [Rdf.Node] -> [Rdf.Triple] -forObjects subj pred objs = (Rdf.Triple subj pred) <$> objs - -iri :: String -> String -> Rdf.Iri -iri ns local = Rdf.Iri $ ns ++ local - -keyIri :: String -> Rdf.Iri -keyIri = iri "urn:key:" -- Note: not an official URN scheme - -mergeGraphs :: [Rdf.Graph] -> Rdf.Graph -mergeGraphs graphs = Rdf.Graph $ L.foldl S.union S.empty (Rdf.unGraph <$> graphs) - -nameToIri :: Name -> Rdf.Iri -nameToIri name = Rdf.Iri $ "urn:" ++ unName name - -nextBlankNode :: Flow (Graph) Rdf.Resource -nextBlankNode = do - count <- nextCount "rdfBlankNodeCounter" - return $ Rdf.ResourceBnode $ Rdf.BlankNode $ "b" ++ show count - --- Note: these are not "proper" URNs, as they do not use an established URN scheme -propertyIri :: Name -> Name -> Rdf.Iri -propertyIri rname fname = Rdf.Iri $ "urn:" ++ unNamespace gname ++ "#" ++ decapitalize local ++ capitalize (unName fname) - where - QualifiedName (Just gname) local = qualifyNameLazy rname - -rdfIri :: String -> Rdf.Iri -rdfIri = iri "http://www.w3.org/1999/02/22-rdf-syntax-ns#" - -resourceToNode :: Rdf.Resource -> Rdf.Node -resourceToNode r = case r of - Rdf.ResourceIri i -> Rdf.NodeIri i - Rdf.ResourceBnode b -> Rdf.NodeBnode b - -subjectsOf :: [Rdf.Description] -> [Rdf.Node] -subjectsOf descs = Rdf.descriptionSubject <$> descs - -triplesOf :: [Rdf.Description] -> [Rdf.Triple] -triplesOf descs = L.concat ((S.toList . Rdf.unGraph . Rdf.descriptionGraph) <$> descs) - -xmlSchemaDatatypeIri :: String -> Rdf.Iri -xmlSchemaDatatypeIri = iri "http://www.w3.org/2001/XMLSchema#" diff --git a/src/main/haskell/Hydra/Langs/Scala/Coder.hs b/src/main/haskell/Hydra/Langs/Scala/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Scala/Coder.hs +++ /dev/null @@ -1,227 +0,0 @@ -module Hydra.Langs.Scala.Coder (moduleToScala) where - -import Hydra.Kernel -import Hydra.Dsl.Terms -import Hydra.Langs.Scala.Language -import Hydra.Langs.Scala.Utils -import Hydra.Adapters -import Hydra.Tools.Serialization -import Hydra.Langs.Scala.Serde -import qualified Hydra.Dsl.Types as Types -import qualified Hydra.Langs.Scala.Meta as Scala -import qualified Hydra.Lib.Strings as Strings - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -moduleToScala :: Module -> Flow (Graph) (M.Map FilePath String) -moduleToScala mod = do - pkg <- moduleToScalaPackage mod - let s = printExpr $ parenthesize $ writePkg pkg - return $ M.fromList [(namespaceToFilePath False (FileExtension "scala") $ moduleNamespace mod, s)] - -moduleToScalaPackage :: Module -> Flow (Graph) Scala.Pkg -moduleToScalaPackage = transformModule scalaLanguage encodeUntypedTerm constructModule - -constructModule :: Module -> M.Map (Type) (Coder (Graph) (Graph) (Term) Scala.Data) -> [(Element, TypedTerm)] - -> Flow (Graph) Scala.Pkg -constructModule mod coders pairs = do - defs <- CM.mapM toDef pairs - let pname = toScalaName $ h $ moduleNamespace mod - let pref = Scala.Data_RefName pname - imports <- findImports - return $ Scala.Pkg pname pref (imports ++ defs) - where - h (Namespace n) = n - findImports = do - elImps <- moduleDependencyNamespaces False False True False mod - primImps <- moduleDependencyNamespaces False True False False mod - return $ (toElImport <$> S.toList elImps) ++ (toPrimImport <$> S.toList primImps) - where - toElImport (Namespace ns) = Scala.StatImportExport $ Scala.ImportExportStatImport $ Scala.Import [ - Scala.Importer (Scala.Data_RefName $ toScalaName ns) [Scala.ImporteeWildcard]] - toPrimImport (Namespace ns) = Scala.StatImportExport $ Scala.ImportExportStatImport $ Scala.Import [ - Scala.Importer (Scala.Data_RefName $ toScalaName ns) []] - toScalaName name = Scala.Data_Name $ Scala.PredefString $ L.intercalate "." $ Strings.splitOn "/" name - toDef (el, TypedTerm term typ) = withTrace ("element " ++ unName (elementName el)) $ do - let coder = Y.fromJust $ M.lookup typ coders - rhs <- coderEncode coder term - Scala.StatDefn <$> case rhs of - Scala.DataApply _ -> toVal rhs - Scala.DataFunctionData fun -> case stripType typ of - TypeFunction (FunctionType _ cod) -> toDefn fun cod - _ -> fail $ "expected function type, but found " ++ show typ - Scala.DataLit _ -> toVal rhs - Scala.DataRef _ -> toVal rhs -- TODO - _ -> fail $ "unexpected RHS: " ++ show rhs - where - lname = localNameOfEager $ elementName el - - freeTypeVars = S.toList $ freeVariablesInType typ - - toDefn (Scala.Data_FunctionDataFunction (Scala.Data_Function params body)) cod = do - let tparams = stparam <$> freeTypeVars - scod <- encodeType cod - return $ Scala.DefnDef $ Scala.Defn_Def [] - (Scala.Data_Name $ Scala.PredefString lname) tparams [params] (Just scod) body - - toVal rhs = pure $ Scala.DefnVal $ Scala.Defn_Val [] [namePat] Nothing rhs - where - namePat = Scala.PatVar $ Scala.Pat_Var $ Scala.Data_Name $ Scala.PredefString lname - -encodeFunction :: M.Map String Term -> Function -> Y.Maybe (Term) -> Flow (Graph) Scala.Data -encodeFunction meta fun arg = case fun of - FunctionLambda (Lambda (Name v) body) -> slambda v <$> encodeTerm body <*> findSdom - FunctionPrimitive name -> pure $ sprim name - FunctionElimination e -> case e of - EliminationWrap name -> pure $ sname $ "ELIM-NOMINAL(" ++ show name ++ ")" -- TODO - EliminationOptional c -> pure $ sname "ELIM-OPTIONAL" -- TODO - EliminationRecord p -> fail "unapplied projection not yet supported" - EliminationUnion (CaseStatement _ def cases) -> do - let v = "v" - dom <- findDomain - ftypes <- withSchemaContext $ fieldTypes dom - cx <- getState - let sn = nameOfType cx dom - scases <- CM.mapM (encodeCase ftypes sn) cases - -- TODO: default - case arg of - Nothing -> slambda v <$> pure (Scala.DataMatch $ Scala.Data_Match (sname v) scases) <*> findSdom - Just a -> do - sa <- encodeTerm a - return $ Scala.DataMatch $ Scala.Data_Match sa scases - where - encodeCase ftypes sn f@(Field fname fterm) = do - -- dom <- findDomain (termMeta fterm) -- Option #1: use type inference - let dom = Y.fromJust $ M.lookup fname ftypes -- Option #2: look up the union type - let patArgs = if dom == Types.unit then [] else [svar v] - -- Note: PatExtract has the right syntax, though this may or may not be the Scalameta-intended way to use it - let pat = Scala.PatExtract $ Scala.Pat_Extract (sname $ qualifyUnionFieldName "MATCHED." sn fname) patArgs - body <- encodeTerm $ applyVar fterm v - return $ Scala.Case pat Nothing body - where - v = Name "y" - applyVar fterm avar@(Name v) = case stripTerm fterm of - TermFunction (FunctionLambda (Lambda v1 body)) -> if isFreeIn v1 body - then body - else substituteVariable v1 avar body - _ -> apply fterm (var v) - where - findSdom = Just <$> (findDomain >>= encodeType) - findDomain = do - cx <- getState - r <- getType meta - case r of - Nothing -> fail "expected a typed term" - Just t -> domainOf t - where - domainOf t = case stripType t of - TypeFunction (FunctionType dom _) -> pure dom - _ -> fail $ "expected a function type, but found " ++ show t - -encodeLiteral :: Literal -> Flow (Graph) Scala.Lit -encodeLiteral av = case av of - LiteralBoolean b -> pure $ Scala.LitBoolean b - LiteralFloat fv -> case fv of - FloatValueFloat32 f -> pure $ Scala.LitFloat f - FloatValueFloat64 f -> pure $ Scala.LitDouble f - _ -> unexpected "floating-point number" $ show fv - LiteralInteger iv -> case iv of - IntegerValueInt16 i -> pure $ Scala.LitShort $ fromIntegral i - IntegerValueInt32 i -> pure $ Scala.LitInt i - IntegerValueInt64 i -> pure $ Scala.LitLong $ fromIntegral i - IntegerValueUint8 i -> pure $ Scala.LitByte $ fromIntegral i - _ -> unexpected "integer" $ show iv - LiteralString s -> pure $ Scala.LitString s - _ -> unexpected "literal value" $ show av - -encodeTerm :: Term -> Flow (Graph) Scala.Data -encodeTerm term = case stripTerm term of - TermApplication (Application fun arg) -> case stripTerm fun of - TermFunction f -> case f of - FunctionElimination e -> case e of - EliminationWrap name -> fallback - EliminationOptional c -> fallback - EliminationRecord (Projection _ (Name fname)) -> do - sarg <- encodeTerm arg - return $ Scala.DataRef $ Scala.Data_RefSelect $ Scala.Data_Select sarg - (Scala.Data_Name $ Scala.PredefString fname) - EliminationUnion _ -> do - cx <- getState - encodeFunction (termAnnotationInternal fun) f (Just arg) - _ -> fallback - _ -> fallback - where - fallback = sapply <$> encodeTerm fun <*> ((: []) <$> encodeTerm arg) - TermFunction f -> do - cx <- getState - encodeFunction (termAnnotationInternal term) f Nothing - TermList els -> sapply (sname "Seq") <$> CM.mapM encodeTerm els - TermLiteral v -> Scala.DataLit <$> encodeLiteral v - TermMap m -> sapply (sname "Map") <$> CM.mapM toPair (M.toList m) - where - toPair (k, v) = sassign <$> encodeTerm k <*> encodeTerm v - TermWrap (WrappedTerm _ term') -> encodeTerm term' - TermOptional m -> case m of - Nothing -> pure $ sname "None" - Just t -> (\s -> sapply (sname "Some") [s]) <$> encodeTerm t - TermRecord (Record name fields) -> do - let n = scalaTypeName False name - args <- CM.mapM encodeTerm (fieldTerm <$> fields) - return $ sapply (sname n) args - TermSet s -> sapply (sname "Set") <$> CM.mapM encodeTerm (S.toList s) - TermUnion (Injection sn (Field fn ft)) -> do - let lhs = sname $ qualifyUnionFieldName "UNION." (Just sn) fn - args <- case stripTerm ft of - TermRecord (Record _ []) -> pure [] - _ -> do - arg <- encodeTerm ft - return [arg] - return $ sapply lhs args - TermVariable (Name v) -> pure $ sname v - _ -> fail $ "unexpected term: " ++ show term - - -encodeType :: Type -> Flow (Graph) Scala.Type -encodeType t = case stripType t of - TypeFunction (FunctionType dom cod) -> do - sdom <- encodeType dom - scod <- encodeType cod - return $ Scala.TypeFunctionType $ Scala.Type_FunctionTypeFunction $ Scala.Type_Function [sdom] scod - TypeList lt -> stapply1 <$> pure (stref "Seq") <*> encodeType lt - TypeLiteral lt -> case lt of --- TypeBinary -> - LiteralTypeBoolean -> pure $ stref "Boolean" - LiteralTypeFloat ft -> case ft of --- FloatTypeBigfloat -> - FloatTypeFloat32 -> pure $ stref "Float" - FloatTypeFloat64 -> pure $ stref "Double" - LiteralTypeInteger it -> case it of --- IntegerTypeBigint -> --- IntegerTypeInt8 -> - IntegerTypeInt16 -> pure $ stref "Short" - IntegerTypeInt32 -> pure $ stref "Int" - IntegerTypeInt64 -> pure $ stref "Long" - IntegerTypeUint8 -> pure $ stref "Byte" --- IntegerTypeUint16 -> --- IntegerTypeUint32 -> --- IntegerTypeUint64 -> - LiteralTypeString -> pure $ stref "String" - TypeMap (MapType kt vt) -> stapply2 <$> pure (stref "Map") <*> encodeType kt <*> encodeType vt - TypeOptional ot -> stapply1 <$> pure (stref "Option") <*> encodeType ot --- TypeRecord sfields -> - TypeSet st -> stapply1 <$> pure (stref "Set") <*> encodeType st --- TypeUnion sfields -> - TypeLambda (LambdaType v body) -> do - sbody <- encodeType body - return $ Scala.TypeLambda $ Scala.Type_Lambda [stparam v] sbody --- TypeVariable name -> pure $ stref $ scalaTypeName True name - TypeVariable (Name v) -> pure $ Scala.TypeVar $ Scala.Type_Var $ Scala.Type_Name v - _ -> fail $ "can't encode unsupported type in Scala: " ++ show t - -encodeUntypedTerm :: Term -> Flow (Graph) Scala.Data -encodeUntypedTerm term = annotateTypedTerms term >>= encodeTerm diff --git a/src/main/haskell/Hydra/Langs/Scala/Language.hs b/src/main/haskell/Hydra/Langs/Scala/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Scala/Language.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Hydra.Langs.Scala.Language where - -import Hydra.Kernel - -import qualified Data.Set as S - - -scalaLanguage :: Language -scalaLanguage = Language (LanguageName "hydra/langs/scala") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.fromList eliminationVariants, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBoolean, - LiteralVariantFloat, - LiteralVariantInteger, - LiteralVariantString], - languageConstraintsFloatTypes = S.fromList [ - -- Bigfloat is excluded for now - FloatTypeFloat32, - FloatTypeFloat64], - languageConstraintsFunctionVariants = S.fromList functionVariants, - languageConstraintsIntegerTypes = S.fromList [ - IntegerTypeBigint, - IntegerTypeInt16, - IntegerTypeInt32, - IntegerTypeInt64, - IntegerTypeUint8], - languageConstraintsTermVariants = S.fromList [ - TermVariantApplication, - TermVariantFunction, - TermVariantList, - TermVariantLiteral, - TermVariantMap, - TermVariantOptional, - TermVariantRecord, - TermVariantSet, - TermVariantUnion, - TermVariantVariable, - TermVariantWrap], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantAnnotated, - TypeVariantFunction, - TypeVariantList, - TypeVariantLiteral, - TypeVariantMap, - TypeVariantOptional, - TypeVariantRecord, - TypeVariantSet, - TypeVariantUnion, - TypeVariantLambda, - TypeVariantVariable, - TypeVariantWrap], - languageConstraintsTypes = const True } - -reservedWords :: S.Set [Char] -reservedWords = S.fromList $ keywords ++ classNames - where - -- Classes in the Scala Standard Library 2.13.8 - -- Note: numbered class names like Function1, Product16, and the names of exception/error classes are omitted, - -- as they are unlikely to occur by chance. - classNames = [ - "Any", "AnyVal", "App", "Array", "Boolean", "Byte", "Char", "Console", "DelayedInit", "Double", "DummyExplicit", - "Dynamic", "Enumeration", "Equals", "Float", "Function", "Int", "Long", "MatchError", "None", - "Nothing", "Null", "Option", "PartialFunction", "Predef", "Product", "Proxy", - "SerialVersionUID", "Short", "Singleton", "Some", "Specializable", "StringContext", - "Symbol", "Unit", "ValueOf"] - -- Not an official or comprehensive list; taken from https://www.geeksforgeeks.org/scala-keywords - keywords = [ - "abstract", "case", "catch", "class", "def", "do", "else", "extends", "false", "final", "finally", "for", - "forSome", "if", "implicit", "import", "lazy", "match", "new", "null", "object", "override", "package", "private", - "protected", "return", "sealed", "super", "this", "throw", "trait", "true", "try", "type", "val", "var", "while", - "with", "yield"] diff --git a/src/main/haskell/Hydra/Langs/Scala/Prepare.hs b/src/main/haskell/Hydra/Langs/Scala/Prepare.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Scala/Prepare.hs +++ /dev/null @@ -1,64 +0,0 @@ -module Hydra.Langs.Scala.Prepare ( - prepareType, -) where - -import Hydra.Kernel -import qualified Hydra.Dsl.Types as Types - -import qualified Data.Set as S - - -prepareLiteralType :: LiteralType -> (LiteralType, Literal -> Literal, S.Set String) -prepareLiteralType at = case at of - LiteralTypeBinary -> subst LiteralTypeString - "binary strings" "character strings" - $ \(LiteralBinary v) -> LiteralString v - LiteralTypeFloat ft -> (LiteralTypeFloat rtyp, \(LiteralFloat v) -> LiteralFloat $ rep v, msgs) - where - (rtyp, rep, msgs) = prepareFloatType ft - LiteralTypeInteger it -> (LiteralTypeInteger rtyp, \(LiteralInteger v) -> LiteralInteger $ rep v, msgs) - where - (rtyp, rep, msgs) = prepareIntegerType it - _ -> same at - -prepareFloatType :: FloatType -> (FloatType, FloatValue -> FloatValue, S.Set String) -prepareFloatType ft = case ft of - FloatTypeBigfloat -> subst FloatTypeFloat64 - "arbitrary-precision floating-point numbers" "64-bit floating-point numbers (doubles)" - $ \(FloatValueBigfloat v) -> FloatValueFloat64 v - _ -> same ft - -prepareIntegerType :: IntegerType -> (IntegerType, IntegerValue -> IntegerValue, S.Set String) -prepareIntegerType it = case it of - IntegerTypeBigint -> subst IntegerTypeInt64 - "arbitrary-precision integers" "64-bit integers" - $ \(IntegerValueBigint v) -> IntegerValueInt64 $ fromIntegral v - IntegerTypeUint8 -> subst IntegerTypeInt8 - "unsigned 8-bit integers" "signed 8-bit integers" - $ \(IntegerValueUint8 v) -> IntegerValueInt8 $ fromIntegral v - IntegerTypeUint32 -> subst IntegerTypeInt32 - "unsigned 32-bit integers" "signed 32-bit integers" - $ \(IntegerValueUint32 v) -> IntegerValueInt32 $ fromIntegral v - IntegerTypeUint64 -> subst IntegerTypeInt64 - "unsigned 64-bit integers" "signed 64-bit integers" - $ \(IntegerValueUint64 v) -> IntegerValueInt64 $ fromIntegral v - _ -> same it - -prepareType :: Graph -> Type -> (Type, Term -> Term, S.Set String) -prepareType cx typ = case stripType typ of - TypeLiteral at -> (Types.literal rtyp, \(TermLiteral av) -> TermLiteral $ rep av, msgs) - where - (rtyp, rep, msgs) = prepareLiteralType at --- TypeFunction (FunctionType dom cod) -> --- TypeList lt -> --- TypeMap (MapType kt vt) -> --- TypeWrap name -> --- TypeRecord fields -> --- TypeSet st -> --- TypeUnion fields -> - -same :: a -> (a, b -> b, S.Set c) -same x = (x, id, S.empty) - -subst :: a -> [Char] -> [Char] -> b -> (a, b, S.Set [Char]) -subst t from to r = (t, r, S.fromList ["replace " ++ from ++ " with " ++ to]) diff --git a/src/main/haskell/Hydra/Langs/Scala/Serde.hs b/src/main/haskell/Hydra/Langs/Scala/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Scala/Serde.hs +++ /dev/null @@ -1,139 +0,0 @@ -module Hydra.Langs.Scala.Serde where - -import Hydra.Ast -import Hydra.Tools.Serialization -import qualified Hydra.Lib.Literals as Literals -import qualified Hydra.Langs.Scala.Meta as Scala - -import qualified Data.List as L -import qualified Data.Maybe as Y - - -dotOp :: Op -dotOp = Op (Symbol ".") (Padding WsNone WsNone) (Precedence 0) AssociativityLeft - -functionArrowOp :: Op -functionArrowOp = op "=>" (negate 1) AssociativityRight - -matchOp :: Op -matchOp = Op (Symbol "match") (Padding WsSpace $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone - -writeCase :: Scala.Case -> Expr -writeCase (Scala.Case pat _ term) = spaceSep [cst "case", writePat pat, cst "=>", writeTerm term] - -writeDefn :: Scala.Defn -> Expr -writeDefn def = case def of - Scala.DefnDef (Scala.Defn_Def _ name tparams [params] scod body) -> spaceSep [ - cst "def", nameAndParams, cst "=", writeTerm body] - where - nameAndParams = noSep $ Y.catMaybes [ - Just $ writeData_Name name, - if L.null tparams then Nothing else Just $ bracketList inlineStyle (writeType_Param <$> tparams), - Just $ parenList False (writeData_Param <$> params), - fmap (\t -> spaceSep [cst ":", writeType t]) scod] - Scala.DefnVal (Scala.Defn_Val _ [Scala.PatVar (Scala.Pat_Var (Scala.Data_Name (Scala.PredefString name)))] typ term) -> spaceSep [ - cst "val", nameAndType, cst "=", writeTerm term] - where - nameAndType = Y.maybe (cst name) (\t -> spaceSep [cst $ name ++ ":", writeType t]) typ - -writeImportExportStat :: Scala.ImportExportStat -> Expr -writeImportExportStat ie = case ie of - Scala.ImportExportStatImport (Scala.Import importers) -> newlineSep (writeImporter <$> importers) --- Scala.ImportExportStatExport exp -> - -writeImporter :: Scala.Importer -> Expr -writeImporter (Scala.Importer (Scala.Data_RefName (Scala.Data_Name (Scala.PredefString ref))) importees) = spaceSep [ - cst "import", noSep [cst ref, forImportees importees]] - where - forImportee it = cst $ case it of - Scala.ImporteeWildcard -> "*" - Scala.ImporteeName (Scala.Importee_Name (Scala.NameValue name)) -> name - forImportees its = if L.null its - then cst "" - else if L.length its == 1 - then noSep [cst ".", forImportee $ L.head its] - else noSep [cst ".", curlyBracesList Nothing inlineStyle (forImportee <$> its)] -writeLit :: Scala.Lit -> Expr -writeLit lit = case lit of --- Scala.LitNull - Scala.LitInt i -> cst $ Literals.showInt32 i --- Scala.LitDouble Double --- Scala.LitFloat Float --- Scala.LitByte Integer --- Scala.LitShort Integer --- Scala.LitChar Integer --- Scala.LitLong Int64 - Scala.LitBoolean b -> cst $ if b then "true" else "false" - Scala.LitUnit -> cst "()" - Scala.LitString s -> cst $ Literals.showString s --- Scala.LitSymbol sym -> - _ -> cst $ Literals.showString $ "TODO:literal:" ++ show lit - -writeName :: Scala.Name -> Expr -writeName name = case name of - Scala.NameValue s -> cst s - -writePat :: Scala.Pat -> Expr -writePat pat = case pat of - Scala.PatExtract (Scala.Pat_Extract fun args) -> noSep [writeTerm fun, parenList False (writePat <$> args)] - Scala.PatVar (Scala.Pat_Var tname) -> writeData_Name tname - -writePkg :: Scala.Pkg -> Expr -writePkg (Scala.Pkg name _ stats) = doubleNewlineSep $ package:(writeStat <$> stats) - where - package = spaceSep [cst "package", writeData_Name name] - -writeStat :: Scala.Stat -> Expr -writeStat stat = case stat of --- Scala.StatTerm Term -> --- Scala.StatDecl Decl -> - Scala.StatDefn def -> writeDefn def - Scala.StatImportExport ie -> writeImportExportStat ie - -writeTerm :: Scala.Data -> Expr -writeTerm term = case term of - Scala.DataLit lit -> writeLit lit - Scala.DataRef ref -> writeData_Ref ref - Scala.DataApply (Scala.Data_Apply fun args) -> noSep [writeTerm fun, parenList False (writeTerm <$> args)] - Scala.DataAssign assign -> cst ">ASSIGN" - Scala.DataTuple (Scala.Data_Tuple args) -> parenList False (writeTerm <$> args) - Scala.DataMatch (Scala.Data_Match expr cases) -> ifx matchOp (writeTerm expr) $ newlineSep (writeCase <$> cases) - Scala.DataFunctionData ft -> writeData_FunctionData ft - -writeData_FunctionData :: Scala.Data_FunctionData -> Expr -writeData_FunctionData ft = case ft of - Scala.Data_FunctionDataFunction (Scala.Data_Function params body) -> - spaceSep [parenList False (writeData_Param <$> params), cst "=>", writeTerm body] - -writeData_Name :: Scala.Data_Name -> Expr -writeData_Name (Scala.Data_Name (Scala.PredefString name)) = cst name - -writeData_Param :: Scala.Data_Param -> Expr -writeData_Param (Scala.Data_Param _ name stype _) = noSep $ Y.catMaybes [ - Just $ writeName name, - fmap (\t -> spaceSep [cst ":", writeType t]) stype] - -writeData_Ref :: Scala.Data_Ref -> Expr -writeData_Ref ref = case ref of - Scala.Data_RefName name -> writeData_Name name - Scala.Data_RefSelect sel -> writeData_Select sel - -writeData_Select :: Scala.Data_Select -> Expr -writeData_Select (Scala.Data_Select arg name) = ifx dotOp (writeTerm arg) (writeTerm proj) - where - proj = Scala.DataRef $ Scala.Data_RefName name - -writeType :: Scala.Type -> Expr -writeType typ = case typ of - Scala.TypeRef (Scala.Type_RefName name) -> writeType_Name name - Scala.TypeApply (Scala.Type_Apply fun args) -> noSep [writeType fun, bracketList inlineStyle (writeType <$> args)] - Scala.TypeFunctionType (Scala.Type_FunctionTypeFunction (Scala.Type_Function [dom] cod)) -> ifx functionArrowOp (writeType dom) (writeType cod) - Scala.TypeLambda (Scala.Type_Lambda params body) -> noSep [writeType body, bracketList inlineStyle (writeType_Param <$> params)] - Scala.TypeVar (Scala.Type_Var name) -> writeType_Name name - _ -> cst $ "UNKNOWN TYPE: " ++ show typ - -writeType_Name :: Scala.Type_Name -> Expr -writeType_Name (Scala.Type_Name name) = cst name - -writeType_Param :: Scala.Type_Param -> Expr -writeType_Param (Scala.Type_Param [] n [] [] [] []) = writeName n diff --git a/src/main/haskell/Hydra/Langs/Scala/Utils.hs b/src/main/haskell/Hydra/Langs/Scala/Utils.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Scala/Utils.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Hydra.Langs.Scala.Utils where - -import Hydra.Kernel -import qualified Hydra.Langs.Scala.Meta as Scala -import qualified Hydra.Lib.Strings as Strings -import Hydra.Langs.Scala.Language - -import qualified Data.List as L -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -nameOfType :: Graph -> Type -> Y.Maybe Name -nameOfType cx t = case stripType t of - TypeVariable name -> Just name - TypeLambda (LambdaType _ body) -> nameOfType cx body - _ -> Nothing - -qualifyUnionFieldName :: String -> Y.Maybe Name -> Name -> String -qualifyUnionFieldName dlft sname (Name fname) = (Y.maybe dlft (\n -> scalaTypeName True n ++ ".") sname) ++ fname - -scalaTypeName :: Bool -> Name -> String -scalaTypeName qualify name@(Name n) = if qualify || S.member local reservedWords - then L.intercalate "." $ Strings.splitOn "/" n - else local - where - local = localNameOfLazy name - -sapply :: Scala.Data -> [Scala.Data] -> Scala.Data -sapply fun args = Scala.DataApply $ Scala.Data_Apply fun args - -sassign :: Scala.Data -> Scala.Data -> Scala.Data -sassign lhs rhs = Scala.DataAssign $ Scala.Data_Assign lhs rhs - -slambda :: String -> Scala.Data -> Y.Maybe Scala.Type -> Scala.Data -slambda v body sdom = Scala.DataFunctionData $ Scala.Data_FunctionDataFunction - $ Scala.Data_Function [Scala.Data_Param mods name sdom def] body - where - mods = [] - name = Scala.NameValue v - def = Nothing - -sname :: String -> Scala.Data -sname = Scala.DataRef . Scala.Data_RefName . Scala.Data_Name . Scala.PredefString - -sprim :: Name -> Scala.Data -sprim name = sname $ prefix ++ "." ++ qualifiedNameLocal qname - where - qname = qualifyNameLazy name - prefix = L.last $ Strings.splitOn "/" $ unNamespace $ Y.fromJust $ qualifiedNameNamespace qname - -stapply :: Scala.Type -> [Scala.Type] -> Scala.Type -stapply t args = Scala.TypeApply $ Scala.Type_Apply t args - -stapply1 :: Scala.Type -> Scala.Type -> Scala.Type -stapply1 t1 t2 = stapply t1 [t2] - -stapply2 :: Scala.Type -> Scala.Type -> Scala.Type -> Scala.Type -stapply2 t1 t2 t3 = stapply t1 [t2, t3] - -stparam :: Name -> Scala.Type_Param -stparam (Name v) = Scala.Type_Param [] (Scala.NameValue v) [] [] [] [] - -stref :: String -> Scala.Type -stref = Scala.TypeRef . Scala.Type_RefName . Scala.Type_Name - -svar :: Name -> Scala.Pat -svar (Name v) = (Scala.PatVar . Scala.Pat_Var . Scala.Data_Name . Scala.PredefString) v diff --git a/src/main/haskell/Hydra/Langs/Shacl/Coder.hs b/src/main/haskell/Hydra/Langs/Shacl/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Shacl/Coder.hs +++ /dev/null @@ -1,197 +0,0 @@ -module Hydra.Langs.Shacl.Coder where - -import Hydra.Kernel -import Hydra.Langs.Rdf.Utils -import qualified Hydra.Langs.Rdf.Syntax as Rdf -import qualified Hydra.Langs.Shacl.Model as Shacl -import qualified Hydra.Dsl.Literals as Literals -import qualified Hydra.Dsl.Expect as Expect -import qualified Hydra.Dsl.Terms as Terms - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -shaclCoder :: Module -> Flow (Graph) (Shacl.ShapesGraph, Graph -> Flow (Graph) Rdf.Graph) -shaclCoder mod = do - g <- getState - -- Note: untested since deprecation of element schemas - typeEls <- CM.filterM (isType g) $ moduleElements mod - shapes <- CM.mapM toShape typeEls - let sg = Shacl.ShapesGraph $ S.fromList shapes - let termFlow = \g -> do - fail "not implemented" - return (sg, termFlow) - where - isType g el = do - typ <- requireTermType $ elementData el - return $ stripType typ == TypeVariable _Type - toShape el = do - typ <- coreDecodeType $ elementData el - common <- encodeType typ - return $ Shacl.Definition (elementIri el) $ Shacl.ShapeNode $ Shacl.NodeShape common - -common :: [Shacl.CommonConstraint] -> Shacl.CommonProperties -common constraints = defaultCommonProperties { - Shacl.commonPropertiesConstraints = S.fromList constraints} - -defaultCommonProperties :: Shacl.CommonProperties -defaultCommonProperties = Shacl.CommonProperties { - Shacl.commonPropertiesConstraints = S.empty, - Shacl.commonPropertiesDeactivated = Nothing, - Shacl.commonPropertiesMessage = emptyLangStrings, - Shacl.commonPropertiesSeverity = Shacl.SeverityInfo, - Shacl.commonPropertiesTargetClass = S.empty, - Shacl.commonPropertiesTargetNode = S.empty, - Shacl.commonPropertiesTargetObjectsOf = S.empty, - Shacl.commonPropertiesTargetSubjectsOf = S.empty} - -elementIri :: Element -> Rdf.Iri -elementIri = nameToIri . elementName - -encodeField :: Name -> Rdf.Resource -> Field -> Flow (Graph) [Rdf.Triple] -encodeField rname subject field = do - node <- nextBlankNode - descs <- encodeTerm node (fieldTerm field) - return $ triplesOf descs ++ - forObjects subject (propertyIri rname $ fieldName field) (subjectsOf descs) - -encodeFieldType :: Name -> Maybe Integer -> FieldType -> Flow (Graph) (Shacl.Definition Shacl.PropertyShape) -encodeFieldType rname order (FieldType fname ft) = do - shape <- forType (Just 1) (Just 1) ft - return $ Shacl.Definition iri shape - where - iri = propertyIri rname fname - forType mn mx t = case stripType t of - TypeOptional ot -> forType (Just 0) mx ot - TypeSet st -> forType mn Nothing st - _ -> do - cp <- encodeType t - let baseProp = property iri - return $ baseProp { - Shacl.propertyShapeCommon = cp, - Shacl.propertyShapeConstraints = S.fromList $ Y.catMaybes [ - Shacl.PropertyShapeConstraintMinCount <$> mn, - Shacl.PropertyShapeConstraintMaxCount <$> mx], - Shacl.propertyShapeOrder = order} - -encodeLiteralType :: LiteralType -> Shacl.CommonProperties -encodeLiteralType lt = case lt of - LiteralTypeBinary -> xsd "base64Binary" - LiteralTypeBoolean -> xsd "boolean" - LiteralTypeFloat ft -> case ft of - FloatTypeBigfloat -> xsd "decimal" - FloatTypeFloat32 -> xsd "float" - FloatTypeFloat64 -> xsd "double" - LiteralTypeInteger it -> case it of - IntegerTypeBigint -> xsd "integer" - IntegerTypeInt8 -> xsd "byte" - IntegerTypeInt16 -> xsd "short" - IntegerTypeInt32 -> xsd "int" - IntegerTypeInt64 -> xsd "long" - IntegerTypeUint8 -> xsd "unsignedByte" - IntegerTypeUint16 -> xsd "unsignedShort" - IntegerTypeUint32 -> xsd "unsignedInt" - IntegerTypeUint64 -> xsd "unsignedLong" - LiteralTypeString -> xsd "string" - where - xsd local = common [Shacl.CommonConstraintDatatype $ xmlSchemaDatatypeIri local] - -encodeTerm :: Rdf.Resource -> Term -> Flow (Graph) [Rdf.Description] -encodeTerm subject term = case term of - TermAnnotated (AnnotatedTerm inner ann) -> encodeTerm subject inner -- TODO: extract an rdfs:comment - TermList terms -> encodeList subject terms - where - encodeList subj terms = if L.null terms - then pure [emptyDescription $ (Rdf.NodeIri $ rdfIri "nil")] - else do - node <- nextBlankNode - fdescs <- encodeTerm node $ L.head terms - let firstTriples = triplesOf fdescs ++ - forObjects subj (rdfIri "first") (subjectsOf fdescs) - next <- nextBlankNode - rdescs <- encodeList next $ L.tail terms - let restTriples = triplesOf rdescs ++ - forObjects subj (rdfIri "rest") (subjectsOf rdescs) - return [Rdf.Description (resourceToNode subj) (Rdf.Graph $ S.fromList $ firstTriples ++ restTriples)] - TermLiteral lit -> do - node <- Rdf.NodeLiteral <$> encodeLiteral lit - return [emptyDescription node] - TermMap m -> do - triples <- L.concat <$> (CM.mapM (forKeyVal subject) $ M.toList m) - return [Rdf.Description (resourceToNode subject) $ Rdf.Graph $ S.fromList triples] - where - forKeyVal subj (k, v) = do - -- Note: only string-valued keys are supported - ks <- Expect.string $ stripTerm k - node <- nextBlankNode - descs <- encodeTerm node v - let pred = keyIri ks - let objs = subjectsOf descs - let triples = forObjects subj pred objs - return $ triples ++ triplesOf descs - TermWrap (WrappedTerm name inner) -> do - descs <- encodeTerm subject inner - return $ (withType name $ L.head descs):(L.tail descs) - TermOptional mterm -> case mterm of - Nothing -> pure [] - Just inner -> encodeTerm subject inner - TermRecord (Record rname fields) -> do - tripless <- CM.mapM (encodeField rname subject) fields - return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList $ L.concat tripless)] - TermSet terms -> L.concat <$> CM.mapM encodeEl (S.toList terms) - where - encodeEl term = do - node <- nextBlankNode - encodeTerm node term - TermUnion (Injection rname field) -> do - triples <- encodeField rname subject field - return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList triples)] - _ -> unexpected "RDF-compatible term" $ show term - -encodeType :: Type -> Flow (Graph) Shacl.CommonProperties -encodeType typ = case stripType typ of - TypeList _ -> any - TypeLiteral lt -> pure $ encodeLiteralType lt - TypeMap _ -> any - TypeWrap name -> any -- TODO: include name - TypeRecord (RowType rname _ fields) -> do - props <- CM.zipWithM (encodeFieldType rname) (Just <$> [0..]) fields - return $ common [Shacl.CommonConstraintProperty $ S.fromList (Shacl.ReferenceDefinition <$> props)] - TypeSet _ -> any - TypeUnion (RowType rname _ fields) -> do - props <- CM.mapM (encodeFieldType rname Nothing) fields - let shapes = (Shacl.ReferenceAnonymous . toShape) <$> props - return $ common [Shacl.CommonConstraintXone $ S.fromList shapes] - where - toShape prop = node [Shacl.CommonConstraintProperty $ S.fromList [Shacl.ReferenceDefinition prop]] - _ -> unexpected "type" $ show typ - where - -- SHACL's built-in vocabulary is less expressive than Hydra's type system, so for now, SHACL validation simply ends - -- when inexpressible types are encountered. However, certain constructs such as lists can be validated using - -- secondary structures. For example, see shsh:ListShape in the SHACL documentation. TODO: explore these constructions. - any = pure $ common [] - -node :: [Shacl.CommonConstraint] -> Shacl.Shape -node = Shacl.ShapeNode . Shacl.NodeShape . common - -property :: Rdf.Iri -> Shacl.PropertyShape -property iri = Shacl.PropertyShape { - Shacl.propertyShapeCommon = defaultCommonProperties, - Shacl.propertyShapeConstraints = S.empty, - Shacl.propertyShapeDefaultValue = Nothing, - Shacl.propertyShapeDescription = emptyLangStrings, - Shacl.propertyShapeName = emptyLangStrings, - Shacl.propertyShapeOrder = Nothing, - Shacl.propertyShapePath = iri} - -withType :: Name -> Rdf.Description -> Rdf.Description -withType name (Rdf.Description subj (Rdf.Graph triples)) = Rdf.Description subj (Rdf.Graph $ S.insert triple triples) - where - subjRes = case subj of - Rdf.NodeIri iri -> Rdf.ResourceIri iri - Rdf.NodeBnode bnode -> Rdf.ResourceBnode bnode - triple = Rdf.Triple subjRes (rdfIri "type") (Rdf.NodeIri $ nameToIri name) diff --git a/src/main/haskell/Hydra/Langs/Shacl/Language.hs b/src/main/haskell/Hydra/Langs/Shacl/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Shacl/Language.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Hydra.Langs.Shacl.Language where - -import Hydra.Kernel - -import qualified Data.Set as S - - -shaclLanguage :: Language -shaclLanguage = Language (LanguageName "hydra/langs/shacl") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.empty, - languageConstraintsLiteralVariants = S.fromList literalVariants, - languageConstraintsFloatTypes = S.fromList floatTypes, - languageConstraintsFunctionVariants = S.empty, - languageConstraintsIntegerTypes = S.fromList integerTypes, - languageConstraintsTermVariants = S.fromList [ - TermVariantList, - TermVariantLiteral, - TermVariantMap, - TermVariantWrap, - TermVariantOptional, - TermVariantRecord, - TermVariantSet, - TermVariantUnion], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantAnnotated, - TypeVariantList, - TypeVariantLiteral, - TypeVariantMap, - TypeVariantWrap, - TypeVariantOptional, - TypeVariantRecord, - TypeVariantSet, - TypeVariantUnion], - languageConstraintsTypes = const True } diff --git a/src/main/haskell/Hydra/Langs/Tinkerpop/Coder.hs b/src/main/haskell/Hydra/Langs/Tinkerpop/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Tinkerpop/Coder.hs +++ /dev/null @@ -1,353 +0,0 @@ -module Hydra.Langs.Tinkerpop.Coder ( - elementCoder, -) where - -import Hydra.Kernel -import Hydra.Langs.Tinkerpop.Mappings -import Hydra.Langs.Tinkerpop.TermsToElements -import qualified Hydra.Langs.Tinkerpop.PropertyGraph as PG -import qualified Hydra.Dsl.Expect as Expect -import qualified Hydra.Dsl.Terms as Terms - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -type ElementAdapter s t v = Adapter s s (Type) (PG.ElementTypeTree t) (Term) (PG.ElementTree v) - -type PropertyAdapter s t v = Adapter s s (FieldType) (PG.PropertyType t) (Field) (PG.Property v) - -type IdAdapter s t v = (Name, Adapter s s (Type) t (Term) v) - -data AdjacentEdgeAdapter s a t v = AdjacentEdgeAdapter { - adjacentEdgeAdapterDirection :: PG.Direction, - adjacentEdgeAdapterField :: FieldType, - adjacentEdgeAdapterLabel :: PG.EdgeLabel, - adjacentEdgeAdapterAdapter :: ElementAdapter s t v} - -data ProjectionSpec a = ProjectionSpec { - projectionSpecField :: FieldType, - projectionSpecValues :: ValueSpec, - projectionSpecAlias :: Maybe String} - -check :: Bool -> Flow s () -> Flow s () -check b err = if b then pure () else err - -checkRecordName expected actual = check (actual == expected) $ - unexpected ("record of type " ++ unName expected) ("record of type " ++ unName actual) - -edgeCoder :: PG.Direction -> Schema s t v - -> Type - -> t - -> Name - -> PG.EdgeLabel -> PG.VertexLabel -> PG.VertexLabel - -> Maybe (IdAdapter s t v) -> Maybe (IdAdapter s t v) -> Maybe (IdAdapter s t v) -> [PropertyAdapter s t v] - -> ElementAdapter s t v -edgeCoder dir schema source eidType tname label outLabel inLabel mIdAdapter outAdapter inAdapter propAdapters - = Adapter lossy source (elementTypeTreeEdge et []) coder - where - et = PG.EdgeType label eidType outLabel inLabel $ propertyTypes propAdapters - coder = Coder encode decode - where - encode term = case stripTerm term of - TermOptional (Just ot) -> encode ot - TermRecord (Record tname' fields) -> do - checkRecordName tname tname' - let fieldsm = fieldMap fields - id <- case mIdAdapter of - Nothing -> pure $ schemaDefaultEdgeId schema - Just ad -> selectEdgeId fieldsm ad - props <- encodeProperties fieldsm propAdapters - outId <- getVertexId PG.DirectionOut fieldsm outAdapter - inId <- getVertexId PG.DirectionIn fieldsm inAdapter - return $ elementTreeEdge (PG.Edge label id outId inId props) [] - _ -> unexpected "record (1)" $ show term - decode el = noDecoding "edge" - getVertexId dir1 fieldsm adapter = if dir1 == dir - then pure $ schemaDefaultVertexId schema - else case adapter of - Nothing -> fail $ "no adapter for " ++ show dir1 ++ " with " ++ show dir - Just ad -> selectVertexId fieldsm ad - -elementCoder :: (Show t, Show v) => Y.Maybe (PG.Direction, PG.VertexLabel) - -> Schema s t v - -> Type - -> t -> t - -> Flow s (ElementAdapter s t v) -elementCoder mparent schema source vidType eidType = case stripType source of - TypeOptional ot -> elementCoder mparent schema ot vidType eidType - TypeRecord (RowType name _ fields) -> withTrace ("adapter for " ++ unName name) $ do - mOutSpec <- findProjectionSpec name outVertexKey outVertexLabelKey fields - mInSpec <- findProjectionSpec name inVertexKey inVertexLabelKey fields - - -- TODO: deprecate "kind" - kind <- case getTypeAnnotation "kind" source of - Nothing -> pure $ if hasVertexAdapters mOutSpec mInSpec - then PG.ElementKindEdge - else PG.ElementKindVertex - Just kindTerm -> do - s <- Expect.string kindTerm - case s of - "vertex" -> return PG.ElementKindVertex - "edge" -> if Y.isNothing mOutSpec || Y.isNothing mInSpec - then fail $ "Record type marked as an edge type, but missing 'out' and/or 'in' fields: " ++ unName name - else return PG.ElementKindEdge - - propSpecs <- findPropertySpecs kind fields - propAdapters <- CM.mapM (propertyAdapter schema) propSpecs - - case kind of - PG.ElementKindVertex -> do - label <- PG.VertexLabel <$> findLabelString name vertexLabelKey - idAdapter <- vertexIdAdapter name vertexIdKey fields - outEdgeAdapters <- edgeAdapters label PG.DirectionOut fields - inEdgeAdapters <- edgeAdapters label PG.DirectionIn fields - return $ vertexCoder schema source vidType name label idAdapter propAdapters (outEdgeAdapters ++ inEdgeAdapters) - PG.ElementKindEdge -> do - label <- PG.EdgeLabel <$> findLabelString name edgeLabelKey - idAdapter <- edgeIdAdapter name edgeIdKey fields - outAdapter <- Y.maybe (pure Nothing) (\s -> Just <$> projectionAdapter vidType (schemaVertexIds schema) s "out") mOutSpec - inAdapter <- Y.maybe (pure Nothing) (\s -> Just <$> projectionAdapter vidType (schemaVertexIds schema) s "in") mInSpec - outLabel <- case mOutSpec of - Nothing -> pure parentLabel - Just spec -> Y.maybe (fail "no out-vertex label") (pure . PG.VertexLabel) $ projectionSpecAlias spec - inLabel <- case mInSpec of - Nothing -> pure parentLabel - Just spec -> Y.maybe (fail "no in-vertex label") (pure . PG.VertexLabel) $ projectionSpecAlias spec - return $ edgeCoder dir schema source eidType name label outLabel inLabel idAdapter outAdapter inAdapter propAdapters - - _ -> unexpected "record type" $ show source - where - dir = Y.maybe PG.DirectionBoth fst mparent - parentLabel = Y.maybe (PG.VertexLabel "NOLABEL") snd mparent - - vertexIdAdapter name idKey fields = do - idSpec <- Y.fromJust <$> findId True name idKey fields - idAdapter <- projectionAdapter vidType (schemaVertexIds schema) idSpec "id" - return idAdapter - - edgeIdAdapter name idKey fields = do - mIdSpec <- findId False name idKey fields - case mIdSpec of - Nothing -> pure Nothing - Just idSpec -> Just <$> projectionAdapter eidType (schemaEdgeIds schema) idSpec "id" - - hasVertexAdapters mOutSpec mInSpec = case dir of - PG.DirectionOut -> Y.isJust mInSpec - PG.DirectionIn -> Y.isJust mOutSpec - PG.DirectionBoth -> Y.isJust mOutSpec && Y.isJust mInSpec - - vertexLabelKey = annotationSchemaVertexLabel $ schemaAnnotations schema - edgeLabelKey = annotationSchemaEdgeLabel $ schemaAnnotations schema - vertexIdKey = annotationSchemaVertexId $ schemaAnnotations schema - edgeIdKey = annotationSchemaEdgeId $ schemaAnnotations schema - propertyKeyKey = annotationSchemaPropertyKey $ schemaAnnotations schema - propertyValueKey = annotationSchemaPropertyValue $ schemaAnnotations schema - outVertexKey = annotationSchemaOutVertex $ schemaAnnotations schema - outVertexLabelKey = annotationSchemaOutVertexLabel $ schemaAnnotations schema - inVertexKey = annotationSchemaInVertex $ schemaAnnotations schema - inVertexLabelKey = annotationSchemaInVertexLabel $ schemaAnnotations schema - outEdgeLabelKey = annotationSchemaOutEdgeLabel $ schemaAnnotations schema - inEdgeLabelKey = annotationSchemaInEdgeLabel $ schemaAnnotations schema - ignoreKey = annotationSchemaIgnore $ schemaAnnotations schema - - findLabelString tname labelKey = case getTypeAnnotation labelKey source of - Nothing -> pure $ unName tname - Just labelTerm -> Expect.string labelTerm - - findId required tname idKey fields = withTrace "find id field" $ do - mid <- findField tname idKey fields - case mid of - Nothing -> if required - then fail $ "no " ++ idKey ++ " field" - else pure Nothing - Just mi -> do - spec <- case getTypeAnnotation idKey (fieldTypeType mi) of - Nothing -> pure ValueSpecValue - Just t -> decodeValueSpec t - return $ Just $ ProjectionSpec mi spec Nothing - - findProjectionSpec tname key aliasKey fields = withTrace ("find " ++ show key ++ " projection") $ do - mfield <- findField tname key fields - case mfield of - Nothing -> pure Nothing - Just field -> do - spec <- decodeValueSpec $ Y.fromJust $ getTypeAnnotation key $ fieldTypeType field - alias <- case getTypeAnnotation aliasKey $ fieldTypeType field of - Nothing -> pure Nothing - Just t -> Just <$> Expect.string t - return $ Just $ ProjectionSpec field spec alias - - findField tname key fields = withTrace ("find " ++ show key ++ " field") $ do - let matches = L.filter (\f -> Y.isJust $ getTypeAnnotation key $ fieldTypeType f) fields - if L.length matches > 1 - then fail $ "Multiple fields marked as '" ++ key ++ "' in record type " ++ unName tname ++ ": " - ++ (L.intercalate ", " (unName . fieldTypeName <$> matches)) - else return $ if L.null matches then Nothing else Just $ L.head matches - - findPropertySpecs kind fields = CM.mapM toSpec $ L.filter isPropField fields - where - isPropField field = not (hasSpecialAnnotation || hasSpecialFieldName) - where - hasSpecialAnnotation = L.foldl (\b k -> b || hasAnnotation k) False (ignoreKey:specialKeys) - hasSpecialFieldName = L.foldl (\b n -> b || hasName n) False specialKeys - specialKeys = case kind of - PG.ElementKindVertex -> [vertexIdKey, outEdgeLabelKey, inEdgeLabelKey] - PG.ElementKindEdge -> [edgeIdKey, outVertexKey, inVertexKey] - hasAnnotation key = Y.isJust $ getTypeAnnotation key $ fieldTypeType field - hasName fname = fieldTypeName field == Name fname - toSpec field = do - alias <- case (getTypeAnnotation propertyKeyKey $ fieldTypeType field) of - Nothing -> pure Nothing - Just a -> Just <$> Expect.string a - values <- case (getTypeAnnotation propertyValueKey $ fieldTypeType field) of - Nothing -> pure ValueSpecValue - Just sp -> decodeValueSpec sp - return $ ProjectionSpec field values alias - - edgeAdapters vlabel dir fields = Y.catMaybes <$> CM.mapM toSpec fields - where - toSpec field = case getTypeAnnotation key (fieldTypeType field) of - Nothing -> pure Nothing - Just a -> do - label <- PG.EdgeLabel <$> Expect.string a - elad <- elementCoder (Just (dir, vlabel)) schema (fieldTypeType field) vidType eidType - return $ Just $ AdjacentEdgeAdapter dir field label elad - key = case dir of - PG.DirectionOut -> outEdgeLabelKey - PG.DirectionIn -> inEdgeLabelKey - -elementTreeEdge :: PG.Edge v -> [PG.ElementTree v] -> PG.ElementTree v -elementTreeEdge edge = PG.ElementTree (PG.ElementEdge edge) - -elementTreeVertex :: PG.Vertex v -> [PG.ElementTree v] -> PG.ElementTree v -elementTreeVertex vertex = PG.ElementTree (PG.ElementVertex vertex) - -elementTypeTreeEdge :: PG.EdgeType t -> [PG.ElementTypeTree t] -> PG.ElementTypeTree t -elementTypeTreeEdge etype = PG.ElementTypeTree (PG.ElementTypeEdge etype) - -elementTypeTreeVertex :: PG.VertexType t -> [PG.ElementTypeTree t] -> PG.ElementTypeTree t -elementTypeTreeVertex vtype = PG.ElementTypeTree (PG.ElementTypeVertex vtype) - -encodeProperties :: M.Map Name (Term) -> [PropertyAdapter s t v] -> Flow s (M.Map PG.PropertyKey v) -encodeProperties fields adapters = do - props <- Y.catMaybes <$> CM.mapM (encodeProperty fields) adapters - return $ M.fromList $ fmap (\(PG.Property key val) -> (key, val)) props - -encodeProperty :: M.Map Name (Term) -> PropertyAdapter s t v -> Flow s (Maybe (PG.Property v)) -encodeProperty fields adapter = do - case M.lookup fname fields of - Nothing -> case ftyp of - TypeOptional _ -> pure Nothing - _ -> fail $ "expected field not found in record: " ++ unName fname - Just value -> case ftyp of - TypeOptional _ -> case stripTerm value of - TermOptional ov -> case ov of - Nothing -> pure Nothing - Just v -> Just <$> encodeValue v - _ -> unexpected "optional term" $ show value - _ -> Just <$> encodeValue value - where - fname = fieldTypeName $ adapterSource adapter - ftyp = stripType (fieldTypeType $ adapterSource adapter) - encodeValue v = coderEncode (adapterCoder adapter) (Field fname v) - --- TODO; infer lossiness -lossy = True - -noDecoding :: String -> Flow s x -noDecoding cat = fail $ cat ++ " decoding is not yet supported" - -projectionAdapter :: t - -> Coder s s (Term) v - -> ProjectionSpec a - -> String - -> Flow s (IdAdapter s t v) -projectionAdapter idtype coder spec key = do - traversal <- parseValueSpec $ projectionSpecValues spec - let field = projectionSpecField spec - let encode = \typ -> traverseToSingleTerm (key ++ "-projection") traversal typ >>= coderEncode coder - return (fieldTypeName field, Adapter lossy (fieldTypeType field) idtype $ Coder encode decode) - where - decode _ = noDecoding $ "edge '" ++ key ++ "'" - -propertyAdapter :: Schema s t v -> ProjectionSpec a -> Flow s (PropertyAdapter s t v) -propertyAdapter schema (ProjectionSpec tfield values alias) = do - let key = PG.PropertyKey $ case alias of - Nothing -> unName $ fieldTypeName tfield - Just k -> k - pt <- coderEncode (schemaPropertyTypes schema) $ fieldTypeType tfield - traversal <- parseValueSpec values - let coder = Coder encode decode - where - encode dfield = withTrace ("encode property field " ++ show (unName $ fieldTypeName tfield)) $ do - if fieldName dfield /= fieldTypeName tfield - then unexpected ("field '" ++ unName (fieldTypeName tfield) ++ "'") $ show dfield - else do - result <- traverseToSingleTerm "property traversal" traversal $ fieldTerm dfield - value <- coderEncode (schemaPropertyValues schema) result - return $ PG.Property key value - decode _ = noDecoding "property" - return $ Adapter lossy tfield (PG.PropertyType key pt True) coder - -propertyTypes propAdapters = toPropertyType <$> propAdapters - where - toPropertyType a = PG.PropertyType (PG.propertyTypeKey $ adapterTarget a) (PG.propertyTypeValue $ adapterTarget a) True - -selectEdgeId fields (fname, ad) = case M.lookup fname fields of - Nothing -> fail $ "no " ++ unName fname ++ " in record" - Just t -> coderEncode (adapterCoder ad) t - -selectVertexId :: M.Map Name (Term) -> IdAdapter s t v -> Flow s v -selectVertexId fields (fname, ad) = case M.lookup fname fields of - Nothing -> fail $ "no " ++ unName fname ++ " in record" - Just t -> coderEncode (adapterCoder ad) t - -traverseToSingleTerm :: String -> (Term -> Flow s [Term]) -> Term -> Flow s (Term) -traverseToSingleTerm desc traversal term = do - terms <- traversal term - case terms of - [] -> fail $ desc ++ " did not resolve to a term" - [t] -> pure t - _ -> fail $ desc ++ " resolved to multiple terms" - -vertexCoder :: (Show t, Show v) - => Schema s t v - -> Type - -> t - -> Name - -> PG.VertexLabel -> IdAdapter s t v -> [PropertyAdapter s t v] - -> [AdjacentEdgeAdapter s a t v] - -> ElementAdapter s t v -vertexCoder schema source vidType tname label idAdapter propAdapters edgeAdapters = Adapter lossy source target coder - where - target = elementTypeTreeVertex vtype depTypes - vtype = PG.VertexType label vidType $ propertyTypes propAdapters - depTypes = adapterTarget . adjacentEdgeAdapterAdapter <$> edgeAdapters - coder = Coder encode decode - where - encode term = case stripTerm term of - TermOptional (Just ot) -> encode ot - TermRecord (Record tname' fields) -> do - checkRecordName tname tname' - let fieldsm = fieldMap fields - vid <- selectVertexId fieldsm idAdapter - props <- encodeProperties (fieldMap fields) propAdapters - deps <- Y.catMaybes <$> CM.mapM (findDeps vid fieldsm) edgeAdapters - return $ elementTreeVertex (PG.Vertex label vid props) deps - _ -> unexpected "record (2)" $ show term - where - findDeps vid fieldsm (AdjacentEdgeAdapter dir field label ad) = do - case M.lookup (fieldTypeName field) fieldsm of - Nothing -> pure Nothing - Just fterm -> Just <$> (coderEncode (adapterCoder ad) fterm >>= fixTree) - where - fixTree tree = case PG.elementTreeSelf tree of - PG.ElementEdge e -> pure $ tree {PG.elementTreeSelf = PG.ElementEdge $ fixEdge e} - _ -> unexpected "edge tree" $ show tree - fixEdge e = case dir of - PG.DirectionOut -> e {PG.edgeOut = vid} - PG.DirectionIn -> e {PG.edgeIn = vid} - decode el = noDecoding "vertex" diff --git a/src/main/haskell/Hydra/Langs/Tinkerpop/Language.hs b/src/main/haskell/Hydra/Langs/Tinkerpop/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Tinkerpop/Language.hs +++ /dev/null @@ -1,96 +0,0 @@ -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 name features extras = Language name $ LanguageConstraints { - languageConstraintsEliminationVariants = S.empty, - - languageConstraintsLiteralVariants = S.fromList $ Y.catMaybes [ - -- Binary values map to byte arrays. Lists of uint8 also map to byte arrays. - cond LiteralVariantBinary (dataTypeFeaturesSupportsByteArrayValues vpFeatures), - cond LiteralVariantBoolean (dataTypeFeaturesSupportsBooleanValues vpFeatures), - cond LiteralVariantFloat (dataTypeFeaturesSupportsFloatValues vpFeatures - || dataTypeFeaturesSupportsDoubleValues vpFeatures), - cond LiteralVariantInteger (dataTypeFeaturesSupportsIntegerValues vpFeatures - || dataTypeFeaturesSupportsLongValues vpFeatures), - cond LiteralVariantString (dataTypeFeaturesSupportsStringValues vpFeatures)], - - languageConstraintsFloatTypes = S.fromList $ Y.catMaybes [ - cond FloatTypeFloat32 (dataTypeFeaturesSupportsFloatValues vpFeatures), - cond FloatTypeFloat64 (dataTypeFeaturesSupportsDoubleValues vpFeatures)], - - languageConstraintsFunctionVariants = S.empty, - - languageConstraintsIntegerTypes = S.fromList $ Y.catMaybes [ - cond IntegerTypeInt32 (dataTypeFeaturesSupportsIntegerValues vpFeatures), - cond IntegerTypeInt64 (dataTypeFeaturesSupportsLongValues vpFeatures)], - - -- Only lists and literal values may be explicitly supported via Graph.Features. - languageConstraintsTermVariants = S.fromList $ Y.catMaybes [ - cond TermVariantList supportsLists, - cond TermVariantLiteral supportsLiterals, - cond TermVariantMap supportsMaps, - -- An optional value translates to an absent vertex property - Just TermVariantOptional], - - languageConstraintsTypeVariants = S.fromList $ Y.catMaybes [ - cond TypeVariantList supportsLists, - cond TypeVariantLiteral supportsLiterals, - cond TypeVariantMap supportsMaps, - Just TypeVariantOptional, - Just TypeVariantWrap], - - languageConstraintsTypes = \typ -> case stripType typ of - -- Only lists of literal values are supported, as nothing else is mentioned in Graph.Features - TypeList t -> case stripType t of - TypeLiteral lt -> case lt of - LiteralTypeBoolean -> dataTypeFeaturesSupportsBooleanArrayValues vpFeatures - LiteralTypeFloat ft -> case ft of - FloatTypeFloat64 -> dataTypeFeaturesSupportsDoubleArrayValues vpFeatures - FloatTypeFloat32 -> dataTypeFeaturesSupportsFloatArrayValues vpFeatures - _ -> False - LiteralTypeInteger it -> case it of - IntegerTypeUint8 -> dataTypeFeaturesSupportsByteArrayValues vpFeatures - IntegerTypeInt32 -> dataTypeFeaturesSupportsIntegerArrayValues vpFeatures - IntegerTypeInt64 -> dataTypeFeaturesSupportsLongArrayValues vpFeatures - _ -> False - LiteralTypeString -> dataTypeFeaturesSupportsStringArrayValues vpFeatures - _ -> False - _ -> False - TypeLiteral _ -> True - TypeMap (MapType kt _) -> extraFeaturesSupportsMapKey extras kt - TypeWrap _ -> True - TypeOptional ot -> case stripType ot of - TypeLiteral _ -> True - _ -> False - _ -> True} - - where - cond v b = if b then Just v else Nothing - - vpFeatures = vertexPropertyFeaturesDataTypeFeatures $ vertexFeaturesProperties $ featuresVertex features - - supportsLists = dataTypeFeaturesSupportsBooleanArrayValues vpFeatures - || dataTypeFeaturesSupportsByteArrayValues vpFeatures - || dataTypeFeaturesSupportsDoubleArrayValues vpFeatures - || dataTypeFeaturesSupportsFloatArrayValues vpFeatures - || dataTypeFeaturesSupportsIntegerArrayValues vpFeatures - || dataTypeFeaturesSupportsLongArrayValues vpFeatures - || dataTypeFeaturesSupportsStringArrayValues vpFeatures - - -- Support for at least one of the Graph.Features literal types is assumed. - supportsLiterals = True - - -- Note: additional constraints are required, beyond Graph.Features, if maps are supported - supportsMaps = dataTypeFeaturesSupportsMapValues vpFeatures diff --git a/src/main/haskell/Hydra/Langs/Tinkerpop/TermsToElements.hs b/src/main/haskell/Hydra/Langs/Tinkerpop/TermsToElements.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Tinkerpop/TermsToElements.hs +++ /dev/null @@ -1,251 +0,0 @@ -module Hydra.Langs.Tinkerpop.TermsToElements ( - decodeValueSpec, - parseValueSpec, - termToElementsAdapter, -) where - -import Hydra.Kernel -import Hydra.Langs.Tinkerpop.Mappings -import qualified Hydra.Langs.Tinkerpop.PropertyGraph as PG -import qualified Hydra.Dsl.Expect as Expect -import qualified Hydra.Dsl.Terms as Terms - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.List.Split as LS -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -type PgAdapter s v = Adapter s s Type [PG.Label] Term [PG.Element v] - -termToElementsAdapter :: Schema s t v -> Type -> Flow s (PgAdapter s v) -termToElementsAdapter schema typ = do - case getTypeAnnotation "elements" typ of - Nothing -> pure trivialAdapter - Just term -> do - specs <- Expect.list decodeElementSpec term >>= CM.mapM (parseElementSpec schema) - let labels = L.nub (fst <$> specs) - let encoders = snd <$> specs - let encode term = L.concat <$> CM.mapM (\e -> e term) encoders - return $ Adapter lossy typ labels $ Coder encode (\els -> noDecoding "element") - where - trivialAdapter = Adapter False typ [] $ Coder (\term -> pure []) (\el -> fail "no corresponding element type") - --- TODO; infer lossiness -lossy = False - -noDecoding :: String -> Flow s x -noDecoding cat = fail $ cat ++ " decoding is not yet supported" - -parseEdgeIdPattern :: Schema s t v -> ValueSpec -> Flow s (Term -> Flow s [v]) -parseEdgeIdPattern schema spec = do - fun <- parseValueSpec spec - return $ \term -> fun term >>= CM.mapM (coderEncode $ schemaEdgeIds schema) - -parseEdgeSpec :: Schema s t v -> EdgeSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v]) -parseEdgeSpec schema (EdgeSpec label id outV inV props) = do - getId <- parseEdgeIdPattern schema id - getOut <- parseVertexIdPattern schema outV - getIn <- parseVertexIdPattern schema inV - getProps <- CM.mapM (parsePropertySpec schema) props - let encode term = withTrace "encode as edge" $ do - tid <- requireUnique "edge id" getId term - tout <- requireUnique "vertex id" getOut term - tin <- requireUnique "edge id" getIn term - tprops <- M.fromList <$> CM.mapM (\g -> requireUnique "property key" g term) getProps - return [PG.ElementEdge $ PG.Edge label tid tout tin tprops] - return (PG.LabelEdge label, encode) - -parseElementSpec :: Schema s t v -> ElementSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v]) -parseElementSpec schema spec = case spec of - ElementSpecVertex vspec -> parseVertexSpec schema vspec - ElementSpecEdge espec -> parseEdgeSpec schema espec - -parsePattern :: String -> Flow s (Term -> Flow s [Term]) -parsePattern pat = withTrace "parse path pattern" $ do - (lits, paths) <- parsePattern [] [] "" pat - return $ traverse lits paths - where - parsePattern lits paths cur s = case s of - [] -> pure (L.reverse (nextLit:lits), L.reverse paths) - ('$':'{':rest) -> parsePath (nextLit:lits) paths "" rest - (c:rest) -> parsePattern lits paths (c:cur) rest - where - nextLit = L.reverse cur - parsePath lits paths cur s = case s of - [] -> fail $ "Unfinished path expression: " ++ pat - ('}':rest) -> parsePattern lits (path:paths) "" rest - where - path = LS.splitOn "/" $ L.reverse cur - (c:rest) -> parsePath lits paths (c:cur) rest - traverse lits paths term = withTrace ("traverse pattern: " ++ pat) $ recurse [""] True lits paths - where - recurse values lp lits paths = if L.null values - then pure [] - else if lp - -- Try to apply a literal - then case lits of - -- All done. The last segment is always a literal. - [] -> return $ Terms.string <$> values - -- Append the literal and continue traversing. - (l:rest) -> recurse (append l) False rest paths - -- Try to apply a path - else case paths of - -- No more paths; continue with literals - [] -> recurse values True lits [] - -- Apply the next path - (path:rest) -> do - strings <- evalPath path term >>= CM.mapM toString - recurse (appendAll strings) True lits rest - where - append s = fmap (\v -> v ++ s) values - appendAll strings = L.concat (append <$> strings) - evalPath path term = case path of - [] -> pure [term] - (step:rest) -> do - results <- evalStep step term - L.concat <$> (CM.mapM (evalPath rest) results) - where - evalStep step term = if L.null step - then pure [term] - else case stripTerm term of - TermList terms -> L.concat <$> CM.mapM (evalStep step) terms - TermOptional mt -> case mt of - Nothing -> pure [] - Just term' -> evalStep step term' - TermRecord (Record _ fields) -> case M.lookup (Name step) (fieldMap fields) of - Nothing -> fail $ "No such field " ++ step ++ " in record: " ++ show term - Just term' -> pure [term'] - TermUnion (Injection _ field) -> if unName (fieldName field) == step - then evalStep step $ fieldTerm field - else pure [] -- Note: not checking the step against the union type; assuming it is correct but that it references a field unused by the injection - TermWrap (WrappedTerm _ term') -> evalStep step term' - _ -> fail $ "Can't traverse through term for step " ++ show step ++ ": " ++ show term - - -- TODO: replace this with a more standard function - toString term = case stripTerm term of - TermLiteral lit -> pure $ case lit of - LiteralBinary b -> b - LiteralBoolean b -> show b - LiteralInteger i -> case i of - IntegerValueBigint v -> show v - IntegerValueInt8 v -> show v - IntegerValueInt16 v -> show v - IntegerValueInt32 v -> show v - IntegerValueInt64 v -> show v - IntegerValueUint8 v -> show v - IntegerValueUint16 v -> show v - IntegerValueUint32 v -> show v - IntegerValueUint64 v -> show v - LiteralFloat f -> case f of - FloatValueBigfloat v -> show v - FloatValueFloat32 v -> show v - FloatValueFloat64 v -> show v - LiteralString s -> s - TermOptional mt -> case mt of - Nothing -> pure "nothing" - Just t -> toString t - _ -> pure $ show term - -parsePropertySpec :: Schema s t v -> PropertySpec -> Flow s (Term -> Flow s [(PG.PropertyKey, v)]) -parsePropertySpec schema (PropertySpec key value) = withTrace "parse property spec" $ do - fun <- parseValueSpec value - return $ \term -> withTrace ("encode property " ++ PG.unPropertyKey key) $ do - results <- fun term - values <- CM.mapM (coderEncode $ schemaPropertyValues schema) results - return $ fmap (\v -> (key, v)) values - -parseValueSpec :: ValueSpec -> Flow s (Term -> Flow s [Term]) -parseValueSpec spec = case spec of - ValueSpecValue -> pure $ \term -> pure [term] - ValueSpecPattern pat -> parsePattern pat - -parseVertexIdPattern :: Schema s t v -> ValueSpec -> Flow s (Term -> Flow s [v]) -parseVertexIdPattern schema spec = do - fun <- parseValueSpec spec - return $ \term -> fun term >>= CM.mapM (coderEncode $ schemaVertexIds schema) - -parseVertexSpec :: Schema s t v -> VertexSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v]) -parseVertexSpec schema (VertexSpec label id props) = do - getId <- parseVertexIdPattern schema id - getProps <- CM.mapM (parsePropertySpec schema) props - let encode term = withTrace "encode as vertex" $ do - tid <- requireUnique "vertex id" getId term - tprops <- M.fromList <$> CM.mapM (\g -> requireUnique "property key" g term) getProps - return [PG.ElementVertex $ PG.Vertex label tid tprops] - return (PG.LabelVertex label, encode) - -requireUnique :: String -> (Term -> Flow s [x]) -> Term -> Flow s x -requireUnique context fun term = do - results <- fun term - case results of - [] -> fail $ "No value found: " ++ context - [value] -> pure value - _ -> fail $ "Multiple values found: " ++ context - - --- Element spec decoding. TODO: this should code should really be generated rather than hand-written. - -decodeEdgeLabel :: Term -> Flow s PG.EdgeLabel -decodeEdgeLabel t = PG.EdgeLabel <$> Expect.string t - -decodeEdgeSpec :: Term -> Flow s EdgeSpec -decodeEdgeSpec term = withTrace "decode edge spec" $ matchRecord (\fields -> EdgeSpec - <$> readField fields _EdgeSpec_label decodeEdgeLabel - <*> readField fields _EdgeSpec_id decodeValueSpec - <*> readField fields _EdgeSpec_out decodeValueSpec - <*> readField fields _EdgeSpec_in decodeValueSpec - <*> readField fields _EdgeSpec_properties (Expect.list decodePropertySpec)) term - -decodeElementSpec :: Term -> Flow s ElementSpec -decodeElementSpec term = withTrace "decode element spec" $ matchInjection [ - (_ElementSpec_vertex, \t -> ElementSpecVertex <$> decodeVertexSpec t), - (_ElementSpec_edge, \t -> ElementSpecEdge <$> decodeEdgeSpec t)] term - -decodePropertyKey :: Term -> Flow s PG.PropertyKey -decodePropertyKey t = PG.PropertyKey <$> Expect.string t - -decodePropertySpec :: Term -> Flow s PropertySpec -decodePropertySpec term = withTrace "decode property spec" $ matchRecord (\fields -> PropertySpec - <$> readField fields _PropertySpec_key decodePropertyKey - <*> readField fields _PropertySpec_value decodeValueSpec) term - -decodeValueSpec :: Term -> Flow s ValueSpec -decodeValueSpec term = withTrace "decode value spec" $ case stripTerm term of - -- Allow an abbreviated specification consisting of only the pattern string - TermLiteral (LiteralString s) -> pure $ ValueSpecPattern s - _ -> matchInjection [ - (_ValueSpec_value, \t -> pure ValueSpecValue), - (_ValueSpec_pattern, \t -> ValueSpecPattern <$> Expect.string t)] term - -decodeVertexLabel :: Term -> Flow s PG.VertexLabel -decodeVertexLabel t = PG.VertexLabel <$> Expect.string t - -decodeVertexSpec :: Term -> Flow s VertexSpec -decodeVertexSpec term = withTrace "decode vertex spec" $ matchRecord (\fields -> VertexSpec - <$> readField fields _VertexSpec_label decodeVertexLabel - <*> readField fields _VertexSpec_id decodeValueSpec - <*> readField fields _VertexSpec_properties (Expect.list decodePropertySpec)) term - - --- General-purpose code for decoding - -matchInjection :: [(Name, Term -> Flow s x)] -> Term -> Flow s x -matchInjection cases encoded = do - mp <- Expect.map (\k -> Name <$> Expect.string k) pure encoded - f <- case M.toList mp of - [] -> fail "empty injection" - [(k, v)] -> pure $ Field k v - _ -> fail $ "invalid injection: " ++ show mp - case snd <$> (L.filter (\c -> fst c == fieldName f) cases) of - [] -> fail $ "unexpected field: " ++ unName (fieldName f) - [fun] -> fun (fieldTerm f) - _ -> fail "duplicate field name in cases" - -matchRecord :: (M.Map Name Term -> Flow s x) -> Term -> Flow s x -matchRecord cons term = Expect.map (\k -> Name <$> Expect.string k) pure term >>= cons - -readField fields fname fun = case M.lookup fname fields of - Nothing -> fail $ "no such field: " ++ unName fname - Just t -> fun t diff --git a/src/main/haskell/Hydra/Langs/Yaml/Coder.hs b/src/main/haskell/Hydra/Langs/Yaml/Coder.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Yaml/Coder.hs +++ /dev/null @@ -1,116 +0,0 @@ -module Hydra.Langs.Yaml.Coder (yamlCoder) where - -import Hydra.Kernel -import Hydra.TermAdapters -import Hydra.Langs.Yaml.Language -import Hydra.AdapterUtils -import qualified Hydra.Langs.Yaml.Model as YM -import qualified Hydra.Dsl.Terms as Terms - -import qualified Control.Monad as CM -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -literalCoder :: LiteralType -> Flow (Graph) (Coder (Graph) (Graph) Literal YM.Scalar) -literalCoder at = pure $ case at of - LiteralTypeBoolean -> Coder { - coderEncode = \(LiteralBoolean b) -> pure $ YM.ScalarBool b, - coderDecode = \s -> case s of - YM.ScalarBool b -> pure $ LiteralBoolean b - _ -> unexpected "boolean" $ show s} - LiteralTypeFloat _ -> Coder { - coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ YM.ScalarFloat f, - coderDecode = \s -> case s of - YM.ScalarFloat f -> pure $ LiteralFloat $ FloatValueBigfloat f - _ -> unexpected "floating-point value" $ show s} - LiteralTypeInteger _ -> Coder { - coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ YM.ScalarInt i, - coderDecode = \s -> case s of - YM.ScalarInt i -> pure $ LiteralInteger $ IntegerValueBigint i - _ -> unexpected "integer" $ show s} - LiteralTypeString -> Coder { - coderEncode = \(LiteralString s) -> pure $ YM.ScalarStr s, - coderDecode = \s -> case s of - YM.ScalarStr s' -> pure $ LiteralString s' - _ -> unexpected "string" $ show s} - -recordCoder :: RowType -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node) -recordCoder rt = do - coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt) - return $ Coder (encode coders) (decode coders) - where - encode coders term = case stripTerm term of - TermRecord (Record _ fields) -> YM.NodeMapping . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields - where - encodeField (ft, coder) (Field (Name fn) fv) = case (fieldTypeType ft, fv) of - (TypeOptional _, TermOptional Nothing) -> pure Nothing - _ -> Just <$> ((,) <$> pure (yamlString fn) <*> coderEncode coder fv) - _ -> unexpected "record" $ show term - decode coders n = case n of - YM.NodeMapping m -> Terms.record (rowTypeTypeName rt) <$> - CM.mapM (decodeField m) coders -- Note: unknown fields are ignored - where - decodeField a (FieldType fname@(Name fn) ft, coder) = do - v <- coderDecode coder $ Y.fromMaybe yamlNull $ M.lookup (yamlString fn) m - return $ Field fname v - _ -> unexpected "mapping" $ show n - getCoder coders fname = Y.maybe error pure $ M.lookup fname coders - where - error = fail $ "no such field: " ++ fname - -termCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node) -termCoder typ = case stripType typ of - TypeLiteral at -> do - ac <- literalCoder at - return Coder { - coderEncode = \t -> case t of - TermLiteral av -> YM.NodeScalar <$> coderEncode ac av - _ -> unexpected "literal" $ show t, - coderDecode = \n -> case n of - YM.NodeScalar s -> Terms.literal <$> coderDecode ac s - _ -> unexpected "scalar node" $ show n} - TypeList lt -> do - lc <- termCoder lt - return Coder { - coderEncode = \t -> case t of - TermList els -> YM.NodeSequence <$> CM.mapM (coderEncode lc) els - _ -> unexpected "list" $ show t, - coderDecode = \n -> case n of - YM.NodeSequence nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes - _ -> unexpected "sequence" $ show n} - TypeOptional ot -> do - oc <- termCoder ot - return Coder { - coderEncode = \t -> case t of - TermOptional el -> Y.maybe (pure yamlNull) (coderEncode oc) el - _ -> unexpected "optional" $ show t, - coderDecode = \n -> case n of - YM.NodeScalar YM.ScalarNull -> pure $ Terms.optional Nothing - _ -> Terms.optional . Just <$> coderDecode oc n} - TypeMap (MapType kt vt) -> do - kc <- termCoder kt - vc <- termCoder vt - let encodeEntry (k, v) = (,) <$> coderEncode kc k <*> coderEncode vc v - let decodeEntry (k, v) = (,) <$> coderDecode kc k <*> coderDecode vc v - return Coder { - coderEncode = \t -> case t of - TermMap m -> YM.NodeMapping . M.fromList <$> CM.mapM encodeEntry (M.toList m) - _ -> unexpected "term" $ show t, - coderDecode = \n -> case n of - YM.NodeMapping m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m) - _ -> unexpected "mapping" $ show n} - TypeRecord rt -> recordCoder rt - _ -> fail $ "unsupported type variant: " ++ show (typeVariant typ) - -yamlCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node) -yamlCoder typ = do - adapter <- languageAdapter yamlLanguage typ - coder <- termCoder $ adapterTarget adapter - return $ composeCoders (adapterCoder adapter) coder - -yamlNull :: YM.Node -yamlNull = YM.NodeScalar YM.ScalarNull - -yamlString :: String -> YM.Node -yamlString = YM.NodeScalar . YM.ScalarStr diff --git a/src/main/haskell/Hydra/Langs/Yaml/Language.hs b/src/main/haskell/Hydra/Langs/Yaml/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Yaml/Language.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Hydra.Langs.Yaml.Language where - -import Hydra.Kernel - -import qualified Data.Set as S - - -yamlLanguage :: Language -yamlLanguage = Language (LanguageName "hydra/langs/yaml") $ LanguageConstraints { - languageConstraintsEliminationVariants = S.empty, - languageConstraintsLiteralVariants = S.fromList [ - LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString], - languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat], - languageConstraintsFunctionVariants = S.empty, - languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint], - languageConstraintsTermVariants = S.fromList [ - TermVariantLiteral, - TermVariantList, - TermVariantMap, - TermVariantOptional, - TermVariantRecord], - languageConstraintsTypeVariants = S.fromList [ - TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantOptional, TypeVariantRecord], - languageConstraintsTypes = \typ -> case stripType typ of - TypeOptional (TypeOptional _) -> False - _ -> True } diff --git a/src/main/haskell/Hydra/Langs/Yaml/Modules.hs b/src/main/haskell/Hydra/Langs/Yaml/Modules.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Yaml/Modules.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Hydra.Langs.Yaml.Modules (moduleToYaml) where - -import Hydra.Kernel -import Hydra.Adapters -import Hydra.Langs.Yaml.Serde -import Hydra.Langs.Yaml.Language -import qualified Hydra.Langs.Yaml.Model as YM -import qualified Hydra.Dsl.Types as Types - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M - - -constructModule :: - Module - -> M.Map (Type) (Coder (Graph) (Graph) (Term) YM.Node) - -> [(Element, TypedTerm)] - -> Flow (Graph) YM.Node -constructModule mod coders pairs = do - keyvals <- withTrace "encoding terms" (CM.mapM toYaml pairs) - return $ YM.NodeMapping $ M.fromList keyvals - where - toYaml (el, (TypedTerm term typ)) = withTrace ("element " ++ unName (elementName el)) $ do - encode <- case M.lookup typ coders of - Nothing -> fail $ "no coder found for type " ++ show typ - Just coder -> pure $ coderEncode coder - node <- encode term - return (YM.NodeScalar $ YM.ScalarStr $ localNameOf $ elementName el, node) - ns = unNamespace $ moduleNamespace mod - localNameOf name = L.drop (1 + L.length ns) $ unName name - -moduleToYaml :: Module -> Flow (Graph) (M.Map FilePath String) -moduleToYaml mod = withTrace ("print module " ++ (unNamespace $ moduleNamespace mod)) $ do - node <- transformModule yamlLanguage encodeTerm constructModule mod - return $ M.fromList [(path, hydraYamlToString node)] - where - path = namespaceToFilePath False (FileExtension "yaml") $ moduleNamespace mod - encodeTerm _ = fail $ "only type definitions are expected in this mapping to YAML" diff --git a/src/main/haskell/Hydra/Langs/Yaml/Serde.hs b/src/main/haskell/Hydra/Langs/Yaml/Serde.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Langs/Yaml/Serde.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Hydra.Langs.Yaml.Serde where - -import Hydra.Kernel -import Hydra.Langs.Yaml.Coder -import Hydra.Tools.Bytestrings -import qualified Hydra.Langs.Yaml.Model as YM - -import qualified Data.ByteString.Lazy as BS -import qualified Control.Monad as CM -import qualified Data.YAML as DY -import qualified Data.YAML.Event as DYE -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Text as T -import qualified Data.ByteString.Lazy.Char8 as LB - - -bytesToHsYaml :: BS.ByteString -> Flow (Graph) (DY.Node DY.Pos) -bytesToHsYaml bs = case DY.decodeNode bs of - Left (pos, msg) -> fail $ "YAML parser failure at " ++ show pos ++ ": " ++ msg - Right docs -> if L.null docs - then fail "no YAML document" - else if L.length docs > 1 - then fail "multiple YAML documents" - else case L.head docs of - (DY.Doc node) -> pure node - -bytesToHydraYaml :: BS.ByteString -> Flow (Graph) YM.Node -bytesToHydraYaml = bytesToHsYaml CM.>=> hsYamlToHydraYaml - -hsYamlToBytes :: DY.Node () -> BS.ByteString -hsYamlToBytes node = DY.encodeNode [DY.Doc node] - -hsYamlToHydraYaml :: DY.Node x -> Flow (Graph) YM.Node -hsYamlToHydraYaml hs = case hs of - DY.Scalar _ s -> YM.NodeScalar <$> case s of - DY.SNull -> pure YM.ScalarNull - DY.SBool b -> pure $ YM.ScalarBool b - DY.SFloat f -> pure $ YM.ScalarFloat f - DY.SInt i -> pure $ YM.ScalarInt i - DY.SStr t -> pure $ YM.ScalarStr $ T.unpack t - DY.SUnknown _ _ -> fail "YAML unknown scalars are unsupported" - DY.Mapping _ _ m -> YM.NodeMapping . M.fromList <$> CM.mapM mapPair (M.toList m) - where - mapPair (k, v) = (,) <$> hsYamlToHydraYaml k <*> hsYamlToHydraYaml v - DY.Sequence _ _ s -> YM.NodeSequence <$> CM.mapM hsYamlToHydraYaml s - DY.Anchor {} -> fail "YAML anchors are unsupported" - -hydraYamlToBytes :: YM.Node -> BS.ByteString -hydraYamlToBytes = hsYamlToBytes . hydraYamlToHsYaml - -hydraYamlToHsYaml :: YM.Node -> DY.Node () -hydraYamlToHsYaml hy = case hy of - YM.NodeMapping m -> DY.Mapping () DYE.untagged $ M.fromList $ mapPair <$> M.toList m - where - mapPair (k, v) = (,) (hydraYamlToHsYaml k) (hydraYamlToHsYaml v) - YM.NodeScalar s -> DY.Scalar () $ case s of - YM.ScalarBool b -> DY.SBool b - YM.ScalarFloat f -> DY.SFloat f - YM.ScalarInt i -> DY.SInt i - YM.ScalarNull -> DY.SNull - YM.ScalarStr s -> DY.SStr $ T.pack s - YM.NodeSequence s -> DY.Sequence () DYE.untagged $ hydraYamlToHsYaml <$> s - -hydraYamlToString :: YM.Node -> String -hydraYamlToString = bytesToString . hydraYamlToBytes - -yamlByteStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) BS.ByteString) -yamlByteStringCoder typ = do - coder <- yamlCoder typ - return Coder { - coderEncode = fmap hydraYamlToBytes . coderEncode coder, - coderDecode = bytesToHydraYaml CM.>=> coderDecode coder} - -yamlStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) String) -yamlStringCoder typ = do - serde <- yamlByteStringCoder typ - return Coder { - coderEncode = fmap LB.unpack . coderEncode serde, - coderDecode = coderDecode serde . LB.pack} diff --git a/src/main/haskell/Hydra/Lexical.hs b/src/main/haskell/Hydra/Lexical.hs --- a/src/main/haskell/Hydra/Lexical.hs +++ b/src/main/haskell/Hydra/Lexical.hs @@ -10,6 +10,7 @@ import Hydra.Compute import Hydra.Tier1 import Hydra.Tier2 +import Hydra.Module import qualified Data.List as L import qualified Data.Map as M @@ -22,6 +23,13 @@ g <- getState return $ M.lookup name (graphElements g) +fieldsOf :: Type -> [FieldType] +fieldsOf t = case stripType t of + TypeLambda (LambdaType _ body) -> fieldsOf body + TypeRecord rt -> rowTypeFields rt + TypeUnion rt -> rowTypeFields rt + _ -> [] + requireElement :: Name -> Flow Graph Element requireElement name = do mel <- dereferenceElement name @@ -58,6 +66,15 @@ -- Note: assuming for now that primitive functions are the same in the schema graph schemaContext :: Graph -> Graph schemaContext g = Y.fromMaybe g (graphSchema g) + +toCompactName :: M.Map Namespace String -> Name -> String +toCompactName namespaces name = case mns of + Nothing -> unName name + Just ns -> case M.lookup ns namespaces of + Just pre -> pre ++ ":" ++ local + Nothing -> local + where + (QualifiedName mns local) = qualifyNameLazy name withSchemaContext :: Flow Graph x -> Flow Graph x withSchemaContext f = do diff --git a/src/main/haskell/Hydra/Lib/Equality.hs b/src/main/haskell/Hydra/Lib/Equality.hs --- a/src/main/haskell/Hydra/Lib/Equality.hs +++ b/src/main/haskell/Hydra/Lib/Equality.hs @@ -7,6 +7,9 @@ import Data.Int +equal :: Eq a => a -> a -> Bool +equal = (==) + equalBinary :: String -> String -> Bool equalBinary = (==) diff --git a/src/main/haskell/Hydra/Lib/Flows.hs b/src/main/haskell/Hydra/Lib/Flows.hs --- a/src/main/haskell/Hydra/Lib/Flows.hs +++ b/src/main/haskell/Hydra/Lib/Flows.hs @@ -47,3 +47,6 @@ pure :: x -> Flow s x pure = return + +sequence :: [Flow s x] -> Flow s [x] +sequence = CM.sequence diff --git a/src/main/haskell/Hydra/Lib/Io.hs b/src/main/haskell/Hydra/Lib/Io.hs --- a/src/main/haskell/Hydra/Lib/Io.hs +++ b/src/main/haskell/Hydra/Lib/Io.hs @@ -8,9 +8,9 @@ import Hydra.Core import Hydra.Compute import Hydra.Graph -import Hydra.Langs.Json.Coder +import Hydra.Ext.Json.Coder import Hydra.Dsl.Annotations -import Hydra.Langs.Json.Serde +import Hydra.Ext.Json.Serde import Hydra.CoreEncoding import Hydra.Rewriting import Hydra.Annotations diff --git a/src/main/haskell/Hydra/Lib/Lists.hs b/src/main/haskell/Hydra/Lib/Lists.hs --- a/src/main/haskell/Hydra/Lib/Lists.hs +++ b/src/main/haskell/Hydra/Lib/Lists.hs @@ -13,6 +13,9 @@ apply :: [a -> b] -> [a] -> [b] apply = (<*>) +at :: Int -> [a] -> a +at i l = l !! i + bind :: [a] -> (a -> [b]) -> [b] bind = (>>=) @@ -24,6 +27,9 @@ cons :: a -> [a] -> [a] cons = (:) + +filter :: (a -> Bool) -> [a] -> [a] +filter = L.filter foldl :: (b -> a -> b) -> b -> [a] -> b foldl = L.foldl diff --git a/src/main/haskell/Hydra/Lib/Optionals.hs b/src/main/haskell/Hydra/Lib/Optionals.hs --- a/src/main/haskell/Hydra/Lib/Optionals.hs +++ b/src/main/haskell/Hydra/Lib/Optionals.hs @@ -14,6 +14,9 @@ cat :: [Y.Maybe a] -> [a] cat = Y.catMaybes +compose :: (a -> Y.Maybe b) -> (b -> Y.Maybe c) -> (a -> Y.Maybe c) +compose f g = \x -> f x >>= g + fromMaybe :: a -> Y.Maybe a -> a fromMaybe = Y.fromMaybe diff --git a/src/main/haskell/Hydra/Minimal.hs b/src/main/haskell/Hydra/Minimal.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Minimal.hs @@ -0,0 +1,24 @@ +-- | A minimal, standalone Hydra kernel which allows external tools (like @wisnesky's Algorithm W implementation) +-- to take a lightweight dependency on Hydra types or functions, without requiring compilation of Hydra proper. +-- There are two versions of this module: +-- * External: has all of the necessary Hydra definitions in one file +-- * Internal: just exports the appropriate symbols from the actual Hydra modules + +module Hydra.Minimal ( + FloatType(..), + FloatValue(..), + IntegerType(..), + IntegerValue(..), + Literal(..), + LiteralType(..), + Name(..), + floatValueType, + integerValueType, + int32, + literalType, + string, +) where + +import Hydra.Core +import Hydra.Basics +import Hydra.Dsl.Literals diff --git a/src/main/haskell/Hydra/Reduction.hs b/src/main/haskell/Hydra/Reduction.hs --- a/src/main/haskell/Hydra/Reduction.hs +++ b/src/main/haskell/Hydra/Reduction.hs @@ -6,7 +6,7 @@ import Hydra.Strip import Hydra.Compute import Hydra.Core -import Hydra.CoreDecoding +import Hydra.Schemas import Hydra.Extras import Hydra.Graph import Hydra.Annotations @@ -25,10 +25,10 @@ alphaConvert :: Name -> Term -> Term -> Term -alphaConvert vold tnew = rewriteTerm rewrite id +alphaConvert vold tnew = rewriteTerm rewrite where rewrite recurse term = case term of - TermFunction (FunctionLambda (Lambda v body)) -> if v == vold + TermFunction (FunctionLambda (Lambda v _ _)) -> if v == vold then term else recurse term TermVariable v -> if v == vold then tnew else TermVariable v @@ -39,8 +39,8 @@ countPrimitiveInvocations = True -- A term evaluation function which is alternatively lazy or eager -reduceTerm :: Bool -> M.Map Name (Term) -> Term -> Flow (Graph) (Term) -reduceTerm eager env = rewriteTermM mapping pure +reduceTerm :: Bool -> M.Map Name Term -> Term -> Flow Graph Term +reduceTerm eager env = rewriteTermM mapping where reduce eager = reduceTerm eager M.empty @@ -59,10 +59,10 @@ [] -> fun (h:r) -> applyToArguments (Terms.apply fun h) r - replaceFreeName toReplace replacement = rewriteTerm mapping id + replaceFreeName toReplace replacement = rewriteTerm mapping where mapping recurse inner = case inner of - TermFunction (FunctionLambda (Lambda param body)) -> if param == toReplace then inner else recurse inner + TermFunction (FunctionLambda (Lambda param _ _)) -> if param == toReplace then inner else recurse inner TermVariable name -> if name == toReplace then replacement else inner _ -> recurse inner @@ -76,7 +76,7 @@ reducedArg <- reduceArg eager $ stripTerm arg reducedResult <- applyElimination elm reducedArg >>= reduce eager applyIfNullary eager reducedResult remainingArgs - FunctionLambda (Lambda param body) -> case args of + FunctionLambda (Lambda param _ body) -> case args of [] -> pure original (arg:remainingArgs) -> do reducedArg <- reduce eager $ stripTerm arg @@ -118,10 +118,10 @@ -- Note: this is eager beta reduction, in that we always descend into subtypes, -- and always reduce the right-hand side of an application prior to substitution -betaReduceType :: Type -> Flow (Graph) (Type) +betaReduceType :: Type -> Flow Graph (Type) betaReduceType typ = do - g <- getState :: Flow (Graph) (Graph) - rewriteTypeM mapExpr (pure . id) typ + g <- getState :: Flow Graph Graph + rewriteTypeM mapExpr typ where mapExpr recurse t = do r <- recurse t @@ -145,11 +145,11 @@ -- ((\x.e1) e2) = e1[x/e2] -- These are both limited forms of beta reduction which help to "clean up" a term without fully evaluating it. contractTerm :: Term -> Term -contractTerm = rewriteTerm rewrite id +contractTerm = rewriteTerm rewrite where rewrite recurse term = case rec of TermApplication (Application lhs rhs) -> case fullyStripTerm lhs of - TermFunction (FunctionLambda (Lambda v body)) -> if isFreeIn v body + TermFunction (FunctionLambda (Lambda v _ body)) -> if isFreeIn v body then body else alphaConvert v rhs body _ -> rec @@ -164,8 +164,8 @@ TermFunction (FunctionLambda l) -> reduceLambda l _ -> noChange where - reduceLambda (Lambda v body) = case etaReduceTerm body of - TermAnnotated (AnnotatedTerm body1 ann) -> reduceLambda (Lambda v body1) + reduceLambda (Lambda v d body) = case etaReduceTerm body of + TermAnnotated (AnnotatedTerm body1 ann) -> reduceLambda (Lambda v d body1) TermApplication a -> reduceApplication a where reduceApplication (Application lhs rhs) = case etaReduceTerm rhs of @@ -210,5 +210,5 @@ && termIsValue g just EliminationRecord _ -> True EliminationUnion (CaseStatement _ def cases) -> checkFields cases && (Y.maybe True (termIsValue g) def) - FunctionLambda (Lambda _ body) -> termIsValue g body + FunctionLambda (Lambda _ _ body) -> termIsValue g body FunctionPrimitive _ -> True diff --git a/src/main/haskell/Hydra/Rewriting.hs b/src/main/haskell/Hydra/Rewriting.hs --- a/src/main/haskell/Hydra/Rewriting.hs +++ b/src/main/haskell/Hydra/Rewriting.hs @@ -28,9 +28,9 @@ -- beneathTermAnnotations :: (Term -> Term) -> Term -> Term -- beneathTermAnnotations f term = case term of -- TermAnnotated (AnnotatedTerm term1 ann) -> --- TermAnnotated (AnnotatedTerm (beneathTermAnnotationsM f term1) ann) +-- TermAnnotated (AnnotatedTerm (beneathTermAnnotations f term1) ann) -- TermTyped (TypedTerm term1 typ) -> --- TermTyped $ TypedTerm (beneathTermAnnotationsM f term1) typ +-- TermTyped $ TypedTerm (beneathTermAnnotations f term1) typ -- _ -> f term -- -- beneathTermAnnotationsM :: (Term -> Flow s Term) -> Term -> Flow s Term @@ -41,6 +41,12 @@ -- TermTyped <$> (TypedTerm <$> beneathTermAnnotationsM f term1 <*> pure typ) -- _ -> f term +-- | Apply a transformation to the first type beneath a chain of annotations +beneathTypeAnnotations :: (Type -> Type) -> Type -> Type +beneathTypeAnnotations f t = case t of + TypeAnnotated (AnnotatedType t1 ann) -> TypeAnnotated (AnnotatedType (beneathTypeAnnotations f t1) ann) + _ -> f t + elementsWithDependencies :: [Element] -> Flow Graph [Element] elementsWithDependencies original = CM.mapM requireElement allDepNames where @@ -51,7 +57,7 @@ -- whose arity (in the absence of application terms) is equal to the depth of nested lambdas. -- This is useful for targets like Java with weaker support for currying. expandTypedLambdas :: Term -> Term -expandTypedLambdas = rewriteTerm rewrite id +expandTypedLambdas = rewriteTerm rewrite where rewrite recurse term = case getFunType term of Nothing -> recurse term @@ -70,7 +76,7 @@ Nothing -> recurse term Just typ -> TermApplication $ Application (expand (typ:doms) cod lhs) $ expandTypedLambdas rhs TermFunction f -> case f of - FunctionLambda (Lambda var body) -> TermFunction $ FunctionLambda $ Lambda var $ + FunctionLambda (Lambda var d body) -> TermFunction $ FunctionLambda $ Lambda var d $ expand (L.tail doms) cod body _ -> pad 1 doms cod term TermLet (Let bindings env) -> TermLet $ Let (expandBinding <$> bindings) $ expand doms cod env @@ -81,19 +87,20 @@ pad i doms cod term = if L.null doms then term - else TermFunction $ FunctionLambda $ Lambda var $ + else TermFunction $ FunctionLambda $ Lambda var (Just dom) $ pad (i+1) (L.tail doms) cod $ -- TODO: omit this type annotation if practical; a type annotation on application terms -- shouldn't really be necessary. typed (toFunctionType (L.tail doms) cod) $ TermApplication $ Application (typed (toFunctionType doms cod) term) $ TermVariable var where + dom = L.head doms typed typ term = TermTyped $ TypedTerm term typ toFunctionType doms cod = L.foldl (\c d -> TypeFunction $ FunctionType d c) cod doms var = Name $ "v" ++ show i flattenLetTerms :: Term -> Term -flattenLetTerms = rewriteTerm flatten id +flattenLetTerms = rewriteTerm flatten where flatten recurse term = case recurse term of TermLet (Let bindings body) -> TermLet $ Let newBindings body @@ -124,7 +131,7 @@ -- | Inline all type variables in a type using the provided schema. -- Note: this function is only appropriate for nonrecursive type definitions. inlineType :: M.Map Name Type -> Type -> Flow s Type -inlineType schema = rewriteTypeM f pure +inlineType schema = rewriteTypeM f where f recurse typ = do tr <- recurse typ @@ -139,23 +146,23 @@ -- | Recursively remove term annotations, including within subterms removeTermAnnotations :: Term -> Term -removeTermAnnotations = rewriteTerm remove id +removeTermAnnotations = rewriteTerm remove where - remove recurse term = case term of - TermAnnotated (AnnotatedTerm term' _) -> remove recurse term' - TermTyped (TypedTerm term' _) -> remove recurse term' - _ -> recurse term + remove recurse term = case recurse term of + TermAnnotated (AnnotatedTerm term1 _) -> term1 + TermTyped (TypedTerm term1 _) -> term1 + t -> t -- | Recursively remove type annotations, including within subtypes removeTypeAnnotations :: Type -> Type -removeTypeAnnotations = rewriteType remove id +removeTypeAnnotations = rewriteType remove where remove recurse typ = case recurse typ of - TypeAnnotated (AnnotatedType typ' _) -> remove recurse typ' - _ -> recurse typ + TypeAnnotated (AnnotatedType typ' _) -> typ' + t -> t replaceFreeName :: Name -> Type -> Type -> Type -replaceFreeName v rep = rewriteType mapExpr id +replaceFreeName v rep = rewriteType mapExpr where mapExpr recurse t = case t of TypeLambda (LambdaType v' body) -> if v == v' @@ -169,11 +176,11 @@ where recurse = f (fsub recurse) -rewriteTerm :: ((Term -> Term) -> Term -> Term) -> (M.Map String Term -> M.Map String Term) -> Term -> Term -rewriteTerm f mf = rewrite fsub f +rewriteTerm :: ((Term -> Term) -> Term -> Term) -> Term -> Term +rewriteTerm f = rewrite fsub f where fsub recurse term = case term of - TermAnnotated (AnnotatedTerm ex ann) -> TermAnnotated $ AnnotatedTerm (recurse ex) (mf ann) + TermAnnotated (AnnotatedTerm ex ann) -> TermAnnotated $ AnnotatedTerm (recurse ex) ann TermApplication (Application lhs rhs) -> TermApplication $ Application (recurse lhs) (recurse rhs) TermFunction fun -> TermFunction $ case fun of FunctionElimination e -> FunctionElimination $ case e of @@ -184,7 +191,7 @@ EliminationRecord p -> EliminationRecord p EliminationUnion (CaseStatement n def cases) -> EliminationUnion $ CaseStatement n (recurse <$> def) (forField <$> cases) EliminationWrap name -> EliminationWrap name - FunctionLambda (Lambda v body) -> FunctionLambda $ Lambda v $ recurse body + FunctionLambda (Lambda v d body) -> FunctionLambda $ Lambda v d $ recurse body FunctionPrimitive name -> FunctionPrimitive name TermLet (Let bindings env) -> TermLet $ Let (mapBinding <$> bindings) (recurse env) where @@ -198,6 +205,8 @@ TermRecord (Record n fields) -> TermRecord $ Record n $ forField <$> fields TermSet s -> TermSet $ S.fromList $ recurse <$> S.toList s TermSum (Sum i s trm) -> TermSum $ Sum i s $ recurse trm + TermTypeAbstraction (TypeAbstraction v t) -> TermTypeAbstraction $ TypeAbstraction v $ recurse t + TermTypeApplication (TypedTerm term1 type2) -> TermTypeApplication $ TypedTerm (recurse term1) type2 TermTyped (TypedTerm term1 type2) -> TermTyped $ TypedTerm (recurse term1) type2 TermUnion (Injection n field) -> TermUnion $ Injection n $ forField field TermVariable v -> TermVariable v @@ -205,14 +214,11 @@ forField f = f {fieldTerm = recurse (fieldTerm f)} rewriteTermM :: - ((Term -> Flow s Term) -> Term -> (Flow s Term)) -> - (M.Map String Term -> Flow s (M.Map String Term)) -> - Term -> - Flow s Term -rewriteTermM f mf = rewrite fsub f + ((Term -> Flow s Term) -> Term -> (Flow s Term)) -> Term -> Flow s Term +rewriteTermM f = rewrite fsub f where fsub recurse term = case term of - TermAnnotated (AnnotatedTerm ex ma) -> TermAnnotated <$> (AnnotatedTerm <$> recurse ex <*> mf ma) + TermAnnotated (AnnotatedTerm ex ma) -> TermAnnotated <$> (AnnotatedTerm <$> recurse ex <*> pure ma) TermApplication (Application lhs rhs) -> TermApplication <$> (Application <$> recurse lhs <*> recurse rhs) TermFunction fun -> TermFunction <$> case fun of FunctionElimination e -> FunctionElimination <$> case e of @@ -227,7 +233,7 @@ Just t -> Just <$> recurse t EliminationUnion <$> (CaseStatement n rdef <$> (CM.mapM forField cases)) EliminationWrap name -> pure $ EliminationWrap name - FunctionLambda (Lambda v body) -> FunctionLambda <$> (Lambda v <$> recurse body) + FunctionLambda (Lambda v d body) -> FunctionLambda <$> (Lambda v d <$> recurse body) FunctionPrimitive name -> pure $ FunctionPrimitive name TermLet (Let bindings env) -> TermLet <$> (Let <$> (CM.mapM mapBinding bindings) <*> recurse env) where @@ -256,21 +262,27 @@ t <- recurse (fieldTerm f) return f {fieldTerm = t} -rewriteTermMeta :: (M.Map String Term -> M.Map String Term) -> Term -> Term -rewriteTermMeta = rewriteTerm mapExpr +rewriteTermMeta :: (M.Map Name Term -> M.Map Name Term) -> Term -> Term +rewriteTermMeta mapping = rewriteTerm rewrite where - mapExpr recurse term = recurse term + rewrite recurse term = case recurse term of + TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated $ AnnotatedTerm term1 $ mapping ann + t -> t -rewriteTermMetaM :: (M.Map String Term -> Flow s (M.Map String Term)) -> Term -> Flow s Term -rewriteTermMetaM = rewriteTermM mapExpr +rewriteTermMetaM :: (M.Map Name Term -> Flow s (M.Map Name Term)) -> Term -> Flow s Term +rewriteTermMetaM mapping = rewriteTermM rewrite where - mapExpr recurse term = recurse term + rewrite recurse term = do + r <- recurse term + case r of + TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated <$> (AnnotatedTerm <$> pure term1 <*> mapping ann) + t -> pure t -rewriteType :: ((Type -> Type) -> Type -> Type) -> (M.Map String Term -> M.Map String Term) -> Type -> Type -rewriteType f mf = rewrite fsub f +rewriteType :: ((Type -> Type) -> Type -> Type) -> Type -> Type +rewriteType f = rewrite fsub f where fsub recurse typ = case typ of - TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated $ AnnotatedType (recurse t) (mf ann) + TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated $ AnnotatedType (recurse t) ann TypeApplication (ApplicationType lhs rhs) -> TypeApplication $ ApplicationType (recurse lhs) (recurse rhs) TypeFunction (FunctionType dom cod) -> TypeFunction (FunctionType (recurse dom) (recurse cod)) TypeLambda (LambdaType v b) -> TypeLambda (LambdaType v $ recurse b) @@ -279,10 +291,10 @@ TypeMap (MapType kt vt) -> TypeMap (MapType (recurse kt) (recurse vt)) TypeOptional t -> TypeOptional $ recurse t TypeProduct types -> TypeProduct (recurse <$> types) - TypeRecord (RowType name extends fields) -> TypeRecord $ RowType name extends (forField <$> fields) + TypeRecord (RowType name fields) -> TypeRecord $ RowType name (forField <$> fields) TypeSet t -> TypeSet $ recurse t TypeSum types -> TypeSum (recurse <$> types) - TypeUnion (RowType name extends fields) -> TypeUnion $ RowType name extends (forField <$> fields) + TypeUnion (RowType name fields) -> TypeUnion $ RowType name (forField <$> fields) TypeVariable v -> TypeVariable v TypeWrap (WrappedType name t) -> TypeWrap $ WrappedType name $ recurse t where @@ -290,13 +302,12 @@ rewriteTypeM :: ((Type -> Flow s Type) -> Type -> (Flow s Type)) -> - (M.Map String Term -> Flow s (M.Map String Term)) -> Type -> Flow s Type -rewriteTypeM f mf = rewrite fsub f +rewriteTypeM f = rewrite fsub f where fsub recurse typ = case typ of - TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated <$> (AnnotatedType <$> recurse t <*> mf ann) + TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated <$> (AnnotatedType <$> recurse t <*> pure ann) TypeApplication (ApplicationType lhs rhs) -> TypeApplication <$> (ApplicationType <$> recurse lhs <*> recurse rhs) TypeFunction (FunctionType dom cod) -> TypeFunction <$> (FunctionType <$> recurse dom <*> recurse cod) TypeLambda (LambdaType v b) -> TypeLambda <$> (LambdaType <$> pure v <*> recurse b) @@ -305,12 +316,12 @@ TypeMap (MapType kt vt) -> TypeMap <$> (MapType <$> recurse kt <*> recurse vt) TypeOptional t -> TypeOptional <$> recurse t TypeProduct types -> TypeProduct <$> CM.mapM recurse types - TypeRecord (RowType name extends fields) -> - TypeRecord <$> (RowType <$> pure name <*> pure extends <*> CM.mapM forField fields) + TypeRecord (RowType name fields) -> + TypeRecord <$> (RowType <$> pure name <*> CM.mapM forField fields) TypeSet t -> TypeSet <$> recurse t TypeSum types -> TypeSum <$> CM.mapM recurse types - TypeUnion (RowType name extends fields) -> - TypeUnion <$> (RowType <$> pure name <*> pure extends <*> CM.mapM forField fields) + TypeUnion (RowType name fields) -> + TypeUnion <$> (RowType <$> pure name <*> CM.mapM forField fields) TypeVariable v -> pure $ TypeVariable v TypeWrap (WrappedType name t) -> TypeWrap <$> (WrappedType <$> pure name <*> recurse t) where @@ -318,17 +329,19 @@ t <- recurse $ fieldTypeType f return f {fieldTypeType = t} -rewriteTypeMeta :: (M.Map String Term -> M.Map String Term) -> Type -> Type -rewriteTypeMeta = rewriteType mapExpr +rewriteTypeMeta :: (M.Map Name Term -> M.Map Name Term) -> Type -> Type +rewriteTypeMeta mapping = rewriteType rewrite where - mapExpr recurse term = recurse term + rewrite recurse typ = case recurse typ of + TypeAnnotated (AnnotatedType typ1 ann) -> TypeAnnotated $ AnnotatedType typ1 $ mapping ann + t -> t simplifyTerm :: Term -> Term -simplifyTerm = rewriteTerm simplify id +simplifyTerm = rewriteTerm simplify where simplify recurse term = recurse $ case fullyStripTerm term of TermApplication (Application lhs rhs) -> case fullyStripTerm lhs of - TermFunction (FunctionLambda (Lambda var body)) -> + TermFunction (FunctionLambda (Lambda var d body)) -> if S.member var (freeVariablesInTerm body) then case fullyStripTerm rhs of TermVariable v -> simplifyTerm $ substituteVariable var v body @@ -338,7 +351,7 @@ _ -> term stripTermRecursive :: Term -> Term -stripTermRecursive = rewriteTerm strip id +stripTermRecursive = rewriteTerm strip where strip recurse term = case recurse term of TermAnnotated (AnnotatedTerm t _) -> t @@ -346,21 +359,21 @@ t -> t substituteVariable :: Name -> Name -> Term -> Term -substituteVariable from to = rewriteTerm replace id +substituteVariable from to = rewriteTerm replace where replace recurse term = case term of TermVariable x -> (TermVariable $ if x == from then to else x) - TermFunction (FunctionLambda (Lambda var _)) -> if var == from + TermFunction (FunctionLambda (Lambda var _ _)) -> if var == from then term else recurse term _ -> recurse term substituteVariables :: M.Map Name Name -> Term -> Term -substituteVariables subst = rewriteTerm replace id +substituteVariables subst = rewriteTerm replace where replace recurse term = case term of TermVariable n -> TermVariable $ Y.fromMaybe n $ M.lookup n subst - TermFunction (FunctionLambda (Lambda v _ )) -> case M.lookup v subst of + TermFunction (FunctionLambda (Lambda v _ _ )) -> case M.lookup v subst of Nothing -> recurse term Just _ -> term _ -> recurse term @@ -388,6 +401,21 @@ prim name = if withPrims then S.insert name names else names var name = if withVars then S.insert name names else names +-- Topological sort of connected components, in terms of dependencies between varable/term binding pairs +topologicalSortBindings :: M.Map Name Term -> [[(Name, Term)]] +topologicalSortBindings bindingMap = fmap (fmap toPair) (topologicalSortComponents (depsOf <$> bindings)) + where + bindings = M.toList bindingMap + keys = S.fromList (fst <$> bindings) + depsOf (name, term) = (name, if hasTypeAnnotation term + then [] + else S.toList (S.intersection keys $ freeVariablesInTerm term)) + toPair name = (name, Y.fromMaybe (TermLiteral $ LiteralString "Impossible!") $ M.lookup name bindingMap) + hasTypeAnnotation term = case term of + TermAnnotated (AnnotatedTerm term1 _) -> hasTypeAnnotation term1 + TermTyped _ -> True + _ -> False + topologicalSortElements :: [Element] -> Either [[Name]] [Name] topologicalSortElements els = topologicalSort $ adjlist <$> els where @@ -395,33 +423,3 @@ typeDependencyNames :: Type -> S.Set Name typeDependencyNames = freeVariablesInType - --- | Where non-lambda terms with nonzero arity occur at the top level, turn them into lambdas, --- also adding an appropriate type annotation to each new lambda. -wrapLambdas :: Term -> Flow Graph Term -wrapLambdas = pure ---wrapLambdas term = do --- typ <- requireTermType term --- let types = uncurryType typ --- let argTypes = L.init types --- let missing = missingArity (L.length argTypes) term --- return $ pad term (L.take missing argTypes) (toFunType $ L.drop missing types) --- where --- toFunType types = case types of --- [t] -> t --- (dom:rest) -> TypeFunction $ FunctionType dom $ toFunType rest --- missingArity arity term = if arity == 0 --- then 0 --- else case term of --- TermAnnotated (AnnotatedTerm term2 _) -> missingArity arity term2 --- TermTyped (TypedTerm term2 _) -> missingArity arity term2 --- TermLet (Let _ env) -> missingArity arity env --- TermFunction (FunctionLambda (Lambda _ body)) -> missingArity (arity - 1) body --- _ -> arity --- pad term doms cod = fst $ L.foldl newLambda (apps, cod) $ L.reverse variables --- where --- newLambda (body, cod) (v, dom) = (TermTyped $ TypedTerm (TermFunction $ FunctionLambda $ Lambda v body) ft, ft) --- where --- ft = TypeFunction $ FunctionType dom cod --- apps = L.foldl (\lhs (v, _) -> TermApplication (Application lhs $ TermVariable v)) term variables --- variables = L.zip ((\i -> Name $ "a" ++ show i) <$> [1..]) doms diff --git a/src/main/haskell/Hydra/Rules.hs b/src/main/haskell/Hydra/Rules.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Rules.hs +++ /dev/null @@ -1,348 +0,0 @@ --- | Inference rules - -module Hydra.Rules where - -import Hydra.Basics -import Hydra.Strip -import Hydra.Compute -import Hydra.Core -import Hydra.CoreDecoding -import Hydra.CoreEncoding -import Hydra.Graph -import Hydra.Lexical -import Hydra.Mantle -import Hydra.Rewriting -import Hydra.Substitution -import Hydra.Unification -import Hydra.Tools.Debug -import Hydra.Annotations -import Hydra.Tier1 -import Hydra.Tier2 -import qualified Hydra.Dsl.Types as Types - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y - - -data InferenceContext = InferenceContext { - inferenceContextGraph :: Graph, - inferenceContextEnvironment :: TypingEnvironment} - -type TypingEnvironment = M.Map Name TypeScheme - -fieldType :: Field -> FieldType -fieldType (Field fname term) = FieldType fname $ termType term - -findMatchingField :: Name -> [FieldType] -> Flow InferenceContext (FieldType) -findMatchingField fname sfields = case L.filter (\f -> fieldTypeName f == fname) sfields of - [] -> fail $ "no such field: " ++ unName fname - (h:_) -> return h - -freshName :: Flow InferenceContext (Type) -freshName = TypeVariable . normalVariable <$> nextCount "hyInf" - -generalize :: TypingEnvironment -> Type -> TypeScheme -generalize env t = TypeScheme vars t - where - vars = S.toList $ S.difference - (freeVariablesInType t) - (L.foldr (S.union . freeVariablesInScheme) S.empty $ M.elems env) - -infer :: Term -> Flow InferenceContext (Term, [Constraint]) -infer term = withTrace ("infer for " ++ show (termVariant term)) $ case term of - TermAnnotated (AnnotatedTerm term1 ann) -> do - (term2, constraints) <- infer term1 - return (TermAnnotated $ AnnotatedTerm term2 ann, constraints) - - TermTyped (TypedTerm term1 typ) -> do - (i, c) <- infer term1 - return (setTermType (Just typ) i, c ++ [(typ, termType i)]) - - TermApplication (Application fun arg) -> do - (ifun, funconst) <- infer fun - (iarg, argconst) <- infer arg - cod <- freshName - let constraints = funconst ++ argconst ++ [(termType ifun, Types.function (termType iarg) cod)] - yield (TermApplication $ Application ifun iarg) cod constraints - - TermFunction f -> case f of - - FunctionElimination e -> case e of - - EliminationList fun -> do - a <- freshName - b <- freshName - let expected = Types.functionN [b, a, b] - (i, c) <- infer fun - let elim = Types.functionN [b, Types.list a, b] - yieldElimination (EliminationList i) elim (c ++ [(expected, termType i)]) - - EliminationOptional (OptionalCases n j) -> do - dom <- freshName - cod <- freshName - (ni, nconst) <- infer n - (ji, jconst) <- infer j - let t = Types.function (Types.optional dom) cod - let constraints = nconst ++ jconst - ++ [(cod, termType ni), (Types.function dom cod, termType ji)] - yieldElimination (EliminationOptional $ OptionalCases ni ji) t constraints - - EliminationProduct (TupleProjection arity idx) -> do - types <- CM.replicateM arity freshName - let cod = types !! idx - let t = Types.function (Types.product types) cod - yieldElimination (EliminationProduct $ TupleProjection arity idx) t [] - - EliminationRecord (Projection name fname) -> do - rt <- withGraphContext $ requireRecordType True name - sfield <- findMatchingField fname (rowTypeFields rt) - yieldElimination (EliminationRecord $ Projection name fname) - (Types.function (TypeRecord rt) $ fieldTypeType sfield) [] - - EliminationUnion (CaseStatement tname def cases) -> do - -- Default value - (idef, dfltConstraints) <- case def of - Nothing -> pure (Nothing, []) - Just d -> do - (i, c) <- infer d - return (Just i, c) - - -- Cases - icases' <- CM.mapM inferFieldType cases - let icases = fst <$> icases' - let casesconst = snd <$> icases' - let icasesMap = fieldMap icases - rt <- withGraphContext $ requireUnionType True tname - let sfields = fieldTypeMap $ rowTypeFields rt - checkCasesAgainstSchema tname icasesMap sfields - let pairMap = productOfMaps icasesMap sfields - - cod <- freshName - let outerConstraints = (\(d, s) -> (termType d, Types.function s cod)) <$> M.elems pairMap - let innerConstraints = dfltConstraints ++ L.concat casesconst - - yieldElimination (EliminationUnion (CaseStatement tname idef icases)) - (Types.function (TypeUnion rt) cod) - (innerConstraints ++ outerConstraints) - where - checkCasesAgainstSchema tname icases sfields = if M.null diff - then pure () - else fail $ "case(s) in case statement which do not exist in type " ++ unName tname ++ ": " - ++ L.intercalate ", " (unName <$> M.keys diff) - where - diff = M.difference icases sfields - - EliminationWrap name -> do - typ <- withGraphContext $ requireWrappedType name - yieldElimination (EliminationWrap name) (Types.function (TypeWrap $ WrappedType name typ) typ) [] - - FunctionLambda (Lambda v body) -> do - tv <- freshName - (i, iconst) <- withBinding v (monotype tv) $ infer body - yieldFunction (FunctionLambda $ Lambda v i) (Types.function tv (termType i)) iconst - - FunctionPrimitive name -> do - t <- (withGraphContext $ typeOfPrimitive name) >>= replaceFreeVariables - yieldFunction (FunctionPrimitive name) t [] - where - -- This prevents type variables from being reused across multiple instantiations of a primitive within a single element, - -- which would lead to false unification. - replaceFreeVariables t = do - pairs <- CM.mapM toPair $ S.toList $ freeVariablesInType t - return $ substituteInType (M.fromList pairs) t - where - toPair v = do - v' <- freshName - return (v, v') - - TermLet lt -> inferLet lt - - TermList els -> do - v <- freshName - if L.null els - then yield (TermList []) (Types.list v) [] - else do - iels' <- CM.mapM infer els - let iels = fst <$> iels' - let elsconst = snd <$> iels' - let co = (\e -> (v, termType e)) <$> iels - let ci = L.concat elsconst - yield (TermList iels) (Types.list v) (co ++ ci) - - TermLiteral l -> yield (TermLiteral l) (Types.literal $ literalType l) [] - - TermMap m -> do - kv <- freshName - vv <- freshName - if M.null m - then yield (TermMap M.empty) (Types.map kv vv) [] - else do - triples <- CM.mapM toTriple $ M.toList m - let pairs = (\(k, v, _) -> (k, v)) <$> triples - let co = L.concat ((\(k, v, c) -> c ++ [(kv, termType k), (vv, termType v)]) <$> triples) - yield (TermMap $ M.fromList pairs) (Types.map kv vv) co - where - toTriple (k, v) = do - (ik, kc) <- infer k - (iv, vc) <- infer v - return (ik, iv, kc ++ vc) - - TermOptional m -> do - v <- freshName - case m of - Nothing -> yield (TermOptional Nothing) (Types.optional v) [] - Just e -> do - (i, ci) <- infer e - yield (TermOptional $ Just i) (Types.optional v) ((v, termType i):ci) - - TermProduct tuple -> do - is' <- CM.mapM infer tuple - let is = fst <$> is' - let co = L.concat (snd <$> is') - yield (TermProduct is) (TypeProduct $ fmap termType is) co - - TermRecord (Record n fields) -> do - rt <- withGraphContext $ requireRecordType True n - ifields' <- CM.mapM inferFieldType fields - let ifields = fst <$> ifields' - let ci = L.concat (snd <$> ifields') - let irt = TypeRecord $ RowType n Nothing (fieldType <$> ifields) - yield (TermRecord $ Record n ifields) irt ((TypeRecord rt, irt):ci) - - TermSet els -> do - v <- freshName - if S.null els - then yield (TermSet S.empty) (Types.set v) [] - else do - iels' <- CM.mapM infer $ S.toList els - let iels = fst <$> iels' - let co = (\e -> (v, termType e)) <$> iels - let ci = L.concat (snd <$> iels') - yield (TermSet $ S.fromList iels) (Types.set v) (co ++ ci) - - TermSum (Sum i s trm) -> do - (it, co) <- infer trm - types <- CM.sequence (varOrTerm it <$> [0..(s-1)]) - yield (TermSum $ Sum i s it) (TypeSum types) co - where - varOrTerm it j = if i == j - then pure $ termType it - else freshName - - TermUnion (Injection n field) -> do - rt <- withGraphContext $ requireUnionType True n - sfield <- findMatchingField (fieldName field) (rowTypeFields rt) - (ifield, ci) <- inferFieldType field - let co = (termType $ fieldTerm ifield, fieldTypeType sfield) - - yield (TermUnion $ Injection n ifield) (TypeUnion rt) (co:ci) - - TermVariable v -> do - t <- requireName v - yield (TermVariable v) t [] - - TermWrap (WrappedTerm name term1) -> do - typ <- withGraphContext $ requireWrappedType name - (i, ci) <- infer term1 - yield (TermWrap $ WrappedTerm name i) (TypeWrap $ WrappedType name typ) (ci ++ [(typ, termType i)]) - -inferFieldType :: Field -> Flow InferenceContext (Field, [Constraint]) -inferFieldType (Field fname term) = do - (i, c) <- infer term - return (Field fname i, c) - -inferLet :: Let -> Flow InferenceContext (Term, [Constraint]) -inferLet (Let bindings env) = withTrace ("let(" ++ L.intercalate "," (unName . letBindingName <$> bindings) ++ ")") $ do - state0 <- getState - let e = preExtendEnv bindings $ inferenceContextEnvironment state0 - let state1 = state0 {inferenceContextEnvironment = e} - withState state1 $ do - -- TODO: perform a topological sort on the bindings; this process should be unified with that of elements in a graph - - -- Infer types of bindings in the pre-extended environment - ivalues' <- CM.mapM infer (letBindingTerm <$> bindings) - let ivalues = fst <$> ivalues' - let ibindings = L.zipWith (\(LetBinding k v t) i -> LetBinding k i t) bindings ivalues - let bc = L.concat (snd <$> ivalues') - - let tbindings = M.fromList $ fmap (\(LetBinding k i t) -> (k, termTypeScheme i)) ibindings - (ienv, cenv) <- withBindings tbindings $ infer env - - yield (TermLet $ Let ibindings ienv) (termType ienv) (bc ++ cenv) - where - -- Add any manual type annotations for the bindings to the environment, enabling type inference over recursive definitions - preExtendEnv bindings e = foldl addPair e bindings - where - addPair e (LetBinding name term _) = case typeOfTerm term of - Nothing -> e - Just typ -> M.insert name (monotype typ) e - -instantiate :: TypeScheme -> Flow InferenceContext (Type) -instantiate (TypeScheme vars t) = do - vars1 <- mapM (const freshName) vars - return $ substituteInType (M.fromList $ zip vars vars1) t - -monotype :: Type -> TypeScheme -monotype typ = TypeScheme [] typ - -productOfMaps :: Ord k => M.Map k l -> M.Map k r -> M.Map k (l, r) -productOfMaps ml mr = M.fromList $ Y.catMaybes (toPair <$> M.toList mr) - where - toPair (k, vr) = (\vl -> (k, (vl, vr))) <$> M.lookup k ml - -reduceType :: Type -> Type -reduceType t = t -- betaReduceType cx t - -requireName :: Name -> Flow InferenceContext (Type) -requireName v = do - env <- inferenceContextEnvironment <$> getState - case M.lookup v env of - Nothing -> fail $ "variable not bound in environment: " ++ unName v ++ ". Environment: " - ++ L.intercalate ", " (unName <$> M.keys env) - Just s -> instantiate s - -termType :: Term -> Type -termType term = case stripTerm term of - (TermTyped (TypedTerm _ typ)) -> typ - --- TODO: limited and temporary -termTypeScheme :: Term -> TypeScheme -termTypeScheme = monotype . termType - -typeOfPrimitive :: Name -> Flow (Graph) (Type) -typeOfPrimitive name = primitiveType <$> requirePrimitive name - -typeOfTerm :: Term -> Maybe Type -typeOfTerm term = case term of - TermAnnotated (AnnotatedTerm term1 _) -> typeOfTerm term1 - TermTyped (TypedTerm term1 typ) -> Just typ - _ -> Nothing - -withBinding :: Name -> TypeScheme -> Flow InferenceContext x -> Flow InferenceContext x -withBinding n ts = withEnvironment (M.insert n ts) - -withBindings :: M.Map Name TypeScheme -> Flow InferenceContext x -> Flow InferenceContext x -withBindings bindings = withEnvironment (\e -> M.union bindings e) - -withEnvironment :: (TypingEnvironment -> TypingEnvironment) -> Flow InferenceContext x -> Flow InferenceContext x -withEnvironment m flow = do - InferenceContext g e <- getState - withState (InferenceContext g (m e)) flow - -withGraphContext :: Flow (Graph) x -> Flow InferenceContext x -withGraphContext f = do - cx <- inferenceContextGraph <$> getState - withState cx f - -yield :: Term -> Type -> [Constraint] -> Flow InferenceContext (Term, [Constraint]) -yield term typ constraints = do - return (TermTyped $ TypedTerm term typ, constraints) - -yieldFunction :: Function -> Type -> [Constraint] -> Flow InferenceContext (Term, [Constraint]) -yieldFunction fun = yield (TermFunction fun) - -yieldElimination :: Elimination -> Type -> [Constraint] -> Flow InferenceContext (Term, [Constraint]) -yieldElimination e = yield (TermFunction $ FunctionElimination e) diff --git a/src/main/haskell/Hydra/Schemas.hs b/src/main/haskell/Hydra/Schemas.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Schemas.hs @@ -0,0 +1,158 @@ +-- | Various functions for dereferencing and decoding schema types + +module Hydra.Schemas ( + elementAsTypedTerm, + fieldTypes, + isSerializable, + moduleDependencyNamespaces, + requireRecordType, + requireType, + requireUnionType, + requireWrappedType, + resolveType, + typeDependencies, + typeDependencyNames, + ) where + +import Hydra.Basics +import Hydra.Strip +import Hydra.Coders +import Hydra.Compute +import Hydra.Core +import Hydra.CoreDecoding +import Hydra.Graph +import Hydra.Mantle +import Hydra.Module +import Hydra.Lexical +import Hydra.Rewriting +import Hydra.Tier1 +import Hydra.Tier2 +import qualified Hydra.Dsl.Expect as Expect +import qualified Hydra.Dsl.Terms as Terms + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y + + +dereferenceType :: Name -> Flow Graph (Maybe Type) +dereferenceType name = do + mel <- dereferenceElement name + case mel of + Nothing -> return Nothing + Just el -> Just <$> coreDecodeType (elementData el) + +elementAsTypedTerm :: Element -> Flow Graph TypedTerm +elementAsTypedTerm el = do + typ <- requireTermType $ elementData el + return $ TypedTerm (elementData el) typ + +fieldTypes :: Type -> Flow Graph (M.Map Name Type) +fieldTypes t = case stripType t of + TypeLambda (LambdaType _ body) -> fieldTypes body + TypeRecord rt -> pure $ toMap $ rowTypeFields rt + TypeUnion rt -> pure $ toMap $ rowTypeFields rt + TypeVariable name -> do + withTrace ("field types of " ++ unName name) $ do + el <- requireElement name + coreDecodeType (elementData el) >>= fieldTypes + _ -> unexpected "record or union type" $ show t + where + toMap fields = M.fromList (toPair <$> fields) + toPair (FieldType fname ftype) = (fname, ftype) + +isSerializable :: Element -> Flow Graph Bool +isSerializable el = do + deps <- typeDependencies (elementName el) + let allVariants = S.fromList $ L.concat (variants <$> M.elems deps) + return $ not $ S.member TypeVariantFunction allVariants + where + variants typ = typeVariant <$> foldOverType TraversalOrderPre (\m t -> t:m) [] typ + +-- | Find dependency namespaces in various dimensions of a term: va +moduleDependencyNamespaces :: Bool -> Bool -> Bool -> Bool -> Module -> Flow Graph (S.Set Namespace) +moduleDependencyNamespaces withVars withPrims withNoms withSchema mod = do + allNames <- S.unions <$> (CM.mapM elNames $ moduleElements mod) + let namespaces = S.fromList $ Y.catMaybes (namespaceOfEager <$> S.toList allNames) + return $ S.delete (moduleNamespace mod) namespaces + where + elNames el = do + let term = elementData el + let dataNames = termDependencyNames withVars withPrims withNoms term + + schemaNames <- if withSchema + then typeDependencyNames <$> requireTermType term + else pure S.empty + + typeNames <- if isEncodedType (fullyStripTerm term) + then typeDependencyNames <$> coreDecodeType term + else pure S.empty + + return $ S.unions [dataNames, schemaNames, typeNames] + +requireRecordType :: Name -> Flow Graph RowType +requireRecordType = requireRowType "record type" $ \t -> case t of + TypeRecord rt -> Just rt + _ -> Nothing + +requireRowType :: String -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType +requireRowType label getter name = do + t <- requireType name + case getter (rawType t) of + Just rt -> return rt + Nothing -> fail $ show name ++ " does not resolve to a " ++ label ++ " type: " ++ show t + where + rawType t = case t of + TypeAnnotated (AnnotatedType t' _) -> rawType t' + TypeLambda (LambdaType _ body) -> rawType body -- Note: throwing away quantification here + _ -> t + +requireType :: Name -> Flow Graph Type +requireType name = withTrace ("require type " ++ unName name) $ + (withSchemaContext $ requireElement name) >>= (coreDecodeType . elementData) + +requireUnionType :: Name -> Flow Graph RowType +requireUnionType = requireRowType "union" $ \t -> case t of + TypeUnion rt -> Just rt + _ -> Nothing + +requireWrappedType :: Name -> Flow Graph Type +requireWrappedType name = do + typ <- requireType name + case stripType typ of + TypeWrap (WrappedType name t) -> return t + _ -> return typ -- TODO: stop allowing this "slop" once typedefs are clearly separated from newtypes +-- _ -> fail $ "expected wrapped type for " ++ unName name ++ " but got " ++ show typ + +resolveType :: Type -> Flow Graph (Maybe Type) +resolveType typ = case stripType typ of + TypeVariable name -> withSchemaContext $ do + mterm <- resolveTerm name + case mterm of + Nothing -> pure Nothing + Just t -> Just <$> coreDecodeType t + _ -> pure $ Just typ + +typeDependencies :: Name -> Flow Graph (M.Map Name Type) +typeDependencies name = deps (S.fromList [name]) M.empty + where + deps seeds names = if S.null seeds + then return names + else do + pairs <- CM.mapM toPair $ S.toList seeds + let newNames = M.union names (M.fromList pairs) + let refs = L.foldl S.union S.empty (typeDependencyNames <$> (snd <$> pairs)) + let visited = S.fromList $ M.keys names + let newSeeds = S.difference refs visited + deps newSeeds newNames + where + toPair name = do + typ <- requireType name + return (name, typ) + + requireType name = do + withTrace ("type dependencies of " ++ unName name) $ do + el <- requireElement name + coreDecodeType (elementData el) diff --git a/src/main/haskell/Hydra/Scratchpad.hs b/src/main/haskell/Hydra/Scratchpad.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Scratchpad.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Hydra.Scratchpad where - -import Hydra.Core -import Hydra.Compute diff --git a/src/main/haskell/Hydra/Sources/Core.hs b/src/main/haskell/Hydra/Sources/Core.hs --- a/src/main/haskell/Hydra/Sources/Core.hs +++ b/src/main/haskell/Hydra/Sources/Core.hs @@ -29,13 +29,13 @@ doc "A term together with an annotation" $ record [ "subject">: core "Term", - "annotation">: Types.map string $ core "Term"], + "annotation">: Types.map (core "Name") $ core "Term"], def "AnnotatedType" $ doc "A type together with an annotation" $ record [ "subject">: core "Type", - "annotation">: Types.map string $ core "Term"], + "annotation">: Types.map (core "Name") $ core "Term"], def "Application" $ doc "A term which applies a function to an argument" $ @@ -181,6 +181,9 @@ "parameter">: doc "The parameter of the lambda" $ core "Name", + "domain">: + doc "An optional domain type for the lambda" $ + optional $ core "Type", "body">: doc "The body of the lambda" $ core "Term"], @@ -239,7 +242,7 @@ "values">: core "Type"], def "Name" $ - doc "A symbol which stands for a term, type, or element" + doc "A unique identifier in some context; a string-valued key" $ wrap string, def "WrappedTerm" $ @@ -286,10 +289,6 @@ "typeName">: doc "The name of the row type, which must correspond to the name of a Type element" $ core "Name", - "extends">: - doc ("Optionally, the name of another row type which this one extends. If/when field order " ++ - "is preserved, the inherited fields of the extended type precede those of the extension.") $ - optional $ core "Name", "fields">: doc "The fields of this row type, excluding any inherited fields" $ list $ core "FieldType"], @@ -340,6 +339,12 @@ "sum">: doc "A variant tuple" $ core "Sum", + "typeAbstraction">: + doc "A System F type abstraction term" $ + core "TypeAbstraction", + "typeApplication">: + doc "A System F type application term" $ + core "TypedTerm", "typed">: doc "A term annotated with its type" $ core "TypedTerm", @@ -380,6 +385,16 @@ "union">: core "RowType", "variable">: core "Name", "wrap">: core "WrappedType"], + + def "TypeAbstraction" $ + doc "A System F type abstraction term" $ + record [ + "parameter">: + doc "The type variable introduced by the abstraction" $ + core "Name", + "body">: + doc "The body of the abstraction" $ + core "Term"], def "TypeScheme" $ doc "A type expression together with free type variables occurring in the expression" $ diff --git a/src/main/haskell/Hydra/Sources/Libraries.hs b/src/main/haskell/Hydra/Sources/Libraries.hs --- a/src/main/haskell/Hydra/Sources/Libraries.hs +++ b/src/main/haskell/Hydra/Sources/Libraries.hs @@ -26,6 +26,7 @@ _hydra_lib_equality :: Namespace _hydra_lib_equality = Namespace "hydra/lib/equality" +_equality_equal = qname _hydra_lib_equality "equal" :: Name _equality_equalBinary = qname _hydra_lib_equality "equalBinary" :: Name _equality_equalBoolean = qname _hydra_lib_equality "equalBoolean" :: Name _equality_equalBigfloat = qname _hydra_lib_equality "equalBigfloat" :: Name @@ -49,6 +50,34 @@ _equality_ltInt32 = qname _hydra_lib_equality "ltInt32" :: Name _equality_lteInt32 = qname _hydra_lib_equality "lteInt32" :: Name +hydraLibEquality :: Library +hydraLibEquality = standardLibrary _hydra_lib_equality [ + prim2 [] _equality_equal x x boolean Equality.equal, + prim2 [] _equality_equalBinary binary binary boolean Equality.equalBinary, + prim2 [] _equality_equalBoolean boolean boolean boolean Equality.equalBoolean, + prim2 [] _equality_equalBigfloat bigfloat bigfloat boolean Equality.equalBigfloat, + prim2 [] _equality_equalFloat32 float32 float32 boolean Equality.equalFloat32, + prim2 [] _equality_equalFloat64 float64 float64 boolean Equality.equalFloat64, + prim2 [] _equality_equalBigint bigint bigint boolean Equality.equalBigint, + prim2 [] _equality_equalInt8 int8 int8 boolean Equality.equalInt8, + prim2 [] _equality_equalInt16 int16 int16 boolean Equality.equalInt16, + prim2 [] _equality_equalInt32 int32 int32 boolean Equality.equalInt32, + prim2 [] _equality_equalInt64 int64 int64 boolean Equality.equalInt64, + prim2 [] _equality_equalTerm term term boolean Equality.equalTerm, + prim2 [] _equality_equalType type_ type_ boolean Equality.equalType, + prim2 [] _equality_equalUint8 uint8 uint8 boolean Equality.equalUint8, + prim2 [] _equality_equalUint16 uint16 uint16 boolean Equality.equalUint16, + prim2 [] _equality_equalUint32 uint32 uint32 boolean Equality.equalUint32, + prim2 [] _equality_equalUint64 uint64 uint64 boolean Equality.equalUint64, + prim2 [] _equality_equalString string string boolean Equality.equalString, + prim1 ["x"] _equality_identity x x Equality.identity, + prim2 [] _equality_gtInt32 int32 int32 boolean Equality.gtInt32, + prim2 [] _equality_gteInt32 int32 int32 boolean Equality.gteInt32, + prim2 [] _equality_ltInt32 int32 int32 boolean Equality.ltInt32, + prim2 [] _equality_lteInt32 int32 int32 boolean Equality.lteInt32] + where + x = variable "x" + _hydra_lib_flows :: Namespace _hydra_lib_flows = Namespace "hydra/lib/flows" @@ -58,21 +87,61 @@ _flows_map = qname _hydra_lib_flows "map" :: Name _flows_mapList = qname _hydra_lib_flows "mapList" :: Name _flows_pure = qname _hydra_lib_flows "pure" :: Name +_flows_sequence = qname _hydra_lib_flows "sequence" :: Name +hydraLibFlows :: Library +hydraLibFlows = standardLibrary _hydra_lib_flows [ + prim2 ["s", "x", "y"] _flows_apply (flow s (function x y)) (flow s x) (flow s y) Flows.apply, + prim2 ["s", "x", "y"] _flows_bind (flow s x) (function x (flow s y)) (flow s y) Flows.bind, + prim1 ["s", "x"] _flows_fail string (flow s x) Flows.fail, + prim2 ["s", "x", "y"] _flows_map (function x y) (flow s x) (flow s y) Flows.map, + prim2 ["s", "x", "y"] _flows_mapList (function x (flow s y)) (list x) (flow s (list y)) Flows.mapList, + prim1 ["s", "x"] _flows_pure x (flow s x) Flows.pure, + prim1 ["s", "x"] _flows_sequence (list (flow s x)) (flow s (list x)) Flows.sequence] + where + s = variable "s" + x = variable "x" + y = variable "y" + +applyInterp :: Term -> Term -> Flow Graph Term +applyInterp funs' args' = do + funs <- Expect.list Prelude.pure funs' + args <- Expect.list Prelude.pure args' + return $ Terms.list $ L.concat (helper args <$> funs) + where + helper args f = Terms.apply f <$> args + +bindInterp :: Term -> Term -> Flow Graph Term +bindInterp args' fun = do + args <- Expect.list Prelude.pure args' + return $ Terms.apply (Terms.primitive $ Name "hydra/lib/lists.concat") (Terms.list $ Terms.apply fun <$> args) + +mapInterp :: Term -> Term -> Flow Graph Term +mapInterp fun args' = do + args <- Expect.list Prelude.pure args' + return $ Terms.list (Terms.apply fun <$> args) + _hydra_lib_io :: Namespace _hydra_lib_io = Namespace "hydra/lib/io" _io_showTerm = qname _hydra_lib_io "showTerm" :: Name _io_showType = qname _hydra_lib_io "showType" :: Name +hydraLibIo :: Library +hydraLibIo = standardLibrary _hydra_lib_io [ + prim1 [] _io_showTerm term string Io.showTerm, + prim1 [] _io_showType type_ string Io.showType] + _hydra_lib_lists :: Namespace _hydra_lib_lists = Namespace "hydra/lib/lists" _lists_apply = qname _hydra_lib_lists "apply" :: Name +_lists_at = qname _hydra_lib_lists "at" :: Name _lists_bind = qname _hydra_lib_lists "bind" :: Name _lists_concat = qname _hydra_lib_lists "concat" :: Name _lists_concat2 = qname _hydra_lib_lists "concat2" :: Name _lists_cons = qname _hydra_lib_lists "cons" :: Name +_lists_filter = qname _hydra_lib_lists "filter" :: Name _lists_foldl = qname _hydra_lib_lists "foldl" :: Name _lists_head = qname _hydra_lib_lists "head" :: Name _lists_intercalate = qname _hydra_lib_lists "intercalate" :: Name @@ -87,6 +156,32 @@ _lists_safeHead = qname _hydra_lib_lists "safeHead" :: Name _lists_tail = qname _hydra_lib_lists "tail" :: Name +hydraLibLists :: Library +hydraLibLists = standardLibrary _hydra_lib_lists [ + prim2Interp ["x", "y"] _lists_apply (list $ function x y) (list x) (list y) applyInterp, + prim2 ["x"] _lists_at int32 (list x) x Lists.at, + prim2Interp ["x", "y"] _lists_bind (list x) (function x (list y)) (list y) bindInterp, + prim1 ["x"] _lists_concat (list (list x)) (list x) Lists.concat, + prim2 ["x"] _lists_concat2 (list x) (list x) (list x) Lists.concat2, + prim2 ["x"] _lists_cons x (list x) (list x) Lists.cons, + prim2 ["x"] _lists_filter (function x boolean) (list x) (list x) Lists.filter, + prim3 ["x", "y"] _lists_foldl (function y (function x y)) y (list x) y Lists.foldl, + prim1 ["x"] _lists_head (list x) x Lists.head, + prim2 ["x"] _lists_intercalate (list x) (list (list x)) (list x) Lists.intercalate, + prim2 ["x"] _lists_intersperse x (list x) (list x) Lists.intersperse, + prim1 ["x"] _lists_last (list x) x Lists.last, + prim1 ["x"] _lists_length (list x) int32 Lists.length, + prim2Interp ["x", "y"] _lists_map (function x y) (list x) (list y) mapInterp, + prim1 ["x"] _lists_nub (list x) (list x) Lists.nub, + prim1 ["x"] _lists_null (list x) boolean Lists.null, + prim1 ["x"] _lists_pure x (list x) Lists.pure, + prim1 ["x"] _lists_reverse (list x) (list x) Lists.reverse, + prim1 ["x"] _lists_safeHead (list x) (optional x) Lists.safeHead, + prim1 ["x"] _lists_tail (list x) (list x) Lists.tail] + where + x = variable "x" + y = variable "y" + _hydra_lib_literals :: Namespace _hydra_lib_literals = Namespace "hydra/lib/literals" @@ -115,6 +210,33 @@ _literals_uint32ToBigint = qname _hydra_lib_literals "uint32ToBigint" :: Name _literals_uint64ToBigint = qname _hydra_lib_literals "uint64ToBigint" :: Name +hydraLibLiterals :: Library +hydraLibLiterals = standardLibrary _hydra_lib_literals [ + prim1 [] _literals_bigfloatToBigint bigfloat bigint Literals.bigfloatToBigint, + prim1 [] _literals_bigfloatToFloat32 bigfloat float32 Literals.bigfloatToFloat32, + prim1 [] _literals_bigfloatToFloat64 bigfloat float64 Literals.bigfloatToFloat64, + prim1 [] _literals_bigintToBigfloat bigint bigfloat Literals.bigintToBigfloat, + prim1 [] _literals_bigintToInt8 bigint int8 Literals.bigintToInt8, + prim1 [] _literals_bigintToInt16 bigint int16 Literals.bigintToInt16, + prim1 [] _literals_bigintToInt32 bigint int32 Literals.bigintToInt32, + prim1 [] _literals_bigintToInt64 bigint int64 Literals.bigintToInt64, + prim1 [] _literals_bigintToUint8 bigint uint8 Literals.bigintToUint8, + prim1 [] _literals_bigintToUint16 bigint uint16 Literals.bigintToUint16, + prim1 [] _literals_bigintToUint32 bigint uint32 Literals.bigintToUint32, + prim1 [] _literals_bigintToUint64 bigint uint64 Literals.bigintToUint64, + prim1 [] _literals_float32ToBigfloat float32 bigfloat Literals.float32ToBigfloat, + prim1 [] _literals_float64ToBigfloat float64 bigfloat Literals.float64ToBigfloat, + prim1 [] _literals_int8ToBigint int8 bigint Literals.int8ToBigint, + prim1 [] _literals_int16ToBigint int16 bigint Literals.int16ToBigint, + prim1 [] _literals_int32ToBigint int32 bigint Literals.int32ToBigint, + prim1 [] _literals_int64ToBigint int64 bigint Literals.int64ToBigint, + prim1 [] _literals_showInt32 int32 string Literals.showInt32, + prim1 [] _literals_showString string string Literals.showString, + prim1 [] _literals_uint8ToBigint uint8 bigint Literals.uint8ToBigint, + prim1 [] _literals_uint16ToBigint uint16 bigint Literals.uint16ToBigint, + prim1 [] _literals_uint32ToBigint uint32 bigint Literals.uint32ToBigint, + prim1 [] _literals_uint64ToBigint uint64 bigint Literals.uint64ToBigint] + _hydra_lib_logic :: Namespace _hydra_lib_logic = Namespace "hydra/lib/logic" @@ -123,6 +245,15 @@ _logic_not = qname _hydra_lib_logic "not" :: Name _logic_or = qname _hydra_lib_logic "or" :: Name +hydraLibLogic :: Library +hydraLibLogic = standardLibrary _hydra_lib_logic [ + prim2 [] _logic_and boolean boolean boolean Logic.and, + prim3 ["x"] _logic_ifElse x x boolean x Logic.ifElse, + prim1 [] _logic_not boolean boolean Logic.not, + prim2 [] _logic_or boolean boolean boolean Logic.or] + where + x = variable "x" + _hydra_lib_maps :: Namespace _hydra_lib_maps = Namespace "hydra/lib/maps" @@ -140,6 +271,31 @@ _maps_toList = qname _hydra_lib_maps "toList" :: Name _maps_values = qname _hydra_lib_maps "values" :: Name +hydraLibMaps :: Library +hydraLibMaps = standardLibrary _hydra_lib_maps [ + prim0 ["k", "v"] _maps_empty mapKv Maps.empty, + prim1 ["k", "v"] _maps_fromList (list $ pair k v) mapKv Maps.fromList, + prim3 ["k", "v"] _maps_insert k v mapKv mapKv Maps.insert, + prim1 ["k", "v"] _maps_isEmpty mapKv boolean Maps.isEmpty, + prim1 ["k", "v"] _maps_keys mapKv (list k) Maps.keys, + prim2 ["k", "v"] _maps_lookup k mapKv (optional v) Maps.lookup, + prim2 ["k", "v1", "v2"] _maps_map (function v1 v2) (Prims.map k v1) (Prims.map k v2) Maps.map, + prim2 ["k1", "k2", "v"] _maps_mapKeys (function k1 k2) (Prims.map k1 v) (Prims.map k2 v) Maps.mapKeys, + prim1 ["k", "v"] _maps_size mapKv int32 Maps.size, + prim2 ["k", "v"] _maps_remove k mapKv mapKv Maps.remove, + prim2 ["k", "v"] _maps_singleton k v mapKv Maps.singleton, + prim1 ["k", "v"] _maps_size mapKv int32 Maps.size, + prim1 ["k", "v"] _maps_toList mapKv (list $ pair k v) Maps.toList, + prim1 ["k", "v"] _maps_values mapKv (list v) Maps.values] + where + k = variable "k" + k1 = variable "k1" + k2 = variable "k2" + v = variable "v" + v1 = variable "v1" + v2 = variable "v2" + mapKv = Prims.map k v + _hydra_lib_math :: Namespace _hydra_lib_math = Namespace "hydra/lib/math" @@ -151,6 +307,16 @@ _math_rem = qname _hydra_lib_math "rem" :: Name _math_sub = qname _hydra_lib_math "sub" :: Name +hydraLibMathInt32 :: Library +hydraLibMathInt32 = standardLibrary _hydra_lib_math [ + prim2 [] _math_add int32 int32 int32 Math.add, + prim2 [] _math_div int32 int32 int32 Math.div, + prim2 [] _math_mod int32 int32 int32 Math.mod, + prim2 [] _math_mul int32 int32 int32 Math.mul, + prim1 [] _math_neg int32 int32 Math.neg, + prim2 [] _math_rem int32 int32 int32 Math.rem, + prim2 [] _math_sub int32 int32 int32 Math.sub] + _hydra_lib_optionals :: Namespace _hydra_lib_optionals = Namespace "hydra/lib/optionals" @@ -158,6 +324,7 @@ _optionals_apply = qname _hydra_lib_optionals "apply" :: Name _optionals_bind = qname _hydra_lib_optionals "bind" :: Name _optionals_cat = qname _hydra_lib_optionals "cat" :: Name +_optionals_compose = qname _hydra_lib_optionals "compose" :: Name _optionals_fromMaybe = qname _hydra_lib_optionals "fromMaybe" :: Name _optionals_isJust = qname _hydra_lib_optionals "isJust" :: Name _optionals_isNothing = qname _hydra_lib_optionals "isNothing" :: Name @@ -165,6 +332,23 @@ _optionals_maybe = qname _hydra_lib_optionals "maybe" :: Name _optionals_pure = qname _hydra_lib_optionals "pure" :: Name +hydraLibOptionals :: Library +hydraLibOptionals = standardLibrary _hydra_lib_optionals [ + prim2 ["x", "y"] _optionals_apply (optional $ function x y) (optional x) (optional y) Optionals.apply, + prim2 ["x", "y"] _optionals_bind (optional x) (function x (optional y)) (optional y) Optionals.bind, + prim1 ["x"] _optionals_cat (list $ optional x) (list x) Optionals.cat, + prim2 ["x", "y", "z"] _optionals_compose (function x $ optional y) (function y $ optional z) (function x $ optional z) Optionals.compose, + prim2 ["x"] _optionals_fromMaybe x (optional x) x Optionals.fromMaybe, + prim1 ["x"] _optionals_isJust (optional x) boolean Optionals.isJust, + prim1 ["x"] _optionals_isNothing (optional x) boolean Optionals.isNothing, + prim2 ["x", "y"] _optionals_map (function x y) (optional x) (optional y) Optionals.map, + prim3 ["x", "y"] _optionals_maybe y (function x y) (optional x) y Optionals.maybe, + prim1 ["x"] _optionals_pure x (optional x) Optionals.pure] + where + x = variable "x" + y = variable "y" + z = variable "z" + _hydra_lib_sets :: Namespace _hydra_lib_sets = Namespace "hydra/lib/sets" @@ -182,6 +366,25 @@ _sets_toList = qname _hydra_lib_sets "toList" :: Name _sets_union = qname _hydra_lib_sets "union" :: Name +hydraLibSets :: Library +hydraLibSets = standardLibrary _hydra_lib_sets [ + prim2 ["x"] _sets_contains x (set x) boolean Sets.contains, + prim2 ["x"] _sets_difference (set x) (set x) (set x) Sets.difference, + prim0 ["x"] _sets_empty (set x) Sets.empty, + prim1 ["x"] _sets_fromList (list x) (set x) Sets.fromList, + prim2 ["x"] _sets_insert x (set x) (set x) Sets.insert, + prim2 ["x"] _sets_intersection (set x) (set x) (set x) Sets.intersection, + prim1 ["x"] _sets_isEmpty (set x) boolean Sets.isEmpty, + prim2 ["x", "y"] _sets_map (function x y) (set x) (set y) Sets.map, + prim2 ["x"] _sets_remove x (set x) (set x) Sets.remove, + prim1 ["x"] _sets_singleton x (set x) Sets.singleton, + prim1 ["x"] _sets_size (set x) int32 Sets.size, + prim1 ["x"] _sets_toList (set x) (list x) Sets.toList, + prim2 ["x"] _sets_union (set x) (set x) (set x) Sets.union] + where + x = variable "x" + y = variable "y" + _hydra_lib_strings :: Namespace _hydra_lib_strings = Namespace "hydra/lib/strings" @@ -196,221 +399,35 @@ _strings_toLower = qname _hydra_lib_strings "toLower" :: Name _strings_toUpper = qname _hydra_lib_strings "toUpper" :: Name -hydraLibEqualityPrimitives :: [Primitive] -hydraLibEqualityPrimitives = [ - prim2 _equality_equalBinary binary binary boolean Equality.equalBinary, - prim2 _equality_equalBoolean boolean boolean boolean Equality.equalBoolean, - prim2 _equality_equalBigfloat bigfloat bigfloat boolean Equality.equalBigfloat, - prim2 _equality_equalFloat32 float32 float32 boolean Equality.equalFloat32, - prim2 _equality_equalFloat64 float64 float64 boolean Equality.equalFloat64, - prim2 _equality_equalBigint bigint bigint boolean Equality.equalBigint, - prim2 _equality_equalInt8 int8 int8 boolean Equality.equalInt8, - prim2 _equality_equalInt16 int16 int16 boolean Equality.equalInt16, - prim2 _equality_equalInt32 int32 int32 boolean Equality.equalInt32, - prim2 _equality_equalInt64 int64 int64 boolean Equality.equalInt64, - prim2 _equality_equalTerm term term boolean Equality.equalTerm, - prim2 _equality_equalType type_ type_ boolean Equality.equalType, - prim2 _equality_equalUint8 uint8 uint8 boolean Equality.equalUint8, - prim2 _equality_equalUint16 uint16 uint16 boolean Equality.equalUint16, - prim2 _equality_equalUint32 uint32 uint32 boolean Equality.equalUint32, - prim2 _equality_equalUint64 uint64 uint64 boolean Equality.equalUint64, - prim2 _equality_equalString string string boolean Equality.equalString, - prim1 _equality_identity x x Equality.identity, - prim2 _equality_gtInt32 int32 int32 boolean Equality.gtInt32, - prim2 _equality_gteInt32 int32 int32 boolean Equality.gteInt32, - prim2 _equality_ltInt32 int32 int32 boolean Equality.ltInt32, - prim2 _equality_lteInt32 int32 int32 boolean Equality.lteInt32] - where - x = variable "x" - -hydraLibFlowsPrimitives :: [Primitive] -hydraLibFlowsPrimitives = [ - prim2 _flows_apply (flow s (function x y)) (flow s x) (flow s y) Flows.apply, - prim2 _flows_bind (flow s x) (function x (flow s y)) (flow s y) Flows.bind, - prim1 _flows_fail string (flow s x) Flows.fail, - prim2 _flows_map (function x y) (flow s x) (flow s y) Flows.map, - prim2 _flows_mapList (function x $ flow s y) (list x) (flow s $ list y) Flows.mapList, - prim1 _flows_pure x (flow s x) Flows.pure] - where - s = variable "s" - x = variable "x" - y = variable "y" - -applyInterp :: Term -> Term -> Flow (Graph) (Term) -applyInterp funs' args' = do - funs <- Expect.list Prelude.pure funs' - args <- Expect.list Prelude.pure args' - return $ Terms.list $ L.concat (helper args <$> funs) - where - helper args f = Terms.apply f <$> args - -bindInterp :: Term -> Term -> Flow (Graph) (Term) -bindInterp args' fun = do - args <- Expect.list Prelude.pure args' - return $ Terms.apply (Terms.primitive $ Name "hydra/lib/lists.concat") (Terms.list $ Terms.apply fun <$> args) - -mapInterp :: Term -> Term -> Flow (Graph) (Term) -mapInterp fun args' = do - args <- Expect.list Prelude.pure args' - return $ Terms.list (Terms.apply fun <$> args) - -hydraLibIoPrimitives :: [Primitive] -hydraLibIoPrimitives = [ - prim1 _io_showTerm term string Io.showTerm, - prim1 _io_showType type_ string Io.showType] - -hydraLibListsPrimitives :: [Primitive] -hydraLibListsPrimitives = [ - prim2Interp _lists_apply (list $ function x y) (list x) (list y) applyInterp, - prim2Interp _lists_bind (list x) (function x (list y)) (list y) bindInterp, - prim1 _lists_concat (list (list x)) (list x) Lists.concat, - prim2 _lists_concat2 (list x) (list x) (list x) Lists.concat2, - prim2 _lists_cons x (list x) (list x) Lists.cons, - prim3 _lists_foldl (function y (function x y)) y (list x) y Lists.foldl, - prim1 _lists_head (list x) x Lists.head, - prim2 _lists_intercalate (list x) (list (list x)) (list x) Lists.intercalate, - prim2 _lists_intersperse x (list x) (list x) Lists.intersperse, - prim1 _lists_last (list x) x Lists.last, - prim1 _lists_length (list x) int32 Lists.length, - prim2Interp _lists_map (function x y) (list x) (list y) mapInterp, - prim1 _lists_nub (list x) (list x) Lists.nub, - prim1 _lists_null (list x) boolean Lists.null, - prim1 _lists_pure x (list x) Lists.pure, - prim1 _lists_reverse (list x) (list x) Lists.reverse, - prim1 _lists_safeHead (list x) (optional x) Lists.safeHead, - prim1 _lists_tail (list x) (list x) Lists.tail] - where - x = variable "x" - y = variable "y" - -hydraLibLiteralsPrimitives :: [Primitive] -hydraLibLiteralsPrimitives = [ - prim1 _literals_bigfloatToBigint bigfloat bigint Literals.bigfloatToBigint, - prim1 _literals_bigfloatToFloat32 bigfloat float32 Literals.bigfloatToFloat32, - prim1 _literals_bigfloatToFloat64 bigfloat float64 Literals.bigfloatToFloat64, - prim1 _literals_bigintToBigfloat bigint bigfloat Literals.bigintToBigfloat, - prim1 _literals_bigintToInt8 bigint int8 Literals.bigintToInt8, - prim1 _literals_bigintToInt16 bigint int16 Literals.bigintToInt16, - prim1 _literals_bigintToInt32 bigint int32 Literals.bigintToInt32, - prim1 _literals_bigintToInt64 bigint int64 Literals.bigintToInt64, - prim1 _literals_bigintToUint8 bigint uint8 Literals.bigintToUint8, - prim1 _literals_bigintToUint16 bigint uint16 Literals.bigintToUint16, - prim1 _literals_bigintToUint32 bigint uint32 Literals.bigintToUint32, - prim1 _literals_bigintToUint64 bigint uint64 Literals.bigintToUint64, - prim1 _literals_float32ToBigfloat float32 bigfloat Literals.float32ToBigfloat, - prim1 _literals_float64ToBigfloat float64 bigfloat Literals.float64ToBigfloat, - prim1 _literals_int8ToBigint int8 bigint Literals.int8ToBigint, - prim1 _literals_int16ToBigint int16 bigint Literals.int16ToBigint, - prim1 _literals_int32ToBigint int32 bigint Literals.int32ToBigint, - prim1 _literals_int64ToBigint int64 bigint Literals.int64ToBigint, - prim1 _literals_showInt32 int32 string Literals.showInt32, - prim1 _literals_showString string string Literals.showString, - prim1 _literals_uint8ToBigint uint8 bigint Literals.uint8ToBigint, - prim1 _literals_uint16ToBigint uint16 bigint Literals.uint16ToBigint, - prim1 _literals_uint32ToBigint uint32 bigint Literals.uint32ToBigint, - prim1 _literals_uint64ToBigint uint64 bigint Literals.uint64ToBigint] - -hydraLibLogicPrimitives :: [Primitive] -hydraLibLogicPrimitives = [ - prim2 _logic_and boolean boolean boolean Logic.and, - prim3 _logic_ifElse x x boolean x Logic.ifElse, - prim1 _logic_not boolean boolean Logic.not, - prim2 _logic_or boolean boolean boolean Logic.or] - where - x = variable "x" - -hydraLibMapsPrimitives :: [Primitive] -hydraLibMapsPrimitives = [ - prim0 _maps_empty mapKv Maps.empty, - prim1 _maps_fromList (list $ pair k v) mapKv Maps.fromList, - prim3 _maps_insert k v mapKv mapKv Maps.insert, - prim1 _maps_isEmpty mapKv boolean Maps.isEmpty, - prim1 _maps_keys mapKv (list k) Maps.keys, - prim2 _maps_lookup k mapKv (optional v) Maps.lookup, - prim2 _maps_map (function v1 v2) (Prims.map k v1) (Prims.map k v2) Maps.map, - prim2 _maps_mapKeys (function k1 k2) (Prims.map k1 v) (Prims.map k2 v) Maps.mapKeys, - prim1 _maps_size mapKv int32 Maps.size, - prim2 _maps_remove k mapKv mapKv Maps.remove, - prim2 _maps_singleton k v mapKv Maps.singleton, - prim1 _maps_size mapKv int32 Maps.size, - prim1 _maps_toList mapKv (list $ pair k v) Maps.toList, - prim1 _maps_values mapKv (list v) Maps.values] - where - k = variable "k" - k1 = variable "k1" - k2 = variable "k2" - v = variable "v" - v1 = variable "v1" - v2 = variable "v2" - mapKv = Prims.map k v - -hydraLibMathInt32Primitives :: [Primitive] -hydraLibMathInt32Primitives = [ - prim2 _math_add int32 int32 int32 Math.add, - prim2 _math_div int32 int32 int32 Math.div, - prim2 _math_mod int32 int32 int32 Math.mod, - prim2 _math_mul int32 int32 int32 Math.mul, - prim1 _math_neg int32 int32 Math.neg, - prim2 _math_rem int32 int32 int32 Math.rem, - prim2 _math_sub int32 int32 int32 Math.sub] - -hydraLibOptionalsPrimitives :: [Primitive] -hydraLibOptionalsPrimitives = [ - prim2 _optionals_apply (optional $ function x y) (optional x) (optional y) Optionals.apply, - prim2 _optionals_bind (optional x) (function x (optional y)) (optional y) Optionals.bind, - prim1 _optionals_cat (list $ optional x) (list x) Optionals.cat, - prim2 _optionals_fromMaybe x (optional x) x Optionals.fromMaybe, - prim1 _optionals_isJust (optional x) boolean Optionals.isJust, - prim1 _optionals_isNothing (optional x) boolean Optionals.isNothing, - prim2 _optionals_map (function x y) (optional x) (optional y) Optionals.map, - prim3 _optionals_maybe y (function x y) (optional x) y Optionals.maybe, - prim1 _optionals_pure x (optional x) Optionals.pure] - where - x = variable "x" - y = variable "y" - -hydraLibSetsPrimitives :: [Primitive] -hydraLibSetsPrimitives = [ - prim2 _sets_contains x (set x) boolean Sets.contains, - prim2 _sets_difference (set x) (set x) (set x) Sets.difference, - prim0 _sets_empty (set x) Sets.empty, - prim1 _sets_fromList (list x) (set x) Sets.fromList, - prim2 _sets_insert x (set x) (set x) Sets.insert, - prim2 _sets_intersection (set x) (set x) (set x) Sets.intersection, - prim1 _sets_isEmpty (set x) boolean Sets.isEmpty, - prim2 _sets_map (function x y) (set x) (set y) Sets.map, - prim2 _sets_remove x (set x) (set x) Sets.remove, - prim1 _sets_singleton x (set x) Sets.singleton, - prim1 _sets_size (set x) int32 Sets.size, - prim1 _sets_toList (set x) (list x) Sets.toList, - prim2 _sets_union (set x) (set x) (set x) Sets.union] - where - x = variable "x" - y = variable "y" +hydraLibStrings :: Library +hydraLibStrings = standardLibrary _hydra_lib_strings [ + prim1 [] _strings_cat (list string) string Strings.cat, + prim2 [] _strings_cat2 string string string Strings.cat2, + prim1 [] _strings_fromList (list int32) string Strings.fromList, + prim2 [] _strings_intercalate string (list string) string Strings.intercalate, + prim1 [] _strings_isEmpty string boolean Strings.isEmpty, + prim1 [] _strings_length string int32 Strings.length, + prim2 [] _strings_splitOn string string (list string) Strings.splitOn, + prim1 [] _strings_toList string (list int32) Strings.toList, + prim1 [] _strings_toLower string string Strings.toLower, + prim1 [] _strings_toUpper string string Strings.toUpper] -hydraLibStringsPrimitives :: [Primitive] -hydraLibStringsPrimitives = [ - prim1 _strings_cat (list string) string Strings.cat, - prim2 _strings_cat2 string string string Strings.cat2, - prim1 _strings_fromList (list int32) string Strings.fromList, - prim2 _strings_intercalate string (list string) string Strings.intercalate, - prim1 _strings_isEmpty string boolean Strings.isEmpty, - prim1 _strings_length string int32 Strings.length, - prim2 _strings_splitOn string string (list string) Strings.splitOn, - prim1 _strings_toList string (list int32) Strings.toList, - prim1 _strings_toLower string string Strings.toLower, - prim1 _strings_toUpper string string Strings.toUpper] +standardLibrary :: Namespace -> [Primitive] -> Library +standardLibrary ns prims = Library { + libraryNamespace = ns, + libraryPrefix = L.drop (L.length ("hydra/lib/" :: String)) $ unNamespace ns, + libraryPrimitives = prims} -standardPrimitives :: [Primitive] -standardPrimitives = - hydraLibEqualityPrimitives - ++ hydraLibFlowsPrimitives - ++ hydraLibIoPrimitives - ++ hydraLibListsPrimitives - ++ hydraLibLiteralsPrimitives - ++ hydraLibLogicPrimitives - ++ hydraLibMapsPrimitives - ++ hydraLibMathInt32Primitives - ++ hydraLibOptionalsPrimitives - ++ hydraLibSetsPrimitives - ++ hydraLibStringsPrimitives +standardLibraries :: [Library] +standardLibraries = [ + hydraLibEquality, + hydraLibFlows, + hydraLibIo, + hydraLibLists, + hydraLibLiterals, + hydraLibLogic, + hydraLibMaps, + hydraLibMathInt32, + hydraLibOptionals, + hydraLibSets, + hydraLibStrings] diff --git a/src/main/haskell/Hydra/Sources/Tier0/Compute.hs b/src/main/haskell/Hydra/Sources/Tier0/Compute.hs --- a/src/main/haskell/Hydra/Sources/Tier0/Compute.hs +++ b/src/main/haskell/Hydra/Sources/Tier0/Compute.hs @@ -65,4 +65,4 @@ "messages">: list string, "other">: doc "A map of string keys to arbitrary terms as values, for application-specific use" $ - Types.map string (core "Term")]] + Types.map (core "Name") (core "Term")]] diff --git a/src/main/haskell/Hydra/Sources/Tier0/Graph.hs b/src/main/haskell/Hydra/Sources/Tier0/Graph.hs --- a/src/main/haskell/Hydra/Sources/Tier0/Graph.hs +++ b/src/main/haskell/Hydra/Sources/Tier0/Graph.hs @@ -49,7 +49,7 @@ Types.map (core "Name") (optional $ core "Term"), "types">: doc "The typing environment of the graph" $ - Types.map (core "Name") (core "Type"), + Types.map (core "Name") (core "TypeScheme"), "body">: doc "The body of the term which generated this context" $ core "Term", @@ -74,7 +74,7 @@ core "Name", "type">: doc "The type signature of the primitive function" $ - core "Type", + core "TypeScheme", "implementation">: doc "A concrete implementation of the primitive function" $ list (core "Term") --> compute "Flow" @@ (graph "Graph") @@ (core "Term")], diff --git a/src/main/haskell/Hydra/Sources/Tier0/Json.hs b/src/main/haskell/Hydra/Sources/Tier0/Json.hs --- a/src/main/haskell/Hydra/Sources/Tier0/Json.hs +++ b/src/main/haskell/Hydra/Sources/Tier0/Json.hs @@ -27,9 +27,21 @@ def "Value" $ doc "A JSON value" $ union [ - "array">: list $ json "Value", - "boolean">: boolean, - "null">: unit, - "number">: bigfloat, -- TODO: JSON numbers are decimal-encoded - "object">: Types.map string (json "Value"), - "string">: string]] + "array">: + doc "A JSON array" $ + list $ json "Value", + "boolean">: + doc "A boolean value" + boolean, + "null">: + doc "JSON's null value" + unit, + "number">: + doc "A numeric value" + bigfloat, -- TODO: JSON numbers are decimal-encoded + "object">: + doc "A JSON object as a set of key/value pairs" $ + Types.map string (json "Value"), + "string">: + doc "A string value" + string]] diff --git a/src/main/haskell/Hydra/Sources/Tier0/Mantle.hs b/src/main/haskell/Hydra/Sources/Tier0/Mantle.hs --- a/src/main/haskell/Hydra/Sources/Tier0/Mantle.hs +++ b/src/main/haskell/Hydra/Sources/Tier0/Mantle.hs @@ -16,7 +16,7 @@ hydraMantleModule :: Module hydraMantleModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $ - Just "A set of types which supplement hydra/core with type variants, graphs, and elements" + Just "A set of types which supplement hydra/core with variants and accessors" where ns = Namespace "hydra/mantle" core = typeref $ moduleNamespace hydraCoreModule @@ -63,6 +63,34 @@ "arbitrary">: unit, "bits">: int32], + def "TermAccessor" $ + doc "A function which maps from a term to a particular immediate subterm" $ + union [ + "annotatedSubject">: unit, + "applicationFunction">: unit, + "applicationArgument">: unit, + "lambdaBody">: unit, + "listFold">: unit, + "optionalCasesNothing">: unit, + "optionalCasesJust">: unit, + "unionCasesDefault">: unit, + "unionCasesBranch">: core "Name", + "letEnvironment">: unit, + "letBinding">: core "Name", + "listElement">: int32, + "mapKey">: int32, + "mapValue">: int32, + "optionalTerm">: unit, + "productTerm">: int32, + "recordField">: core "Name", + "setElement">: int32, + "sumTerm">: unit, + "typeAbstractionBody">: unit, + "typeApplicationTerm">: unit, + "typedTerm">: unit, + "injectionTerm">: unit, + "wrappedTerm">: unit], + def "TermVariant" $ doc "The identifier of a term expression constructor" $ enum [ @@ -78,10 +106,19 @@ "record", "set", "sum", + "typeAbstraction", + "typeApplication", "typed", "union", "variable", "wrap"], + + def "TypeConstraint" $ + doc "An assertion that two types can be unified into a single type" $ + record [ + "left">: core "Type", + "right">: core "Type", + "context">: optional string], def "TypeVariant" $ doc "The identifier of a type constructor" $ diff --git a/src/main/haskell/Hydra/Sources/Tier0/Module.hs b/src/main/haskell/Hydra/Sources/Tier0/Module.hs --- a/src/main/haskell/Hydra/Sources/Tier0/Module.hs +++ b/src/main/haskell/Hydra/Sources/Tier0/Module.hs @@ -29,6 +29,19 @@ def "FileExtension" string, + def "Library" $ + doc "A library of primitive functions" $ + record [ + "namespace">: + doc "A common prefix for all primitive function names in the library" $ + mod "Namespace", + "prefix">: + doc "A preferred namespace prefix for function names in the library" + string, + "primitives">: + doc "The primitives defined in this library" $ + list $ graph "Primitive"], + def "Module" $ doc "A logical collection of elements in the same namespace, having dependencies on zero or more other modules" $ record [ diff --git a/src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs b/src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs --- a/src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs +++ b/src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs @@ -18,7 +18,7 @@ hydraPhantomsModule :: Module hydraPhantomsModule = Module ns elements [hydraComputeModule] [hydraCoreModule] $ - Just "Phantom types for use in model definitions" + Just "Phantom types for use with Hydra DSLs" where ns = Namespace "hydra/phantoms" core = typeref $ moduleNamespace hydraCoreModule @@ -26,24 +26,21 @@ def = datatype ns elements = [ - def "Case" $ + + def "TCase" $ doc "An association of a field name (as in a case statement) with a phantom type" $ lambda "a" $ core "Name", - def "Datum" $ - doc "An association of a term with a phantom type" $ - lambda "a" $ core "Term", - - def "Definition" $ - doc "An association with a named term with a phantom type" $ + def "TElement" $ + doc "An association with a named term (element) with a phantom type" $ lambda "a" $ record [ "name">: core "Name", - "datum">: phantoms "Datum" @@ "a"], + "term">: phantoms "TTerm" @@ "a"], - def "Fld" $ + def "TField" $ doc "An association with a term-level field with a phantom type" $ lambda "a" $ core "Field", - def "Reference" $ - doc "A pure association with a phantom type" $ - lambda "a" $ unit] + def "TTerm" $ + doc "An association of a term with a phantom type" $ + lambda "a" $ core "Term"] diff --git a/src/main/haskell/Hydra/Sources/Tier1/All.hs b/src/main/haskell/Hydra/Sources/Tier1/All.hs --- a/src/main/haskell/Hydra/Sources/Tier1/All.hs +++ b/src/main/haskell/Hydra/Sources/Tier1/All.hs @@ -3,6 +3,7 @@ module Hydra.Sources.Tier0.All, module Hydra.Sources.Tier1.Constants, module Hydra.Sources.Tier1.CoreEncoding, + module Hydra.Sources.Tier1.Decode, module Hydra.Sources.Tier1.Messages, module Hydra.Sources.Tier1.Strip, module Hydra.Sources.Tier1.Tier1, @@ -11,6 +12,7 @@ import Hydra.Sources.Tier0.All import Hydra.Sources.Tier1.Constants import Hydra.Sources.Tier1.CoreEncoding hiding (ref) +import Hydra.Sources.Tier1.Decode import Hydra.Sources.Tier1.Messages import Hydra.Sources.Tier1.Strip import Hydra.Sources.Tier1.Tier1 @@ -18,6 +20,7 @@ tier1Modules :: [Module] tier1Modules = [ coreEncodingModule, + decodeModule, hydraConstantsModule, hydraMessagesModule, hydraStripModule, diff --git a/src/main/haskell/Hydra/Sources/Tier1/Constants.hs b/src/main/haskell/Hydra/Sources/Tier1/Constants.hs --- a/src/main/haskell/Hydra/Sources/Tier1/Constants.hs +++ b/src/main/haskell/Hydra/Sources/Tier1/Constants.hs @@ -26,7 +26,7 @@ import Hydra.Sources.Tier0.All -constantsDefinition :: String -> Datum a -> Definition a +constantsDefinition :: String -> TTerm a -> TElement a constantsDefinition = definitionInModule hydraConstantsModule hydraConstantsModule :: Module @@ -38,14 +38,14 @@ el placeholderNameDef, el maxTraceDepthDef] -ignoredVariableDef :: Definition String +ignoredVariableDef :: TElement String ignoredVariableDef = constantsDefinition "ignoredVariable" $ string "_" -placeholderNameDef :: Definition Name +placeholderNameDef :: TElement Name placeholderNameDef = constantsDefinition "placeholderName" $ doc "A placeholder name for row types as they are being constructed" $ wrap _Name $ string "Placeholder" -maxTraceDepthDef :: Definition Int +maxTraceDepthDef :: TElement Int maxTraceDepthDef = constantsDefinition "maxTraceDepth" $ int32 50 diff --git a/src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs b/src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs --- a/src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs +++ b/src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs @@ -53,112 +53,114 @@ el coreEncodeTermDef, el coreEncodeTupleProjectionDef, el coreEncodeTypeDef, + el coreEncodeTypeAbstractionDef, el coreEncodeTypeSchemeDef, + el coreEncodeTypedTermDef, el coreEncodeWrappedTermDef, el coreEncodeWrappedTypeDef] -coreEncodingDefinition :: String -> Type -> Datum x -> Definition x +coreEncodingDefinition :: String -> Type -> TTerm x -> TElement x coreEncodingDefinition label dom datum = definitionInModule coreEncodingModule ("coreEncode" ++ label) $ function dom termT datum -encodedBinary :: Datum String -> Datum Term +encodedBinary :: TTerm String -> TTerm Term encodedBinary = encodedLiteral . Core.literalBinary -encodedBoolean :: Datum Bool -> Datum Term +encodedBoolean :: TTerm Bool -> TTerm Term encodedBoolean = encodedLiteral . Core.literalBoolean -encodedCase :: Name -> Name -> Datum (a -> Term) -> Field +encodedCase :: Name -> Name -> TTerm (a -> Term) -> Field encodedCase tname fname enc = field fname $ lambda "v" $ encodedVariant tname fname (enc @@ var "v") -encodedField :: Name -> Datum Term -> Datum Term +encodedField :: Name -> TTerm Term -> TTerm Term encodedField fname term = encodedFieldRaw (encodedName fname) term -encodedFieldRaw :: Datum Name -> Datum Term -> Datum Term -encodedFieldRaw (Datum fname) (Datum term) = Datum $ Terms.record _Field [ +encodedFieldRaw :: TTerm Name -> TTerm Term -> TTerm Term +encodedFieldRaw (TTerm fname) (TTerm term) = TTerm $ Terms.record _Field [ Field _Field_name fname, Field _Field_term term] -encodedFloatValue :: Datum FloatValue -> Datum Term +encodedFloatValue :: TTerm FloatValue -> TTerm Term encodedFloatValue = encodedLiteral . Core.literalFloat -encodedInjection :: Name -> Name -> Datum Term -> Datum Term -encodedInjection tname fname term = Datum $ Terms.record _Injection [ +encodedInjection :: Name -> Name -> TTerm Term -> TTerm Term +encodedInjection tname fname term = TTerm $ Terms.record _Injection [ field _Injection_typeName $ encodedName tname, field _Injection_field $ encodedField fname term] -encodedInt32 :: Datum Int -> Datum Term +encodedInt32 :: TTerm Int -> TTerm Term encodedInt32 v = encodedIntegerValue $ variant _IntegerValue _IntegerValue_int32 v -encodedIntegerValue :: Datum IntegerValue -> Datum Term +encodedIntegerValue :: TTerm IntegerValue -> TTerm Term encodedIntegerValue = encodedLiteral . Core.literalInteger -encodedList :: Datum [a] -> Datum Term +encodedList :: TTerm [a] -> TTerm Term encodedList = variant _Term _Term_list -encodedLiteral :: Datum Literal -> Datum Term +encodedLiteral :: TTerm Literal -> TTerm Term encodedLiteral = variant _Term _Term_literal -encodedMap :: Datum (M.Map k v) -> Datum Term +encodedMap :: TTerm (M.Map k v) -> TTerm Term encodedMap = variant _Term _Term_map -encodedName :: Name -> Datum Name +encodedName :: Name -> TTerm Name encodedName = wrap _Name . string . unName -encodedWrappedTerm :: Name -> Datum Term -> Datum Term +encodedWrappedTerm :: Name -> TTerm Term -> TTerm Term encodedWrappedTerm name = encodedWrappedTermRaw (encodedName name) -encodedWrappedTermRaw :: Datum Name -> Datum Term -> Datum Term -encodedWrappedTermRaw (Datum name) (Datum term) = Datum $ Terms.variant _Term _Term_wrap $ Terms.record _WrappedTerm [ +encodedWrappedTermRaw :: TTerm Name -> TTerm Term -> TTerm Term +encodedWrappedTermRaw (TTerm name) (TTerm term) = TTerm $ Terms.variant _Term _Term_wrap $ Terms.record _WrappedTerm [ Field _WrappedTerm_typeName name, Field _WrappedTerm_object term] -encodedOptional :: Datum (Maybe a) -> Datum Term +encodedOptional :: TTerm (Maybe a) -> TTerm Term encodedOptional = variant _Term _Term_optional -encodedRecord :: Name -> [Field] -> Datum Term -encodedRecord tname fields = Datum $ Terms.variant _Term _Term_record $ Terms.record _Record [ +encodedRecord :: Name -> [Field] -> TTerm Term +encodedRecord tname fields = TTerm $ Terms.variant _Term _Term_record $ Terms.record _Record [ field _Record_typeName $ encodedName tname, field _Record_fields $ list (encField <$> fields)] where - encField (Field fname term) = encodedField fname $ Datum term + encField (Field fname term) = encodedField fname $ TTerm term -encodedSet :: Datum (S.Set a) -> Datum Term +encodedSet :: TTerm (S.Set a) -> TTerm Term encodedSet = variant _Term _Term_set -encodedString :: Datum String -> Datum Term +encodedString :: TTerm String -> TTerm Term encodedString = encodedLiteral . variant _Literal _Literal_string -encodedUnion :: Datum Term -> Datum Term +encodedUnion :: TTerm Term -> TTerm Term encodedUnion = variant _Term _Term_union -encodedVariant :: Name -> Name -> Datum Term -> Datum Term +encodedVariant :: Name -> Name -> TTerm Term -> TTerm Term encodedVariant tname fname term = encodedUnion $ encodedInjection tname fname term -coreEncodeAnnotatedTermDef :: Definition (AnnotatedTerm -> Term) +coreEncodeAnnotatedTermDef :: TElement (AnnotatedTerm -> Term) coreEncodeAnnotatedTermDef = coreEncodingDefinition "AnnotatedTerm" annotatedTermT $ lambda "a" $ variant _Term _Term_annotated $ record _AnnotatedTerm [ field _AnnotatedTerm_subject $ ref coreEncodeTermDef @@ (Core.annotatedTermSubject @@ var "a"), field _AnnotatedTerm_annotation $ Core.annotatedTermAnnotation @@ var "a"] -coreEncodeAnnotatedTypeDef :: Definition (AnnotatedType -> Term) +coreEncodeAnnotatedTypeDef :: TElement (AnnotatedType -> Term) coreEncodeAnnotatedTypeDef = coreEncodingDefinition "AnnotatedType" annotatedTypeT $ lambda "at" $ variant _Term _Term_annotated $ record _AnnotatedTerm [ field _AnnotatedTerm_subject $ ref coreEncodeTypeDef @@ (Core.annotatedTypeSubject @@ var "at"), field _AnnotatedTerm_annotation $ Core.annotatedTypeAnnotation @@ var "at"] -coreEncodeApplicationDef :: Definition (Application -> Term) +coreEncodeApplicationDef :: TElement (Application -> Term) coreEncodeApplicationDef = coreEncodingDefinition "Application" applicationT $ lambda "app" $ encodedRecord _Application [ field _Application_function $ ref coreEncodeTermDef @@ (Core.applicationFunction @@ var "app"), field _Application_argument $ ref coreEncodeTermDef @@ (Core.applicationArgument @@ var "app")] -coreEncodeApplicationTypeDef :: Definition (ApplicationType -> Term) +coreEncodeApplicationTypeDef :: TElement (ApplicationType -> Term) coreEncodeApplicationTypeDef = coreEncodingDefinition "ApplicationType" applicationTypeT $ lambda "at" $ encodedRecord _ApplicationType [ field _ApplicationType_function $ ref coreEncodeTypeDef @@ (Core.applicationTypeFunction @@ var "at"), field _ApplicationType_argument $ ref coreEncodeTypeDef @@ (Core.applicationTypeArgument @@ var "at")] -coreEncodeCaseStatementDef :: Definition (CaseStatement -> Term) +coreEncodeCaseStatementDef :: TElement (CaseStatement -> Term) coreEncodeCaseStatementDef = coreEncodingDefinition "CaseStatement" caseStatementT $ lambda "cs" $ encodedRecord _CaseStatement [ field _CaseStatement_typeName $ ref coreEncodeNameDef @@ (Core.caseStatementTypeName @@ var "cs"), @@ -167,7 +169,7 @@ field _CaseStatement_cases $ encodedList (primitive _lists_map @@ ref coreEncodeFieldDef @@ (Core.caseStatementCases @@ var "cs"))] -coreEncodeEliminationDef :: Definition (Elimination -> Term) +coreEncodeEliminationDef :: TElement (Elimination -> Term) coreEncodeEliminationDef = coreEncodingDefinition "Elimination" eliminationT $ match _Elimination Nothing [ ecase _Elimination_list coreEncodeTermDef, @@ -179,28 +181,28 @@ where ecase fname funname = encodedCase _Elimination fname (ref funname) -coreEncodeFieldDef :: Definition (Field -> Term) +coreEncodeFieldDef :: TElement (Field -> Term) coreEncodeFieldDef = coreEncodingDefinition "Field" fieldT $ lambda "f" $ encodedRecord _Field [ field _Field_name $ encodedWrappedTerm _Name $ encodedString $ (unwrap _Name @@ (Core.fieldName @@ var "f")), field _Field_term $ ref coreEncodeTermDef @@ (Core.fieldTerm @@ var "f")] -coreEncodeFieldTypeDef :: Definition (FieldType -> Term) +coreEncodeFieldTypeDef :: TElement (FieldType -> Term) coreEncodeFieldTypeDef = coreEncodingDefinition "FieldType" fieldTypeT $ lambda "ft" $ encodedRecord _FieldType [ field _FieldType_name $ ref coreEncodeNameDef @@ (Core.fieldTypeName @@ var "ft"), field _FieldType_type $ ref coreEncodeTypeDef @@ (Core.fieldTypeType @@ var "ft")] -coreEncodeFloatTypeDef :: Definition (FloatType -> Term) +coreEncodeFloatTypeDef :: TElement (FloatType -> Term) coreEncodeFloatTypeDef = coreEncodingDefinition "FloatType" floatTypeT $ match _FloatType Nothing (cs <$> [ _FloatType_bigfloat, _FloatType_float32, _FloatType_float64]) where - cs fname = field fname $ constant $ Datum $ coreEncodeTerm $ unDatum $ unitVariant _FloatType fname + cs fname = field fname $ constant $ TTerm $ coreEncodeTerm $ unTTerm $ unitVariant _FloatType fname -coreEncodeFloatValueDef :: Definition (FloatValue -> Term) +coreEncodeFloatValueDef :: TElement (FloatValue -> Term) coreEncodeFloatValueDef = coreEncodingDefinition "FloatValue" floatValueT $ match _FloatValue Nothing (varField <$> [ _FloatValue_bigfloat, @@ -210,7 +212,7 @@ varField fname = field fname $ lambda "v" $ encodedVariant _FloatValue fname $ encodedFloatValue $ variant _FloatValue fname $ var "v" -coreEncodeFunctionDef :: Definition (Function -> Term) +coreEncodeFunctionDef :: TElement (Function -> Term) coreEncodeFunctionDef = coreEncodingDefinition "Function" functionT $ match _Function Nothing [ ecase _Function_elimination coreEncodeEliminationDef, @@ -219,19 +221,19 @@ where ecase fname funname = encodedCase _Function fname (ref funname) -coreEncodeFunctionTypeDef :: Definition (FunctionType -> Term) +coreEncodeFunctionTypeDef :: TElement (FunctionType -> Term) coreEncodeFunctionTypeDef = coreEncodingDefinition "FunctionType" functionTypeT $ lambda "ft" $ encodedRecord _FunctionType [ field _FunctionType_domain $ ref coreEncodeTypeDef @@ (Core.functionTypeDomain @@ var "ft"), field _FunctionType_codomain $ ref coreEncodeTypeDef @@ (Core.functionTypeCodomain @@ var "ft")] -coreEncodeInjectionDef :: Definition (Injection -> Term) +coreEncodeInjectionDef :: TElement (Injection -> Term) coreEncodeInjectionDef = coreEncodingDefinition "Injection" injectionT $ lambda "i" $ encodedRecord _Injection [ field _Injection_typeName $ ref coreEncodeNameDef @@ (Core.injectionTypeName @@ var "i"), field _Injection_field $ ref coreEncodeFieldDef @@ (Core.injectionField @@ var "i")] -coreEncodeIntegerTypeDef :: Definition (IntegerType -> Term) +coreEncodeIntegerTypeDef :: TElement (IntegerType -> Term) coreEncodeIntegerTypeDef = coreEncodingDefinition "IntegerType" integerTypeT $ match _IntegerType Nothing (cs <$> [ _IntegerType_bigint, @@ -244,9 +246,9 @@ _IntegerType_uint32, _IntegerType_uint64]) where - cs fname = field fname $ constant $ Datum $ coreEncodeTerm $ unDatum $ unitVariant _IntegerType fname + cs fname = field fname $ constant $ TTerm $ coreEncodeTerm $ unTTerm $ unitVariant _IntegerType fname -coreEncodeIntegerValueDef :: Definition (IntegerValue -> Term) +coreEncodeIntegerValueDef :: TElement (IntegerValue -> Term) coreEncodeIntegerValueDef = coreEncodingDefinition "IntegerValue" integerValueT $ match _IntegerValue Nothing (varField <$> [ _IntegerValue_bigint, @@ -262,32 +264,33 @@ varField fname = field fname $ lambda "v" $ encodedVariant _IntegerValue fname $ encodedIntegerValue $ variant _IntegerValue fname $ var "v" -coreEncodeLambdaDef :: Definition (Lambda -> Term) +coreEncodeLambdaDef :: TElement (Lambda -> Term) coreEncodeLambdaDef = coreEncodingDefinition "Lambda" lambdaT $ lambda "l" $ encodedRecord _Lambda [ field _Lambda_parameter $ ref coreEncodeNameDef @@ (Core.lambdaParameter @@ var "l"), + field _Lambda_domain $ encodedOptional $ primitive _optionals_map @@ ref coreEncodeTypeDef @@ (Core.lambdaDomain @@ var "l"), field _Lambda_body $ ref coreEncodeTermDef @@ (Core.lambdaBody @@ var "l")] -coreEncodeLambdaTypeDef :: Definition (LambdaType -> Term) +coreEncodeLambdaTypeDef :: TElement (LambdaType -> Term) coreEncodeLambdaTypeDef = coreEncodingDefinition "LambdaType" lambdaTypeT $ lambda "lt" $ encodedRecord _LambdaType [ field _LambdaType_parameter $ ref coreEncodeNameDef @@ (Core.lambdaTypeParameter @@ var "lt"), field _LambdaType_body $ ref coreEncodeTypeDef @@ (Core.lambdaTypeBody @@ var "lt")] -coreEncodeLetDef :: Definition (Let -> Term) +coreEncodeLetDef :: TElement (Let -> Term) coreEncodeLetDef = coreEncodingDefinition "Let" letT $ lambda "l" $ encodedRecord _Let [ field _Let_bindings $ encodedList (primitive _lists_map @@ ref coreEncodeLetBindingDef @@ (Core.letBindings @@ var "l")), field _Let_environment $ ref coreEncodeTermDef @@ (Core.letEnvironment @@ var "l")] -coreEncodeLetBindingDef :: Definition (LetBinding -> Term) +coreEncodeLetBindingDef :: TElement (LetBinding -> Term) coreEncodeLetBindingDef = coreEncodingDefinition "LetBinding" letBindingT $ lambda "b" $ encodedRecord _LetBinding [ field _LetBinding_name $ ref coreEncodeNameDef @@ (Core.letBindingName @@ var "b"), field _LetBinding_term $ ref coreEncodeTermDef @@ (Core.letBindingTerm @@ var "b"), field _LetBinding_type $ encodedOptional $ primitive _optionals_map @@ ref coreEncodeTypeSchemeDef @@ (Core.letBindingType @@ var "b")] -coreEncodeLiteralDef :: Definition (Literal -> Term) +coreEncodeLiteralDef :: TElement (Literal -> Term) coreEncodeLiteralDef = coreEncodingDefinition "Literal" literalT $ match _Literal Nothing [ varField _Literal_binary $ encodedBinary $ var "v", @@ -298,7 +301,7 @@ where varField fname = field fname . lambda "v" . encodedVariant _Literal fname -coreEncodeLiteralTypeDef :: Definition (LiteralType -> Term) +coreEncodeLiteralTypeDef :: TElement (LiteralType -> Term) coreEncodeLiteralTypeDef = coreEncodingDefinition "LiteralType" literalTypeT $ match _LiteralType Nothing [ csunit _LiteralType_binary, @@ -308,51 +311,50 @@ csunit _LiteralType_string] where cs fname fun = field fname $ lambda "v" $ encodedVariant _LiteralType fname (ref fun @@ var "v") - csunit fname = field fname $ constant $ Datum $ coreEncodeTerm $ unDatum $ variant _LiteralType fname unit + csunit fname = field fname $ constant $ TTerm $ coreEncodeTerm $ unTTerm $ variant _LiteralType fname unit -coreEncodeMapTypeDef :: Definition (MapType -> Term) +coreEncodeMapTypeDef :: TElement (MapType -> Term) coreEncodeMapTypeDef = coreEncodingDefinition "MapType" mapTypeT $ lambda "mt" $ encodedRecord _MapType [ field _MapType_keys $ ref coreEncodeTypeDef @@ (Core.mapTypeKeys @@ var "mt"), field _MapType_values $ ref coreEncodeTypeDef @@ (Core.mapTypeValues @@ var "mt")] -coreEncodeNameDef :: Definition (Name -> Term) +coreEncodeNameDef :: TElement (Name -> Term) coreEncodeNameDef = coreEncodingDefinition "Name" nameT $ lambda "fn" $ encodedWrappedTerm _Name $ encodedString $ unwrap _Name @@ var "fn" -coreEncodeOptionalCasesDef :: Definition (OptionalCases -> Term) +coreEncodeOptionalCasesDef :: TElement (OptionalCases -> Term) coreEncodeOptionalCasesDef = coreEncodingDefinition "OptionalCases" optionalCasesT $ lambda "oc" $ encodedRecord _OptionalCases [ field _OptionalCases_nothing $ ref coreEncodeTermDef @@ (Core.optionalCasesNothing @@ var "oc"), field _OptionalCases_just $ ref coreEncodeTermDef @@ (Core.optionalCasesJust @@ var "oc")] -coreEncodeProjectionDef :: Definition (Projection -> Term) +coreEncodeProjectionDef :: TElement (Projection -> Term) coreEncodeProjectionDef = coreEncodingDefinition "Projection" projectionT $ lambda "p" $ encodedRecord _Projection [ field _Projection_typeName $ ref coreEncodeNameDef @@ (Core.projectionTypeName @@ var "p"), field _Projection_field $ ref coreEncodeNameDef @@ (Core.projectionField @@ var "p")] -coreEncodeRecordDef :: Definition (Record -> Term) +coreEncodeRecordDef :: TElement (Record -> Term) coreEncodeRecordDef = coreEncodingDefinition "Record" recordT $ lambda "r" $ encodedRecord _Record [ field _Record_typeName $ ref coreEncodeNameDef @@ (Core.recordTypeName @@ var "r"), field _Record_fields $ encodedList (primitive _lists_map @@ (ref coreEncodeFieldDef) @@ (Core.recordFields @@ var "r"))] -coreEncodeRowTypeDef :: Definition (RowType -> Term) +coreEncodeRowTypeDef :: TElement (RowType -> Term) coreEncodeRowTypeDef = coreEncodingDefinition "RowType" rowTypeT $ lambda "rt" $ encodedRecord _RowType [ field _RowType_typeName $ ref coreEncodeNameDef @@ (Core.rowTypeTypeName @@ var "rt"), - field _RowType_extends $ encodedOptional (primitive _optionals_map @@ ref coreEncodeNameDef @@ (Core.rowTypeExtends @@ var "rt")), field _RowType_fields $ encodedList (primitive _lists_map @@ ref coreEncodeFieldTypeDef @@ (Core.rowTypeFields @@ var "rt"))] -coreEncodeSumDef :: Definition (Sum -> Term) +coreEncodeSumDef :: TElement (Sum -> Term) coreEncodeSumDef = coreEncodingDefinition "Sum" sumT $ lambda "s" $ encodedRecord _Sum [ field _Sum_index $ encodedInt32 $ Core.sumIndex @@ var "s", field _Sum_size $ encodedInt32 $ Core.sumSize @@ var "s", field _Sum_term $ ref coreEncodeTermDef @@ (Core.sumTerm @@ var "s")] -coreEncodeTermDef :: Definition (Term -> Term) +coreEncodeTermDef :: TElement (Term -> Term) coreEncodeTermDef = coreEncodingDefinition "Term" termT $ match _Term (Just $ encodedString $ string "not implemented") [ ecase _Term_annotated (ref coreEncodeAnnotatedTermDef), @@ -368,6 +370,9 @@ ecase _Term_record (ref coreEncodeRecordDef), ecase' _Term_set $ encodedSet $ primitive _sets_map @@ (ref coreEncodeTermDef) @@ var "v", ecase _Term_sum (ref coreEncodeSumDef), + ecase _Term_typeAbstraction $ ref coreEncodeTypeAbstractionDef, + ecase _Term_typeApplication $ ref coreEncodeTypedTermDef, + ecase _Term_typed $ ref coreEncodeTypedTermDef, ecase _Term_union (ref coreEncodeInjectionDef), ecase _Term_variable $ ref coreEncodeNameDef, ecase _Term_wrap $ ref coreEncodeWrappedTermDef] @@ -375,13 +380,13 @@ ecase = encodedCase _Term ecase' fname = field fname . lambda "v" . encodedVariant _Term fname -coreEncodeTupleProjectionDef :: Definition (TupleProjection -> Term) +coreEncodeTupleProjectionDef :: TElement (TupleProjection -> Term) coreEncodeTupleProjectionDef = coreEncodingDefinition "TupleProjection" tupleProjectionT $ lambda "tp" $ encodedRecord _TupleProjection [ field _TupleProjection_arity $ encodedInt32 $ Core.tupleProjectionArity @@ var "tp", field _TupleProjection_index $ encodedInt32 $ Core.tupleProjectionIndex @@ var "tp"] -coreEncodeTypeDef :: Definition (Type -> Term) +coreEncodeTypeDef :: TElement (Type -> Term) coreEncodeTypeDef = coreEncodingDefinition "Type" typeT $ match _Type Nothing [ field _Type_annotated $ lambda "v" $ variant _Term _Term_annotated $ record _AnnotatedTerm [ @@ -405,19 +410,31 @@ cs fname term = field fname $ lambda "v" $ encodedVariant _Type fname term csref fname fun = cs fname (ref fun @@ var "v") -coreEncodeTypeSchemeDef :: Definition (TypeScheme -> Term) +coreEncodeTypeAbstractionDef :: TElement (TypeAbstraction -> Term) +coreEncodeTypeAbstractionDef = coreEncodingDefinition "TypeAbstraction" typeAbstractionT $ + lambda "l" $ encodedRecord _TypeAbstraction [ + field _TypeAbstraction_parameter $ ref coreEncodeNameDef @@ (project _TypeAbstraction _TypeAbstraction_parameter @@ var "l"), + field _TypeAbstraction_body $ ref coreEncodeTermDef @@ (project _TypeAbstraction _TypeAbstraction_body @@ var "l")] + +coreEncodeTypeSchemeDef :: TElement (TypeScheme -> Term) coreEncodeTypeSchemeDef = coreEncodingDefinition "TypeScheme" typeSchemeT $ lambda "ts" $ encodedRecord _TypeScheme [ field _TypeScheme_variables $ encodedList (primitive _lists_map @@ ref coreEncodeNameDef @@ (Core.typeSchemeVariables @@ var "ts")), field _TypeScheme_type $ ref coreEncodeTypeDef @@ (Core.typeSchemeType @@ var "ts")] -coreEncodeWrappedTermDef :: Definition (WrappedTerm -> Term) +coreEncodeTypedTermDef :: TElement (TypedTerm -> Term) +coreEncodeTypedTermDef = coreEncodingDefinition "TypedTerm" typedTermT $ + lambda "tt" $ encodedRecord _TypedTerm [ + field _TypedTerm_term $ ref coreEncodeTermDef @@ (project _TypedTerm _TypedTerm_term @@ var "tt"), + field _TypedTerm_type $ ref coreEncodeTypeDef @@ (project _TypedTerm _TypedTerm_type @@ var "tt")] + +coreEncodeWrappedTermDef :: TElement (WrappedTerm -> Term) coreEncodeWrappedTermDef = coreEncodingDefinition "WrappedTerm" wrappedTermT $ lambda "n" $ encodedRecord _WrappedTerm [ field _WrappedTerm_typeName $ ref coreEncodeNameDef @@ (Core.wrappedTermTypeName @@ var "n"), field _WrappedTerm_object $ ref coreEncodeTermDef @@ (Core.wrappedTermObject @@ var "n")] -coreEncodeWrappedTypeDef :: Definition (WrappedType -> Term) +coreEncodeWrappedTypeDef :: TElement (WrappedType -> Term) coreEncodeWrappedTypeDef = coreEncodingDefinition "WrappedType" wrappedTypeT $ lambda "nt" $ encodedRecord _WrappedType [ field _WrappedType_typeName $ ref coreEncodeNameDef @@ (Core.wrappedTypeTypeName @@ var "nt"), diff --git a/src/main/haskell/Hydra/Sources/Tier1/Decode.hs b/src/main/haskell/Hydra/Sources/Tier1/Decode.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier1/Decode.hs @@ -0,0 +1,419 @@ +module Hydra.Sources.Tier1.Decode where + +-- Standard Tier-1 imports +import Prelude hiding ((++)) +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Hydra.Dsl.Base as Base +import qualified Hydra.Dsl.Core as Core +import qualified Hydra.Dsl.Graph as Graph +import qualified Hydra.Dsl.Lib.Equality as Equality +import qualified Hydra.Dsl.Lib.Flows as Flows +import qualified Hydra.Dsl.Lib.Io as Io +import qualified Hydra.Dsl.Lib.Lists as Lists +import qualified Hydra.Dsl.Lib.Literals as Literals +import qualified Hydra.Dsl.Lib.Logic as Logic +import qualified Hydra.Dsl.Lib.Maps as Maps +import qualified Hydra.Dsl.Lib.Math as Math +import qualified Hydra.Dsl.Lib.Optionals as Optionals +import qualified Hydra.Dsl.Lib.Sets as Sets +import Hydra.Dsl.Lib.Strings as Strings +import qualified Hydra.Dsl.Module as Module +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types +import Hydra.Sources.Tier0.All + +import Hydra.Sources.Tier1.Strip + +import qualified Data.Map as M +import qualified Data.Set as S + + +decodeDefinition :: String -> TTerm a -> TElement a +decodeDefinition = definitionInModule decodeModule + +decodeFunctionDefinition :: String -> Type -> Type -> TTerm a -> TElement a +decodeFunctionDefinition name dom cod term = decodeDefinition name $ + function dom (optionalT cod) term + +decodeNominalFunctionDefinition :: String -> Type -> TTerm a -> TElement a +decodeNominalFunctionDefinition name cod term = decodeDefinition name $ + function nameT (funT termT $ optionalT cod) term + +decodeModule :: Module +decodeModule = Module (Namespace "hydra/decode") elements [hydraStripModule] tier0Modules $ + Just "A module for decoding terms to native objects" + where + elements = [ + el bigfloatDef, + el bigfloatValueDef, + el bigintDef, + el bigintValueDef, + el binaryDef, + el binaryLiteralDef, + el booleanDef, + el booleanLiteralDef, + el casesCaseDef, + el casesDef, + el fieldDef, + el float32Def, + el float32ValueDef, + el float64Def, + el float64ValueDef, + el floatLiteralDef, + el int16Def, + el int16ValueDef, + el int32Def, + el int32ValueDef, + el int64Def, + el int64ValueDef, + el int8Def, + el int8ValueDef, + el integerLiteralDef, + el lambdaDef, + el letBindingDef, + el letBindingWithKeyDef, + el letTermDef, + el listDef, + el literalDef, + el mapDef, + el nameDef, + el nominalDef, + el optCasesDef, + el optCasesJustDef, + el optCasesNothingDef, + el optionalDef, + el pairDef, + el recordDef, + el setDef, + el stringDef, + el stringLiteralDef, + el uint16Def, + el uint16ValueDef, + el uint32Def, + el uint32ValueDef, + el uint64Def, + el uint64ValueDef, + el uint8Def, + el uint8ValueDef, + el unitDef, + el unitVariantDef, + el variableDef, + el variantDef, + el wrapDef] + +bigfloatDef :: TElement (Term -> Maybe Float) +bigfloatDef = decodeFunctionDefinition "bigfloat" termT bigfloatT $ + compose3 (ref literalDef) (ref floatLiteralDef) (ref bigfloatValueDef) + +bigfloatValueDef :: TElement (FloatValue -> Maybe Float) +bigfloatValueDef = decodeFunctionDefinition "bigfloatValue" floatValueT bigfloatT $ + matchVariant _FloatValue _FloatValue_bigfloat + +bigintDef :: TElement (Term -> Maybe Int) +bigintDef = decodeFunctionDefinition "bigint" termT bigintT $ + compose3 (ref literalDef) (ref integerLiteralDef) (ref bigintValueDef) + +bigintValueDef :: TElement (IntegerValue -> Maybe Int) +bigintValueDef = decodeFunctionDefinition "bigintValue" integerValueT bigintT $ + matchVariant _IntegerValue _IntegerValue_bigint + +binaryDef :: TElement (Term -> Maybe String) +binaryDef = decodeFunctionDefinition "binary" termT binaryT $ + compose2 (ref literalDef) (ref binaryLiteralDef) + +binaryLiteralDef :: TElement (Literal -> Maybe String) +binaryLiteralDef = decodeFunctionDefinition "binaryLiteral" literalT binaryT $ + matchVariant _Literal _Literal_binary + +booleanDef :: TElement (Term -> Maybe Bool) +booleanDef = decodeFunctionDefinition "boolean" termT booleanT $ + compose2 (ref literalDef) (ref booleanLiteralDef) + +booleanLiteralDef :: TElement (Literal -> Maybe Bool) +booleanLiteralDef = decodeFunctionDefinition "booleanLiteral" literalT booleanT $ + matchVariant _Literal _Literal_boolean + +casesDef :: TElement (Name -> Term -> Maybe [Field]) +casesDef = decodeNominalFunctionDefinition "cases" (listT fieldT) $ + ref nominalDef + @@ Core.caseStatementTypeName + @@ Core.caseStatementCases + @@ compose3 + (matchTermVariant _Term_function) + (matchVariant _Function _Function_elimination) + (matchVariant _Elimination _Elimination_union) + +casesCaseDef :: TElement (Name -> Name -> Term -> Y.Maybe Term) +casesCaseDef = decodeDefinition "casesCase" $ + functionN [nameT, nameT, termT, optionalT termT] $ + lambda "tname" $ lambda "fname" $ + compose2 + (ref casesDef @@ var "tname" ) + (ref fieldDef @@ var "fname") + +fieldDef :: TElement (Name -> [Field] -> Maybe Term) +fieldDef = decodeDefinition "field" $ + functionN [nameT, listT fieldT, optionalT termT] $ + lambda "fname" $ lambda "fields" ((Logic.ifElse + @@ just (Core.fieldTerm @@ (Lists.head @@ var "matches")) + @@ nothing + @@ (Equality.equal @@ int32 1 @@ (Lists.length @@ var "matches")) + ) `with` [ + "matches">: Lists.filter @@ (lambda "f" $ Equality.equal @@ (Core.fieldName @@ var "f") @@ var "fname") @@ var "fields"]) + +float32Def :: TElement (Term -> Maybe Float) +float32Def = decodeFunctionDefinition "float32" termT float32T $ + compose3 + (ref literalDef) + (ref floatLiteralDef) + (ref float32ValueDef) + +float32ValueDef :: TElement (FloatValue -> Maybe Float) +float32ValueDef = decodeFunctionDefinition "float32Value" floatValueT float32T $ + matchVariant _FloatValue _FloatValue_float32 + +float64Def :: TElement (Term -> Maybe Float) +float64Def = decodeFunctionDefinition "float64" termT float64T $ + compose3 + (ref literalDef) + (ref floatLiteralDef) + (ref float64ValueDef) + +float64ValueDef :: TElement (FloatValue -> Maybe Float) +float64ValueDef = decodeFunctionDefinition "float64Value" floatValueT float64T $ + matchVariant _FloatValue _FloatValue_float64 + +floatLiteralDef = decodeFunctionDefinition "floatLiteral" literalT floatValueT $ + matchVariant _Literal _Literal_float + +int8Def :: TElement (Term -> Maybe Int) +int8Def = decodeFunctionDefinition "int8" termT int8T $ + compose3 + (ref literalDef) + (ref integerLiteralDef) + (ref int8ValueDef) + +int8ValueDef :: TElement (IntegerValue -> Maybe Int) +int8ValueDef = decodeFunctionDefinition "int8Value" integerValueT int8T $ + matchVariant _IntegerValue _IntegerValue_int8 + +int16Def :: TElement (Term -> Maybe Int) +int16Def = decodeFunctionDefinition "int16" termT int16T $ + compose3 + (ref literalDef) + (ref integerLiteralDef) + (ref int16ValueDef) + +int16ValueDef :: TElement (IntegerValue -> Maybe Int) +int16ValueDef = decodeFunctionDefinition "int16Value" integerValueT int16T $ + matchVariant _IntegerValue _IntegerValue_int16 + +int32Def :: TElement (Term -> Maybe Int) +int32Def = decodeFunctionDefinition "int32" termT int32T $ + compose3 + (ref literalDef) + (ref integerLiteralDef) + (ref int32ValueDef) + +int32ValueDef :: TElement (IntegerValue -> Maybe Int) +int32ValueDef = decodeFunctionDefinition "int32Value" integerValueT int32T $ + matchVariant _IntegerValue _IntegerValue_int32 + +int64Def :: TElement (Term -> Maybe Int) +int64Def = decodeFunctionDefinition "int64" termT int64T $ + compose3 + (ref literalDef) + (ref integerLiteralDef) + (ref int64ValueDef) + +int64ValueDef :: TElement (IntegerValue -> Maybe Int) +int64ValueDef = decodeFunctionDefinition "int64Value" integerValueT int64T $ + matchVariant _IntegerValue _IntegerValue_int64 + +integerLiteralDef :: TElement (Literal -> Maybe IntegerValue) +integerLiteralDef = decodeFunctionDefinition "integerLiteral" literalT integerValueT $ + matchVariant _Literal _Literal_integer + +lambdaDef :: TElement (Term -> Maybe Lambda) +lambdaDef = decodeFunctionDefinition "lambda" termT lambdaT $ + compose2 + (matchTermVariant _Term_function) + (matchVariant _Function _Function_lambda) + +letBindingDef :: TElement (Name -> Term -> Maybe LetBinding) +letBindingDef = decodeDefinition "letBinding" $ + functionN [nameT, termT, optionalT letBindingT] $ + lambda "fname" $ lambda "term" $ Optionals.bind + @@ (Optionals.map + @@ Core.letBindings + @@ (ref letTermDef @@ var "term")) + @@ (ref letBindingWithKeyDef @@ var "fname") + +letBindingWithKeyDef :: TElement (Name -> [LetBinding] -> Maybe LetBinding) +letBindingWithKeyDef = decodeDefinition "letBindingWithKey" $ + functionN [nameT, listT letBindingT, optionalT letBindingT] $ + lambda "fname" $ lambda "bindings" ((Logic.ifElse + @@ just (Lists.head @@ var "matches") + @@ nothing + @@ (Equality.equal @@ int32 1 @@ (Lists.length @@ var "matches")) + ) `with` [ + "matches">: Lists.filter @@ (lambda "b" $ Equality.equal @@ (Core.letBindingName @@ var "b") @@ var "fname") @@ var "bindings"]) + +letTermDef :: TElement (Term -> Maybe Let) +letTermDef = decodeFunctionDefinition "letTerm" termT letT $ + matchTermVariant _Term_let + +listDef :: TElement (Term -> Maybe [Term]) +listDef = decodeFunctionDefinition "list" termT (listT termT) $ + matchTermVariant _Term_list + +literalDef :: TElement (Term -> Maybe Literal) +literalDef = decodeFunctionDefinition "literal" termT literalT $ + matchTermVariant _Term_literal + +mapDef :: TElement (Term -> Maybe (M.Map Term Term)) +mapDef = decodeFunctionDefinition "map" termT (mapT termT termT) $ + matchTermVariant _Term_map + +nameDef :: TElement (Term -> Name) +nameDef = decodeFunctionDefinition "name" termT nameT $ + lambda "term" $ Optionals.map + @@ nm + @@ (Optionals.bind + @@ (ref wrapDef @@ Core.name _Name @@ var "term") + @@ ref stringDef) + where + nm :: TTerm (String -> Name) + nm = TTerm $ Terms.lambda "s" $ TermWrap $ WrappedTerm _Name $ Terms.var "s" + +nominalDef :: TElement ((a -> Name) -> (a -> b) -> (c -> Maybe a) -> Name -> c -> Maybe b) +nominalDef = decodeDefinition "nominal" $ + functionN [funT aT nameT, funT aT bT, funT cT (optionalT aT), nameT, cT, optionalT bT] $ + lambda "getName" $ lambda "getB" $ lambda "getA" $ lambda "expected" $ + compose2 + (var "getA") + (lambda "a" $ (Logic.ifElse + @@ (just (var "getB" @@ var "a")) + @@ nothing + @@ (Equality.equal @@ (var "getName" @@ var "a") @@ var "expected"))) + +optCasesDef :: TElement (Term -> Maybe OptionalCases) +optCasesDef = decodeFunctionDefinition "optCases" termT optionalCasesT $ + compose3 + (matchTermVariant _Term_function) + (matchVariant _Function _Function_elimination) + (matchVariant _Elimination _Elimination_optional) + +optCasesJustDef :: TElement (Term -> Maybe Term) +optCasesJustDef = decodeFunctionDefinition "optCasesJust" termT termT $ + lambda "term" $ Optionals.map @@ Core.optionalCasesJust @@ (ref optCasesDef @@ var "term") + +optCasesNothingDef :: TElement (Term -> Maybe Term) +optCasesNothingDef = decodeFunctionDefinition "optCasesNothing" termT termT $ + lambda "term" $ Optionals.map @@ Core.optionalCasesNothing @@ (ref optCasesDef @@ var "term") + +optionalDef :: TElement (Term -> Maybe (Maybe Term)) +optionalDef = decodeFunctionDefinition "optional" termT (optionalT termT) $ + matchTermVariant _Term_optional + +pairDef :: TElement (Term -> Maybe (Term, Term)) +pairDef = decodeFunctionDefinition "pair" termT (pairT termT termT) $ + compose2 + (matchTermVariant _Term_product) + (lambda "l" $ Logic.ifElse + @@ (just $ pair (Lists.at @@ int32 0 @@ var "l") (Lists.at @@ int32 1 @@ var "l")) + @@ nothing + @@ (Equality.equal @@ int32 2 @@ (Lists.length @@ var "l"))) + +recordDef :: TElement (Name -> Term -> Maybe [Field]) +recordDef = decodeNominalFunctionDefinition "record" (listT fieldT) $ + matchNominal _Term_record Core.recordTypeName Core.recordFields + +setDef :: TElement (Term -> Maybe (S.Set Term)) +setDef = decodeFunctionDefinition "set" termT (setT termT) $ + matchTermVariant _Term_set + +stringDef :: TElement (Term -> Maybe String) +stringDef = decodeFunctionDefinition "string" termT stringT $ + compose2 (ref literalDef) (ref stringLiteralDef) + +stringLiteralDef :: TElement (Literal -> Maybe String) +stringLiteralDef = decodeFunctionDefinition "stringLiteral" literalT stringT $ + matchVariant _Literal _Literal_string + +uint8Def :: TElement (Term -> Maybe Int) +uint8Def = decodeFunctionDefinition "uint8" termT uint8T $ + compose3 (ref literalDef) (ref integerLiteralDef) (ref uint8ValueDef) + +uint8ValueDef :: TElement (IntegerValue -> Maybe Int) +uint8ValueDef = decodeFunctionDefinition "uint8Value" integerValueT uint8T $ + matchVariant _IntegerValue _IntegerValue_uint8 + +uint16Def :: TElement (Term -> Maybe Int) +uint16Def = decodeFunctionDefinition "uint16" termT uint16T $ + compose3 (ref literalDef) (ref integerLiteralDef) (ref uint16ValueDef) + +uint16ValueDef :: TElement (IntegerValue -> Maybe Int) +uint16ValueDef = decodeFunctionDefinition "uint16Value" integerValueT uint16T $ + matchVariant _IntegerValue _IntegerValue_uint16 + +uint32Def :: TElement (Term -> Maybe Int) +uint32Def = decodeFunctionDefinition "uint32" termT uint32T $ + compose3 (ref literalDef) (ref integerLiteralDef) (ref uint32ValueDef) + +uint32ValueDef :: TElement (IntegerValue -> Maybe Int) +uint32ValueDef = decodeFunctionDefinition "uint32Value" integerValueT uint32T $ + matchVariant _IntegerValue _IntegerValue_uint32 + +uint64Def :: TElement (Term -> Maybe Int) +uint64Def = decodeFunctionDefinition "uint64" termT uint64T $ + compose3 (ref literalDef) (ref integerLiteralDef) (ref uint64ValueDef) + +uint64ValueDef :: TElement (IntegerValue -> Maybe Int) +uint64ValueDef = decodeFunctionDefinition "uint64Value" integerValueT uint64T $ + matchVariant _IntegerValue _IntegerValue_uint64 + +unitDef :: TElement (Term -> Maybe ()) +unitDef = decodeFunctionDefinition "unit" termT unitT $ + lambda "term" $ Optionals.map + @@ (constant unit) + @@ (ref recordDef @@ Core.name _Unit @@ var "term") + +unitVariantDef :: TElement (Name -> Term -> Maybe Name) +unitVariantDef = decodeDefinition "unitVariant" $ + functionN [nameT, termT, optionalT nameT] $ + lambda "tname" $ lambda "term" $ Optionals.map + @@ Core.fieldName + @@ (ref variantDef @@ var "tname" @@ var "term") + +variableDef :: TElement (Term -> Y.Maybe Name) +variableDef = decodeFunctionDefinition "variable" termT nameT $ + matchTermVariant _Term_variable <.> ref fullyStripTermDef + +variantDef :: TElement (Name -> Term -> Maybe Field) +variantDef = decodeNominalFunctionDefinition "variant" fieldT $ + matchNominal _Term_union Core.injectionTypeName Core.injectionField + +wrapDef :: TElement (Name -> Term -> Maybe Term) +wrapDef = decodeNominalFunctionDefinition "wrap" termT $ + matchNominal _Term_wrap Core.wrappedTermTypeName Core.wrappedTermObject + +-- + +compose2 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (a -> Maybe c) +compose2 f g = Optionals.compose @@ f @@ g + +compose3 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (c -> Maybe d) -> TTerm (a -> Maybe d) +compose3 f g h = Optionals.compose @@ (Optionals.compose @@ f @@ g) @@ h + +matchNominal :: Name -> TTerm (a -> Name) -> TTerm (a -> b) -> TTerm (Name -> Term -> Maybe b) +matchNominal fname getName getB = ref nominalDef @@ getName @@ getB @@ matchTermVariant fname + +matchTermVariant :: Name -> TTerm (Term -> Maybe a) +matchTermVariant fname = matchVariant _Term fname <.> ref fullyStripTermDef + +matchVariant :: Name -> Name -> TTerm (a -> Maybe b) +matchVariant tname fname = match tname (Just nothing) [TCase fname --> Optionals.pure] diff --git a/src/main/haskell/Hydra/Sources/Tier1/Messages.hs b/src/main/haskell/Hydra/Sources/Tier1/Messages.hs --- a/src/main/haskell/Hydra/Sources/Tier1/Messages.hs +++ b/src/main/haskell/Hydra/Sources/Tier1/Messages.hs @@ -28,7 +28,7 @@ import Hydra.Sources.Tier0.All -messagesDefinition :: String -> Datum a -> Definition a +messagesDefinition :: String -> TTerm a -> TElement a messagesDefinition = definitionInModule hydraMessagesModule hydraMessagesModule :: Module @@ -38,6 +38,6 @@ elements = [ el warningAutoGeneratedFileDef] -warningAutoGeneratedFileDef :: Definition String +warningAutoGeneratedFileDef :: TElement String warningAutoGeneratedFileDef = messagesDefinition "warningAutoGeneratedFile" $ string "Note: this is an automatically generated file. Do not edit." diff --git a/src/main/haskell/Hydra/Sources/Tier1/Strip.hs b/src/main/haskell/Hydra/Sources/Tier1/Strip.hs --- a/src/main/haskell/Hydra/Sources/Tier1/Strip.hs +++ b/src/main/haskell/Hydra/Sources/Tier1/Strip.hs @@ -26,7 +26,7 @@ import Hydra.Sources.Tier0.All -stripDefinition :: String -> Datum a -> Definition a +stripDefinition :: String -> TTerm a -> TElement a stripDefinition = definitionInModule hydraStripModule hydraStripModule :: Module @@ -39,35 +39,35 @@ el stripTypeDef, el stripTypeParametersDef] -fullyStripTermDef :: Definition (Term -> Term) +fullyStripTermDef :: TElement (Term -> Term) fullyStripTermDef = stripDefinition "fullyStripTerm" $ doc "Strip all annotations from a term, including first-class type annotations" $ function termT termT $ lambda "t" (match _Term (Just $ var "t") [ - Case _Term_annotated --> ref fullyStripTermDef <.> (project _AnnotatedTerm _AnnotatedTerm_subject), - Case _Term_typed --> ref fullyStripTermDef <.> (project _TypedTerm _TypedTerm_term) + TCase _Term_annotated --> ref fullyStripTermDef <.> (project _AnnotatedTerm _AnnotatedTerm_subject), + TCase _Term_typed --> ref fullyStripTermDef <.> (project _TypedTerm _TypedTerm_term) ] @@ (var "t")) -stripTermDef :: Definition (Term -> Term) +stripTermDef :: TElement (Term -> Term) stripTermDef = stripDefinition "stripTerm" $ doc "Strip all annotations from a term" $ function termT termT $ lambda "t" (match _Term (Just $ var "t") [ - Case _Term_annotated --> ref stripTermDef <.> (project _AnnotatedTerm _AnnotatedTerm_subject) + TCase _Term_annotated --> ref stripTermDef <.> (project _AnnotatedTerm _AnnotatedTerm_subject) ] @@ (var "t")) -stripTypeDef :: Definition (Type -> Type) +stripTypeDef :: TElement (Type -> Type) stripTypeDef = stripDefinition "stripType" $ doc "Strip all annotations from a term" $ function typeT typeT $ lambda "t" (match _Type (Just $ var "t") [ - Case _Type_annotated --> ref stripTypeDef <.> (project _AnnotatedType _AnnotatedType_subject) + TCase _Type_annotated --> ref stripTypeDef <.> (project _AnnotatedType _AnnotatedType_subject) ] @@ (var "t")) -stripTypeParametersDef :: Definition (Type -> Type) +stripTypeParametersDef :: TElement (Type -> Type) stripTypeParametersDef = stripDefinition "stripTypeParameters" $ doc "Strip any top-level type lambdas from a type, extracting the (possibly nested) type body" $ function typeT typeT $ lambda "t" $ match _Type (Just $ var "t") [ - Case _Type_lambda --> lambda "lt" (ref stripTypeParametersDef @@ (project _LambdaType _LambdaType_body @@ var "lt")) + TCase _Type_lambda --> lambda "lt" (ref stripTypeParametersDef @@ (project _LambdaType _LambdaType_body @@ var "lt")) ] @@ (ref stripTypeDef @@ var "t") diff --git a/src/main/haskell/Hydra/Sources/Tier1/Tier1.hs b/src/main/haskell/Hydra/Sources/Tier1/Tier1.hs --- a/src/main/haskell/Hydra/Sources/Tier1/Tier1.hs +++ b/src/main/haskell/Hydra/Sources/Tier1/Tier1.hs @@ -29,9 +29,10 @@ import Hydra.Sources.Tier1.Constants import Hydra.Sources.Tier1.Strip +import Hydra.Dsl.Mantle -tier1Definition :: String -> Datum a -> Definition a +tier1Definition :: String -> TTerm a -> TElement a tier1Definition = definitionInModule hydraTier1Module hydraTier1Module :: Module @@ -50,6 +51,7 @@ el freeVariablesInTermDef, el freeVariablesInTypeDef, el subtermsDef, + el subtermsWithAccessorsDef, el subtypesDef, -- Flows.hs el emptyTraceDef, @@ -63,7 +65,7 @@ el withTraceDef ] -floatValueToBigfloatDef :: Definition (Double -> Double) +floatValueToBigfloatDef :: TElement (Double -> Double) floatValueToBigfloatDef = tier1Definition "floatValueToBigfloat" $ doc "Convert a floating-point value of any precision to a bigfloat" $ function floatValueT Types.bigfloat $ @@ -72,7 +74,7 @@ _FloatValue_float32>>: Literals.float32ToBigfloat, _FloatValue_float64>>: Literals.float64ToBigfloat] -integerValueToBigintDef :: Definition (IntegerValue -> Integer) +integerValueToBigintDef :: TElement (IntegerValue -> Integer) integerValueToBigintDef = tier1Definition "integerValueToBigint" $ doc "Convert an integer value of any precision to a bigint" $ function integerValueT Types.bigint $ @@ -87,7 +89,7 @@ _IntegerValue_uint32>>: Literals.uint32ToBigint, _IntegerValue_uint64>>: Literals.uint64ToBigint] -isLambdaDef :: Definition (Term -> Bool) +isLambdaDef :: TElement (Term -> Bool) isLambdaDef = tier1Definition "isLambda" $ doc "Check whether a term is a lambda, possibly nested within let and/or annotation terms" $ function termT Types.boolean $ @@ -99,7 +101,7 @@ -- Rewriting.hs -foldOverTermDef :: Definition (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x) +foldOverTermDef :: TElement (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x) foldOverTermDef = tier1Definition "foldOverTerm" $ doc "Fold over a term, traversing its subterms in the specified order" $ functionN [TypeVariable _TraversalOrder, funT xT (funT termT xT), xT, termT, xT] $ @@ -113,7 +115,7 @@ @@ (ref subtermsDef @@ var "term")) @@ var "term")] @@ var "order") -foldOverTypeDef :: Definition (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x) +foldOverTypeDef :: TElement (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x) foldOverTypeDef = tier1Definition "foldOverType" $ doc "Fold over a type, traversing its subtypes in the specified order" $ functionN [TypeVariable _TraversalOrder, funT xT (funT typeT xT), xT, typeT, xT] $ @@ -127,7 +129,7 @@ @@ (ref subtypesDef @@ var "typ")) @@ var "typ")] @@ var "order") -freeVariablesInTermDef :: Definition (Term -> S.Set Name) +freeVariablesInTermDef :: TElement (Term -> S.Set Name) freeVariablesInTermDef = tier1Definition "freeVariablesInTerm" $ doc "Find the free variables (i.e. variables not bound by a lambda or let) in a term" $ function termT (setT nameT) $ @@ -147,7 +149,7 @@ @@ Sets.empty @@ (ref subtermsDef @@ var "term")]) -freeVariablesInTypeDef :: Definition (Type -> S.Set Name) +freeVariablesInTypeDef :: TElement (Type -> S.Set Name) freeVariablesInTypeDef = tier1Definition "freeVariablesInType" $ doc "Find the free variables (i.e. variables not bound by a lambda or let) in a type" $ function typeT (setT nameT) $ @@ -163,7 +165,7 @@ @@ Sets.empty @@ (ref subtypesDef @@ var "typ")]) -subtermsDef :: Definition (Term -> [Term]) +subtermsDef :: TElement (Term -> [Term]) subtermsDef = tier1Definition "subterms" $ doc "Find the children of a given term" $ function termT (listT termT) $ @@ -194,12 +196,85 @@ _Term_record>>: lambda "rt" (Lists.map @@ Core.fieldTerm @@ (Core.recordFields @@ var "rt")), _Term_set>>: Sets.toList, _Term_sum>>: lambda "st" $ list [Core.sumTerm @@ var "st"], + _Term_typeAbstraction>>: lambda "ta" $ list [Core.typeAbstractionBody @@ var "ta"], + _Term_typeApplication>>: lambda "ta" $ list [Core.typedTermTerm @@ var "ta"], _Term_typed>>: lambda "tt" $ list [Core.typedTermTerm @@ var "tt"], _Term_union>>: lambda "ut" $ list [Core.fieldTerm @@ (Core.injectionField @@ var "ut")], _Term_variable>>: constant $ list [], _Term_wrap>>: lambda "n" $ list [Core.wrappedTermObject @@ var "n"]] -subtypesDef :: Definition (Type -> [Type]) +subtermsWithAccessorsDef :: TElement (Term -> [(TermAccessor, Term)]) +subtermsWithAccessorsDef = tier1Definition "subtermsWithAccessors" $ + doc "Find the children of a given term" $ + function termT (listT $ pairT termAccessorT termT) $ + match _Term Nothing [ + _Term_annotated>>: lambda "at" $ single termAccessorAnnotatedSubject $ Core.annotatedTermSubject @@ var "at", + _Term_application>>: lambda "p" $ list [ + result termAccessorApplicationFunction $ Core.applicationFunction @@ var "p", + result termAccessorApplicationArgument $ Core.applicationArgument @@ var "p"], + _Term_function>>: match _Function (Just none) [ + _Function_elimination>>: match _Elimination (Just none) [ + _Elimination_list>>: lambda "fld" $ single termAccessorListFold $ var "fld", + _Elimination_optional>>: lambda "oc" $ list [ + result termAccessorOptionalCasesNothing $ Core.optionalCasesNothing @@ var "oc", + result termAccessorOptionalCasesJust $ Core.optionalCasesJust @@ var "oc"], + _Elimination_union>>: lambda "cs" $ Lists.concat2 + @@ ((matchOpt none (lambda "t" $ single termAccessorUnionCasesDefault $ var "t")) @@ (Core.caseStatementDefault @@ var "cs")) + @@ (Lists.map + @@ (lambda "f" $ result (termAccessorUnionCasesBranch $ Core.fieldName @@ var "f") $ Core.fieldTerm @@ var "f") + @@ (Core.caseStatementCases @@ var "cs"))], + _Function_lambda>>: lambda "l" $ single termAccessorLambdaBody $ Core.lambdaBody @@ var "l"], + _Term_let>>: lambda "lt" $ Lists.cons + @@ (result termAccessorLetEnvironment $ Core.letEnvironment @@ var "lt") + @@ (Lists.map + @@ (lambda "b" $ result (termAccessorLetBinding $ Core.letBindingName @@ var "b") $ Core.letBindingTerm @@ var "b") + @@ (Core.letBindings @@ var "lt")), + _Term_list>>: Lists.map + -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0 + @@ (lambda "e" $ result (termAccessorListElement $ int32 0) $ var "e"), + _Term_literal>>: constant none, + _Term_map>>: lambda "m" (Lists.concat @@ + (Lists.map + @@ (lambda "p" $ list [ + -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0 + result (termAccessorMapKey $ int32 0) $ first @@ var "p", + result (termAccessorMapValue $ int32 0) $ second @@ var "p"]) + @@ (Maps.toList @@ var "m"))), + _Term_optional>>: matchOpt none (lambda "t" $ single termAccessorOptionalTerm $ var "t"), + _Term_product>>: Lists.map + -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0 + @@ (lambda "e" $ result (termAccessorProductTerm $ int32 0) $ var "e"), + _Term_record>>: lambda "rt" (Lists.map + @@ (lambda "f" $ result (termAccessorRecordField $ Core.fieldName @@ var "f") $ Core.fieldTerm @@ var "f") + @@ (Core.recordFields @@ var "rt")), + _Term_set>>: lambda "s" $ Lists.map + -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0 + @@ (lambda "e" $ result (termAccessorListElement $ int32 0) $ var "e") + @@ (Sets.toList @@ var "s"), + _Term_sum>>: lambda "st" $ + single termAccessorSumTerm $ + Core.sumTerm @@ var "st", + _Term_typeAbstraction>>: lambda "ta" $ + single termAccessorTypeAbstractionBody $ + Core.typeAbstractionBody @@ var "ta", + _Term_typeApplication>>: lambda "ta" $ + single termAccessorTypeApplicationTerm $ + Core.typedTermTerm @@ var "ta", + _Term_typed>>: lambda "tt" $ + single termAccessorTypedTerm $ + Core.typedTermTerm @@ var "tt", + _Term_union>>: lambda "ut" $ + single termAccessorInjectionTerm $ + Core.fieldTerm @@ (Core.injectionField @@ var "ut"), + _Term_variable>>: constant none, + _Term_wrap>>: lambda "n" $ single termAccessorWrappedTerm $ Core.wrappedTermObject @@ var "n"] + where + none = list [] + single accessor term = list [result accessor term] + result accessor term = pair accessor term + simple term = result termAccessorAnnotatedSubject term + +subtypesDef :: TElement (Type -> [Type]) subtypesDef = tier1Definition "subtypes" $ doc "Find the children of a given type expression" $ function typeT (listT typeT) $ @@ -226,7 +301,7 @@ _Type_variable>>: constant $ list [], _Type_wrap>>: lambda "nt" $ list [Core.wrappedTypeObject @@ var "nt"]] -unqualifyNameDef :: Definition (QualifiedName -> Name) +unqualifyNameDef :: TElement (QualifiedName -> Name) unqualifyNameDef = tier1Definition "unqualifyName" $ doc "Convert a qualified name to a dot-separated name" $ function qualifiedNameT nameT $ @@ -237,21 +312,21 @@ -- Flows.hs -emptyTraceDef :: Definition Trace +emptyTraceDef :: TElement Trace emptyTraceDef = tier1Definition "emptyTrace" $ record _Trace [ _Trace_stack>>: list [], _Trace_messages>>: list [], _Trace_other>>: Maps.empty] -flowSucceedsDef :: Definition (Flow s a -> Bool) +flowSucceedsDef :: TElement (Flow s a -> Bool) flowSucceedsDef = tier1Definition "flowSucceeds" $ doc "Check whether a flow succeeds" $ function (Types.var "s") (Types.function flowSAT Types.boolean) $ lambda "cx" $ lambda "f" $ Optionals.isJust @@ (Flows.flowStateValue @@ (Flows.unFlow @@ var "f" @@ var "cx" @@ ref emptyTraceDef)) -fromFlowDef :: Definition (a -> s -> Flow s a -> a) +fromFlowDef :: TElement (a -> s -> Flow s a -> a) fromFlowDef = tier1Definition "fromFlow" $ doc "Get the value of a flow, or a default value if the flow fails" $ function (Types.var "a") (Types.function (Types.var "s") (Types.function flowSAT (Types.var "a"))) $ @@ -259,7 +334,7 @@ matchOpt (var "def") (lambda "x" $ var "x") @@ (Flows.flowStateValue @@ (Flows.unFlow @@ var "f" @@ var "cx" @@ ref emptyTraceDef)) -mutateTraceDef :: Definition ((Trace -> Either_ String Trace) -> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a) +mutateTraceDef :: TElement ((Trace -> Either_ String Trace) -> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a) mutateTraceDef = tier1Definition "mutateTrace" $ functionN [ Types.function traceT (eitherT Types.string traceT), @@ -289,7 +364,7 @@ where eitherT l r = Types.applyN [TypeVariable _Either, l, r] -pushErrorDef :: Definition (String -> Trace -> Trace) +pushErrorDef :: TElement (String -> Trace -> Trace) pushErrorDef = tier1Definition "pushError" $ doc "Push an error message" $ functionN [Types.string, traceT, traceT] $ @@ -300,7 +375,7 @@ `with` [ "errorMsg">: Strings.concat ["Error: ", var "msg", " (", (Strings.intercalate @@ " > " @@ (Lists.reverse @@ (Flows.traceStack @@ var "t"))), ")"]]) -warnDef :: Definition (String -> Flow s a -> Flow s a) +warnDef :: TElement (String -> Flow s a -> Flow s a) warnDef = tier1Definition "warn" $ doc "Continue the current flow after adding a warning message" $ functionN [Types.string, flowSAT, flowSAT] $ @@ -316,10 +391,10 @@ (Lists.cons @@ ("Warning: " ++ var "msg") @@ (Flows.traceMessages @@ var "t")) (Flows.traceOther @@ var "t")]) -withFlagDef :: Definition (String -> Flow s a -> Flow s a) +withFlagDef :: TElement (String -> Flow s a -> Flow s a) withFlagDef = tier1Definition "withFlag" $ doc "Continue the current flow after setting a flag" $ - function Types.string (Types.function flowSAT flowSAT) $ + function nameT (Types.function flowSAT flowSAT) $ lambda "flag" ((ref mutateTraceDef @@ var "mutate" @@ var "restore") `with` [ "mutate">: lambda "t" $ inject _Either _Either_right $ (Flows.trace @@ -331,7 +406,7 @@ (Flows.traceMessages @@ var "t1") (Maps.remove @@ var "flag" @@ (Flows.traceOther @@ var "t1"))]) -withStateDef :: Definition (s1 -> Flow s1 a -> Flow s2 a) +withStateDef :: TElement (s1 -> Flow s1 a -> Flow s2 a) withStateDef = tier1Definition "withState" $ doc "Continue a flow using a given state" $ function (Types.var "s1") (Types.function flowS1AT flowS2AT) $ @@ -343,7 +418,7 @@ typed (Types.apply (Types.apply (TypeVariable _FlowState) (Types.var "s1")) (Types.var "a")) $ Flows.unFlow @@ var "f" @@ var "cx0" @@ var "t1"]) -withTraceDef :: Definition (String -> Flow s a -> Flow s a) +withTraceDef :: TElement (String -> Flow s a -> Flow s a) withTraceDef = tier1Definition "withTrace" $ doc "Continue the current flow after augmenting the trace" $ functionN [Types.string, flowSAT, flowSAT] $ diff --git a/src/main/haskell/Hydra/Sources/Tier2/Basics.hs b/src/main/haskell/Hydra/Sources/Tier2/Basics.hs --- a/src/main/haskell/Hydra/Sources/Tier2/Basics.hs +++ b/src/main/haskell/Hydra/Sources/Tier2/Basics.hs @@ -28,7 +28,7 @@ import Hydra.Sources.Tier1.All -basicsDefinition :: String -> Datum a -> Definition a +basicsDefinition :: String -> TTerm a -> TElement a basicsDefinition = definitionInModule hydraBasicsModule hydraBasicsModule :: Module @@ -79,7 +79,7 @@ el qualifyNameLazyDef ] -eliminationVariantDef :: Definition (Elimination -> EliminationVariant) +eliminationVariantDef :: TElement (Elimination -> EliminationVariant) eliminationVariantDef = basicsDefinition "eliminationVariant" $ doc "Find the elimination variant (constructor) for a given elimination term" $ function eliminationT eliminationVariantT $ @@ -91,7 +91,7 @@ _Elimination_union @-> _EliminationVariant_union, _Elimination_wrap @-> _EliminationVariant_wrap] -eliminationVariantsDef :: Definition [EliminationVariant] +eliminationVariantsDef :: TElement [EliminationVariant] eliminationVariantsDef = basicsDefinition "eliminationVariants" $ doc "All elimination variants (constructors), in a canonical order" $ typed (listT eliminationVariantT) $ @@ -103,7 +103,7 @@ _EliminationVariant_record, _EliminationVariant_union] -floatTypePrecisionDef :: Definition (FloatType -> Precision) +floatTypePrecisionDef :: TElement (FloatType -> Precision) floatTypePrecisionDef = basicsDefinition "floatTypePrecision" $ doc "Find the precision of a given floating-point type" $ function floatTypeT precisionT $ @@ -112,7 +112,7 @@ _FloatType_float32 @-> field _Precision_bits $ int 32, _FloatType_float64 @-> field _Precision_bits $ int 64] -floatTypesDef :: Definition [FloatType] +floatTypesDef :: TElement [FloatType] floatTypesDef = basicsDefinition "floatTypes" $ doc "All floating-point types in a canonical order" $ typed (listT floatTypeT) $ @@ -121,7 +121,7 @@ _FloatType_float32, _FloatType_float64] -floatValueTypeDef :: Definition (FloatValue -> FloatType) +floatValueTypeDef :: TElement (FloatValue -> FloatType) floatValueTypeDef = basicsDefinition "floatValueType" $ doc "Find the float type for a given floating-point value" $ function floatValueT floatTypeT $ @@ -130,7 +130,7 @@ _FloatValue_float32 @-> _FloatType_float32, _FloatValue_float64 @-> _FloatType_float64] -functionVariantDef :: Definition (Function -> FunctionVariant) +functionVariantDef :: TElement (Function -> FunctionVariant) functionVariantDef = basicsDefinition "functionVariant" $ doc "Find the function variant (constructor) for a given function" $ function functionT functionVariantT $ @@ -139,7 +139,7 @@ _Function_lambda @-> _FunctionVariant_lambda, _Function_primitive @-> _FunctionVariant_primitive] -functionVariantsDef :: Definition [FunctionVariant] +functionVariantsDef :: TElement [FunctionVariant] functionVariantsDef = basicsDefinition "functionVariants" $ doc "All function variants (constructors), in a canonical order" $ typed (listT functionVariantT) $ @@ -148,13 +148,13 @@ _FunctionVariant_lambda, _FunctionVariant_primitive] -idDef :: Definition (a -> a) +idDef :: TElement (a -> a) idDef = basicsDefinition "id" $ doc "The identity function" $ function aT aT $ lambda "x" $ var "x" -integerTypeIsSignedDef :: Definition (IntegerType -> Bool) +integerTypeIsSignedDef :: TElement (IntegerType -> Bool) integerTypeIsSignedDef = basicsDefinition "integerTypeIsSigned" $ doc "Find whether a given integer type is signed (true) or unsigned (false)" $ function integerTypeT booleanT $ @@ -169,7 +169,7 @@ _IntegerType_uint32 @-> constant false, _IntegerType_uint64 @-> constant false] -integerTypePrecisionDef :: Definition (IntegerType -> Precision) +integerTypePrecisionDef :: TElement (IntegerType -> Precision) integerTypePrecisionDef = basicsDefinition "integerTypePrecision" $ doc "Find the precision of a given integer type" $ function integerTypeT precisionT $ @@ -184,7 +184,7 @@ _IntegerType_uint32 @-> field _Precision_bits $ int 32, _IntegerType_uint64 @-> field _Precision_bits $ int 64] -integerTypesDef :: Definition [IntegerType] +integerTypesDef :: TElement [IntegerType] integerTypesDef = basicsDefinition "integerTypes" $ doc "All integer types, in a canonical order" $ typed (listT integerTypeT) $ @@ -199,7 +199,7 @@ _IntegerType_uint32, _IntegerType_uint64] -integerValueTypeDef :: Definition (IntegerValue -> IntegerType) +integerValueTypeDef :: TElement (IntegerValue -> IntegerType) integerValueTypeDef = basicsDefinition "integerValueType" $ doc "Find the integer type for a given integer value" $ function integerValueT integerTypeT $ @@ -214,18 +214,18 @@ _IntegerValue_uint32 @-> _IntegerType_uint32, _IntegerValue_uint64 @-> _IntegerType_uint64] -literalTypeDef :: Definition (Literal -> LiteralType) +literalTypeDef :: TElement (Literal -> LiteralType) literalTypeDef = basicsDefinition "literalType" $ doc "Find the literal type for a given literal value" $ function literalT literalTypeT $ match _Literal Nothing [ - Case _Literal_binary --> constant $ variant _LiteralType _LiteralType_binary unit, - Case _Literal_boolean --> constant $ variant _LiteralType _LiteralType_boolean unit, - Case _Literal_float --> inject2 _LiteralType _LiteralType_float <.> ref floatValueTypeDef, - Case _Literal_integer --> inject2 _LiteralType _LiteralType_integer <.> ref integerValueTypeDef, - Case _Literal_string --> constant $ variant _LiteralType _LiteralType_string unit] + TCase _Literal_binary --> constant $ variant _LiteralType _LiteralType_binary unit, + TCase _Literal_boolean --> constant $ variant _LiteralType _LiteralType_boolean unit, + TCase _Literal_float --> inject2 _LiteralType _LiteralType_float <.> ref floatValueTypeDef, + TCase _Literal_integer --> inject2 _LiteralType _LiteralType_integer <.> ref integerValueTypeDef, + TCase _Literal_string --> constant $ variant _LiteralType _LiteralType_string unit] -literalTypeVariantDef :: Definition (LiteralType -> LiteralVariant) +literalTypeVariantDef :: TElement (LiteralType -> LiteralVariant) literalTypeVariantDef = basicsDefinition "literalTypeVariant" $ doc "Find the literal type variant (constructor) for a given literal value" $ function literalTypeT literalVariantT $ @@ -236,13 +236,13 @@ _LiteralType_integer @-> _LiteralVariant_integer, _LiteralType_string @-> _LiteralVariant_string] -literalVariantDef :: Definition (Literal -> LiteralVariant) +literalVariantDef :: TElement (Literal -> LiteralVariant) literalVariantDef = basicsDefinition "literalVariant" $ doc "Find the literal variant (constructor) for a given literal value" $ function literalT literalVariantT $ ref literalTypeVariantDef <.> ref literalTypeDef -literalVariantsDef :: Definition [LiteralVariant] +literalVariantsDef :: TElement [LiteralVariant] literalVariantsDef = basicsDefinition "literalVariants" $ doc "All literal variants, in a canonical order" $ typed (listT literalVariantT) $ @@ -253,7 +253,7 @@ _LiteralVariant_integer, _LiteralVariant_string] -termVariantDef :: Definition (Term -> TermVariant) +termVariantDef :: TElement (Term -> TermVariant) termVariantDef = basicsDefinition "termVariant" $ doc "Find the term variant (constructor) for a given term" $ function termT termVariantT $ @@ -270,12 +270,14 @@ _Term_record @-> _TermVariant_record, _Term_set @-> _TermVariant_set, _Term_sum @-> _TermVariant_sum, + _Term_typeAbstraction @-> _TermVariant_typeAbstraction, + _Term_typeApplication @-> _TermVariant_typeApplication, _Term_typed @-> _TermVariant_typed, _Term_union @-> _TermVariant_union, _Term_variable @-> _TermVariant_variable, _Term_wrap @-> _TermVariant_wrap] -termVariantsDef :: Definition [TermVariant] +termVariantsDef :: TElement [TermVariant] termVariantsDef = basicsDefinition "termVariants" $ doc "All term (expression) variants, in a canonical order" $ typed (listT termVariantT) $ @@ -291,12 +293,14 @@ _TermVariant_record, _TermVariant_set, _TermVariant_sum, + _TermVariant_typeAbstraction, + _TermVariant_typeApplication, _TermVariant_typed, _TermVariant_union, _TermVariant_variable, _TermVariant_wrap] -typeVariantDef :: Definition (Type -> TypeVariant) +typeVariantDef :: TElement (Type -> TypeVariant) typeVariantDef = basicsDefinition "typeVariant" $ doc "Find the type variant (constructor) for a given type" $ function typeT typeVariantT $ @@ -317,7 +321,7 @@ _Type_variable @-> _TypeVariant_variable, _Type_wrap @-> _TypeVariant_wrap] -typeVariantsDef :: Definition [TypeVariant] +typeVariantsDef :: TElement [TypeVariant] typeVariantsDef = basicsDefinition "typeVariants" $ doc "All type variants, in a canonical order" $ typed (listT typeVariantT) $ @@ -340,20 +344,20 @@ -- Formatting.hs -capitalizeDef :: Definition (String -> String) +capitalizeDef :: TElement (String -> String) capitalizeDef = basicsDefinition "capitalize" $ doc "Capitalize the first letter of a string" $ function stringT stringT $ ref mapFirstLetterDef @@ Strings.toUpper -decapitalizeDef :: Definition (String -> String) +decapitalizeDef :: TElement (String -> String) decapitalizeDef = basicsDefinition "decapitalize" $ doc "Decapitalize the first letter of a string" $ function stringT stringT $ ref mapFirstLetterDef @@ Strings.toLower -- TODO: simplify this helper -mapFirstLetterDef :: Definition ((String -> String) -> String -> String) +mapFirstLetterDef :: TElement ((String -> String) -> String -> String) mapFirstLetterDef = basicsDefinition "mapFirstLetter" $ doc "A helper which maps the first letter of a string to another string" $ function (funT stringT stringT) (funT stringT stringT) $ @@ -367,54 +371,54 @@ -- Common.hs -fieldMapDef :: Definition ([Field] -> M.Map Name Term) +fieldMapDef :: TElement ([Field] -> M.Map Name Term) fieldMapDef = basicsDefinition "fieldMap" $ function (TypeList fieldT) (mapT fieldNameT termT) $ (lambda "fields" $ Maps.fromList @@ (Lists.map @@ var "toPair" @@ var "fields")) `with` [ - "toPair">: lambda "f" $ pair (project _Field _Field_name @@ var "f", project _Field _Field_term @@ var "f")] + "toPair">: lambda "f" $ pair (Core.fieldName @@ var "f") (Core.fieldTerm @@ var "f")] -fieldTypeMapDef :: Definition ([FieldType] -> M.Map Name Type) +fieldTypeMapDef :: TElement ([FieldType] -> M.Map Name Type) fieldTypeMapDef = basicsDefinition "fieldTypeMap" $ function (TypeList fieldTypeT) (mapT fieldNameT typeT) $ (lambda "fields" $ Maps.fromList @@ (Lists.map @@ var "toPair" @@ var "fields")) `with` [ - "toPair">: lambda "f" $ pair (project _FieldType _FieldType_name @@ var "f", project _FieldType _FieldType_type @@ var "f")] + "toPair">: lambda "f" $ pair (Core.fieldTypeName @@ var "f") (Core.fieldTypeType @@ var "f")] -isEncodedTypeDef :: Definition (Term -> Bool) +isEncodedTypeDef :: TElement (Term -> Bool) isEncodedTypeDef = basicsDefinition "isEncodedType" $ function termT booleanT $ lambda "t" $ (match _Term (Just false) [ - Case _Term_application --> lambda "a" $ - ref isEncodedTypeDef @@ (project _Application _Application_function @@ var "a"), - Case _Term_union --> lambda "i" $ - Equality.equalString @@ (string $ unName _Type) @@ (unwrap _Name @@ (project _Injection _Injection_typeName @@ var "i")) + TCase _Term_application --> lambda "a" $ + ref isEncodedTypeDef @@ (Core.applicationFunction @@ var "a"), + TCase _Term_union --> lambda "i" $ + Equality.equalString @@ (string $ unName _Type) @@ (Core.unName @@ (Core.injectionTypeName @@ var "i")) ]) @@ (ref stripTermDef @@ var "t") -isTypeDef :: Definition (Type -> Bool) +isTypeDef :: TElement (Type -> Bool) isTypeDef = basicsDefinition "isType" $ function typeT booleanT $ lambda "t" $ (match _Type (Just false) [ - Case _Type_application --> lambda "a" $ - ref isTypeDef @@ (project _ApplicationType _ApplicationType_function @@ var "a"), - Case _Type_lambda --> lambda "l" $ - ref isTypeDef @@ (project _LambdaType _LambdaType_body @@ var "l"), - Case _Type_union --> lambda "rt" $ - Equality.equalString @@ (string $ unName _Type) @@ (unwrap _Name @@ (project _RowType _RowType_typeName @@ var "rt")) --- Case _Type_variable --> constant true + TCase _Type_application --> lambda "a" $ + ref isTypeDef @@ (Core.applicationTypeFunction @@ var "a"), + TCase _Type_lambda --> lambda "l" $ + ref isTypeDef @@ (Core.lambdaTypeBody @@ var "l"), + TCase _Type_union --> lambda "rt" $ + Equality.equalString @@ (string $ unName _Type) @@ (Core.unName @@ (Core.rowTypeTypeName @@ var "rt")) +-- TCase _Type_variable --> constant true ]) @@ (ref stripTypeDef @@ var "t") -isUnitTermDef :: Definition (Term -> Bool) +isUnitTermDef :: TElement (Term -> Bool) isUnitTermDef = basicsDefinition "isUnitTerm" $ function termT booleanT $ - lambda "t" $ Equality.equalTerm @@ (ref fullyStripTermDef @@ var "t") @@ Datum (coreEncodeTerm Terms.unit) + lambda "t" $ Equality.equalTerm @@ (ref fullyStripTermDef @@ var "t") @@ TTerm (coreEncodeTerm Terms.unit) -isUnitTypeDef :: Definition (Term -> Bool) +isUnitTypeDef :: TElement (Term -> Bool) isUnitTypeDef = basicsDefinition "isUnitType" $ function typeT booleanT $ - lambda "t" $ Equality.equalType @@ (ref stripTypeDef @@ var "t") @@ Datum (coreEncodeType unitT) + lambda "t" $ Equality.equalType @@ (ref stripTypeDef @@ var "t") @@ TTerm (coreEncodeType unitT) -elementsToGraphDef :: Definition (Graph -> Maybe Graph -> [Element] -> Graph) +elementsToGraphDef :: TElement (Graph -> Maybe Graph -> [Element] -> Graph) elementsToGraphDef = basicsDefinition "elementsToGraph" $ function graphT (funT (optionalT graphT) (funT (TypeList elementT) graphT)) $ lambda "parent" $ lambda "schema" $ lambda "elements" $ @@ -426,56 +430,61 @@ (Graph.graphPrimitives @@ var "parent") (var "schema") `with` [ - "toPair" >: lambda "el" $ pair (project _Element _Element_name @@ var "el", var "el")] + "toPair" >: lambda "el" $ pair (Graph.elementName @@ var "el") (var "el")] -localNameOfEagerDef :: Definition (Name -> String) +localNameOfEagerDef :: TElement (Name -> String) localNameOfEagerDef = basicsDefinition "localNameOfEager" $ function nameT stringT $ Module.qualifiedNameLocal <.> ref qualifyNameEagerDef -localNameOfLazyDef :: Definition (Name -> String) +localNameOfLazyDef :: TElement (Name -> String) localNameOfLazyDef = basicsDefinition "localNameOfLazy" $ function nameT stringT $ Module.qualifiedNameLocal <.> ref qualifyNameLazyDef -namespaceOfEagerDef :: Definition (Name -> Maybe Namespace) +namespaceOfEagerDef :: TElement (Name -> Maybe Namespace) namespaceOfEagerDef = basicsDefinition "namespaceOfEager" $ function nameT (optionalT namespaceT) $ Module.qualifiedNameNamespace <.> ref qualifyNameEagerDef -namespaceOfLazyDef :: Definition (Name -> Maybe Namespace) +namespaceOfLazyDef :: TElement (Name -> Maybe Namespace) namespaceOfLazyDef = basicsDefinition "namespaceOfLazy" $ function nameT (optionalT namespaceT) $ Module.qualifiedNameNamespace <.> ref qualifyNameLazyDef -namespaceToFilePathDef :: Definition (Bool -> FileExtension -> Namespace -> String) +namespaceToFilePathDef :: TElement (Bool -> FileExtension -> Namespace -> String) namespaceToFilePathDef = basicsDefinition "namespaceToFilePath" $ function booleanT (funT fileExtensionT (funT namespaceT stringT)) $ lambda "caps" $ lambda "ext" $ lambda "ns" $ - (((Strings.intercalate @@ "/" @@ var "parts") ++ "." ++ (unwrap _FileExtension @@ var "ext")) + (((Strings.intercalate @@ "/" @@ var "parts") ++ "." ++ (Module.unFileExtension @@ var "ext")) `with` [ - "parts">: Lists.map @@ (Logic.ifElse @@ ref capitalizeDef @@ ref idDef @@ var "caps") @@ (Strings.splitOn @@ "/" @@ (unwrap _Namespace @@ var "ns"))]) + "parts">: Lists.map + @@ (Logic.ifElse + @@ ref capitalizeDef + @@ ref idDef + @@ var "caps") + @@ (Strings.splitOn @@ "/" @@ (Core.unNamespace @@ var "ns"))]) -qualifyNameEagerDef :: Definition (Name -> QualifiedName) +qualifyNameEagerDef :: TElement (Name -> QualifiedName) qualifyNameEagerDef = basicsDefinition "qualifyNameEager" $ function nameT qualifiedNameT $ lambda "name" $ ((Logic.ifElse - @@ Module.qualifiedName nothing (unwrap _Name @@ var "name") + @@ Module.qualifiedName nothing (Core.unName @@ var "name") @@ Module.qualifiedName (just $ wrap _Namespace (Lists.head @@ var "parts")) (Strings.intercalate @@ "." @@ (Lists.tail @@ var "parts")) @@ (Equality.equalInt32 @@ int32 1 @@ (Lists.length @@ var "parts"))) `with` [ - "parts">: Strings.splitOn @@ "." @@ (unwrap _Name @@ var "name")]) + "parts">: Strings.splitOn @@ "." @@ (Core.unName @@ var "name")]) -qualifyNameLazyDef :: Definition (Name -> QualifiedName) +qualifyNameLazyDef :: TElement (Name -> QualifiedName) qualifyNameLazyDef = basicsDefinition "qualifyNameLazy" $ function nameT qualifiedNameT $ lambda "name" $ (Logic.ifElse - @@ Module.qualifiedName nothing (unwrap _Name @@ var "name") + @@ Module.qualifiedName nothing (Core.unName @@ var "name") @@ Module.qualifiedName (just $ wrap _Namespace (Strings.intercalate @@ "." @@ (Lists.reverse @@ (Lists.tail @@ var "parts")))) (Lists.head @@ var "parts") @@ (Equality.equalInt32 @@ int32 1 @@ (Lists.length @@ var "parts"))) `with` [ - "parts">: Lists.reverse @@ (Strings.splitOn @@ "." @@ (unwrap _Name @@ var "name"))] + "parts">: Lists.reverse @@ (Strings.splitOn @@ "." @@ (Core.unName @@ var "name"))] diff --git a/src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs b/src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs --- a/src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs +++ b/src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs @@ -39,7 +39,7 @@ ns = Namespace "hydra/coreLanguage" elements = [el hydraCoreLanguageDef] -hydraCoreLanguageDef :: Definition Language +hydraCoreLanguageDef :: TElement Language hydraCoreLanguageDef = definitionInModule hydraCoreLanguageModule "hydraCoreLanguage" $ doc "Language constraints for Java" $ typed languageT $ diff --git a/src/main/haskell/Hydra/Sources/Tier2/Extras.hs b/src/main/haskell/Hydra/Sources/Tier2/Extras.hs --- a/src/main/haskell/Hydra/Sources/Tier2/Extras.hs +++ b/src/main/haskell/Hydra/Sources/Tier2/Extras.hs @@ -26,7 +26,7 @@ import Hydra.Sources.Tier1.All -hydraExtrasDefinition :: String -> Datum a -> Definition a +hydraExtrasDefinition :: String -> TTerm a -> TElement a hydraExtrasDefinition = definitionInModule hydraExtrasModule hydraExtrasModule :: Module @@ -44,33 +44,32 @@ el typeArityDef, el uncurryTypeDef, el getAnnotationDef --- el getAttrDef ] -functionArityDef :: Definition (Function -> Int) +functionArityDef :: TElement (Function -> Int) functionArityDef = hydraExtrasDefinition "functionArity" $ function (TypeVariable _Function) Types.int32 $ match _Function Nothing [ - Case _Function_elimination --> constant (int32 1), - Case _Function_lambda --> (Math.add @@ int32 1) <.> (ref termArityDef <.> project _Lambda _Lambda_body), - Case _Function_primitive --> constant $ + TCase _Function_elimination --> constant (int32 1), + TCase _Function_lambda --> (Math.add @@ int32 1) <.> (ref termArityDef <.> Core.lambdaBody), + TCase _Function_primitive --> constant $ doc "TODO: This function needs to be monadic, so we can look up the primitive" (int32 42)] -lookupPrimitiveDef :: Definition (Graph -> Name -> Maybe (Primitive)) +lookupPrimitiveDef :: TElement (Graph -> Name -> Maybe (Primitive)) lookupPrimitiveDef = hydraExtrasDefinition "lookupPrimitive" $ function graphT (Types.function nameT (optionalT primitiveT)) $ lambda "g" $ lambda "name" $ - apply (Maps.lookup @@ var "name") (project _Graph _Graph_primitives @@ var "g") + apply (Maps.lookup @@ var "name") (Graph.graphPrimitives @@ var "g") -primitiveArityDef :: Definition (Primitive -> Int) +primitiveArityDef :: TElement (Primitive -> Int) primitiveArityDef = hydraExtrasDefinition "primitiveArity" $ doc "Find the arity (expected number of arguments) of a primitive constant or function" $ function primitiveT Types.int32 $ - (ref typeArityDef <.> (project _Primitive _Primitive_type)) + (ref typeArityDef <.> Core.typeSchemeType <.> Graph.primitiveType) -qnameDef :: Definition (Namespace -> String -> Name) +qnameDef :: TElement (Namespace -> String -> Name) qnameDef = hydraExtrasDefinition "qname" $ doc "Construct a qualified (dot-separated) name" $ functionN [namespaceT, stringT, nameT] $ @@ -79,25 +78,25 @@ apply Strings.cat $ list [apply (unwrap _Namespace) (var "ns"), string ".", var "name"] -termArityDef :: Definition (Term -> Int) +termArityDef :: TElement (Term -> Int) termArityDef = hydraExtrasDefinition "termArity" $ function termT Types.int32 $ match _Term (Just $ int32 0) [ - Case _Term_application --> (lambda "x" $ Math.sub @@ var "x" @@ int32 1) <.> (ref termArityDef <.> (project _Application _Application_function)), - Case _Term_function --> ref functionArityDef] + TCase _Term_application --> (lambda "x" $ Math.sub @@ var "x" @@ int32 1) <.> ref termArityDef <.> Core.applicationFunction, + TCase _Term_function --> ref functionArityDef] -- Note: ignoring variables which might resolve to functions -typeArityDef :: Definition (Type -> Int) +typeArityDef :: TElement (Type -> Int) typeArityDef = hydraExtrasDefinition "typeArity" $ function typeT Types.int32 $ match _Type (Just $ int32 0) [ - Case _Type_annotated --> ref typeArityDef <.> Core.annotatedTypeSubject, - Case _Type_application --> ref typeArityDef <.> (project _ApplicationType _ApplicationType_function), - Case _Type_lambda --> ref typeArityDef <.> (project _LambdaType _LambdaType_body), - Case _Type_function --> lambda "f" $ - Math.add @@ (int32 1) @@ (ref typeArityDef @@ (apply (project _FunctionType _FunctionType_codomain) (var "f")))] + TCase _Type_annotated --> ref typeArityDef <.> Core.annotatedTypeSubject, + TCase _Type_application --> ref typeArityDef <.> Core.applicationTypeFunction, + TCase _Type_lambda --> ref typeArityDef <.> Core.lambdaTypeBody, + TCase _Type_function --> lambda "f" $ + Math.add @@ (int32 1) @@ (ref typeArityDef @@ (Core.functionTypeCodomain @@ var "f"))] -uncurryTypeDef :: Definition (Type -> [Type]) +uncurryTypeDef :: TElement (Type -> [Type]) uncurryTypeDef = hydraExtrasDefinition "uncurryType" $ function typeT (listT typeT) $ doc "Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)" $ @@ -109,20 +108,10 @@ @@ (Core.functionTypeDomain @@ var "ft") @@ (ref uncurryTypeDef @@ (Core.functionTypeCodomain @@ var "ft"))]) @@ var "t") --- hydra/kv +-- hydra/annotations -getAnnotationDef :: Definition (String -> M.Map String Term -> Maybe Term) +getAnnotationDef :: TElement (Name -> M.Map Name Term -> Maybe Term) getAnnotationDef = hydraExtrasDefinition "getAnnotation" $ - functionN [stringT, kvT, optionalT termT] $ + functionN [nameT, kvT, optionalT termT] $ lambda "key" $ lambda "ann" $ Maps.lookup @@ var "key" @@ var "ann" - - ---getAttrDef :: Definition (String -> Flow s (Maybe Term)) ---getAttrDef = hydraExtrasDefinition "getAttr" $ --- lambda "key" $ wrap _Flow $ --- function Types.string (Types.apply (Types.apply (TypeVariable _Flow) (Types.var "s")) (Types.optional $ Types.apply (TypeVariable _Term) (TypeVariable _Kv))) $ --- lambda "s0" $ lambda "t0" $ record _FlowState [ --- fld _FlowState_value (just (Maps.lookup @@ var "key" @@ (project _Trace _Trace_other @@ var "t0"))), --- fld _FlowState_state $ var "s0", --- fld _FlowState_trace $ var "t0"] diff --git a/src/main/haskell/Hydra/Sources/Tier2/Printing.hs b/src/main/haskell/Hydra/Sources/Tier2/Printing.hs --- a/src/main/haskell/Hydra/Sources/Tier2/Printing.hs +++ b/src/main/haskell/Hydra/Sources/Tier2/Printing.hs @@ -43,67 +43,67 @@ el describePrecisionDef, el describeTypeDef] -printingDefinition :: String -> Datum a -> Definition a +printingDefinition :: String -> TTerm a -> TElement a printingDefinition = definitionInModule hydraPrintingModule -describeFloatTypeDef :: Definition (FloatType -> String) +describeFloatTypeDef :: TElement (FloatType -> String) describeFloatTypeDef = printingDefinition "describeFloatType" $ doc "Display a floating-point type as a string" $ function floatTypeT stringT $ lambda "t" $ (ref describePrecisionDef <.> ref floatTypePrecisionDef @@ var "t") ++ string " floating-point numbers" -describeIntegerTypeDef :: Definition (IntegerType -> String) +describeIntegerTypeDef :: TElement (IntegerType -> String) describeIntegerTypeDef = printingDefinition "describeIntegerType" $ doc "Display an integer type as a string" $ function integerTypeT stringT $ lambda "t" $ (ref describePrecisionDef <.> ref integerTypePrecisionDef @@ var "t") ++ string " integers" -describeLiteralTypeDef :: Definition (LiteralType -> String) +describeLiteralTypeDef :: TElement (LiteralType -> String) describeLiteralTypeDef = printingDefinition "describeLiteralType" $ doc "Display a literal type as a string" $ function literalTypeT stringT $ match _LiteralType Nothing [ - Case _LiteralType_binary --> constant $ string "binary strings", - Case _LiteralType_boolean --> constant $ string "boolean values", - Case _LiteralType_float --> ref describeFloatTypeDef, - Case _LiteralType_integer --> ref describeIntegerTypeDef, - Case _LiteralType_string --> constant $ string "character strings"] + TCase _LiteralType_binary --> constant $ string "binary strings", + TCase _LiteralType_boolean --> constant $ string "boolean values", + TCase _LiteralType_float --> ref describeFloatTypeDef, + TCase _LiteralType_integer --> ref describeIntegerTypeDef, + TCase _LiteralType_string --> constant $ string "character strings"] -describePrecisionDef :: Definition (Precision -> String) +describePrecisionDef :: TElement (Precision -> String) describePrecisionDef = printingDefinition "describePrecision" $ doc "Display numeric precision as a string" $ function precisionT stringT $ match _Precision Nothing [ - Case _Precision_arbitrary --> constant $ string "arbitrary-precision", - Case _Precision_bits --> lambda "bits" $ Literals.showInt32 @@ var "bits" ++ string "-bit"] + TCase _Precision_arbitrary --> constant $ string "arbitrary-precision", + TCase _Precision_bits --> lambda "bits" $ Literals.showInt32 @@ var "bits" ++ string "-bit"] -describeTypeDef :: Definition (Type -> String) +describeTypeDef :: TElement (Type -> String) describeTypeDef = printingDefinition "describeType" $ doc "Display a type as a string" $ function typeT stringT $ match _Type Nothing [ - Case _Type_annotated --> lambda "a" $ string "annotated " ++ (ref describeTypeDef @@ + TCase _Type_annotated --> lambda "a" $ string "annotated " ++ (ref describeTypeDef @@ (project _AnnotatedType _AnnotatedType_subject @@ var "a")), - Case _Type_application --> constant $ string "instances of an application type", - Case _Type_literal --> ref describeLiteralTypeDef, - Case _Type_function --> lambda "ft" $ string "functions from " + TCase _Type_application --> constant $ string "instances of an application type", + TCase _Type_literal --> ref describeLiteralTypeDef, + TCase _Type_function --> lambda "ft" $ string "functions from " ++ (ref describeTypeDef @@ (project _FunctionType _FunctionType_domain @@ var "ft")) ++ string " to " ++ (ref describeTypeDef @@ (project _FunctionType _FunctionType_codomain @@ var "ft")), - Case _Type_lambda --> constant $ string "polymorphic terms", - Case _Type_list --> lambda "t" $ string "lists of " ++ (ref describeTypeDef @@ var "t"), - Case _Type_map --> lambda "mt" $ string "maps from " + TCase _Type_lambda --> constant $ string "polymorphic terms", + TCase _Type_list --> lambda "t" $ string "lists of " ++ (ref describeTypeDef @@ var "t"), + TCase _Type_map --> lambda "mt" $ string "maps from " ++ (ref describeTypeDef @@ (project _MapType _MapType_keys @@ var "mt")) ++ string " to " ++ (ref describeTypeDef @@ (project _MapType _MapType_values @@ var "mt")), - Case _Type_optional --> lambda "ot" $ string "optional " ++ (ref describeTypeDef @@ var "ot"), - Case _Type_product --> constant $ string "tuples", - Case _Type_record --> constant $ string "records", - Case _Type_set --> lambda "st" $ string "sets of " ++ (ref describeTypeDef @@ var "st"), - Case _Type_sum --> constant $ string "variant tuples", - Case _Type_union --> constant $ string "unions", - Case _Type_variable --> constant $ string "instances of a named type", - Case _Type_wrap --> lambda "n" $ string "wrapper for " + TCase _Type_optional --> lambda "ot" $ string "optional " ++ (ref describeTypeDef @@ var "ot"), + TCase _Type_product --> constant $ string "tuples", + TCase _Type_record --> constant $ string "records", + TCase _Type_set --> lambda "st" $ string "sets of " ++ (ref describeTypeDef @@ var "st"), + TCase _Type_sum --> constant $ string "variant tuples", + TCase _Type_union --> constant $ string "unions", + TCase _Type_variable --> constant $ string "instances of a named type", + TCase _Type_wrap --> lambda "n" $ string "wrapper for " ++ (ref describeTypeDef @@ (project _WrappedType _WrappedType_object @@ var "n"))] diff --git a/src/main/haskell/Hydra/Sources/Tier2/Tier2.hs b/src/main/haskell/Hydra/Sources/Tier2/Tier2.hs --- a/src/main/haskell/Hydra/Sources/Tier2/Tier2.hs +++ b/src/main/haskell/Hydra/Sources/Tier2/Tier2.hs @@ -28,7 +28,7 @@ import Hydra.Sources.Tier1.All -tier2Definition :: String -> Datum a -> Definition a +tier2Definition :: String -> TTerm a -> TElement a tier2Definition = definitionInModule hydraTier2Module hydraTier2Module :: Module @@ -45,7 +45,7 @@ el unexpectedDef ] -getStateDef :: Definition (Flow s s) +getStateDef :: TElement (Flow s s) getStateDef = tier2Definition "getState" $ doc "Get the state of the current flow" $ typed flowSST $ @@ -61,7 +61,7 @@ typed (Types.apply (Types.apply (TypeVariable _FlowState) sT) unitT) $ Flows.unFlow @@ (Flows.pure @@ unit) @@ var "s0" @@ var "t0"]) -getTermTypeDef :: Definition (Term -> Flow Graph (Maybe Type)) +getTermTypeDef :: TElement (Term -> Flow Graph (Maybe Type)) getTermTypeDef = tier2Definition "getTermType" $ doc "Get the annotated type of a given term, if any" $ function termT (optionalT typeT) $ @@ -69,7 +69,7 @@ "annotated">: ref getTermTypeDef <.> project _AnnotatedTerm _AnnotatedTerm_subject, "typed">: lambda "tt" $ just (project _TypedTerm _TypedTerm_type @@ var "tt")] -putStateDef :: Definition (s -> Flow s ()) +putStateDef :: TElement (s -> Flow s ()) putStateDef = tier2Definition "putState" $ doc "Set the state of a flow" $ function sT (flowT sT unitT) $ @@ -81,7 +81,7 @@ `with` [ "f1">: Flows.unFlow @@ (Flows.pure @@ unit) @@ var "s0" @@ var "t0"]) -requireElementTypeDef :: Definition (Element -> Flow Graph Type) +requireElementTypeDef :: TElement (Element -> Flow Graph Type) requireElementTypeDef = tier2Definition "requireElementType" $ doc "Get the annotated type of a given element, or fail if it is missing" $ function elementT (flowT graphT typeT) $ @@ -91,7 +91,7 @@ (Flows.fail @@ ("missing type annotation for element " ++ (unwrap _Name @@ (project _Element _Element_name @@ var "el")))) Flows.pure]) -requireTermTypeDef :: Definition (Term -> Flow Graph Type) +requireTermTypeDef :: TElement (Term -> Flow Graph Type) requireTermTypeDef = tier2Definition "requireTermType" $ doc "Get the annotated type of a given term, or fail if it is missing" $ function termT (flowT graphT typeT) $ @@ -101,7 +101,7 @@ (Flows.fail @@ "missing type annotation") Flows.pure] -unexpectedDef :: Definition (String -> String -> Flow s x) +unexpectedDef :: TElement (String -> String -> Flow s x) unexpectedDef = tier2Definition "unexpected" $ doc "Fail if an actual value does not match an expected value" $ function stringT (funT stringT (flowT sT xT)) $ diff --git a/src/main/haskell/Hydra/Sources/Tier3/Tier3.hs b/src/main/haskell/Hydra/Sources/Tier3/Tier3.hs --- a/src/main/haskell/Hydra/Sources/Tier3/Tier3.hs +++ b/src/main/haskell/Hydra/Sources/Tier3/Tier3.hs @@ -28,19 +28,19 @@ import Hydra.Sources.Tier2.All -tier3Definition :: String -> Datum a -> Definition a +tier3Definition :: String -> TTerm a -> TElement a tier3Definition = definitionInModule hydraTier3Module -- TODO: this need not be a tier-3 module; it has no term-level dependencies. It could be a tier-1 module. hydraTier3Module :: Module -hydraTier3Module = Module (Namespace "hydra/tier3") elements [] tier0Modules $ +hydraTier3Module = Module (Namespace "hydra/tier3") elements [hydraCoreModule] tier0Modules $ Just ("A module for miscellaneous tier-3 functions and constants.") where elements = [ el traceSummaryDef ] -traceSummaryDef :: Definition (Trace -> String) +traceSummaryDef :: TElement (Trace -> String) traceSummaryDef = tier3Definition "traceSummary" $ doc "Summarize a trace as a string" $ function traceT stringT $ @@ -55,4 +55,4 @@ @@ (Maps.isEmpty @@ (Flows.traceOther @@ var "t")), "toLine">: function (pairT stringT termT) stringT $ - lambda "pair" $ "\t" ++ (first @@ var "pair") ++ ": " ++ (Io.showTerm @@ (second @@ var "pair"))]) + lambda "pair" $ "\t" ++ (Core.unName @@ (first @@ var "pair")) ++ ": " ++ (Io.showTerm @@ (second @@ var "pair"))]) diff --git a/src/main/haskell/Hydra/Sources/Tier4/All.hs b/src/main/haskell/Hydra/Sources/Tier4/All.hs --- a/src/main/haskell/Hydra/Sources/Tier4/All.hs +++ b/src/main/haskell/Hydra/Sources/Tier4/All.hs @@ -5,40 +5,31 @@ ) where import Hydra.Sources.Tier3.All -import Hydra.Sources.Tier4.Langs.Avro.Schema -import Hydra.Sources.Tier4.Langs.Cypher.Features -import Hydra.Sources.Tier4.Langs.Cypher.OpenCypher -import Hydra.Sources.Tier4.Langs.Graphql.Syntax -import Hydra.Sources.Tier4.Langs.Haskell.Ast -import Hydra.Sources.Tier4.Langs.Java.Language -import Hydra.Sources.Tier4.Langs.Java.Syntax -import Hydra.Sources.Tier4.Langs.Json.Decoding -import Hydra.Sources.Tier4.Langs.Kusto.Kql -import Hydra.Sources.Tier4.Langs.Owl.Syntax -import Hydra.Sources.Tier4.Langs.Parquet.Delta -import Hydra.Sources.Tier4.Langs.Parquet.Format -import Hydra.Sources.Tier4.Langs.Pegasus.Pdl -import Hydra.Sources.Tier4.Langs.Protobuf.Any -import Hydra.Sources.Tier4.Langs.Protobuf.Language -import Hydra.Sources.Tier4.Langs.Protobuf.Proto3 -import Hydra.Sources.Tier4.Langs.Protobuf.SourceContext -import Hydra.Sources.Tier4.Langs.Python.Python3 -import Hydra.Sources.Tier4.Langs.Rdf.Syntax -import Hydra.Sources.Tier4.Langs.RelationalModel -import Hydra.Sources.Tier4.Langs.Scala.Meta -import Hydra.Sources.Tier4.Langs.Shacl.Model -import Hydra.Sources.Tier4.Langs.Shex.Syntax -import Hydra.Sources.Tier4.Langs.Sql.Ansi -import Hydra.Sources.Tier4.Langs.Tabular -import Hydra.Sources.Tier4.Langs.Tinkerpop.Features -import Hydra.Sources.Tier4.Langs.Tinkerpop.Gremlin -import Hydra.Sources.Tier4.Langs.Tinkerpop.Mappings -import Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph -import Hydra.Sources.Tier4.Langs.Tinkerpop.Queries -import Hydra.Sources.Tier4.Langs.Tinkerpop.Validate -import Hydra.Sources.Tier4.Langs.Xml.Schema -import Hydra.Sources.Tier4.Langs.Yaml.Model +import Hydra.Sources.Tier4.Ext.Avro.Schema +import Hydra.Sources.Tier4.Ext.Csharp.Syntax +import Hydra.Sources.Tier4.Ext.Cypher.Features +import Hydra.Sources.Tier4.Ext.Cypher.OpenCypher +import Hydra.Sources.Tier4.Ext.Graphql.Syntax +import Hydra.Sources.Tier4.Ext.Haskell.Ast +import Hydra.Sources.Tier4.Ext.Java.Language +import Hydra.Sources.Tier4.Ext.Java.Syntax +import Hydra.Sources.Tier4.Ext.Json.Decoding +import Hydra.Sources.Tier4.Ext.Pegasus.Pdl +import Hydra.Sources.Tier4.Ext.Protobuf.Any +import Hydra.Sources.Tier4.Ext.Protobuf.Language +import Hydra.Sources.Tier4.Ext.Protobuf.Proto3 +import Hydra.Sources.Tier4.Ext.Protobuf.SourceContext +import Hydra.Sources.Tier4.Ext.Rdf.Syntax +import Hydra.Sources.Tier4.Ext.RelationalModel +import Hydra.Sources.Tier4.Ext.Scala.Meta +import Hydra.Sources.Tier4.Ext.Shacl.Model +import Hydra.Sources.Tier4.Ext.Tabular +import Hydra.Sources.Tier4.Ext.Yaml.Model import Hydra.Sources.Tier4.Test.TestSuite +import Hydra.Sources.Tier4.Ext.Pg.Mapping +import Hydra.Sources.Tier4.Ext.Pg.Model +import Hydra.Sources.Tier4.Ext.Pg.Query +import Hydra.Sources.Tier4.Ext.Pg.Validation allModules :: [Module] @@ -54,35 +45,26 @@ tier4LangModules :: [Module] tier4LangModules = [ avroSchemaModule, - deltaParquetModule, + csharpSyntaxModule, graphqlSyntaxModule, - gremlinModule, haskellAstModule, javaLanguageModule, javaSyntaxModule, jsonDecodingModule, - kqlModule, openCypherModule, openCypherFeaturesModule, - owlSyntaxModule, - parquetFormatModule, pegasusPdlModule, proto3Module, protobufAnyModule, protobufLanguageModule, protobufSourceContextModule, --- python3Module, rdfSyntaxModule, relationalModelModule, scalaMetaModule, shaclModelModule, - shexSyntaxModule, - sqlModule, tabularModule, - tinkerpopFeaturesModule, - tinkerpopMappingsModule, - tinkerpopPropertyGraphModule, - propertyGraphQueriesModule, - tinkerpopValidateModule, - xmlSchemaModule, + pgMappingModule, + pgModelModule, + pgQueryModule, + pgValidationModule, yamlModelModule] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Avro/Schema.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Avro/Schema.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Avro/Schema.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Avro.Schema where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +avroSchemaModule :: Module +avroSchemaModule = Module ns elements [jsonModelModule] tier0Modules $ + Just ("A model for Avro schemas. Based on the Avro 1.11.1 specification:\n" ++ + " https://avro.apache.org/docs/1.11.1/specification") + where + ns = Namespace "hydra/ext/org/apache/avro/schema" + def = datatype ns + avro = typeref ns + json = typeref $ moduleNamespace jsonModelModule + + elements = [ + def "Array" $ + record [ + "items">: avro "Schema"], + + def "Enum" $ + record [ + "symbols">: + doc ("a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; " ++ + "duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* " ++ + "(the same requirement as for names)") $ + list string, + "default">: + doc ("A default value for this enumeration, used during resolution when the reader encounters " ++ + "a symbol from the writer that isn't defined in the reader's schema. " ++ + "The value provided here must be a JSON string that's a member of the symbols array") $ + optional string], + + def "Field" $ + record [ + "name">: + doc "a JSON string providing the name of the field" + string, + "doc">: + doc "a JSON string describing this field for users" $ + optional string, + "type">: + doc "a schema" $ + avro "Schema", + "default">: + doc "default value for this field, only used when reading instances that lack the field for schema evolution purposes" $ + optional $ json "Value", + "order">: + doc "specifies how this field impacts sort ordering of this record" $ + optional $ avro "Order", + "aliases">: + doc "a JSON array of strings, providing alternate names for this field" $ + optional $ list string, + "annotations">: + doc "Any additional key/value pairs attached to the field" $ + Types.map string $ json "Value"], + + def "Fixed" $ + record [ + "size">: + doc "an integer, specifying the number of bytes per value" + int32], + + def "Map" $ + record [ + "values">: avro "Schema"], + + def "Named" $ + record [ + "name">: + doc "a string naming this schema" + string, + "namespace">: + doc "a string that qualifies the name" $ + optional string, + "aliases">: + doc "a JSON array of strings, providing alternate names for this schema" $ + optional $ list string, + "doc">: + doc "a JSON string providing documentation to the user of this schema" $ + optional string, + "type">: avro "NamedType", + "annotations">: + doc "Any additional key/value pairs attached to the type" $ + Types.map string $ json "Value"], + + def "NamedType" $ + union [ + "enum">: avro "Enum", + "fixed">: avro "Fixed", + "record">: avro "Record"], + + def "Order" $ + enum ["ascending", "descending", "ignore"], + + def "Primitive" $ + union [ + "null">: + doc "no value" unit, + "boolean">: + doc "A binary value" unit, + "int">: + doc "32-bit signed integer" unit, + "long">: + doc "64-bit signed integer" unit, + "float">: + doc "single precision (32-bit) IEEE 754 floating-point number" unit, + "double">: + doc "double precision (64-bit) IEEE 754 floating-point number" unit, + "bytes">: + doc "sequence of 8-bit unsigned bytes" unit, + "string">: + doc "unicode character sequence" unit], + + def "Record" $ + record [ + "fields">: + doc "a JSON array, listing fields" $ + list $ avro "Field"], + + def "Schema" $ + union [ + "array">: avro "Array", + "map">: avro "Map", + "named">: avro "Named", + "primitive">: avro "Primitive", + "reference">: -- Note: "reference" is not described in the Avro specification; this has been added + doc "A reference by name to a previously defined type" string, + "union">: avro "Union" + ], + + def "Union" $ + list $ avro "Schema"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Csharp/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Csharp/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Csharp/Syntax.hs @@ -0,0 +1,4430 @@ +module Hydra.Sources.Tier4.Ext.Csharp.Syntax where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Types as Types +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap + + +csharpSyntaxModule :: Module +csharpSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A C# syntax module based on the ANTLR grammar dated 02/07/2024 and available at:\n" + ++ " https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/language-specification/grammar") + where + ns = Namespace "hydra/ext/csharp/syntax" + def = datatype ns + csharp = typeref ns + + elements = lexicalElements ++ syntacticElements ++ unsafeElements + + lexicalElements = [ +-- // Source: §6.3.1 General +-- DEFAULT : 'default' ; +-- NULL : 'null' ; +-- TRUE : 'true' ; +-- FALSE : 'false' ; +-- ASTERISK : '*' ; +-- SLASH : '/' ; +-- +-- // Source: §6.3.1 General +-- input +-- : input_section? +-- ; +-- +-- input_section +-- : input_section_part+ +-- ; +-- +-- input_section_part +-- : input_element* New_Line +-- | PP_Directive +-- ; +-- +-- input_element +-- : Whitespace +-- | Comment +-- | token +-- ; +-- +-- // Source: §6.3.2 Line terminators +-- New_Line +-- : New_Line_Character +-- | '\u000D\u000A' // carriage return, line feed +-- ; +-- +-- // Source: §6.3.3 Comments +-- Comment +-- : Single_Line_Comment +-- | Delimited_Comment +-- ; +-- +-- fragment Single_Line_Comment +-- : '//' Input_Character* +-- ; +-- +-- fragment Input_Character +-- // anything but New_Line_Character +-- : ~('\u000D' | '\u000A' | '\u0085' | '\u2028' | '\u2029') +-- ; +-- +-- fragment New_Line_Character +-- : '\u000D' // carriage return +-- | '\u000A' // line feed +-- | '\u0085' // next line +-- | '\u2028' // line separator +-- | '\u2029' // paragraph separator +-- ; +-- +-- fragment Delimited_Comment +-- : '/*' Delimited_Comment_Section* ASTERISK+ '/' +-- ; +-- +-- fragment Delimited_Comment_Section +-- : SLASH +-- | ASTERISK* Not_Slash_Or_Asterisk +-- ; +-- +-- fragment Not_Slash_Or_Asterisk +-- : ~('/' | '*') // Any except SLASH or ASTERISK +-- ; +-- +-- // Source: §6.3.4 White space +-- Whitespace +-- : [\p{Zs}] // any character with Unicode class Zs +-- | '\u0009' // horizontal tab +-- | '\u000B' // vertical tab +-- | '\u000C' // form feed +-- ; +-- +-- // Source: §6.4.1 General +-- token +-- : identifier +-- | keyword +-- | Integer_Literal +-- | Real_Literal +-- | Character_Literal +-- | String_Literal +-- | operator_or_punctuator +-- ; +-- +-- // Source: §6.4.2 Unicode character escape sequences +-- fragment Unicode_Escape_Sequence +-- : '\\u' Hex_Digit Hex_Digit Hex_Digit Hex_Digit +-- | '\\U' Hex_Digit Hex_Digit Hex_Digit Hex_Digit +-- Hex_Digit Hex_Digit Hex_Digit Hex_Digit +-- ; +-- +-- // Source: §6.4.3 Identifiers +-- identifier +-- : Simple_Identifier +-- | contextual_keyword +-- ; + + def "Identifier" string, + +-- Simple_Identifier +-- : Available_Identifier +-- | Escaped_Identifier +-- ; +-- +-- fragment Available_Identifier +-- // excluding keywords or contextual keywords, see note below +-- : Basic_Identifier +-- ; +-- +-- fragment Escaped_Identifier +-- // Includes keywords and contextual keywords prefixed by '@'. +-- // See note below. +-- : '@' Basic_Identifier +-- ; +-- +-- fragment Basic_Identifier +-- : Identifier_Start_Character Identifier_Part_Character* +-- ; +-- +-- fragment Identifier_Start_Character +-- : Letter_Character +-- | Underscore_Character +-- ; +-- +-- fragment Underscore_Character +-- : '_' // underscore +-- | '\\u005' [fF] // Unicode_Escape_Sequence for underscore +-- | '\\U0000005' [fF] // Unicode_Escape_Sequence for underscore +-- ; +-- +-- fragment Identifier_Part_Character +-- : Letter_Character +-- | Decimal_Digit_Character +-- | Connecting_Character +-- | Combining_Character +-- | Formatting_Character +-- ; +-- +-- fragment Letter_Character +-- // Category Letter, all subcategories; category Number, subcategory letter. +-- : [\p{L}\p{Nl}] +-- // Only escapes for categories L & Nl allowed. See note below. +-- | Unicode_Escape_Sequence +-- ; +-- +-- fragment Combining_Character +-- // Category Mark, subcategories non-spacing and spacing combining. +-- : [\p{Mn}\p{Mc}] +-- // Only escapes for categories Mn & Mc allowed. See note below. +-- | Unicode_Escape_Sequence +-- ; +-- +-- fragment Decimal_Digit_Character +-- // Category Number, subcategory decimal digit. +-- : [\p{Nd}] +-- // Only escapes for category Nd allowed. See note below. +-- | Unicode_Escape_Sequence +-- ; +-- +-- fragment Connecting_Character +-- // Category Punctuation, subcategory connector. +-- : [\p{Pc}] +-- // Only escapes for category Pc allowed. See note below. +-- | Unicode_Escape_Sequence +-- ; +-- +-- fragment Formatting_Character +-- // Category Other, subcategory format. +-- : [\p{Cf}] +-- // Only escapes for category Cf allowed, see note below. +-- | Unicode_Escape_Sequence +-- ; +-- +-- // Source: §6.4.4 Keywords +-- keyword +-- : 'abstract' | 'as' | 'base' | 'bool' | 'break' +-- | 'byte' | 'case' | 'catch' | 'char' | 'checked' +-- | 'class' | 'const' | 'continue' | 'decimal' | DEFAULT +-- | 'delegate' | 'do' | 'double' | 'else' | 'enum' +-- | 'event' | 'explicit' | 'extern' | FALSE | 'finally' +-- | 'fixed' | 'float' | 'for' | 'foreach' | 'goto' +-- | 'if' | 'implicit' | 'in' | 'int' | 'interface' +-- | 'internal' | 'is' | 'lock' | 'long' | 'namespace' +-- | 'new' | NULL | 'object' | 'operator' | 'out' +-- | 'override' | 'params' | 'private' | 'protected' | 'public' +-- | 'readonly' | 'ref' | 'return' | 'sbyte' | 'sealed' +-- | 'short' | 'sizeof' | 'stackalloc' | 'static' | 'string' +-- | 'struct' | 'switch' | 'this' | 'throw' | TRUE +-- | 'try' | 'typeof' | 'uint' | 'ulong' | 'unchecked' +-- | 'unsafe' | 'ushort' | 'using' | 'virtual' | 'void' +-- | 'volatile' | 'while' +-- ; + + def "Keyword" string, + +-- // Source: §6.4.4 Keywords +-- contextual_keyword +-- : 'add' | 'alias' | 'ascending' | 'async' | 'await' +-- | 'by' | 'descending' | 'dynamic' | 'equals' | 'from' +-- | 'get' | 'global' | 'group' | 'into' | 'join' +-- | 'let' | 'nameof' | 'on' | 'orderby' | 'partial' +-- | 'remove' | 'select' | 'set' | 'unmanaged' | 'value' +-- | 'var' | 'when' | 'where' | 'yield' +-- ; +-- +-- // Source: §6.4.5.1 General +-- literal +-- : boolean_literal +-- | Integer_Literal +-- | Real_Literal +-- | Character_Literal +-- | String_Literal +-- | null_literal +-- ; + + def "Literal" $ union [ + "boolean">: boolean, + "integer">: csharp "IntegerLiteral", + "real">: bigfloat, + "character">: string, + "string">: string, + "null">: unit], + +-- // Source: §6.4.5.2 Boolean literals +-- boolean_literal +-- : TRUE +-- | FALSE +-- ; +-- +-- // Source: §6.4.5.3 Integer literals +-- Integer_Literal +-- : Decimal_Integer_Literal +-- | Hexadecimal_Integer_Literal +-- | Binary_Integer_Literal +-- ; + + def "IntegerLiteral" $ union [ + "decimal">: string, + "hexadecimal">: string, + "binary">: bigint] + +-- fragment Decimal_Integer_Literal +-- : Decimal_Digit Decorated_Decimal_Digit* Integer_Type_Suffix? +-- ; +-- +-- fragment Decorated_Decimal_Digit +-- : '_'* Decimal_Digit +-- ; +-- +-- fragment Decimal_Digit +-- : '0'..'9' +-- ; +-- +-- fragment Integer_Type_Suffix +-- : 'U' | 'u' | 'L' | 'l' | +-- 'UL' | 'Ul' | 'uL' | 'ul' | 'LU' | 'Lu' | 'lU' | 'lu' +-- ; +-- +-- fragment Hexadecimal_Integer_Literal +-- : ('0x' | '0X') Decorated_Hex_Digit+ Integer_Type_Suffix? +-- ; +-- +-- fragment Decorated_Hex_Digit +-- : '_'* Hex_Digit +-- ; +-- +-- fragment Hex_Digit +-- : '0'..'9' | 'A'..'F' | 'a'..'f' +-- ; +-- +-- fragment Binary_Integer_Literal +-- : ('0b' | '0B') Decorated_Binary_Digit+ Integer_Type_Suffix? +-- ; +-- +-- fragment Decorated_Binary_Digit +-- : '_'* Binary_Digit +-- ; +-- +-- fragment Binary_Digit +-- : '0' | '1' +-- ; +-- +-- // Source: §6.4.5.4 Real literals +-- Real_Literal +-- : Decimal_Digit Decorated_Decimal_Digit* '.' +-- Decimal_Digit Decorated_Decimal_Digit* Exponent_Part? Real_Type_Suffix? +-- | '.' Decimal_Digit Decorated_Decimal_Digit* Exponent_Part? Real_Type_Suffix? +-- | Decimal_Digit Decorated_Decimal_Digit* Exponent_Part Real_Type_Suffix? +-- | Decimal_Digit Decorated_Decimal_Digit* Real_Type_Suffix +-- ; +-- +-- fragment Exponent_Part +-- : ('e' | 'E') Sign? Decimal_Digit Decorated_Decimal_Digit* +-- ; +-- +-- fragment Sign +-- : '+' | '-' +-- ; +-- +-- fragment Real_Type_Suffix +-- : 'F' | 'f' | 'D' | 'd' | 'M' | 'm' +-- ; +-- +-- // Source: §6.4.5.5 Character literals +-- Character_Literal +-- : '\'' Character '\'' +-- ; +-- +-- fragment Character +-- : Single_Character +-- | Simple_Escape_Sequence +-- | Hexadecimal_Escape_Sequence +-- | Unicode_Escape_Sequence +-- ; +-- +-- fragment Single_Character +-- // anything but ', \, and New_Line_Character +-- : ~['\\\u000D\u000A\u0085\u2028\u2029] +-- ; +-- +-- fragment Simple_Escape_Sequence +-- : '\\\'' | '\\"' | '\\\\' | '\\0' | '\\a' | '\\b' | +-- '\\f' | '\\n' | '\\r' | '\\t' | '\\v' +-- ; +-- +-- fragment Hexadecimal_Escape_Sequence +-- : '\\x' Hex_Digit Hex_Digit? Hex_Digit? Hex_Digit? +-- ; +-- +-- // Source: §6.4.5.6 String literals +-- String_Literal +-- : Regular_String_Literal +-- | Verbatim_String_Literal +-- ; +-- +-- fragment Regular_String_Literal +-- : '"' Regular_String_Literal_Character* '"' +-- ; +-- +-- fragment Regular_String_Literal_Character +-- : Single_Regular_String_Literal_Character +-- | Simple_Escape_Sequence +-- | Hexadecimal_Escape_Sequence +-- | Unicode_Escape_Sequence +-- ; +-- +-- fragment Single_Regular_String_Literal_Character +-- // anything but ", \, and New_Line_Character +-- : ~["\\\u000D\u000A\u0085\u2028\u2029] +-- ; +-- +-- fragment Verbatim_String_Literal +-- : '@"' Verbatim_String_Literal_Character* '"' +-- ; +-- +-- fragment Verbatim_String_Literal_Character +-- : Single_Verbatim_String_Literal_Character +-- | Quote_Escape_Sequence +-- ; +-- +-- fragment Single_Verbatim_String_Literal_Character +-- : ~["] // anything but quotation mark (U+0022) +-- ; +-- +-- fragment Quote_Escape_Sequence +-- : '""' +-- ; +-- +-- // Source: §6.4.5.7 The null literal +-- null_literal +-- : NULL +-- ; +-- +-- // Source: §6.4.6 Operators and punctuators +-- operator_or_punctuator +-- : '{' | '}' | '[' | ']' | '(' | ')' | '.' | ',' | ':' | ';' +-- | '+' | '-' | ASTERISK | SLASH | '%' | '&' | '|' | '^' | '!' | '~' +-- | '=' | '<' | '>' | '?' | '??' | '::' | '++' | '--' | '&&' | '||' +-- | '->' | '==' | '!=' | '<=' | '>=' | '+=' | '-=' | '*=' | '/=' | '%=' +-- | '&=' | '|=' | '^=' | '<<' | '<<=' | '=>' +-- ; +-- +-- right_shift +-- : '>' '>' +-- ; +-- +-- right_shift_assignment +-- : '>' '>=' +-- ; +-- +-- // Source: §6.5.1 General +-- PP_Directive +-- : PP_Start PP_Kind PP_New_Line +-- ; +-- +-- fragment PP_Kind +-- : PP_Declaration +-- | PP_Conditional +-- | PP_Line +-- | PP_Diagnostic +-- | PP_Region +-- | PP_Pragma +-- | PP_Nullable +-- ; +-- +-- // Only recognised at the beginning of a line +-- fragment PP_Start +-- // See note below. +-- : { getCharPositionInLine() == 0 }? PP_Whitespace? '#' PP_Whitespace? +-- ; +-- +-- fragment PP_Whitespace +-- : ( [\p{Zs}] // any character with Unicode class Zs +-- | '\u0009' // horizontal tab +-- | '\u000B' // vertical tab +-- | '\u000C' // form feed +-- )+ +-- ; +-- +-- fragment PP_New_Line +-- : PP_Whitespace? Single_Line_Comment? New_Line +-- ; +-- +-- // Source: §6.5.2 Conditional compilation symbols +-- fragment PP_Conditional_Symbol +-- // Must not be equal to tokens TRUE or FALSE. See note below. +-- : Basic_Identifier +-- ; +-- +-- // Source: §6.5.3 Pre-processing expressions +-- fragment PP_Expression +-- : PP_Whitespace? PP_Or_Expression PP_Whitespace? +-- ; +-- +-- fragment PP_Or_Expression +-- : PP_And_Expression (PP_Whitespace? '||' PP_Whitespace? PP_And_Expression)* +-- ; +-- +-- fragment PP_And_Expression +-- : PP_Equality_Expression (PP_Whitespace? '&&' PP_Whitespace? +-- PP_Equality_Expression)* +-- ; +-- +-- fragment PP_Equality_Expression +-- : PP_Unary_Expression (PP_Whitespace? ('==' | '!=') PP_Whitespace? +-- PP_Unary_Expression)* +-- ; +-- +-- fragment PP_Unary_Expression +-- : PP_Primary_Expression +-- | '!' PP_Whitespace? PP_Unary_Expression +-- ; +-- +-- fragment PP_Primary_Expression +-- : TRUE +-- | FALSE +-- | PP_Conditional_Symbol +-- | '(' PP_Whitespace? PP_Expression PP_Whitespace? ')' +-- ; +-- +-- // Source: §6.5.4 Definition directives +-- fragment PP_Declaration +-- : 'define' PP_Whitespace PP_Conditional_Symbol +-- | 'undef' PP_Whitespace PP_Conditional_Symbol +-- ; +-- +-- // Source: §6.5.5 Conditional compilation directives +-- fragment PP_Conditional +-- : PP_If_Section +-- | PP_Elif_Section +-- | PP_Else_Section +-- | PP_Endif +-- ; +-- +-- fragment PP_If_Section +-- : 'if' PP_Whitespace PP_Expression +-- ; +-- +-- fragment PP_Elif_Section +-- : 'elif' PP_Whitespace PP_Expression +-- ; +-- +-- fragment PP_Else_Section +-- : 'else' +-- ; +-- +-- fragment PP_Endif +-- : 'endif' +-- ; +-- +-- // Source: §6.5.6 Diagnostic directives +-- fragment PP_Diagnostic +-- : 'error' PP_Message? +-- | 'warning' PP_Message? +-- ; +-- +-- fragment PP_Message +-- : PP_Whitespace Input_Character* +-- ; +-- +-- // Source: §6.5.7 Region directives +-- fragment PP_Region +-- : PP_Start_Region +-- | PP_End_Region +-- ; +-- +-- fragment PP_Start_Region +-- : 'region' PP_Message? +-- ; +-- +-- fragment PP_End_Region +-- : 'endregion' PP_Message? +-- ; +-- +-- // Source: §6.5.8 Line directives +-- fragment PP_Line +-- : 'line' PP_Whitespace PP_Line_Indicator +-- ; +-- +-- fragment PP_Line_Indicator +-- : Decimal_Digit+ PP_Whitespace PP_Compilation_Unit_Name +-- | Decimal_Digit+ +-- | DEFAULT +-- | 'hidden' +-- ; +-- +-- fragment PP_Compilation_Unit_Name +-- : '"' PP_Compilation_Unit_Name_Character+ '"' +-- ; +-- +-- fragment PP_Compilation_Unit_Name_Character +-- // Any Input_Character except " +-- : ~('\u000D' | '\u000A' | '\u0085' | '\u2028' | '\u2029' | '#') +-- ; +-- +-- // Source: §6.5.9 Nullable directive +-- fragment PP_Nullable +-- : 'nullable' PP_Whitespace PP_Nullable_Action (PP_Whitespace PP_Nullable_Target)? +-- ; +-- fragment PP_Nullable_Action +-- : 'disable' +-- | 'enable' +-- | 'restore' +-- ; +-- fragment PP_Nullable_Target +-- : 'warnings' +-- | 'annotations' +-- ; +-- +-- // Source: §6.5.10 Pragma directives +-- fragment PP_Pragma +-- : 'pragma' PP_Pragma_Text? +-- ; +-- +-- fragment PP_Pragma_Text +-- : PP_Whitespace Input_Character* +-- ; + ] + + syntacticElements = [ +-- // Source: §7.8.1 General +-- namespace_name +-- : namespace_or_type_name +-- ; + + def "NamespaceName" $ csharp "NamespaceOrTypeName", + +-- type_name +-- : namespace_or_type_name +-- ; + + def "TypeName" $ csharp "NamespaceOrTypeName", + +-- namespace_or_type_name +-- : identifier type_argument_list? +-- | namespace_or_type_name '.' identifier type_argument_list? +-- | qualified_alias_member +-- ; + + def "NamespaceOrTypeName" $ union [ + "identifier">: csharp "IdentifierNamespaceOrTypeName", + "qualified">: csharp "QualifiedNamespaceOrTypeName", + "alias">: csharp "QualifiedAliasMember"], + + def "IdentifierNamespaceOrTypeName" $ record [ + "identifier">: csharp "Identifier", + "arguments">: optional $ csharp "TypeArgumentList"], + + def "QualifiedNamespaceOrTypeName" $ record [ + "namespaceOrType">: csharp "NamespaceOrTypeName", + "identifier">: csharp "Identifier", + "arguments">: optional $ csharp "TypeArgumentList"], + +-- // Source: §8.1 General +-- type +-- : reference_type +-- | value_type +-- | type_parameter +-- | pointer_type // unsafe code support +-- ; + + def "Type" $ union [ + "reference">: csharp "ReferenceType", + "value">: csharp "ValueType", + "param">: csharp "TypeParameter", + "pointer">: csharp "PointerType"], + +-- // Source: §8.2.1 General +-- reference_type +-- : class_type +-- | interface_type +-- | array_type +-- | delegate_type +-- | 'dynamic' +-- ; + + def "ReferenceType" $ union [ + "class">: csharp "ClassType", + "interface">: csharp "InterfaceType", + "array">: csharp "ArrayType", + "delegate">: csharp "DelegateType", + "dynamic">: unit], + +-- class_type +-- : type_name +-- | 'object' +-- | 'string' +-- ; + + def "ClassType" $ union [ + "typeName">: csharp "TypeName", + "object">: unit, + "string">: unit], + +-- interface_type +-- : type_name +-- ; + + def "InterfaceType" $ csharp "TypeName", + +-- array_type +-- : non_array_type rank_specifier+ +-- ; + + def "ArrayType" $ record [ + "type">: csharp "NonArrayType", + "rank">: list $ csharp "RankSpecifier"], + +-- non_array_type +-- : value_type +-- | class_type +-- | interface_type +-- | delegate_type +-- | 'dynamic' +-- | type_parameter +-- | pointer_type // unsafe code support +-- ; + + def "NonArrayType" $ union [ + "value">: csharp "ValueType", + "class">: csharp "ClassType", + "interface">: csharp "InterfaceType", + "delegate">: csharp "DelegateType", + "dynamic">: unit, + "parameter">: csharp "TypeParameter", + "pointer">: csharp "PointerType"], + +-- rank_specifier +-- : '[' ','* ']' +-- ; + + def "RankSpecifier" int32, -- Note: non-negative + +-- delegate_type +-- : type_name +-- ; + + def "DelegateType" $ csharp "TypeName", + +-- // Source: §8.3.1 General +-- value_type +-- : non_nullable_value_type +-- | nullable_value_type +-- ; + + def "ValueType" $ union [ + "nonNullable">: csharp "StructOrEnumType", + "nullable">: csharp "StructOrEnumType"], + +-- non_nullable_value_type +-- : struct_type +-- | enum_type +-- ; + + def "StructOrEnumType" $ union [ + "struct">: csharp "StructType", + "enum">: csharp "EnumType"], + +-- struct_type +-- : type_name +-- | simple_type +-- | tuple_type +-- ; + + def "StructType" $ union [ + "typeName">: csharp "TypeName", + "simple">: csharp "SimpleType", + "tuple">: csharp "TupleType"], + +-- simple_type +-- : numeric_type +-- | 'bool' +-- ; + + def "SimpleType" $ union [ + "numeric">: csharp "NumericType", + "bool">: unit], + +-- numeric_type +-- : integral_type +-- | floating_point_type +-- | 'decimal' +-- ; + + def "NumericType" $ union [ + "integral">: csharp "IntegralType", + "floatingPoint">: csharp "FloatingPointType", + "decimal">: unit], + +-- integral_type +-- : 'sbyte' +-- | 'byte' +-- | 'short' +-- | 'ushort' +-- | 'int' +-- | 'uint' +-- | 'long' +-- | 'ulong' +-- | 'char' +-- ; + + def "IntegralType" $ union [ + "sbyte">: unit, + "byte">: unit, + "short">: unit, + "ushort">: unit, + "int">: unit, + "uint">: unit, + "long">: unit, + "ulong">: unit, + "char">: unit], + +-- floating_point_type +-- : 'float' +-- | 'double' +-- ; + + def "FloatingPointType" $ union [ + "float">: unit, + "double">: unit], + +-- tuple_type +-- : '(' tuple_type_element (',' tuple_type_element)+ ')' +-- ; + + def "TupleType" $ nonemptyList $ csharp "TupleTypeElement", + +-- tuple_type_element +-- : type identifier? +-- ; + + def "TupleTypeElement" $ record [ + "type">: csharp "Type", + "identifier">: optional $ csharp "Identifier"], + +-- enum_type +-- : type_name +-- ; + + def "EnumType" $ csharp "TypeName", + +-- nullable_value_type +-- : non_nullable_value_type '?' +-- ; +-- +-- // Source: §8.4.2 Type arguments +-- type_argument_list +-- : '<' type_arguments '>' +-- ; + + def "TypeArgumentList" $ list $ csharp "Type", + +-- type_arguments +-- : type_argument (',' type_argument)* +-- ; +-- +-- type_argument +-- : type +-- ; +-- +-- // Source: §8.5 Type parameters +-- type_parameter +-- : identifier +-- ; + + def "TypeParameter" $ csharp "Identifier", + +-- // Source: §8.8 Unmanaged types +-- unmanaged_type +-- : value_type +-- | pointer_type // unsafe code support +-- ; + + def "UnmanagedType" $ union [ + "value">: csharp "ValueType", + "pointer">: csharp "PointerType"], + +-- // Source: §9.5 Variable references +-- variable_reference +-- : expression +-- ; + + def "VariableReference" $ csharp "Expression", + +-- // Source: §11.2.1 General +-- pattern +-- : declaration_pattern +-- | constant_pattern +-- | var_pattern +-- ; + + def "Pattern" $ union [ + "declaration">: csharp "DeclarationPattern", + "constant">: csharp "Expression", + "var">: csharp "Designation"], + +-- // Source: §11.2.2 Declaration pattern +-- declaration_pattern +-- : type simple_designation +-- ; + + def "DeclarationPattern" $ record [ + "type">: csharp "Type", + "designation">: csharp "Designation"], + +-- simple_designation +-- : single_variable_designation +-- ; + + def "Designation" $ csharp "Identifier", + +-- single_variable_designation +-- : identifier +-- ; +-- +-- // Source: §11.2.3 Constant pattern +-- constant_pattern +-- : constant_expression +-- ; +-- +-- // Source: §11.2.4 Var pattern +-- var_pattern +-- : 'var' designation +-- ; +-- designation +-- : simple_designation +-- ; +-- +-- // Source: §12.6.2.1 General +-- argument_list +-- : argument (',' argument)* +-- ; + + def "ArgumentList" $ nonemptyList $ csharp "Argument", + +-- argument +-- : argument_name? argument_value +-- ; + + def "Argument" $ record [ + "name">: optional $ csharp "Identifier", + "value">: csharp "ArgumentValue"], + +-- argument_name +-- : identifier ':' +-- ; +-- +-- argument_value +-- : expression +-- | 'in' variable_reference +-- | 'ref' variable_reference +-- | 'out' variable_reference +-- ; + + def "ArgumentValue" $ union [ + "expression">: csharp "Expression", + "in">: csharp "VariableReference", + "ref">: csharp "VariableReference", + "out">: csharp "VariableReference"], + +-- // Source: §12.8.1 General +-- primary_expression +-- : primary_no_array_creation_expression +-- | array_creation_expression +-- ; + + def "PrimaryExpression" $ union [ + "noArray">: csharp "PrimaryNoArrayCreationExpression", + "array">: csharp "ArrayCreationExpression"], + +-- primary_no_array_creation_expression +-- : literal +-- | interpolated_string_expression +-- | simple_name +-- | parenthesized_expression +-- | tuple_expression +-- | member_access +-- | null_conditional_member_access +-- | invocation_expression +-- | element_access +-- | null_conditional_element_access +-- | this_access +-- | base_access +-- | post_increment_expression +-- | post_decrement_expression +-- | object_creation_expression +-- | delegate_creation_expression +-- | anonymous_object_creation_expression +-- | typeof_expression +-- | sizeof_expression +-- | checked_expression +-- | unchecked_expression +-- | default_value_expression +-- | nameof_expression +-- | anonymous_method_expression +-- | pointer_member_access // unsafe code support +-- | pointer_element_access // unsafe code support +-- | stackalloc_expression +-- ; + + def "PrimaryNoArrayCreationExpression" $ union [ + "literal">: csharp "Literal", + "interpolatedString">: csharp "InterpolatedStringExpression", + "simpleName">: csharp "SimpleName", + "parenthesized">: csharp "Expression", + "tuple">: csharp "TupleExpression", + "memberAccess">: csharp "MemberAccess", + "nullConditionalMemberAccess">: csharp "NullConditionalMemberAccess", + "invocation">: csharp "InvocationExpression", + "elementAccess">: csharp "ElementAccess", + "nullConditionalElementAccess">: csharp "NullConditionalElementAccess", + "thisAccess">: unit, + "baseAccess">: csharp "BaseAccess", + "postIncrement">: csharp "PrimaryExpression", + "postDecrement">: csharp "PrimaryExpression", + "objectCreation">: csharp "ObjectCreationExpression", + "delegateCreation">: csharp "DelegateCreationExpression", + "anonymousObjectCreation">: optional $ csharp "MemberDeclaratorList", + "typeof">: csharp "TypeofExpression", + "sizeof">: csharp "UnmanagedType", + "checked">: csharp "Expression", + "unchecked">: csharp "Expression", + "defaultValue">: csharp "DefaultValueExpression", + "nameof">: csharp "NamedEntity", + "anonymousMethod">: csharp "AnonymousMethodExpression", + "pointerMemberAccess">: csharp "PointerMemberAccess", + "pointerElementAccess">: csharp "PointerElementAccess", + "stackalloc">: csharp "StackallocExpression"], + +-- // Source: §12.8.3 Interpolated string expressions +-- interpolated_string_expression +-- : interpolated_regular_string_expression +-- | interpolated_verbatim_string_expression +-- ; + + def "InterpolatedStringExpression" $ union [ + "regular">: csharp "InterpolatedRegularStringExpression", + "verbatim">: csharp "InterpolatedVerbatimStringExpression"], + +-- // interpolated regular string expressions +-- +-- interpolated_regular_string_expression +-- : Interpolated_Regular_String_Start Interpolated_Regular_String_Mid? +-- ('{' regular_interpolation '}' Interpolated_Regular_String_Mid?)* +-- Interpolated_Regular_String_End +-- ; + + def "InterpolatedRegularStringExpression" string, + +-- regular_interpolation +-- : expression (',' interpolation_minimum_width)? +-- Regular_Interpolation_Format? +-- ; + + def "RegularInterpolation" $ record [ + "expression">: csharp "Expression", + "width">: optional $ csharp "Expression", + "format">: optional string], + +-- interpolation_minimum_width +-- : constant_expression +-- ; +-- +-- Interpolated_Regular_String_Start +-- : '$"' +-- ; +-- +-- // the following three lexical rules are context sensitive, see details below +-- +-- Interpolated_Regular_String_Mid +-- : Interpolated_Regular_String_Element+ +-- ; +-- +-- Regular_Interpolation_Format +-- : ':' Interpolated_Regular_String_Element+ +-- ; +-- +-- Interpolated_Regular_String_End +-- : '"' +-- ; +-- +-- fragment Interpolated_Regular_String_Element +-- : Interpolated_Regular_String_Character +-- | Simple_Escape_Sequence +-- | Hexadecimal_Escape_Sequence +-- | Unicode_Escape_Sequence +-- | Open_Brace_Escape_Sequence +-- | Close_Brace_Escape_Sequence +-- ; +-- +-- fragment Interpolated_Regular_String_Character +-- // Any character except " (U+0022), \\ (U+005C), +-- // { (U+007B), } (U+007D), and New_Line_Character. +-- : ~["\\{}\u000D\u000A\u0085\u2028\u2029] +-- ; +-- +-- // interpolated verbatim string expressions +-- +-- interpolated_verbatim_string_expression +-- : Interpolated_Verbatim_String_Start Interpolated_Verbatim_String_Mid? +-- ('{' verbatim_interpolation '}' Interpolated_Verbatim_String_Mid?)* +-- Interpolated_Verbatim_String_End +-- ; + + def "InterpolatedVerbatimStringExpression" string, + +-- verbatim_interpolation +-- : expression (',' interpolation_minimum_width)? +-- Verbatim_Interpolation_Format? +-- ; + + def "VerbatimInterpolation" $ record [ + "expression">: csharp "Expression", + "width">: optional $ csharp "ConstantExpression", + "format">: optional string], + +-- Interpolated_Verbatim_String_Start +-- : '$@"' +-- | '@$"' +-- ; +-- +-- // the following three lexical rules are context sensitive, see details below +-- +-- Interpolated_Verbatim_String_Mid +-- : Interpolated_Verbatim_String_Element+ +-- ; +-- +-- Verbatim_Interpolation_Format +-- : ':' Interpolated_Verbatim_String_Element+ +-- ; +-- +-- Interpolated_Verbatim_String_End +-- : '"' +-- ; +-- +-- fragment Interpolated_Verbatim_String_Element +-- : Interpolated_Verbatim_String_Character +-- | Quote_Escape_Sequence +-- | Open_Brace_Escape_Sequence +-- | Close_Brace_Escape_Sequence +-- ; +-- +-- fragment Interpolated_Verbatim_String_Character +-- : ~["{}] // Any character except " (U+0022), { (U+007B) and } (U+007D) +-- ; +-- +-- // lexical fragments used by both regular and verbatim interpolated strings +-- +-- fragment Open_Brace_Escape_Sequence +-- : '{{' +-- ; +-- +-- fragment Close_Brace_Escape_Sequence +-- : '}}' +-- ; +-- +-- // Source: §12.8.4 Simple names +-- simple_name +-- : identifier type_argument_list? +-- ; + + def "SimpleName" $ record [ + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + +-- // Source: §12.8.5 Parenthesized expressions +-- parenthesized_expression +-- : '(' expression ')' +-- ; +-- +-- // Source: §12.8.6 Tuple expressions +-- tuple_expression +-- : '(' tuple_element (',' tuple_element)+ ')' +-- | deconstruction_expression +-- ; + + def "TupleExpression" $ union [ + "elements">: nonemptyList $ csharp "TupleElement", + "deconstruction">: csharp "DeconstructionTuple"], + +-- tuple_element +-- : (identifier ':')? expression +-- ; + + def "TupleElement" $ record [ + "name">: optional $ csharp "Identifier", + "expression">: csharp "Expression"], + +-- deconstruction_expression +-- : 'var' deconstruction_tuple +-- ; +-- +-- deconstruction_tuple +-- : '(' deconstruction_element (',' deconstruction_element)+ ')' +-- ; + + def "DeconstructionTuple" $ nonemptyList $ csharp "DeconstructionElement", + +-- deconstruction_element +-- : deconstruction_tuple +-- | identifier +-- ; + + def "DeconstructionElement" $ union [ + "tuple">: csharp "DeconstructionTuple", + "identifier">: csharp "Identifier"], + +-- // Source: §12.8.7.1 General +-- member_access +-- : primary_expression '.' identifier type_argument_list? +-- | predefined_type '.' identifier type_argument_list? +-- | qualified_alias_member '.' identifier type_argument_list? +-- ; + + def "MemberAccess" $ record [ + "head">: csharp "MemberAccessHead", + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + + def "MemberAccessHead" $ union [ + "primary">: csharp "PrimaryExpression", + "predefined">: csharp "PredefinedType", + "qualifiedAlias">: csharp "QualifiedAliasMember"], + +-- predefined_type +-- : 'bool' | 'byte' | 'char' | 'decimal' | 'double' | 'float' | 'int' +-- | 'long' | 'object' | 'sbyte' | 'short' | 'string' | 'uint' | 'ulong' +-- | 'ushort' +-- ; + + def "PredefinedType" $ enum [ + "bool", "byte", "char", "decimal", "double", "float", "int", "long", "object", "sbyte", "short", "string", + "uint", "ulong", "ushort"], + +-- // Source: §12.8.8 Null Conditional Member Access +-- null_conditional_member_access +-- : primary_expression '?' '.' identifier type_argument_list? +-- dependent_access* +-- ; + + def "NullConditionalMemberAccess" $ record [ + "expression">: csharp "PrimaryExpression", + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList", + "dependentAccess">: list $ csharp "DependentAccess"], + +-- dependent_access +-- : '.' identifier type_argument_list? // member access +-- | '[' argument_list ']' // element access +-- | '(' argument_list? ')' // invocation +-- ; + + def "DependentAccess" $ union [ + "memberAccess">: csharp "DependentAccessForMember", + "elementAccess">: csharp "ArgumentList", + "invocation">: optional $ csharp "ArgumentList"], + + def "DependentAccessForMember" $ record [ + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + +-- null_conditional_projection_initializer +-- : primary_expression '?' '.' identifier type_argument_list? +-- ; + + def "NullConditionalProjectionInitializer" $ record [ + "expression">: csharp "PrimaryExpression", + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + +-- // Source: §12.8.9.1 General +-- invocation_expression +-- : primary_expression '(' argument_list? ')' +-- ; + + def "InvocationExpression" $ record [ + "expression">: csharp "PrimaryExpression", + "arguments">: optional $ csharp "ArgumentList"], + +-- // Source: §12.8.10 Null Conditional Invocation Expression +-- null_conditional_invocation_expression +-- : null_conditional_member_access '(' argument_list? ')' +-- | null_conditional_element_access '(' argument_list? ')' +-- ; + + def "NullConditionalInvocationExpression" $ record [ + "head">: csharp "NullConditionalInvocationExpressionHead", + "arguments">: optional $ csharp "ArgumentList"], + + def "NullConditionalInvocationExpressionHead" $ union [ + "member">: csharp "NullConditionalMemberAccess", + "element">: csharp "NullConditionalElementAccess"], + +-- // Source: §12.8.11.1 General +-- element_access +-- : primary_no_array_creation_expression '[' argument_list ']' +-- ; + + def "ElementAccess" $ record [ + "expression">: csharp "PrimaryNoArrayCreationExpression", + "arguments">: csharp "ArgumentList"], + +-- // Source: §12.8.12 Null Conditional Element Access +-- null_conditional_element_access +-- : primary_no_array_creation_expression '?' '[' argument_list ']' +-- dependent_access* +-- ; + + def "NullConditionalElementAccess" $ record [ + "expression">: csharp "PrimaryNoArrayCreationExpression", + "arguments">: csharp "ArgumentList", + "dependentAccess">: list $ csharp "DependentAccess"], + +-- // Source: §12.8.13 This access +-- this_access +-- : 'this' +-- ; +-- +-- // Source: §12.8.14 Base access +-- base_access +-- : 'base' '.' identifier type_argument_list? +-- | 'base' '[' argument_list ']' +-- ; + + def "BaseAccess" $ union [ + "identifier">: csharp "BaseAccessWithIdentifier", + "arguments">: csharp "ArgumentList"], + + def "BaseAccessWithIdentifier" $ record [ + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + +-- // Source: §12.8.15 Postfix increment and decrement operators +-- post_increment_expression +-- : primary_expression '++' +-- ; +-- +-- post_decrement_expression +-- : primary_expression '--' +-- ; +-- +-- // Source: §12.8.16.2 Object creation expressions +-- object_creation_expression +-- : 'new' type '(' argument_list? ')' object_or_collection_initializer? +-- | 'new' type object_or_collection_initializer +-- ; + + def "ObjectCreationExpression" $ record [ + "type">: csharp "Type", + "arguments">: optional $ csharp "ArgumentList", + "initializer">: optional $ csharp "ObjectOrCollectionInitializer"], + +-- object_or_collection_initializer +-- : object_initializer +-- | collection_initializer +-- ; + + def "ObjectOrCollectionInitializer" $ union [ + "object">: list $ csharp "MemberInitializer", + "collection">: list $ csharp "ElementInitializer"], + +-- // Source: §12.8.16.3 Object initializers +-- object_initializer +-- : '{' member_initializer_list? '}' +-- | '{' member_initializer_list ',' '}' +-- ; +-- +-- member_initializer_list +-- : member_initializer (',' member_initializer)* +-- ; +-- +-- member_initializer +-- : initializer_target '=' initializer_value +-- ; + + def "MemberInitializer" $ record [ + "target">: csharp "InitializerTarget", + "value">: csharp "InitializerValue"], + +-- initializer_target +-- : identifier +-- | '[' argument_list ']' +-- ; + + def "InitializerTarget" $ union [ + "identifier">: csharp "Identifier", + "arguments">: csharp "ArgumentList"], + +-- initializer_value +-- : expression +-- | object_or_collection_initializer +-- ; + + def "InitializerValue" $ union [ + "expression">: csharp "Expression", + "objectOrCollection">: csharp "ObjectOrCollectionInitializer"], + +-- // Source: §12.8.16.4 Collection initializers +-- collection_initializer +-- : '{' element_initializer_list '}' +-- | '{' element_initializer_list ',' '}' +-- ; +-- +-- element_initializer_list +-- : element_initializer (',' element_initializer)* +-- ; +-- +-- element_initializer +-- : non_assignment_expression +-- | '{' expression_list '}' +-- ; + + def "ElementInitializer" $ union [ + "single">: csharp "NonAssignmentExpression", + "list">: csharp "ExpressionList"], + +-- expression_list +-- : expression +-- | expression_list ',' expression +-- ; + + def "ExpressionList" $ nonemptyList $ csharp "Expression", + +-- // Source: §12.8.16.5 Array creation expressions +-- array_creation_expression +-- : 'new' non_array_type '[' expression_list ']' rank_specifier* +-- array_initializer? +-- | 'new' array_type array_initializer +-- | 'new' rank_specifier array_initializer +-- ; + + def "ArrayCreationExpression" $ union [ + "nonArrayType">: csharp "NonArrayTypeArrayCreationExpression", + "arrayType">: csharp "ArrayTypeArrayCreationExpression", + "rankSpecifier">: csharp "RankSpecifierArrayCreationExpression"], + + def "NonArrayTypeArrayCreationExpression" $ record [ + "type">: csharp "NonArrayType", + "expressions">: csharp "ExpressionList", + "rankSpecifiers">: list $ csharp "RankSpecifier", + "initializer">: optional $ csharp "ArrayInitializer"], + + def "ArrayTypeArrayCreationExpression" $ record [ + "type">: csharp "ArrayType", + "initializer">: csharp "ArrayInitializer"], + + def "RankSpecifierArrayCreationExpression" $ record [ + "rankSpecifier">: csharp "RankSpecifier", + "initializer">: csharp "ArrayInitializer"], + +-- // Source: §12.8.16.6 Delegate creation expressions +-- delegate_creation_expression +-- : 'new' delegate_type '(' expression ')' +-- ; + + def "DelegateCreationExpression" $ record [ + "type">: csharp "DelegateType", + "expression">: csharp "Expression"], + +-- // Source: §12.8.16.7 Anonymous object creation expressions +-- anonymous_object_creation_expression +-- : 'new' anonymous_object_initializer +-- ; +-- +-- anonymous_object_initializer +-- : '{' member_declarator_list? '}' +-- | '{' member_declarator_list ',' '}' +-- ; +-- +-- member_declarator_list +-- : member_declarator (',' member_declarator)* +-- ; + + def "MemberDeclaratorList" $ nonemptyList $ csharp "MemberDeclarator", + +-- member_declarator +-- : simple_name +-- | member_access +-- | null_conditional_projection_initializer +-- | base_access +-- | identifier '=' expression +-- ; + + def "MemberDeclarator" $ union [ + "name">: csharp "SimpleName", + "memberAccess">: csharp "MemberAccess", + "nullConditionalProjectionInitializer">: csharp "NullConditionalProjectionInitializer", + "baseAccess">: csharp "BaseAccess", + "assignment">: csharp "AssignmentMemberDeclarator"], + + def "AssignmentMemberDeclarator" $ record [ + "identifier">: csharp "Identifier", + "expression">: csharp "Expression"], + +-- // Source: §12.8.17 The typeof operator +-- typeof_expression +-- : 'typeof' '(' type ')' +-- | 'typeof' '(' unbound_type_name ')' +-- | 'typeof' '(' 'void' ')' +-- ; + + def "TypeofExpression" $ union [ + "type">: csharp "Type", + "unboundTypeName">: csharp "UnboundTypeName", + "void">: unit], + +-- unbound_type_name +-- : identifier generic_dimension_specifier? +-- | identifier '::' identifier generic_dimension_specifier? +-- | unbound_type_name '.' identifier generic_dimension_specifier? +-- ; + + def "UnboundTypeName" $ nonemptyList $ csharp "UnboundTypeNamePart", + + def "UnboundTypeNamePart" $ record [ + "identifier">: csharp "Identifier", + "aliased">: boolean, + "dimension">: optional int32], -- Note: non-negative + +-- generic_dimension_specifier +-- : '<' comma* '>' +-- ; +-- comma +-- : ',' +-- ; +-- +-- +-- // Source: §12.8.18 The sizeof operator +-- sizeof_expression +-- : 'sizeof' '(' unmanaged_type ')' +-- ; +-- +-- // Source: §12.8.19 The checked and unchecked operators +-- checked_expression +-- : 'checked' '(' expression ')' +-- ; +-- +-- unchecked_expression +-- : 'unchecked' '(' expression ')' +-- ; +-- +-- // Source: §12.8.20 Default value expressions +-- default_value_expression +-- : explictly_typed_default +-- | default_literal +-- ; + + def "DefaultValueExpression" $ union [ + "explicitlyTyped">: csharp "Type", + "defaultLiteral">: unit], + +-- explictly_typed_default +-- : 'default' '(' type ')' +-- ; +-- +-- default_literal +-- : 'default' +-- ; +-- +-- // Source: §12.8.21 Stack allocation +-- stackalloc_expression +-- : 'stackalloc' unmanaged_type '[' expression ']' +-- | 'stackalloc' unmanaged_type? '[' constant_expression? ']' +-- stackalloc_initializer +-- ; + + def "StackallocExpression" $ record [ + "type">: optional $ csharp "UnmanagedType", + "expression">: optional $ csharp "ConstantExpression", + "initializer">: list $ csharp "Expression"], + +-- stackalloc_initializer +-- : '{' stackalloc_initializer_element_list '}' +-- ; +-- +-- stackalloc_initializer_element_list +-- : stackalloc_element_initializer (',' stackalloc_element_initializer)* ','? +-- ; +-- +-- stackalloc_element_initializer +-- : expression +-- ; +-- +-- // Source: §12.8.22 The nameof operator +-- nameof_expression +-- : 'nameof' '(' named_entity ')' +-- ; +-- +-- named_entity +-- : named_entity_target ('.' identifier type_argument_list?)* +-- ; + + def "NamedEntity" $ record [ + "target">: csharp "NamedEntityTarget", + "parts">: list $ csharp "NamedEntityPart"], + + def "NamedEntityPart" $ record [ + "identifier">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + +-- named_entity_target +-- : simple_name +-- | 'this' +-- | 'base' +-- | predefined_type +-- | qualified_alias_member +-- ; + + def "NamedEntityTarget" $ union [ + "name">: csharp "SimpleName", + "this">: unit, + "base">: unit, + "predefinedType">: csharp "PredefinedType", + "qualifiedAliasMember">: csharp "QualifiedAliasMember"], + +-- // Source: §12.9.1 General +-- unary_expression +-- : primary_expression +-- | '+' unary_expression +-- | '-' unary_expression +-- | '!' unary_expression +-- | '~' unary_expression +-- | pre_increment_expression +-- | pre_decrement_expression +-- | cast_expression +-- | await_expression +-- | pointer_indirection_expression // unsafe code support +-- | addressof_expression // unsafe code support +-- ; + + def "UnaryExpression" $ union [ + "primary">: csharp "PrimaryExpression", + "plus">: csharp "UnaryExpression", + "minus">: csharp "UnaryExpression", + "not">: csharp "UnaryExpression", + "bitwiseComplement">: csharp "UnaryExpression", + "preIncrement">: csharp "UnaryExpression", + "preDecrement">: csharp "UnaryExpression", + "cast">: csharp "CastExpression", + "await">: csharp "UnaryExpression", + "pointerIndirection">: csharp "UnaryExpression", + "addressOf">: csharp "UnaryExpression"], + +-- // Source: §12.9.6 Prefix increment and decrement operators +-- pre_increment_expression +-- : '++' unary_expression +-- ; +-- +-- pre_decrement_expression +-- : '--' unary_expression +-- ; +-- +-- // Source: §12.9.7 Cast expressions +-- cast_expression +-- : '(' type ')' unary_expression +-- ; + + def "CastExpression" $ record [ + "type">: csharp "Type", + "expression">: csharp "UnaryExpression"], + +-- // Source: §12.9.8.1 General +-- await_expression +-- : 'await' unary_expression +-- ; +-- +-- // Source: §12.10.1 General +-- multiplicative_expression +-- : unary_expression +-- | multiplicative_expression '*' unary_expression +-- | multiplicative_expression '/' unary_expression +-- | multiplicative_expression '%' unary_expression +-- ; + + def "MultiplicativeExpression" $ union [ + "simple">: csharp "UnaryExpression", + "binary">: csharp "BinaryMultiplicativeExpression"], + + def "BinaryMultiplicativeExpression" $ record [ + "left">: csharp "MultiplicativeExpression", + "operator">: csharp "MultiplicativeOperator", + "right">: csharp "UnaryExpression"], + + def "MultiplicativeOperator" $ enum ["times", "divide", "modulo"], + +-- additive_expression +-- : multiplicative_expression +-- | additive_expression '+' multiplicative_expression +-- | additive_expression '-' multiplicative_expression +-- ; + + def "AdditiveExpression" $ union [ + "simple">: csharp "MultiplicativeExpression", + "binary">: csharp "BinaryAdditiveExpression"], + + def "BinaryAdditiveExpression" $ record [ + "left">: csharp "AdditiveExpression", + "operator">: csharp "AdditiveOperator", + "right">: csharp "MultiplicativeExpression"], + + def "AdditiveOperator" $ enum ["plus", "minus"], + +-- // Source: §12.11 Shift operators +-- shift_expression +-- : additive_expression +-- | shift_expression '<<' additive_expression +-- | shift_expression right_shift additive_expression +-- ; + + def "ShiftExpression" $ union [ + "simple">: csharp "AdditiveExpression", + "binary">: csharp "BinaryShiftExpression"], + + def "BinaryShiftExpression" $ record [ + "left">: csharp "ShiftExpression", + "operator">: csharp "ShiftOperator", + "right">: csharp "AdditiveExpression"], + + def "ShiftOperator" $ enum ["left", "right"], + +-- // Source: §12.12.1 General +-- relational_expression +-- : shift_expression +-- | relational_expression '<' shift_expression +-- | relational_expression '>' shift_expression +-- | relational_expression '<=' shift_expression +-- | relational_expression '>=' shift_expression +-- | relational_expression 'is' type +-- | relational_expression 'is' pattern +-- | relational_expression 'as' type +-- ; + + def "RelationalExpression" $ union [ + "simple">: csharp "ShiftExpression", + "binary">: csharp "BinaryRelationalExpression", + "isType">: csharp "IsTypeExpression", + "isPattern">: csharp "IsPatternExpression", + "asType">: csharp "AsTypeExpression"], + + def "BinaryRelationalExpression" $ record [ + "left">: csharp "RelationalExpression", + "operator">: csharp "RelationalOperator", + "right">: csharp "ShiftExpression"], + + def "RelationalOperator" $ enum [ + "lessThan", "greaterThan", "lessThanOrEqual", "greaterThanOrEqual"], + + def "IsTypeExpression" $ record [ + "expression">: csharp "RelationalExpression", + "type">: csharp "Type"], + + def "IsPatternExpression" $ record [ + "expression">: csharp "RelationalExpression", + "pattern">: csharp "Pattern"], + + def "AsTypeExpression" $ record [ + "expression">: csharp "RelationalExpression", + "type">: csharp "Type"], + +-- equality_expression +-- : relational_expression +-- | equality_expression '==' relational_expression +-- | equality_expression '!=' relational_expression +-- ; + + def "EqualityExpression" $ union [ + "simple">: csharp "RelationalExpression", + "binary">: csharp "BinaryEqualityExpression"], + + def "BinaryEqualityExpression" $ record [ + "left">: csharp "EqualityExpression", + "operator">: csharp "EqualityOperator", + "right">: csharp "RelationalExpression"], + + def "EqualityOperator" $ enum ["equal", "notEqual"], + +-- // Source: §12.13.1 General +-- and_expression +-- : equality_expression +-- | and_expression '&' equality_expression +-- ; + + def "AndExpression" $ union [ + "simple">: csharp "EqualityExpression", + "binary">: csharp "BinaryAndExpression"], + + def "BinaryAndExpression" $ record [ + "left">: csharp "AndExpression", + "right">: csharp "EqualityExpression"], + +-- exclusive_or_expression +-- : and_expression +-- | exclusive_or_expression '^' and_expression +-- ; + + def "ExclusiveOrExpression" $ union [ + "simple">: csharp "AndExpression", + "binary">: csharp "BinaryExclusiveOrExpression"], + + def "BinaryExclusiveOrExpression" $ record [ + "left">: csharp "ExclusiveOrExpression", + "right">: csharp "AndExpression"], + +-- inclusive_or_expression +-- : exclusive_or_expression +-- | inclusive_or_expression '|' exclusive_or_expression +-- ; + + def "InclusiveOrExpression" $ union [ + "simple">: csharp "ExclusiveOrExpression", + "binary">: csharp "BinaryInclusiveOrExpression"], + + def "BinaryInclusiveOrExpression" $ record [ + "left">: csharp "InclusiveOrExpression", + "right">: csharp "ExclusiveOrExpression"], + +-- // Source: §12.14.1 General +-- conditional_and_expression +-- : inclusive_or_expression +-- | conditional_and_expression '&&' inclusive_or_expression +-- ; + + def "ConditionalAndExpression" $ union [ + "simple">: csharp "InclusiveOrExpression", + "binary">: csharp "BinaryConditionalAndExpression"], + + def "BinaryConditionalAndExpression" $ record [ + "left">: csharp "ConditionalAndExpression", + "right">: csharp "InclusiveOrExpression"], + +-- conditional_or_expression +-- : conditional_and_expression +-- | conditional_or_expression '||' conditional_and_expression +-- ; + + def "ConditionalOrExpression" $ union [ + "simple">: csharp "ConditionalAndExpression", + "binary">: csharp "BinaryConditionalOrExpression"], + + def "BinaryConditionalOrExpression" $ record [ + "left">: csharp "ConditionalOrExpression", + "right">: csharp "ConditionalAndExpression"], + +-- // Source: §12.15 The null coalescing operator +-- null_coalescing_expression +-- : conditional_or_expression +-- | conditional_or_expression '??' null_coalescing_expression +-- | throw_expression +-- ; + + def "NullCoalescingExpression" $ union [ + "simple">: csharp "ConditionalOrExpression", + "binary">: csharp "BinaryNullCoalescingExpression", + "throw">: csharp "NullCoalescingExpression"], + + def "BinaryNullCoalescingExpression" $ record [ + "left">: csharp "ConditionalOrExpression", + "right">: csharp "NullCoalescingExpression"], + +-- // Source: §12.16 The throw expression operator +-- throw_expression +-- : 'throw' null_coalescing_expression +-- ; +-- +-- // Source: §12.17 Declaration expressions +-- declaration_expression +-- : local_variable_type identifier +-- ; + + def "DeclarationExpression" $ record [ + "type">: csharp "LocalVariableType", + "identifier">: csharp "Identifier"], + +-- local_variable_type +-- : type +-- | 'var' +-- ; + + def "LocalVariableType" $ union [ + "type">: csharp "Type", + "var">: unit], + +-- // Source: §12.18 Conditional operator +-- conditional_expression +-- : null_coalescing_expression +-- | null_coalescing_expression '?' expression ':' expression +-- | null_coalescing_expression '?' 'ref' variable_reference ':' +-- 'ref' variable_reference +-- ; + + def "ConditionalExpression" $ union [ + "simple">: csharp "NullCoalescingExpression", + "simpleConditional">: csharp "SimpleConditionalExpression", + "refConditional">: csharp "RefConditionalExpression"], + + def "SimpleConditionalExpression" $ record [ + "condition">: csharp "NullCoalescingExpression", + "true">: csharp "Expression", + "false">: csharp "Expression"], + + def "RefConditionalExpression" $ record [ + "condition">: csharp "NullCoalescingExpression", + "true">: csharp "VariableReference", + "false">: csharp "VariableReference"], + +-- // Source: §12.19.1 General +-- lambda_expression +-- : 'async'? anonymous_function_signature '=>' anonymous_function_body +-- ; + + def "LambdaExpression" $ record [ + "async">: boolean, + "signature">: csharp "AnonymousFunctionSignature", + "body">: csharp "AnonymousFunctionBody"], + +-- anonymous_method_expression +-- : 'async'? 'delegate' explicit_anonymous_function_signature? block +-- ; + + def "AnonymousMethodExpression" $ record [ + "async">: boolean, + "signature">: list $ csharp "ExplicitAnonymousFunctionParameter", + "body">: csharp "Block"], + +-- anonymous_function_signature +-- : explicit_anonymous_function_signature +-- | implicit_anonymous_function_signature +-- ; + + def "AnonymousFunctionSignature" $ union [ + "explicit">: list $ csharp "ExplicitAnonymousFunctionParameter", + "implicit">: list $ csharp "Identifier"], + +-- explicit_anonymous_function_signature +-- : '(' explicit_anonymous_function_parameter_list? ')' +-- ; +-- +-- explicit_anonymous_function_parameter_list +-- : explicit_anonymous_function_parameter +-- (',' explicit_anonymous_function_parameter)* +-- ; +-- +-- explicit_anonymous_function_parameter +-- : anonymous_function_parameter_modifier? type identifier +-- ; + + def "ExplicitAnonymousFunctionParameter" $ record [ + "modifier">: optional $ csharp "AnonymousFunctionParameterModifier", + "type">: csharp "Type", + "identifier">: csharp "Identifier"], + +-- anonymous_function_parameter_modifier +-- : 'ref' +-- | 'out' +-- | 'in' +-- ; + + def "AnonymousFunctionParameterModifier" $ enum [ "ref", "out", "in" ], + +-- implicit_anonymous_function_signature +-- : '(' implicit_anonymous_function_parameter_list? ')' +-- | implicit_anonymous_function_parameter +-- ; +-- +-- implicit_anonymous_function_parameter_list +-- : implicit_anonymous_function_parameter +-- (',' implicit_anonymous_function_parameter)* +-- ; +-- +-- implicit_anonymous_function_parameter +-- : identifier +-- ; +-- +-- anonymous_function_body +-- : null_conditional_invocation_expression +-- | expression +-- | 'ref' variable_reference +-- | block +-- ; + + def "AnonymousFunctionBody" $ union [ + "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression", + "expression">: csharp "Expression", + "ref">: csharp "VariableReference", + "block">: csharp "Block"], + +-- // Source: §12.20.1 General +-- query_expression +-- : from_clause query_body +-- ; + + def "QueryExpression" $ record [ + "from">: csharp "FromClause", + "body">: csharp "QueryBody"], + +-- from_clause +-- : 'from' type? identifier 'in' expression +-- ; + + def "FromClause" $ record [ + "type">: optional $ csharp "Type", + "identifier">: csharp "Identifier", + "in">: csharp "Expression"], + +-- query_body +-- : query_body_clauses? select_or_group_clause query_continuation? +-- ; + + def "QueryBody" $ record [ + "clauses">: list $ csharp "QueryBodyClause", + "selectOrGroup">: csharp "SelectOrGroupClause", + "continuation">: optional $ csharp "QueryContinuation"], + +-- query_body_clauses +-- : query_body_clause +-- | query_body_clauses query_body_clause +-- ; +-- +-- query_body_clause +-- : from_clause +-- | let_clause +-- | where_clause +-- | join_clause +-- | join_into_clause +-- | orderby_clause +-- ; + + def "QueryBodyClause" $ union [ + "from">: csharp "FromClause", + "let">: csharp "LetClause", + "where">: csharp "BooleanExpression", + "join">: csharp "JoinClause", + "orderby">: nonemptyList $ csharp "Ordering"], + +-- let_clause +-- : 'let' identifier '=' expression +-- ; + + def "LetClause" $ record [ + "left">: csharp "Identifier", + "right">: csharp "Expression"], + +-- where_clause +-- : 'where' boolean_expression +-- ; +-- +-- join_clause +-- : 'join' type? identifier 'in' expression 'on' expression +-- 'equals' expression +-- ; + + def "JoinClause" $ record [ + "type">: optional $ csharp "Type", + "identifier">: csharp "Identifier", + "in">: csharp "Expression", + "on">: csharp "Expression", + "equals">: csharp "Expression", + "into">: optional $ csharp "Identifier"], + +-- join_into_clause +-- : 'join' type? identifier 'in' expression 'on' expression +-- 'equals' expression 'into' identifier +-- ; +-- +-- orderby_clause +-- : 'orderby' orderings +-- ; +-- +-- orderings +-- : ordering (',' ordering)* +-- ; +-- +-- ordering +-- : expression ordering_direction? +-- ; + + def "Ordering" $ record [ + "expression">: csharp "Expression", + "direction">: optional $ csharp "OrderingDirection"], + +-- ordering_direction +-- : 'ascending' +-- | 'descending' +-- ; + + def "OrderingDirection" $ enum [ "ascending", "descending" ], + +-- select_or_group_clause +-- : select_clause +-- | group_clause +-- ; + + def "SelectOrGroupClause" $ union [ + "select">: csharp "Expression", + "group">: csharp "GroupClause"], + +-- select_clause +-- : 'select' expression +-- ; +-- +-- group_clause +-- : 'group' expression 'by' expression +-- ; + + + def "GroupClause" $ record [ + "grouped">: csharp "Expression", + "by">: csharp "Expression"], + +-- query_continuation +-- : 'into' identifier query_body +-- ; + + def "QueryContinuation" $ record [ + "into">: csharp "Identifier", + "body">: csharp "QueryBody"], + +-- // Source: §12.21.1 General +-- assignment +-- : unary_expression assignment_operator expression +-- ; + + def "Assignment" $ record [ + "left">: csharp "UnaryExpression", + "operator">: csharp "AssignmentOperator", + "right">: csharp "Expression"], + +-- assignment_operator +-- : '=' 'ref'? | '+=' | '-=' | '*=' | '/=' | '%=' | '&=' | '|=' | '^=' | '<<=' +-- | right_shift_assignment +-- ; + + def "AssignmentOperator" $ union [ + "simple">: boolean, + "plusEquals">: unit, + "minusEquals">: unit, + "timesEquals">: unit, + "divideEquals">: unit, + "modEquals">: unit, + "andEquals">: unit, + "orEquals">: unit, + "xorEquals">: unit, + "leftShiftEquals">: unit, + "rightShiftEquals">: unit], + +-- // Source: §12.22 Expression +-- expression +-- : non_assignment_expression +-- | assignment +-- ; + + def "Expression" $ union [ + "nonAssignment">: csharp "NonAssignmentExpression", + "assignment">: csharp "Assignment"], + +-- non_assignment_expression +-- : declaration_expression +-- | conditional_expression +-- | lambda_expression +-- | query_expression +-- ; + + def "NonAssignmentExpression" $ union [ + "declaration">: csharp "DeclarationExpression", + "conditional">: csharp "ConditionalExpression", + "lambda">: csharp "LambdaExpression", + "query">: csharp "QueryExpression"], + +-- // Source: §12.23 Constant expressions +-- constant_expression +-- : expression +-- ; + + def "ConstantExpression" $ csharp "Expression", + +-- // Source: §12.24 Boolean expressions +-- boolean_expression +-- : expression +-- ; + + def "BooleanExpression" $ csharp "Expression", + +-- // Source: §13.1 General +-- statement +-- : labeled_statement +-- | declaration_statement +-- | embedded_statement +-- ; + + def "Statement" $ union [ + "labeled">: csharp "LabeledStatement", + "declaration">: csharp "DeclarationStatement", + "embedded">: csharp "EmbeddedStatement"], + +-- embedded_statement +-- : block +-- | empty_statement +-- | expression_statement +-- | selection_statement +-- | iteration_statement +-- | jump_statement +-- | try_statement +-- | checked_statement +-- | unchecked_statement +-- | lock_statement +-- | using_statement +-- | yield_statement +-- | unsafe_statement // unsafe code support +-- | fixed_statement // unsafe code support +-- ; + + def "EmbeddedStatement" $ union [ + "block">: csharp "Block", + "empty">: unit, + "expression">: csharp "StatementExpression", + "selection">: csharp "SelectionStatement", + "iteration">: csharp "IterationStatement", + "jump">: csharp "JumpStatement", + "try">: csharp "TryStatement", + "checked">: csharp "Block", + "unchecked">: csharp "Block", + "lock">: csharp "LockStatement", + "using">: csharp "UsingStatement", + "yield">: csharp "YieldStatement", + "unsafe">: csharp "Block", + "fixed">: csharp "FixedStatement"], + +-- // Source: §13.3.1 General +-- block +-- : '{' statement_list? '}' +-- ; + + def "Block" $ list $ csharp "Statement", + +-- // Source: §13.3.2 Statement lists +-- statement_list +-- : statement+ +-- ; +-- +-- // Source: §13.4 The empty statement +-- empty_statement +-- : ';' +-- ; +-- +-- // Source: §13.5 Labeled statements +-- labeled_statement +-- : identifier ':' statement +-- ; + + def "LabeledStatement" $ record [ + "label">: csharp "Identifier", + "statement">: csharp "Statement"], + +-- // Source: §13.6.1 General +-- declaration_statement +-- : local_variable_declaration ';' +-- | local_constant_declaration ';' +-- | local_function_declaration +-- ; + + def "DeclarationStatement" $ union [ + "variable">: csharp "LocalVariableDeclaration", + "constant">: csharp "LocalConstantDeclaration", + "function">: csharp "LocalFunctionDeclaration"], + +-- // Source: §13.6.2.1 General +-- local_variable_declaration +-- : implicitly_typed_local_variable_declaration +-- | explicitly_typed_local_variable_declaration +-- | ref_local_variable_declaration +-- ; + + + def "LocalVariableDeclaration" $ union [ + "implicitlyTyped">: csharp "ImplicitlyTypedLocalVariableDeclaration", + "explicitlyTyped">: csharp "ExplicitlyTypedLocalVariableDeclaration", + "ref">: csharp "RefLocalVariableDeclaration"], + +-- // Source: §13.6.2.2 Implicitly typed local variable declarations +-- implicitly_typed_local_variable_declaration +-- : 'var' implicitly_typed_local_variable_declarator +-- | ref_kind 'var' ref_local_variable_declarator +-- ; + + def "ImplicitlyTypedLocalVariableDeclaration" $ union [ + "var">: csharp "ImplicitlyTypedLocalVariableDeclarator", + "refVar">: csharp "RefVarImplicitlyTypedLocalVariableDeclaration"], + + def "RefVarImplicitlyTypedLocalVariableDeclaration" $ record [ + "refKind">: csharp "RefKind", + "declarator">: csharp "RefLocalVariableDeclarator"], + +-- implicitly_typed_local_variable_declarator +-- : identifier '=' expression +-- ; + + def "ImplicitlyTypedLocalVariableDeclarator" $ record [ + "identifier">: csharp "Identifier", + "expression">: csharp "Expression"], + +-- // Source: §13.6.2.3 Explicitly typed local variable declarations +-- explicitly_typed_local_variable_declaration +-- : type explicitly_typed_local_variable_declarators +-- ; + + def "ExplicitlyTypedLocalVariableDeclaration" $ record [ + "type">: csharp "Type", + "declarators">: list $ csharp "ExplicitlyTypedLocalVariableDeclarator"], + +-- explicitly_typed_local_variable_declarators +-- : explicitly_typed_local_variable_declarator +-- (',' explicitly_typed_local_variable_declarator)* +-- ; + + def "ExplicitlyTypedLocalVariableDeclarator" $ record [ + "identifier">: csharp "Identifier", + "initializer">: optional $ csharp "LocalVariableInitializer"], + +-- explicitly_typed_local_variable_declarator +-- : identifier ('=' local_variable_initializer)? +-- ; +-- +-- local_variable_initializer +-- : expression +-- | array_initializer +-- ; + + def "LocalVariableInitializer" $ union [ + "expression">: csharp "Expression", + "initializer">: csharp "ArrayInitializer"], + +-- // Source: §13.6.2.4 Ref local variable declarations +-- ref_local_variable_declaration +-- : ref_kind type ref_local_variable_declarators +-- ; + + def "RefLocalVariableDeclaration" $ record [ + "refKind">: csharp "RefKind", + "type">: csharp "Type", + "declarators">: nonemptyList $ csharp "RefLocalVariableDeclarator"], + +-- ref_local_variable_declarators +-- : ref_local_variable_declarator (',' ref_local_variable_declarator)* +-- ; +-- +-- ref_local_variable_declarator +-- : identifier '=' 'ref' variable_reference +-- ; + + def "RefLocalVariableDeclarator" $ record [ + "left">: csharp "Identifier", + "right">: csharp "VariableReference"], + +-- // Source: §13.6.3 Local constant declarations +-- local_constant_declaration +-- : 'const' type constant_declarators +-- ; + + def "LocalConstantDeclaration" $ record [ + "type">: csharp "Type", + "declarators">: nonemptyList $ csharp "ConstantDeclarator"], + +-- constant_declarators +-- : constant_declarator (',' constant_declarator)* +-- ; +-- +-- constant_declarator +-- : identifier '=' constant_expression +-- ; + + def "ConstantDeclarator" $ record [ + "identifier">: csharp "Identifier", + "expression">: csharp "ConstantExpression"], + +-- // Source: §13.6.4 Local function declarations +-- local_function_declaration +-- : local_function_modifier* return_type local_function_header +-- local_function_body +-- | ref_local_function_modifier* ref_kind ref_return_type +-- local_function_header ref_local_function_body +-- ; + + def "LocalFunctionDeclaration" $ union [ + "standard">: csharp "StandardLocalFunctionDeclaration", + "ref">: csharp "RefLocalFunctionDeclaration"], + + def "StandardLocalFunctionDeclaration" $ record [ + "modifiers">: list $ csharp "LocalFunctionModifier", + "returnType">: csharp "ReturnType", + "header">: csharp "LocalFunctionHeader", + "body">: csharp "LocalFunctionBody"], + + def "RefLocalFunctionDeclaration" $ record [ + "modifiers">: list $ csharp "RefLocalFunctionModifier", + "refKind">: csharp "RefKind", + "returnType">: csharp "Type", + "header">: csharp "LocalFunctionHeader", + "body">: csharp "RefLocalFunctionBody"], + +-- local_function_header +-- : identifier '(' formal_parameter_list? ')' +-- | identifier type_parameter_list '(' formal_parameter_list? ')' +-- type_parameter_constraints_clause* +-- ; + + def "LocalFunctionHeader" $ record [ + "identifier">: csharp "Identifier", + "typeParameters">: optional $ csharp "TypeParameterList", + "parameters">: csharp "FormalParameterList", + "constraints">: list $ csharp "TypeParameterConstraintsClause"], + +-- local_function_modifier +-- : ref_local_function_modifier +-- | 'async' +-- ; + + def "LocalFunctionModifier" $ union [ + "ref">: csharp "RefLocalFunctionModifier", + "async">: unit], + +-- ref_local_function_modifier +-- : 'static' +-- | unsafe_modifier // unsafe code support +-- ; + + def "RefLocalFunctionModifier" $ enum ["static", "unsafe"], + +-- local_function_body +-- : block +-- | '=>' null_conditional_invocation_expression ';' +-- | '=>' expression ';' +-- ; + + def "LocalFunctionBody" $ union [ + "block">: csharp "Block", + "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression", + "expression">: csharp "Expression"], + +-- ref_local_function_body +-- : block +-- | '=>' 'ref' variable_reference ';' +-- ; + + def "RefLocalFunctionBody" $ union [ + "block">: csharp "Block", + "ref">: csharp "VariableReference"], + +-- // Source: §13.7 Expression statements +-- expression_statement +-- : statement_expression ';' +-- ; +-- +-- statement_expression +-- : null_conditional_invocation_expression +-- | invocation_expression +-- | object_creation_expression +-- | assignment +-- | post_increment_expression +-- | post_decrement_expression +-- | pre_increment_expression +-- | pre_decrement_expression +-- | await_expression +-- ; + + def "StatementExpression" $ union [ + "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression", + "invocation">: csharp "InvocationExpression", + "objectCreation">: csharp "ObjectCreationExpression", + "assignment">: csharp "Assignment", + "postIncrement">: csharp "PrimaryExpression", + "postDecrement">: csharp "PrimaryExpression", + "preIncrement">: csharp "UnaryExpression", + "preDecrement">: csharp "UnaryExpression", + "await">: csharp "UnaryExpression"], + +-- // Source: §13.8.1 General +-- selection_statement +-- : if_statement +-- | switch_statement +-- ; + + def "SelectionStatement" $ union [ + "if">: csharp "IfStatement", + "switch">: csharp "SwitchStatement"], + +-- // Source: §13.8.2 The if statement +-- if_statement +-- : 'if' '(' boolean_expression ')' embedded_statement +-- | 'if' '(' boolean_expression ')' embedded_statement +-- 'else' embedded_statement +-- ; + + def "IfStatement" $ record [ + "condition">: csharp "BooleanExpression", + "ifBranch">: csharp "EmbeddedStatement", + "elseBranch">: csharp "EmbeddedStatement"], + +-- // Source: §13.8.3 The switch statement +-- switch_statement +-- : 'switch' '(' expression ')' switch_block +-- ; + + def "SwitchStatement" $ record [ + "expression">: csharp "Expression", + "branches">: list $ csharp "SwitchSection"], + +-- switch_block +-- : '{' switch_section* '}' +-- ; +-- +-- switch_section +-- : switch_label+ statement_list +-- ; + + def "SwitchSection" $ record [ + "labels">: nonemptyList $ csharp "SwitchLabel", + "statements">: list $ csharp "Statement"], + +-- switch_label +-- : 'case' pattern case_guard? ':' +-- | 'default' ':' +-- ; + + def "SwitchLabel" $ union [ + "branch">: csharp "SwitchBranch", + "default">: unit], + + def "SwitchBranch" $ record [ + "pattern">: csharp "Pattern", + "guard">: optional $ csharp "Expression"], + +-- case_guard +-- : 'when' expression +-- ; +-- +-- // Source: §13.9.1 General +-- iteration_statement +-- : while_statement +-- | do_statement +-- | for_statement +-- | foreach_statement +-- ; + + def "IterationStatement" $ union [ + "while">: csharp "WhileStatement", + "do">: csharp "DoStatement", + "for">: csharp "ForStatement", + "foreach">: csharp "ForeachStatement"], + +-- // Source: §13.9.2 The while statement +-- while_statement +-- : 'while' '(' boolean_expression ')' embedded_statement +-- ; + + def "WhileStatement" $ record [ + "condition">: csharp "BooleanExpression", + "body">: csharp "EmbeddedStatement"], + +-- // Source: §13.9.3 The do statement +-- do_statement +-- : 'do' embedded_statement 'while' '(' boolean_expression ')' ';' +-- ; + + def "DoStatement" $ record [ + "body">: csharp "EmbeddedStatement", + "while">: csharp "BooleanExpression"], + +-- // Source: §13.9.4 The for statement +-- for_statement +-- : 'for' '(' for_initializer? ';' for_condition? ';' for_iterator? ')' +-- embedded_statement +-- ; + + def "ForStatement" $ record [ + "initializer">: optional $ csharp "ForInitializer", + "condition">: optional $ csharp "BooleanExpression", + "iterator">: optional $ csharp "StatementExpressionList", + "body">: csharp "EmbeddedStatement"], + +-- for_initializer +-- : local_variable_declaration +-- | statement_expression_list +-- ; + + def "ForInitializer" $ union [ + "variable">: csharp "LocalVariableDeclaration", + "statements">: csharp "StatementExpressionList"], + +-- for_condition +-- : boolean_expression +-- ; +-- +-- for_iterator +-- : statement_expression_list +-- ; +-- +-- statement_expression_list +-- : statement_expression (',' statement_expression)* +-- ; + + def "StatementExpressionList" $ nonemptyList $ csharp "StatementExpression", + +-- // Source: §13.9.5 The foreach statement +-- foreach_statement +-- : 'foreach' '(' ref_kind? local_variable_type identifier 'in' +-- expression ')' embedded_statement +-- ; + + def "ForeachStatement" $ record [ + "kind">: optional $ csharp "RefKind", + "type">: csharp "LocalVariableType", + "identifier">: csharp "Identifier", + "expression">: csharp "Expression", + "body">: csharp "EmbeddedStatement"], + +-- // Source: §13.10.1 General +-- jump_statement +-- : break_statement +-- | continue_statement +-- | goto_statement +-- | return_statement +-- | throw_statement +-- ; + + def "JumpStatement" $ union [ + "break">: unit, + "continue">: unit, + "goto">: csharp "GotoStatement", + "return">: csharp "ReturnStatement", + "throw">: optional $ csharp "Expression"], + +-- // Source: §13.10.2 The break statement +-- break_statement +-- : 'break' ';' +-- ; +-- +-- // Source: §13.10.3 The continue statement +-- continue_statement +-- : 'continue' ';' +-- ; +-- +-- // Source: §13.10.4 The goto statement +-- goto_statement +-- : 'goto' identifier ';' +-- | 'goto' 'case' constant_expression ';' +-- | 'goto' 'default' ';' +-- ; + + def "GotoStatement" $ union [ + "identifier">: csharp "Identifier", + "case">: csharp "ConstantExpression", + "default">: unit], + +-- // Source: §13.10.5 The return statement +-- return_statement +-- : 'return' ';' +-- | 'return' expression ';' +-- | 'return' 'ref' variable_reference ';' +-- ; + + def "ReturnStatement" $ union [ + "simple">: unit, + "value">: csharp "Expression", + "ref">: csharp "VariableReference"], + +-- // Source: §13.10.6 The throw statement +-- throw_statement +-- : 'throw' expression? ';' +-- ; +-- +-- // Source: §13.11 The try statement +-- try_statement +-- : 'try' block catch_clauses +-- | 'try' block catch_clauses? finally_clause +-- ; + + def "TryStatement" $ record [ + "body">: csharp "Block", + "catches">: csharp "CatchClauses", + "finally">: optional $ csharp "Block"], + +-- catch_clauses +-- : specific_catch_clause+ +-- | specific_catch_clause* general_catch_clause +-- ; + + def "CatchClauses" $ union [ + "specific">: list $ csharp "SpecificCatchClause", + "general">: csharp "Block"], + +-- specific_catch_clause +-- : 'catch' exception_specifier exception_filter? block +-- | 'catch' exception_filter block +-- ; + + def "SpecificCatchClause" $ record [ + "specifier">: optional $ csharp "ExceptionSpecifier", + "filter">: optional $ csharp "BooleanExpression", + "body">: csharp "Block"], + +-- exception_specifier +-- : '(' type identifier? ')' +-- ; + + def "ExceptionSpecifier" $ record [ + "type">: csharp "Type", + "identifier">: optional $ csharp "Identifier"], + +-- exception_filter +-- : 'when' '(' boolean_expression ')' +-- ; +-- +-- general_catch_clause +-- : 'catch' block +-- ; +-- +-- finally_clause +-- : 'finally' block +-- ; +-- +-- // Source: §13.12 The checked and unchecked statements +-- checked_statement +-- : 'checked' block +-- ; +-- +-- unchecked_statement +-- : 'unchecked' block +-- ; +-- +-- // Source: §13.13 The lock statement +-- lock_statement +-- : 'lock' '(' expression ')' embedded_statement +-- ; + + def "LockStatement" $ record [ + "expression">: csharp "Expression", + "body">: csharp "EmbeddedStatement"], + +-- // Source: §13.14 The using statement +-- using_statement +-- : 'using' '(' resource_acquisition ')' embedded_statement +-- ; + + def "UsingStatement" $ record [ + "acquisition">: csharp "ResourceAcquisition", + "body">: csharp "EmbeddedStatement"], + +-- resource_acquisition +-- : local_variable_declaration +-- | expression +-- ; + + def "ResourceAcquisition" $ union [ + "local">: csharp "LocalVariableDeclaration", + "expression">: csharp "Expression"], + +-- // Source: §13.15 The yield statement +-- yield_statement +-- : 'yield' 'return' expression ';' +-- | 'yield' 'break' ';' +-- ; + + def "YieldStatement" $ union [ + "return">: csharp "Expression", + "break">: unit], + +-- // Source: §14.2 Compilation units +-- compilation_unit +-- : extern_alias_directive* using_directive* global_attributes? +-- namespace_member_declaration* +-- ; + + def "CompilationUnit" $ record [ + "externs">: list $ csharp "Identifier", + "usings">: list $ csharp "UsingDirective", + "attributes">: list $ csharp "GlobalAttributeSection", + "members">: list $ csharp "NamespaceMemberDeclaration"], + +-- // Source: §14.3 Namespace declarations +-- namespace_declaration +-- : 'namespace' qualified_identifier namespace_body ';'? +-- ; + + def "NamespaceDeclaration" $ record [ + "name">: nonemptyList $ csharp "Identifier", + "body">: csharp "NamespaceBody"], + +-- qualified_identifier +-- : identifier ('.' identifier)* +-- ; +-- +-- namespace_body +-- : '{' extern_alias_directive* using_directive* +-- namespace_member_declaration* '}' +-- ; + + def "NamespaceBody" $ record [ + "externs">: list $ csharp "Identifier", + "usings">: list $ csharp "UsingDirective", + "members">: list $ csharp "NamespaceMemberDeclaration"], + +-- // Source: §14.4 Extern alias directives +-- extern_alias_directive +-- : 'extern' 'alias' identifier ';' +-- ; +-- +-- // Source: §14.5.1 General +-- using_directive +-- : using_alias_directive +-- | using_namespace_directive +-- | using_static_directive +-- ; + + def "UsingDirective" $ union [ + "alias">: csharp "UsingAliasDirective", + "namespace">: csharp "NamespaceName", + "static">: csharp "TypeName"], + +-- // Source: §14.5.2 Using alias directives +-- using_alias_directive +-- : 'using' identifier '=' namespace_or_type_name ';' +-- ; + + def "UsingAliasDirective" $ record [ + "alias">: csharp "Identifier", + "name">: csharp "NamespaceOrTypeName"], + +-- // Source: §14.5.3 Using namespace directives +-- using_namespace_directive +-- : 'using' namespace_name ';' +-- ; +-- +-- // Source: §14.5.4 Using static directives +-- using_static_directive +-- : 'using' 'static' type_name ';' +-- ; +-- +-- // Source: §14.6 Namespace member declarations +-- namespace_member_declaration +-- : namespace_declaration +-- | type_declaration +-- ; + + def "NamespaceMemberDeclaration" $ union [ + "namespace">: csharp "NamespaceDeclaration", + "type">: csharp "TypeDeclaration"], + +-- // Source: §14.7 Type declarations +-- type_declaration +-- : class_declaration +-- | struct_declaration +-- | interface_declaration +-- | enum_declaration +-- | delegate_declaration +-- ; + + def "TypeDeclaration" $ union [ + "class">: csharp "ClassDeclaration", + "struct">: csharp "StructDeclaration", + "interface">: csharp "InterfaceDeclaration", + "enum">: csharp "EnumDeclaration", + "delegate">: csharp "DelegateDeclaration"], + +-- // Source: §14.8.1 General +-- qualified_alias_member +-- : identifier '::' identifier type_argument_list? +-- ; + + def "QualifiedAliasMember" $ record [ + "alias">: csharp "Identifier", + "member">: csharp "Identifier", + "arguments">: optional $ csharp "TypeArgumentList"], + +-- // Source: §15.2.1 General +-- class_declaration +-- : attributes? class_modifier* 'partial'? 'class' identifier +-- type_parameter_list? class_base? type_parameter_constraints_clause* +-- class_body ';'? +-- ; + + def "ClassDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "ClassModifier", + "partial">: unit, + "name">: csharp "Identifier", + "parameters">: optional $ csharp "TypeParameterList", + "base">: optional $ csharp "ClassBase", + "constraints">: list $ csharp "TypeParameterConstraintsClause", + "body">: csharp "ClassBody"], + +-- // Source: §15.2.2.1 General +-- class_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'abstract' +-- | 'sealed' +-- | 'static' +-- | unsafe_modifier // unsafe code support +-- ; + + def "ClassModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "abstract", + "sealed", + "static", + "unsafe"], + +-- // Source: §15.2.3 Type parameters +-- type_parameter_list +-- : '<' type_parameters '>' +-- ; +-- +-- type_parameters +-- : attributes? type_parameter +-- | type_parameters ',' attributes? type_parameter +-- ; + + def "TypeParameterList" $ nonemptyList $ csharp "TypeParameterPart", + + def "TypeParameterPart" $ record [ + "attributes">: optional $ csharp "Attributes", + "name">: csharp "TypeParameter"], + +-- // Source: §15.2.4.1 General +-- class_base +-- : ':' class_type +-- | ':' interface_type_list +-- | ':' class_type ',' interface_type_list +-- ; + + def "ClassBase" $ union [ + "class">: optional $ csharp "ClassType", + "interfaces">: list $ csharp "InterfaceType"], + +-- interface_type_list +-- : interface_type (',' interface_type)* +-- ; +-- +-- // Source: §15.2.5 Type parameter constraints +-- type_parameter_constraints_clauses +-- : type_parameter_constraints_clause +-- | type_parameter_constraints_clauses type_parameter_constraints_clause +-- ; +-- +-- type_parameter_constraints_clause +-- : 'where' type_parameter ':' type_parameter_constraints +-- ; + + def "TypeParameterConstraintsClause" $ record [ + "parameter">: csharp "TypeParameter", + "constraints">: list $ csharp "TypeParameterConstraints"], + +-- type_parameter_constraints +-- : primary_constraint +-- | secondary_constraints +-- | constructor_constraint +-- | primary_constraint ',' secondary_constraints +-- | primary_constraint ',' constructor_constraint +-- | secondary_constraints ',' constructor_constraint +-- | primary_constraint ',' secondary_constraints ',' constructor_constraint +-- ; + + def "TypeParameterConstraints" $ record [ + "primary">: optional $ csharp "PrimaryConstraint", + "secondary">: optional $ csharp "SecondaryConstraints", + "constructor">: boolean], + +-- primary_constraint +-- : class_type +-- | 'class' +-- | 'struct' +-- | 'unmanaged' +-- ; + + def "PrimaryConstraint" $ union [ + "classType">: csharp "ClassType", + "class">: unit, + "struct">: unit, + "unmanaged">: unit], + +-- secondary_constraints +-- : interface_type +-- | type_parameter +-- | secondary_constraints ',' interface_type +-- | secondary_constraints ',' type_parameter +-- ; + + def "SecondaryConstraints" $ nonemptyList $ csharp "SecondaryConstraint", + + def "SecondaryConstraint" $ union [ + "interface">: csharp "InterfaceType", + "parameter">: csharp "TypeParameter"], + +-- constructor_constraint +-- : 'new' '(' ')' +-- ; +-- +-- // Source: §15.2.6 Class body +-- class_body +-- : '{' class_member_declaration* '}' +-- ; + + def "ClassBody" $ list $ csharp "ClassMemberDeclaration", + +-- // Source: §15.3.1 General +-- class_member_declaration +-- : constant_declaration +-- | field_declaration +-- | method_declaration +-- | property_declaration +-- | event_declaration +-- | indexer_declaration +-- | operator_declaration +-- | constructor_declaration +-- | finalizer_declaration +-- | static_constructor_declaration +-- | type_declaration +-- ; + + def "ClassMemberDeclaration" $ union [ + "constant">: csharp "ConstantDeclaration", + "field">: csharp "FieldDeclaration", + "method">: csharp "MethodDeclaration", + "property">: csharp "PropertyDeclaration", + "event">: csharp "EventDeclaration", + "indexer">: csharp "IndexerDeclaration", + "operator">: csharp "OperatorDeclaration", + "constructor">: csharp "ConstructorDeclaration", + "finalizer">: csharp "FinalizerDeclaration", + "staticConstructor">: csharp "StaticConstructorDeclaration", + "type">: csharp "TypeDeclaration"], + +-- // Source: §15.4 Constants +-- constant_declaration +-- : attributes? constant_modifier* 'const' type constant_declarators ';' +-- ; + + def "ConstantDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "ConstantModifier", + "type">: csharp "Type", + "declarators">: nonemptyList $ csharp "ConstantDeclarator"], + +-- constant_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- ; + + def "ConstantModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private"], + +-- // Source: §15.5.1 General +-- field_declaration +-- : attributes? field_modifier* type variable_declarators ';' +-- ; + + def "FieldDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "FieldModifier", + "type">: csharp "Type", + "declarators">: nonemptyList $ csharp "VariableDeclarator"], + +-- field_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'static' +-- | 'readonly' +-- | 'volatile' +-- | unsafe_modifier // unsafe code support +-- ; + + def "FieldModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "static", + "readonly", + "volatile", + "unsafe"], + +-- variable_declarators +-- : variable_declarator (',' variable_declarator)* +-- ; + + def "VariableDeclarators" $ nonemptyList $ csharp "VariableDeclarator", + +-- variable_declarator +-- : identifier ('=' variable_initializer)? +-- ; + + def "VariableDeclarator" $ record [ + "identifier">: csharp "Identifier", + "initializer">: optional $ csharp "VariableInitializer"], + +-- // Source: §15.6.1 General +-- method_declaration +-- : attributes? method_modifiers return_type method_header method_body +-- | attributes? ref_method_modifiers ref_kind ref_return_type method_header +-- ref_method_body +-- ; + + def "MethodDeclaration" $ union [ + "standard">: csharp "StandardMethodDeclaration", + "refReturn">: csharp "RefReturnMethodDeclaration"], + + def "StandardMethodDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "MethodModifier", + "returnType">: csharp "ReturnType", + "header">: csharp "MethodHeader", + "body">: csharp "MethodBody"], + + def "RefReturnMethodDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "RefMethodModifier", + "kind">: csharp "RefKind", + "returnType">: csharp "ReturnType", + "header">: csharp "MethodHeader", + "body">: csharp "RefMethodBody"], + +-- method_modifiers +-- : method_modifier* 'partial'? +-- ; + + def "MethodModifiers" $ record [ + "modifiers">: list $ csharp "MethodModifier", + "partial">: boolean], + +-- ref_kind +-- : 'ref' +-- | 'ref' 'readonly' +-- ; + + def "RefKind" $ enum [ + "ref", + "refReadonly"], + +-- ref_method_modifiers +-- : ref_method_modifier* +-- ; +-- +-- method_header +-- : member_name '(' formal_parameter_list? ')' +-- | member_name type_parameter_list '(' formal_parameter_list? ')' +-- type_parameter_constraints_clause* +-- ; + + def "MethodHeader" $ record [ + "name">: csharp "MemberName", + "typeParameters">: optional $ csharp "TypeParameterList", + "parameters">: optional $ csharp "FormalParameterList", + "constraints">: list $ csharp "TypeParameterConstraintsClause"], + +-- method_modifier +-- : ref_method_modifier +-- | 'async' +-- ; + + def "MethodModifier" $ union [ + "ref">: csharp "RefMethodModifier", + "async">: unit], + +-- ref_method_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'static' +-- | 'virtual' +-- | 'sealed' +-- | 'override' +-- | 'abstract' +-- | 'extern' +-- | unsafe_modifier // unsafe code support +-- ; + + def "RefMethodModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "static", + "virtual", + "sealed", + "override", + "abstract", + "extern", + "unsafe"], + +-- return_type +-- : ref_return_type +-- | 'void' +-- ; + + def "ReturnType" $ union [ + "ref">: csharp "Type", + "void">: unit], + +-- ref_return_type +-- : type +-- ; +-- +-- member_name +-- : identifier +-- | interface_type '.' identifier +-- ; + + def "MemberName" $ record [ + "interfaceType">: optional $ csharp "TypeName", + "identifier">: csharp "Identifier"], + +-- method_body +-- : block +-- | '=>' null_conditional_invocation_expression ';' +-- | '=>' expression ';' +-- | ';' +-- ; + + def "MethodBody" $ union [ + "block">: csharp "Block", + "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression", + "expression">: csharp "Expression", + "empty">: unit], + +-- ref_method_body +-- : block +-- | '=>' 'ref' variable_reference ';' +-- | ';' +-- ; + + def "RefMethodBody" $ union [ + "block">: csharp "Block", + "ref">: csharp "VariableReference", + "empty">: unit], + +-- // Source: §15.6.2.1 General +-- formal_parameter_list +-- : fixed_parameters +-- | fixed_parameters ',' parameter_array +-- | parameter_array +-- ; + + def "FormalParameterList" $ record [ + "fixed">: list $ csharp "FixedParameter", + "array">: optional $ csharp "ParameterArray"], + +-- fixed_parameters +-- : fixed_parameter (',' fixed_parameter)* +-- ; +-- +-- fixed_parameter +-- : attributes? parameter_modifier? type identifier default_argument? +-- ; + + def "FixedParameter" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifier">: optional $ csharp "ParameterModifier", + "type">: csharp "Type", + "identifier">: csharp "Identifier", + "defaultArgument">: optional $ csharp "Expression"], + +-- default_argument +-- : '=' expression +-- ; +-- +-- parameter_modifier +-- : parameter_mode_modifier +-- | 'this' +-- ; + + def "ParameterModifier" $ union [ + "mode">: csharp "ParameterModeModifier", + "this">: unit], + +-- parameter_mode_modifier +-- : 'ref' +-- | 'out' +-- | 'in' +-- ; + + def "ParameterModeModifier" $ enum [ + "ref", + "out", + "in"], + +-- parameter_array +-- : attributes? 'params' array_type identifier +-- ; + + def "ParameterArray" $ record [ + "attributes">: optional $ csharp "Attributes", + "type">: csharp "ArrayType", + "identifier">: csharp "Identifier"], + +-- // Source: §15.7.1 General +-- property_declaration +-- : attributes? property_modifier* type member_name property_body +-- | attributes? property_modifier* ref_kind type member_name ref_property_body +-- ; + + def "PropertyDeclaration" $ union [ + "standard">: csharp "StandardPropertyDeclaration", + "refReturn">: csharp "RefReturnPropertyDeclaration"], + + def "StandardPropertyDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "PropertyModifier", + "type">: csharp "Type", + "name">: csharp "MemberName", + "body">: csharp "PropertyBody"], + + def "RefReturnPropertyDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "PropertyModifier", + "refKind">: csharp "RefKind", + "type">: csharp "Type", + "name">: csharp "MemberName", + "body">: csharp "RefPropertyBody"], + +-- property_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'static' +-- | 'virtual' +-- | 'sealed' +-- | 'override' +-- | 'abstract' +-- | 'extern' +-- | unsafe_modifier // unsafe code support +-- ; + + def "PropertyModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "static", + "virtual", + "sealed", + "override", + "abstract", + "extern", + "unsafe"], + +-- property_body +-- : '{' accessor_declarations '}' property_initializer? +-- | '=>' expression ';' +-- ; + + def "PropertyBody" $ union [ + "block">: csharp "BlockPropertyBody", + "expression">: csharp "Expression"], + + def "BlockPropertyBody" $ record [ + "accessors">: csharp "AccessorDeclarations", + "initializer">: optional $ csharp "VariableInitializer"], + +-- property_initializer +-- : '=' variable_initializer ';' +-- ; +-- +-- ref_property_body +-- : '{' ref_get_accessor_declaration '}' +-- | '=>' 'ref' variable_reference ';' +-- ; + + def "RefPropertyBody" $ union [ + "block">: csharp "RefGetAccessorDeclaration", + "ref">: csharp "VariableReference"], + +-- // Source: §15.7.3 Accessors +-- accessor_declarations +-- : get_accessor_declaration set_accessor_declaration? +-- | set_accessor_declaration get_accessor_declaration? +-- ; + + def "AccessorDeclarations" $ union [ + "get">: optional $ csharp "AccessorDeclaration", + "set">: optional $ csharp "AccessorDeclaration"], + + def "AccessorDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifier">: optional $ csharp "AccessorModifier", + "body">: csharp "AccessorBody"], + +-- get_accessor_declaration +-- : attributes? accessor_modifier? 'get' accessor_body +-- ; +-- +-- set_accessor_declaration +-- : attributes? accessor_modifier? 'set' accessor_body +-- ; +-- +-- accessor_modifier +-- : 'protected' +-- | 'internal' +-- | 'private' +-- | 'protected' 'internal' +-- | 'internal' 'protected' +-- | 'protected' 'private' +-- | 'private' 'protected' +-- ; + + def "AccessorModifier" $ enum [ + "protected", + "internal", + "private", + "protectedInternal", + "internalProtected", + "protectedPrivate", + "privateProtected"], + +-- accessor_body +-- : block +-- | '=>' expression ';' +-- | ';' +-- ; + + def "AccessorBody" $ union [ + "block">: csharp "Block", + "expression">: csharp "Expression", + "empty">: unit], + +-- ref_get_accessor_declaration +-- : attributes? accessor_modifier? 'get' ref_accessor_body +-- ; + + def "RefGetAccessorDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifier">: optional $ csharp "AccessorModifier", + "body">: csharp "RefAccessorBody"], + +-- ref_accessor_body +-- : block +-- | '=>' 'ref' variable_reference ';' +-- | ';' +-- ; + + def "RefAccessorBody" $ union [ + "block">: csharp "Block", + "ref">: csharp "VariableReference", + "empty">: unit], + +-- // Source: §15.8.1 General +-- event_declaration +-- : attributes? event_modifier* 'event' type variable_declarators ';' +-- | attributes? event_modifier* 'event' type member_name +-- '{' event_accessor_declarations '}' +-- ; + + def "EventDeclaration" $ union [ + "standard">: csharp "StandardEventDeclaration", + "accessors">: csharp "AccessorsEventDeclaration"], + + def "StandardEventDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "EventModifier", + "type">: csharp "Type", + "declarators">: csharp "VariableDeclarators"], + + def "AccessorsEventDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "EventModifier", + "type">: csharp "Type", + "name">: csharp "MemberName", + "accessors">: csharp "EventAccessorDeclarations"], + +-- event_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'static' +-- | 'virtual' +-- | 'sealed' +-- | 'override' +-- | 'abstract' +-- | 'extern' +-- | unsafe_modifier // unsafe code support +-- ; + + def "EventModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "static", + "virtual", + "sealed", + "override", + "abstract", + "extern", + "unsafe"], + +-- event_accessor_declarations +-- : add_accessor_declaration remove_accessor_declaration +-- | remove_accessor_declaration add_accessor_declaration +-- ; + + def "EventAccessorDeclarations" $ union [ + "add">: csharp "AddRemoveAccessorDeclaration", + "remove">: csharp "AddRemoveAccessorDeclaration"], + + def "AddRemoveAccessorDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "body">: csharp "Block"], + +-- add_accessor_declaration +-- : attributes? 'add' block +-- ; +-- +-- remove_accessor_declaration +-- : attributes? 'remove' block +-- ; +-- +-- // Source: §15.9.1 General +-- indexer_declaration +-- : attributes? indexer_modifier* indexer_declarator indexer_body +-- | attributes? indexer_modifier* ref_kind indexer_declarator ref_indexer_body +-- ; + + def "IndexerDeclaration" $ union [ + "standard">: csharp "StandardIndexerDeclaration", + "ref">: csharp "RefIndexerDeclaration"], + + def "StandardIndexerDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "IndexerModifier", + "declarator">: csharp "IndexerDeclarator", + "body">: csharp "IndexerBody"], + + def "RefIndexerDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "IndexerModifier", + "refKind">: csharp "RefKind", + "declarator">: csharp "IndexerDeclarator", + "body">: csharp "RefIndexerBody"], + +-- indexer_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'virtual' +-- | 'sealed' +-- | 'override' +-- | 'abstract' +-- | 'extern' +-- | unsafe_modifier // unsafe code support +-- ; + + def "IndexerModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "virtual", + "sealed", + "override", + "abstract", + "extern", + "unsafe"], + +-- indexer_declarator +-- : type 'this' '[' formal_parameter_list ']' +-- | type interface_type '.' 'this' '[' formal_parameter_list ']' +-- ; + + def "IndexerDeclarator" $ record [ + "type">: csharp "Type", + "interface">: optional $ csharp "InterfaceType", + "parameters">: csharp "FormalParameterList"], + +-- indexer_body +-- : '{' accessor_declarations '}' +-- | '=>' expression ';' +-- ; + + def "IndexerBody" $ union [ + "block">: csharp "AccessorDeclarations", + "expression">: csharp "Expression"], + +-- ref_indexer_body +-- : '{' ref_get_accessor_declaration '}' +-- | '=>' 'ref' variable_reference ';' +-- ; + + def "RefIndexerBody" $ union [ + "block">: csharp "RefGetAccessorDeclaration", + "ref">: csharp "VariableReference"], + +-- // Source: §15.10.1 General +-- operator_declaration +-- : attributes? operator_modifier+ operator_declarator operator_body +-- ; + + def "OperatorDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "OperatorModifier", + "declarator">: csharp "OperatorDeclarator", + "body">: csharp "OperatorBody"], + +-- operator_modifier +-- : 'public' +-- | 'static' +-- | 'extern' +-- | unsafe_modifier // unsafe code support +-- ; + + def "OperatorModifier" $ enum [ + "public", + "static", + "extern", + "unsafe"], + +-- operator_declarator +-- : unary_operator_declarator +-- | binary_operator_declarator +-- | conversion_operator_declarator +-- ; + + def "OperatorDeclarator" $ union [ + "unary">: csharp "UnaryOperatorDeclarator", + "binary">: csharp "BinaryOperatorDeclarator", + "conversion">: csharp "ConversionOperatorDeclarator"], + +-- unary_operator_declarator +-- : type 'operator' overloadable_unary_operator '(' fixed_parameter ')' +-- ; + + def "UnaryOperatorDeclarator" $ record [ + "type">: csharp "Type", + "operator">: csharp "OverloadableUnaryOperator", + "parameter">: csharp "FixedParameter"], + +-- overloadable_unary_operator +-- : '+' | '-' | '!' | '~' | '++' | '--' | 'true' | 'false' +-- ; + + def "OverloadableUnaryOperator" $ enum [ + "plus", + "minus", + "not", + "complement", + "increment", + "decrement", + "true", + "false"], + +-- binary_operator_declarator +-- : type 'operator' overloadable_binary_operator +-- '(' fixed_parameter ',' fixed_parameter ')' +-- ; + + def "BinaryOperatorDeclarator" $ record [ + "type">: csharp "Type", + "operator">: csharp "OverloadableBinaryOperator", + "left">: csharp "FixedParameter", + "right">: csharp "FixedParameter"], + +-- overloadable_binary_operator +-- : '+' | '-' | '*' | '/' | '%' | '&' | '|' | '^' | '<<' +-- | right_shift | '==' | '!=' | '>' | '<' | '>=' | '<=' +-- ; + + def "OverloadableBinaryOperator" $ enum [ + "add", + "subtract", + "multiply", + "divide", + "modulus", + "and", + "or", + "xor", + "leftShift", + "rightShift", + "equal", + "notEqual", + "greaterThan", + "lessThan", + "greaterThanOrEqual", + "lessThanOrEqual"], + +-- conversion_operator_declarator +-- : 'implicit' 'operator' type '(' fixed_parameter ')' +-- | 'explicit' 'operator' type '(' fixed_parameter ')' +-- ; + + def "ConversionOperatorDeclarator" $ record [ + "kind">: csharp "ConversionKind", + "type">: csharp "Type", + "parameter">: csharp "FixedParameter"], + + def "ConversionKind" $ enum [ + "implicit", + "explicit"], + +-- operator_body +-- : block +-- | '=>' expression ';' +-- | ';' +-- ; + + def "OperatorBody" $ union [ + "block">: csharp "Block", + "expression">: csharp "Expression", + "empty">: unit], + +-- // Source: §15.11.1 General +-- constructor_declaration +-- : attributes? constructor_modifier* constructor_declarator constructor_body +-- ; + + def "ConstructorDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "ConstructorModifier", + "declarator">: csharp "ConstructorDeclarator", + "body">: csharp "ConstructorBody"], + +-- constructor_modifier +-- : 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'extern' +-- | unsafe_modifier // unsafe code support +-- ; + + def "ConstructorModifier" $ enum [ + "public", + "protected", + "internal", + "private", + "extern", + "unsafe"], + +-- constructor_declarator +-- : identifier '(' formal_parameter_list? ')' constructor_initializer? +-- ; + + def "ConstructorDeclarator" $ record [ + "name">: csharp "Identifier", + "parameters">: optional $ csharp "FormalParameterList", + "initializer">: optional $ csharp "ConstructorInitializer"], + +-- constructor_initializer +-- : ':' 'base' '(' argument_list? ')' +-- | ':' 'this' '(' argument_list? ')' +-- ; + + def "ConstructorInitializer" $ union [ + "base">: optional $ csharp "ArgumentList", + "this">: optional $ csharp "ArgumentList"], + +-- constructor_body +-- : block +-- | '=>' expression ';' +-- | ';' +-- ; + + def "ConstructorBody" $ union [ + "block">: csharp "Block", + "expression">: csharp "Expression", + "empty">: unit], + +-- // Source: §15.12 Static constructors +-- static_constructor_declaration +-- : attributes? static_constructor_modifiers identifier '(' ')' +-- static_constructor_body +-- ; + + def "StaticConstructorDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: csharp "StaticConstructorModifiers", + "name">: csharp "Identifier", + "body">: csharp "StaticConstructorBody"], + +-- static_constructor_modifiers +-- : 'static' +-- | 'static' 'extern' unsafe_modifier? +-- | 'static' unsafe_modifier 'extern'? +-- | 'extern' 'static' unsafe_modifier? +-- | 'extern' unsafe_modifier 'static' +-- | unsafe_modifier 'static' 'extern'? +-- | unsafe_modifier 'extern' 'static' +-- ; + + def "StaticConstructorModifiers" $ record [ + "extern">: boolean, + "unsafe">: boolean], + +-- static_constructor_body +-- : block +-- | '=>' expression ';' +-- | ';' +-- ; + + def "StaticConstructorBody" $ union [ + "block">: csharp "Block", + "expression">: csharp "Expression", + "empty">: unit], + +-- // Source: §15.13 Finalizers +-- finalizer_declaration +-- : attributes? '~' identifier '(' ')' finalizer_body +-- | attributes? 'extern' unsafe_modifier? '~' identifier '(' ')' +-- finalizer_body +-- | attributes? unsafe_modifier 'extern'? '~' identifier '(' ')' +-- finalizer_body +-- ; + + def "FinalizerDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "extern">: boolean, + "unsafe">: boolean, + "name">: csharp "Identifier", + "body">: csharp "FinalizerBody"], + +-- finalizer_body +-- : block +-- | '=>' expression ';' +-- | ';' +-- ; + + def "FinalizerBody" $ union [ + "block">: csharp "Block", + "expression">: csharp "Expression", + "empty">: unit], + +-- // Source: §16.2.1 General +-- struct_declaration +-- : attributes? struct_modifier* 'ref'? 'partial'? 'struct' +-- identifier type_parameter_list? struct_interfaces? +-- type_parameter_constraints_clause* struct_body ';'? +-- ; + + def "StructDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "StructModifier", + "ref">: boolean, + "partial">: boolean, + "name">: csharp "Identifier", + "parameters">: optional $ csharp "TypeParameterList", + "interfaces">: list $ csharp "InterfaceType", + "constraints">: list $ csharp "TypeParameterConstraintsClause", + "body">: list $ csharp "StructMemberDeclaration"], + +-- // Source: §16.2.2 Struct modifiers +-- struct_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | 'readonly' +-- | unsafe_modifier // unsafe code support +-- ; + + def "StructModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "readonly", + "unsafe"], + +-- // Source: §16.2.5 Struct interfaces +-- struct_interfaces +-- : ':' interface_type_list +-- ; +-- +-- // Source: §16.2.6 Struct body +-- struct_body +-- : '{' struct_member_declaration* '}' +-- ; +-- +-- // Source: §16.3 Struct members +-- struct_member_declaration +-- : constant_declaration +-- | field_declaration +-- | method_declaration +-- | property_declaration +-- | event_declaration +-- | indexer_declaration +-- | operator_declaration +-- | constructor_declaration +-- | static_constructor_declaration +-- | type_declaration +-- | fixed_size_buffer_declaration // unsafe code support +-- ; + + def "StructMemberDeclaration" $ union [ + "constant">: csharp "ConstantDeclaration", + "field">: csharp "FieldDeclaration", + "method">: csharp "MethodDeclaration", + "property">: csharp "PropertyDeclaration", + "event">: csharp "EventDeclaration", + "indexer">: csharp "IndexerDeclaration", + "operator">: csharp "OperatorDeclaration", + "constructor">: csharp "ConstructorDeclaration", + "staticConstructor">: csharp "StaticConstructorDeclaration", + "type">: csharp "TypeDeclaration", + "fixedSizeBuffer">: csharp "FixedSizeBufferDeclaration"], + +-- // Source: §17.7 Array initializers +-- array_initializer +-- : '{' variable_initializer_list? '}' +-- | '{' variable_initializer_list ',' '}' +-- ; + + def "ArrayInitializer" $ list $ csharp "VariableInitializer", + +-- variable_initializer_list +-- : variable_initializer (',' variable_initializer)* +-- ; +-- +-- variable_initializer +-- : expression +-- | array_initializer +-- ; + + def "VariableInitializer" $ union [ + "expression">: csharp "Expression", + "array">: csharp "ArrayInitializer"], + +-- // Source: §18.2.1 General +-- interface_declaration +-- : attributes? interface_modifier* 'partial'? 'interface' +-- identifier variant_type_parameter_list? interface_base? +-- type_parameter_constraints_clause* interface_body ';'? +-- ; + + def "InterfaceDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "InterfaceModifier", + "partial">: boolean, + "name">: csharp "Identifier", + "parameters">: optional $ csharp "VariantTypeParameters", + "base">: list $ csharp "InterfaceType", + "constraints">: list $ csharp "TypeParameterConstraintsClause", + "body">: list $ csharp "InterfaceMemberDeclaration"], + +-- // Source: §18.2.2 Interface modifiers +-- interface_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | unsafe_modifier // unsafe code support +-- ; + + def "InterfaceModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "unsafe"], + +-- // Source: §18.2.3.1 General +-- variant_type_parameter_list +-- : '<' variant_type_parameters '>' +-- ; +-- +-- // Source: §18.2.3.1 General +-- variant_type_parameters +-- : attributes? variance_annotation? type_parameter +-- | variant_type_parameters ',' attributes? variance_annotation? +-- type_parameter +-- ; + + def "VariantTypeParameters" $ list $ csharp "VariantTypeParameter", + + def "VariantTypeParameter" $ record [ + "attributes">: optional $ csharp "Attributes", + "variance">: optional $ csharp "VarianceAnnotation", + "parameter">: csharp "TypeParameter"], + +-- // Source: §18.2.3.1 General +-- variance_annotation +-- : 'in' +-- | 'out' +-- ; + + def "VarianceAnnotation" $ enum [ + "in", + "out"], + +-- // Source: §18.2.4 Base interfaces +-- interface_base +-- : ':' interface_type_list +-- ; +-- +-- // Source: §18.3 Interface body +-- interface_body +-- : '{' interface_member_declaration* '}' +-- ; +-- +-- // Source: §18.4.1 General +-- interface_member_declaration +-- : interface_method_declaration +-- | interface_property_declaration +-- | interface_event_declaration +-- | interface_indexer_declaration +-- ; + + def "InterfaceMemberDeclaration" $ union [ + "method">: csharp "InterfaceMethodDeclaration", + "property">: csharp "InterfacePropertyDeclaration", + "event">: csharp "InterfaceEventDeclaration", + "indexer">: csharp "InterfaceIndexerDeclaration"], + +-- // Source: §18.4.2 Interface methods +-- interface_method_declaration +-- : attributes? 'new'? return_type interface_method_header +-- | attributes? 'new'? ref_kind ref_return_type interface_method_header +-- ; + + def "InterfaceMethodDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "new">: boolean, + "returnType">: csharp "ReturnType", + "refKind">: optional $ csharp "RefKind", + "header">: csharp "InterfaceMethodHeader"], + +-- interface_method_header +-- : identifier '(' formal_parameter_list? ')' ';' +-- | identifier type_parameter_list '(' formal_parameter_list? ')' +-- type_parameter_constraints_clause* ';' +-- ; + + def "InterfaceMethodHeader" $ record [ + "name">: csharp "Identifier", + "parameters">: optional $ csharp "FormalParameterList", + "typeParameters">: optional $ csharp "TypeParameterList", + "constraints">: list $ csharp "TypeParameterConstraintsClause"], + +-- // Source: §18.4.3 Interface properties +-- interface_property_declaration +-- : attributes? 'new'? type identifier '{' interface_accessors '}' +-- | attributes? 'new'? ref_kind type identifier '{' ref_interface_accessor '}' +-- ; + + def "InterfacePropertyDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "new">: boolean, + "refKind">: optional $ csharp "RefKind", + "type">: csharp "Type", + "name">: csharp "Identifier", + "accessors">: csharp "InterfaceAccessors"], + +-- interface_accessors +-- : attributes? 'get' ';' +-- | attributes? 'set' ';' +-- | attributes? 'get' ';' attributes? 'set' ';' +-- | attributes? 'set' ';' attributes? 'get' ';' +-- ; + + def "InterfaceAccessors" $ record [ + "attributes">: optional $ csharp "Attributes", + "get">: optional $ csharp "Attributes", + "set">: optional $ csharp "Attributes"], + +-- ref_interface_accessor +-- : attributes? 'get' ';' +-- ; +-- +-- // Source: §18.4.4 Interface events +-- interface_event_declaration +-- : attributes? 'new'? 'event' type identifier ';' +-- ; + + def "InterfaceEventDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "new">: boolean, + "type">: csharp "Type", + "name">: csharp "Identifier"], + +-- // Source: §18.4.5 Interface indexers +-- interface_indexer_declaration +-- : attributes? 'new'? type 'this' '[' formal_parameter_list ']' +-- '{' interface_accessors '}' +-- | attributes? 'new'? ref_kind type 'this' '[' formal_parameter_list ']' +-- '{' ref_interface_accessor '}' +-- ; + + def "InterfaceIndexerDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "new">: boolean, + "refKind">: optional $ csharp "RefKind", + "type">: csharp "Type", + "parameters">: csharp "FormalParameterList", + "accessors">: csharp "InterfaceAccessors"], + +-- // Source: §19.2 Enum declarations +-- enum_declaration +-- : attributes? enum_modifier* 'enum' identifier enum_base? enum_body ';'? +-- ; + + def "EnumDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "EnumModifier", + "name">: csharp "Identifier", + "base">: optional $ csharp "EnumBase", + "body">: optional $ csharp "EnumBody"], + +-- enum_base +-- : ':' integral_type +-- | ':' integral_type_name +-- ; + + def "EnumBase" $ union [ + "type">: csharp "IntegralType", + "name">: csharp "TypeName"], + +-- integral_type_name +-- : type_name // Shall resolve to an integral type other than char +-- ; +-- +-- enum_body +-- : '{' enum_member_declarations? '}' +-- | '{' enum_member_declarations ',' '}' +-- ; + + def "EnumBody" $ list $ csharp "EnumMemberDeclaration", + +-- // Source: §19.3 Enum modifiers +-- enum_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- ; + + def "EnumModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private"], + +-- // Source: §19.4 Enum members +-- enum_member_declarations +-- : enum_member_declaration (',' enum_member_declaration)* +-- ; +-- +-- // Source: §19.4 Enum members +-- enum_member_declaration +-- : attributes? identifier ('=' constant_expression)? +-- ; + + def "EnumMemberDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "name">: csharp "Identifier", + "value">: optional $ csharp "ConstantExpression"], + +-- // Source: §20.2 Delegate declarations +-- delegate_declaration +-- : attributes? delegate_modifier* 'delegate' return_type delegate_header +-- | attributes? delegate_modifier* 'delegate' ref_kind ref_return_type +-- delegate_header +-- ; + + def "DelegateDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: list $ csharp "DelegateModifier", + "returnType">: csharp "ReturnType", + "refKind">: optional $ csharp "RefKind", + "refReturnType">: optional $ csharp "Type", + "header">: csharp "DelegateHeader"], + +-- delegate_header +-- : identifier '(' formal_parameter_list? ')' ';' +-- | identifier variant_type_parameter_list '(' formal_parameter_list? ')' +-- type_parameter_constraints_clause* ';' +-- ; + + def "DelegateHeader" $ record [ + "name">: csharp "Identifier", + "typeParameters">: optional $ csharp "VariantTypeParameters", + "parameters">: optional $ csharp "FormalParameterList", + "constraints">: list $ csharp "TypeParameterConstraintsClause"], + +-- delegate_modifier +-- : 'new' +-- | 'public' +-- | 'protected' +-- | 'internal' +-- | 'private' +-- | unsafe_modifier // unsafe code support +-- ; + + def "DelegateModifier" $ enum [ + "new", + "public", + "protected", + "internal", + "private", + "unsafe"], + +-- // Source: §22.3 Attribute specification +-- global_attributes +-- : global_attribute_section+ +-- ; +-- +-- global_attribute_section +-- : '[' global_attribute_target_specifier attribute_list ']' +-- | '[' global_attribute_target_specifier attribute_list ',' ']' +-- ; + + def "GlobalAttributeSection" $ record [ + "target">: csharp "Identifier", + "attributes">: csharp "AttributeList"], + +-- global_attribute_target_specifier +-- : global_attribute_target ':' +-- ; +-- +-- global_attribute_target +-- : identifier +-- ; +-- +-- attributes +-- : attribute_section+ +-- ; + + def "Attributes" $ nonemptyList $ csharp "AttributeSection", + +-- attribute_section +-- : '[' attribute_target_specifier? attribute_list ']' +-- | '[' attribute_target_specifier? attribute_list ',' ']' +-- ; + + def "AttributeSection" $ record [ + "target">: optional $ csharp "AttributeTarget", + "attributes">: csharp "AttributeList"], + +-- attribute_target_specifier +-- : attribute_target ':' +-- ; +-- +-- attribute_target +-- : identifier +-- | keyword +-- ; + + def "AttributeTarget" $ union [ + "identifier">: csharp "Identifier", + "keyword">: csharp "Keyword"], + +-- attribute_list +-- : attribute (',' attribute)* +-- ; + + def "AttributeList" $ nonemptyList $ csharp "Attribute", + +-- attribute +-- : attribute_name attribute_arguments? +-- ; + + def "Attribute" $ record [ + "name">: csharp "AttributeName", + "arguments">: optional $ csharp "AttributeArguments"], + +-- attribute_name +-- : type_name +-- ; + + def "AttributeName" $ csharp "TypeName", + +-- attribute_arguments +-- : '(' ')' +-- | '(' positional_argument_list (',' named_argument_list)? ')' +-- | '(' named_argument_list ')' +-- ; + + def "AttributeArguments" $ record [ + "positonal">: optional $ csharp "PositionalArgumentList", + "named">: optional $ csharp "NamedArgumentList"], + +-- positional_argument_list +-- : positional_argument (',' positional_argument)* +-- ; + + def "PositionalArgumentList" $ nonemptyList $ csharp "PositionalArgument", + +-- positional_argument +-- : argument_name? attribute_argument_expression +-- ; + + def "PositionalArgument" $ record [ + "name">: optional $ csharp "Identifier", + "value">: csharp "AttributeArgumentExpression"], + +-- named_argument_list +-- : named_argument (',' named_argument)* +-- ; + + def "NamedArgumentList" $ nonemptyList $ csharp "NamedArgument", + +-- named_argument +-- : identifier '=' attribute_argument_expression +-- ; + + def "NamedArgument" $ record [ + "name">: csharp "Identifier", + "value">: csharp "AttributeArgumentExpression"], + +-- attribute_argument_expression +-- : non_assignment_expression +-- ; + + def "AttributeArgumentExpression" $ csharp "NonAssignmentExpression"] + + unsafeElements = [ + +-- // Source: §23.2 Unsafe contexts +-- unsafe_modifier +-- : 'unsafe' +-- ; +-- +-- unsafe_statement +-- : 'unsafe' block +-- ; +-- +-- // Source: §23.3 Pointer types +-- pointer_type +-- : value_type ('*')+ +-- | 'void' ('*')+ +-- ; + + def "PointerType" $ union [ + "valueType">: optional $ csharp "ValueType", + "pointerDepth">: int32], -- Note: positive integer + +-- // Source: §23.6.2 Pointer indirection +-- pointer_indirection_expression +-- : '*' unary_expression +-- ; +-- +-- // Source: §23.6.3 Pointer member access +-- pointer_member_access +-- : primary_expression '->' identifier type_argument_list? +-- ; + + def "PointerMemberAccess" $ record [ + "pointer">: csharp "PrimaryExpression", + "member">: csharp "Identifier", + "typeArguments">: optional $ csharp "TypeArgumentList"], + +-- // Source: §23.6.4 Pointer element access +-- pointer_element_access +-- : primary_no_array_creation_expression '[' expression ']' +-- ; + + def "PointerElementAccess" $ record [ + "pointer">: csharp "PrimaryNoArrayCreationExpression", + "index">: csharp "Expression"], + +-- // Source: §23.6.5 The address-of operator +-- addressof_expression +-- : '&' unary_expression +-- ; +-- +-- // Source: §23.7 The fixed statement +-- fixed_statement +-- : 'fixed' '(' pointer_type fixed_pointer_declarators ')' embedded_statement +-- ; + + def "FixedStatement" $ record [ + "pointerType">: csharp "PointerType", + "declarators">: nonemptyList $ csharp "FixedPointerDeclarator", + "statement">: csharp "EmbeddedStatement"], + +-- fixed_pointer_declarators +-- : fixed_pointer_declarator (',' fixed_pointer_declarator)* +-- ; +-- +-- fixed_pointer_declarator +-- : identifier '=' fixed_pointer_initializer +-- ; +-- +-- fixed_pointer_initializer +-- : '&' variable_reference +-- | expression +-- ; + + def "FixedPointerDeclarator" $ union [ + "reference">: csharp "VariableReference", + "expression">: csharp "Expression"], + +-- // Source: §23.8.2 Fixed-size buffer declarations +-- fixed_size_buffer_declaration +-- : attributes? fixed_size_buffer_modifier* 'fixed' buffer_element_type +-- fixed_size_buffer_declarators ';' +-- ; + + def "FixedSizeBufferDeclaration" $ record [ + "attributes">: optional $ csharp "Attributes", + "modifiers">: nonemptyList $ csharp "FixedSizeBufferModifier", + "elementType">: csharp "Type", + "declarators">: nonemptyList $ csharp "FixedSizeBufferDeclarator"], + +-- fixed_size_buffer_modifier +-- : 'new' +-- | 'public' +-- | 'internal' +-- | 'private' +-- | 'unsafe' +-- ; + + def "FixedSizeBufferModifier" $ enum [ + "new", + "public", + "internal", + "private", + "unsafe"], + +-- buffer_element_type +-- : type +-- ; +-- +-- fixed_size_buffer_declarators +-- : fixed_size_buffer_declarator (',' fixed_size_buffer_declarator)* +-- ; +-- +-- fixed_size_buffer_declarator +-- : identifier '[' constant_expression ']' +-- ; + + def "FixedSizeBufferDeclarator" $ record [ + "name">: csharp "Identifier", + "size">: csharp "ConstantExpression"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Features.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Features.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Features.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Cypher.Features where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types +import Hydra.Sources.Tier4.Ext.Cypher.Functions + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Maybe as Y + + +data FeatureSet = FeatureSet { + featureSetName :: String, + featureSetDescription :: String, + featureSetChildren :: [FeatureSet]} + +openCypherFeaturesModule :: Module +openCypherFeaturesModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A model for characterizing OpenCypher queries and implementations in terms of included features." + ++ "Based on the OpenCypher grammar and the list of standard Cypher functions at " + ++ "https://neo4j.com/docs/cypher-manual/current/functions." + ++ " Current as of August 2024.") + where + ns = Namespace "hydra/ext/cypher/features" + cypherFeatures = typeref ns + + elements = featureSetToType <$> flatten openCypherFeatures + where + flatten fs = if L.null children then [] else (fs:(L.concat (flatten <$> children))) + where + children = featureSetChildren fs + featureSetToType (FeatureSet name desc children) = datatype ns (featureSetName name) $ + doc (featureSetDesc desc) $ record (toField <$> children) + where + toField (FeatureSet name1 desc1 children1) = (decapitalize name1)>: if L.null children1 + then doc (featureSetDesc desc1) boolean + else doc (featureSetDesc desc1) $ cypherFeatures $ featureSetName name1 + where + fieldDesc = "Whether to expect " ++ desc1 + featureSetName name = capitalize name ++ "Features" + featureSetDesc desc = capitalize desc + +openCypherFeatures :: FeatureSet +openCypherFeatures = FeatureSet "Cypher" + ("A set of features which characterize an OpenCypher query or implementation. " + ++ "Any features which are omitted from the set are assumed to be unsupported or nonrequired.") [ + + FeatureSet "Arithmetic" "arithmetic operations" [ + feature "plus" "the + operator", + feature "minus" "the - operator", + feature "multiply" "the * operator", + feature "divide" "the / operator", + feature "modulus" "the % operator", + feature "powerOf" "the ^ operator"], + + FeatureSet "Atom" "various kinds of atomic expressions" [ + feature "caseExpression" "CASE expressions", + feature "count" "the COUNT (*) expression", + feature "existentialSubquery" "existential subqueries", + feature "functionInvocation" "function invocation", + feature "parameter" "parameter expressions", + feature "patternComprehension" "pattern comprehensions", + feature "patternPredicate" "relationship patterns as subexpressions", + fixed $ feature "variable" "variable expressions"], + + FeatureSet "Comparison" "comparison operators and functions" [ + feature "equal" "the = comparison operator", + feature "greaterThan" "the > comparison operator", + feature "greaterThanOrEqual" "the >= comparison operator", + feature "lessThan" "the < comparison operator", + feature "lessThanOrEqual" "the <= comparison operator", + feature "notEqual" "the <> comparison operator"], + + FeatureSet "Delete" "delete operations" [ + feature "delete" "the basic DELETE clause", + feature "detachDelete" "the DETACH DELETE clause"], + + FeatureSet "Function" "standard Cypher functions" (libraryToFeatureSet <$> cypherLibraries), + + FeatureSet "List" "list functionality" [ + feature "listComprehension" "basic list comprehensions", + feature "listRange" "list range comprehensions (e.g. [1..10])"], + + FeatureSet "Literal" "various types of literal values" [ + fixed $ feature "boolean" "boolean literals", + feature "double" "double-precision floating-point literals", + feature "integer" "integer literals", + feature "list" "list literals", + feature "map" "map literals", + feature "null" "the NULL literal", + fixed $ feature "string" "string literals"], + + FeatureSet "Logical" "logical operations" [ + feature "and" "the AND operator", + feature "not" "the NOT operator", + feature "or" "the OR operator", + feature "xor" "the XOR operator"], + + FeatureSet "Match" "match queries" [ + feature "match" "the basic (non-optional) MATCH clause", + feature "optionalMatch" "OPTIONAL MATCH"], + + FeatureSet "Merge" "merge operations" [ + feature "merge" "the basic MERGE clause", + feature "mergeOnCreate" "MERGE with the ON CREATE action", + feature "mergeOnMatch" "MERGE with the ON MATCH action"], + + FeatureSet "NodePattern" "node patterns" [ + feature "multipleLabels" "specifying multiple labels in a node pattern", + feature "parameter" "specifying a parameter as part of a node pattern", + feature "propertyMap" "specifying a key/value map of properties in a node pattern", + fixed $ feature "variableNode" "binding a variable to a node in a node pattern", + feature "wildcardLabel" "omitting labels from a node pattern"], + + FeatureSet "Null" "IS NULL / IS NOT NULL checks" [ + feature "isNull" "the IS NULL operator", + feature "isNotNull" "the IS NOT NULL operator"], + + FeatureSet "Path" "path functions only found in OpenCypher" [ + function "shortestPath"], + + FeatureSet "ProcedureCall" "procedure calls" [ + feature "inQueryCall" "CALL within a query", + feature "standaloneCall" "standalone / top-level CALL", + -- Note: additional features are possible around YIELD + feature "yield" "the YIELD clause in CALL"], + + FeatureSet "Projection" "projections" [ + feature "limit" "the LIMIT clause", + feature "orderBy" "the ORDER BY clause", + feature "projectDistinct" "the DISTINCT keyword", + feature "projectAll" "the * projection", + feature "projectAs" "the AS keyword", + feature "skip" "the SKIP clause", + feature "sortOrder" "the ASC/ASCENDING and DESC/DESCENDING keywords"], + + FeatureSet "Quantifier" "quantifier expressions" [ + feature "all" "the ALL quantifier", + feature "any" "the ANY quantifier", + feature "none" "the NONE quantifier", + feature "single" "the SINGLE quantifier"], + + FeatureSet "RangeLiteral" "range literals within relationship patterns" [ + feature "bounds" "range literals with both lower and upper bounds", + feature "exactRange" "range literals providing an exact number of repetitions", + feature "lowerBound" "range literals with a lower bound (only)", + feature "starRange" "the * range literal", + feature "upperBound" "range literals with an upper bound (only)"], + + FeatureSet "Reading" "specific syntax related to reading data from the graph." [ + feature "union" "the UNION operator", + feature "unionAll" "the UNION ALL operator", + feature "unwind" "the UNWIND clause"], + + FeatureSet "RelationshipDirection" "relationship directions / arrow patterns" [ + feature "both" "the two-headed arrow (<-[]->) relationship direction", + feature "left" "the left arrow (<-[]-) relationship direction", + feature "neither" "the headless arrow (-[]-) relationship direction", + feature "right" "the right arrow (-[]->) relationship direction"], + + FeatureSet "RelationshipPattern" "relationship patterns" [ + feature "multipleTypes" "specifying a disjunction of multiple types in a relationship pattern", + fixed $ feature "variableRelationship" "binding a variable to a relationship in a relationship pattern", + feature "wildcardType" "omitting types from a relationship pattern"], + + FeatureSet "Remove" "REMOVE operations" [ + feature "byLabel" "REMOVE Variable:NodeLabels", + feature "byProperty" "REMOVE PropertyExpression"], + + FeatureSet "Set" "set definitions" [ + feature "propertyEquals" "defining a set using PropertyExpression = Expression", + feature "variableEquals" "defining a set using Variable = Expression", + feature "variablePlusEquals" "defining a set using Variable += Expression", + feature "variableWithNodeLabels" "defining a set using Variable:NodeLabels"], + + FeatureSet "String" "string functions/keywords only found in OpenCypher" [ + functionWithKeyword "contains" "CONTAINS", + functionWithKeyword "endsWith" "ENDS WITH", + functionWithKeyword "in" "IN", + functionWithKeyword "startsWith" "STARTS WITH"], + + FeatureSet "Updating" "specific syntax related to updating data in the graph" [ + feature "create" "the CREATE clause", + feature "set" "the SET clause", + feature "with" "multi-part queries using WITH"]] + where + feature name desc = FeatureSet name desc [] + fixed (FeatureSet name desc children) + = FeatureSet name (desc ++ " (note: included by most if not all implementations).") children + function name = FeatureSet name (funDesc name Nothing Nothing) [] + funDesc name mkeyword mdesc = "the " ++ name ++ "() function" ++ keyword ++ desc + where + keyword = Y.maybe "" (\k -> " / " ++ k) mkeyword + desc = Y.maybe "" (\d -> ". " ++ d) mdesc + functionWithKeyword name keyword = FeatureSet name (funDesc name (Just keyword) Nothing) [] + libraryToFeatureSet (CypherLibrary name desc funs) = FeatureSet (capitalize name ++ "Function") desc (toFeature <$> funs) + where + toFeature (CypherFunction name keyword forms) = FeatureSet name (funDesc name keyword $ Just desc) [] + where + -- Note: signatures are currently not used + desc = L.intercalate "; " (cypherFunctionFormDescription <$> forms) + +-- | An alternative model of (Open)Cypher features, flattened into an enumeration. +-- Usage: +-- writeProtobuf "/tmp/proto" [openCypherFeaturesEnumModule] +openCypherFeaturesEnumModule :: Module +openCypherFeaturesEnumModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A model with an enumeration of (Open)Cypher features.") + where + ns = Namespace "hydra/org/opencypher/features" + def = datatype ns + elements = [ + def "CypherFeature" $ + doc "An enumeration of (Open)Cypher features." + openCypherFeaturesEnum] + +openCypherFeaturesEnum :: Type +openCypherFeaturesEnum = union $ gatherFields True "" openCypherFeatures + where + gatherFields root prefix (FeatureSet name desc children) = if L.null children + then [FieldType (Name selfName) $ doc (capitalize desc) unit] + else L.concat (gatherFields False selfName <$> children) + where + --selfName = capitalize name + selfName = if root + then "" + else prefix ++ stripFunctionSuffix (capitalize name) + stripFunctionSuffix name = if "Function" `L.isSuffixOf` name && L.length name > flen + then removeLastN flen name + else name + where + removeLastN n xs = L.take (L.length xs - n) xs + flen = L.length ("Function" :: String) diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Functions.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Functions.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Functions.hs @@ -0,0 +1,587 @@ +module Hydra.Sources.Tier4.Ext.Cypher.Functions where + +data CypherFunction = CypherFunction { + cypherFunctionName :: String, + cypherFunctionKeyword :: Maybe String, + cypherFunctionForms :: [CypherFunctionForm]} deriving (Eq, Ord, Show) + +data CypherFunctionForm = CypherFunctionForm { + cypherFunctionFormSignature :: String, + cypherFunctionFormDescription :: String} deriving (Eq, Ord, Show) + +data CypherLibrary = CypherLibrary { + cypherLibraryName :: String, + cypherLibraryDescription :: String, + cypherLibraryFunctions :: [CypherFunction]} deriving (Eq, Ord, Show) + +cypherLibraries :: [CypherLibrary] +cypherLibraries = [ + CypherLibrary "Aggregate" "aggregate functions" [ + CypherFunction "avg" (Just "AVG") [ + CypherFunctionForm + "avg(input :: DURATION) :: DURATION" + "Returns the average of a set of DURATION values.", + CypherFunctionForm + "avg(input :: FLOAT) :: FLOAT" + "Returns the average of a set of FLOAT values.", + CypherFunctionForm + "avg(input :: INTEGER) :: INTEGER" + "Returns the average of a set of INTEGER values."], + CypherFunction "collect" (Just "COLLECT") [CypherFunctionForm + "collect(input :: ANY) :: LIST" + "Returns a list containing the values returned by an expression."], + CypherFunction "count" (Just "COUNT") [CypherFunctionForm + "count(input :: ANY) :: INTEGER" + "Returns the number of values or rows."], + CypherFunction "max" (Just "MAX") [CypherFunctionForm + "max(input :: ANY) :: ANY" + "Returns the maximum value in a set of values."], + CypherFunction "min" (Just "MIN") [CypherFunctionForm + "min(input :: ANY) :: ANY" + "Returns the minimum value in a set of values."], + CypherFunction "percentileCont" Nothing [CypherFunctionForm + "percentileCont(input :: FLOAT, percentile :: FLOAT) :: FLOAT" + "Returns the percentile of a value over a group using linear interpolation."], + CypherFunction "percentileDisc" Nothing [ + CypherFunctionForm + "percentileDisc(input :: FLOAT, percentile :: FLOAT) :: FLOAT" + "Returns the nearest FLOAT value to the given percentile over a group using a rounding method.", + CypherFunctionForm + "percentileDisc(input :: INTEGER, percentile :: FLOAT) :: INTEGER" + "Returns the nearest INTEGER value to the given percentile over a group using a rounding method."], + CypherFunction "stdev" Nothing [CypherFunctionForm + "stdev(input :: FLOAT) :: FLOAT" + "Returns the standard deviation for the given value over a group for a sample of a population."], + CypherFunction "stdevp" Nothing [CypherFunctionForm + "stdevp(input :: FLOAT) :: FLOAT" + "Returns the standard deviation for the given value over a group for an entire population."], + CypherFunction "sum" (Just "SUM") [ + CypherFunctionForm + "sum(input :: DURATION) :: DURATION" + "Returns the sum of a set of DURATION values.", + CypherFunctionForm + "sum(input :: FLOAT) :: FLOAT" + "Returns the sum of a set of FLOAT values.", + CypherFunctionForm + "sum(input :: INTEGER) :: INTEGER" + "Returns the sum of a set of INTEGER values."]], + + CypherLibrary "Database" "database functions" [ + CypherFunction "db.nameFromElementId" Nothing [CypherFunctionForm + "db.nameFromElementId(name :: STRING) :: STRING" + "Resolves the database name from the given element id. Introduced in 5.12."]], + + CypherLibrary "GenAI" "genAI functions" [ + CypherFunction "genai.vector.encode" Nothing [CypherFunctionForm + "genai.vector.encode(resource :: STRING, provider :: STRING, configuration :: MAP = {}) :: LIST" + "Encode a given resource as a vector using the named provider. Introduced in 5.17."]], + + CypherLibrary "Graph" "graph functions" [ + CypherFunction "graph.byElementId" Nothing [CypherFunctionForm + "USE graph.byElementId(elementId :: STRING)" + "Resolves the constituent graph to which a given element id belongs. Introduced in 5.13."], + CypherFunction "graph.byName" Nothing [CypherFunctionForm + "USE graph.byName(name :: STRING)" + "Resolves a constituent graph by name."], + CypherFunction "graph.names" Nothing [CypherFunctionForm + "graph.names() :: LIST" + "Returns a list containing the names of all graphs in the current composite database."], + CypherFunction "graph.propertiesByName" Nothing [CypherFunctionForm + "graph.propertiesByName(name :: STRING) :: MAP" + "Returns a map containing the properties associated with the given graph."]], + + CypherLibrary "List" "list functions" [ + CypherFunction "keys" Nothing [ + CypherFunctionForm + "keys(input :: MAP) :: LIST" + "Returns a LIST containing the STRING representations for all the property names of a MAP.", + CypherFunctionForm + "keys(input :: NODE) :: LIST" + "Returns a LIST containing the STRING representations for all the property names of a NODE.", + CypherFunctionForm + "keys(input :: RELATIONSHIP) :: LIST" + "Returns a LIST containing the STRING representations for all the property names of a RELATIONSHIP."], + CypherFunction "labels" Nothing [CypherFunctionForm + "labels(input :: NODE) :: LIST" + "Returns a LIST containing the STRING representations for all the labels of a NODE."], + CypherFunction "nodes" Nothing [CypherFunctionForm + "nodes(input :: PATH) :: LIST" + "Returns a LIST containing all the NODE values in a PATH."], + CypherFunction "range" Nothing [ + CypherFunctionForm + "range(start :: INTEGER, end :: INTEGER) :: LIST" + "Returns a LIST comprising all INTEGER values within a specified range.", + CypherFunctionForm + "range(start :: INTEGER, end :: INTEGER, step :: INTEGER) :: LIST" + "Returns a LIST comprising all INTEGER values within a specified range created with step length."], + CypherFunction "reduce" Nothing [CypherFunctionForm + "reduce(accumulator :: VARIABLE = initial :: ANY, variable :: VARIABLE IN list :: LIST | expression :: ANY) :: ANY" + "Runs an expression against individual elements of a LIST, storing the result of the expression in an accumulator."], + CypherFunction "relationships" Nothing [CypherFunctionForm + "relationships(input :: PATH) :: LIST" + "Returns a LIST containing all the RELATIONSHIP values in a PATH."], + CypherFunction "reverse" Nothing [CypherFunctionForm + "reverse(input :: LIST) :: LIST" + "Returns a LIST in which the order of all elements in the given LIST have been reversed."], + CypherFunction "tail" Nothing [CypherFunctionForm + "tail(input :: LIST) :: LIST" + "Returns all but the first element in a LIST."], + CypherFunction "toBooleanList" Nothing [CypherFunctionForm + "toBooleanList(input :: LIST) :: LIST" + "Converts a LIST of values to a LIST values. If any values are not convertible to BOOLEAN they will be null in the LIST returned."], + CypherFunction "toFloatList" Nothing [CypherFunctionForm + "toFloatList(input :: LIST) :: LIST" + "Converts a LIST to a LIST values. If any values are not convertible to FLOAT they will be null in the LIST returned."], + CypherFunction "toIntegerList" Nothing [CypherFunctionForm + "toIntegerList(input :: LIST) :: LIST" + "Converts a LIST to a LIST values. If any values are not convertible to INTEGER they will be null in the LIST returned."], + CypherFunction "toStringList" Nothing [CypherFunctionForm + "toStringList(input :: LIST) :: LIST" + "Converts a LIST to a LIST values. If any values are not convertible to STRING they will be null in the LIST returned."]], + + CypherLibrary "LoadCSV" "load CSV functions" [ + CypherFunction "file" Nothing [CypherFunctionForm + "file() :: STRING" + "Returns the absolute path of the file that LOAD CSV is using."], + CypherFunction "linenumber" Nothing [CypherFunctionForm + "linenumber() :: INTEGER" + "Returns the line number that LOAD CSV is currently using."]], + + CypherLibrary "Logarithmic" "logarithmic functions" [ + CypherFunction "e" Nothing [CypherFunctionForm + "e() :: FLOAT" + "Returns the base of the natural logarithm, e."], + CypherFunction "exp" Nothing [CypherFunctionForm + "exp(input :: FLOAT) :: FLOAT" + "Returns e^n, where e is the base of the natural logarithm, and n is the value of the argument expression."], + CypherFunction "log" Nothing [CypherFunctionForm + "log(input :: FLOAT) :: FLOAT" + "Returns the natural logarithm of a FLOAT."], + CypherFunction "log10" Nothing [CypherFunctionForm + "log10(input :: FLOAT) :: FLOAT" + "Returns the common logarithm (base 10) of a FLOAT."], + CypherFunction "sqrt" Nothing [CypherFunctionForm + "sqrt(input :: FLOAT) :: FLOAT" + "Returns the square root of a FLOAT."]], + + CypherLibrary "Numeric" "numeric functions" [ + CypherFunction "abs" Nothing [ + CypherFunctionForm + "abs(input :: FLOAT) :: FLOAT" + "Returns the absolute value of a FLOAT.", + CypherFunctionForm + "abs(input :: INTEGER) :: INTEGER" + "Returns the absolute value of an INTEGER."], + CypherFunction "ceil" Nothing [CypherFunctionForm + "ceil(input :: FLOAT) :: FLOAT" + "Returns the smallest FLOAT that is greater than or equal to a number and equal to an INTEGER."], + CypherFunction "floor" Nothing [CypherFunctionForm + "floor(input :: FLOAT) :: FLOAT" + "Returns the largest FLOAT that is less than or equal to a number and equal to an INTEGER."], + CypherFunction "isNaN" Nothing [ + CypherFunctionForm + "isNaN(input :: FLOAT) :: BOOLEAN" + "Returns true if the floating point number is NaN.", + CypherFunctionForm + "isNaN(input :: INTEGER) :: BOOLEAN" + "Returns true if the integer number is NaN."], + CypherFunction "rand" Nothing [CypherFunctionForm + "rand() :: FLOAT" + "Returns a random FLOAT in the range from 0 (inclusive) to 1 (exclusive)."], + CypherFunction "round" Nothing [ + CypherFunctionForm + "round(input :: FLOAT) :: FLOAT" + "Returns the value of a number rounded to the nearest INTEGER.", + CypherFunctionForm + "round(value :: FLOAT, precision :: INTEGER | FLOAT) :: FLOAT" + "Returns the value of a number rounded to the specified precision using rounding mode HALF_UP.", + CypherFunctionForm + "round(value :: FLOAT, precision :: INTEGER | FLOAT, mode :: STRING) :: FLOAT" + "Returns the value of a number rounded to the specified precision with the specified rounding mode."], + CypherFunction "sign" Nothing [ + CypherFunctionForm + "sign(input :: FLOAT) :: INTEGER" + "Returns the signum of a FLOAT: 0 if the number is 0, -1 for any negative number, and 1 for any positive number.", + CypherFunctionForm + "sign(input :: INTEGER) :: INTEGER" + "Returns the signum of an INTEGER: 0 if the number is 0, -1 for any negative number, and 1 for any positive number."]], + + CypherLibrary "Predicate" "predicate functions" [ + CypherFunction "all" Nothing [CypherFunctionForm + "all(variable :: VARIABLE IN list :: LIST WHERE predicate :: ANY) :: BOOLEAN" + "Returns true if the predicate holds for all elements in the given LIST."], + CypherFunction "any" Nothing [CypherFunctionForm + "any(variable :: VARIABLE IN list :: LIST WHERE predicate :: ANY) :: BOOLEAN" + "Returns true if the predicate holds for at least one element in the given LIST."], + CypherFunction "exists" Nothing [CypherFunctionForm + "exists(input :: ANY) :: BOOLEAN" + "Returns true if a match for the pattern exists in the graph."], + CypherFunction "isEmpty" Nothing [ + CypherFunctionForm + "isEmpty(input :: LIST) :: BOOLEAN" + "Checks whether a LIST is empty.", + CypherFunctionForm + "isEmpty(input :: MAP) :: BOOLEAN" + "Checks whether a MAP is empty.", + CypherFunctionForm + "isEmpty(input :: STRING) :: BOOLEAN" + "Checks whether a STRING is empty."], + CypherFunction "none" Nothing [CypherFunctionForm + "none(variable :: VARIABLE IN list :: LIST WHERE predicate :: ANY) :: BOOLEAN" + "Returns true if the predicate holds for no element in the given LIST."], + CypherFunction "single" Nothing [CypherFunctionForm + "single(variable :: VARIABLE IN list :: LIST WHERE predicate :: ANY) :: BOOLEAN" + "Returns true if the predicate holds for exactly one of the elements in the given LIST."]], + + CypherLibrary "Scalar" "scalar functions" [ + CypherFunction "char_length" Nothing [CypherFunctionForm + "char_length(input :: STRING) :: INTEGER" + "Returns the number of Unicode characters in a STRING."], + CypherFunction "character_length" Nothing [CypherFunctionForm + "character_length(input :: STRING) :: INTEGER" + "Returns the number of Unicode characters in a STRING."], + CypherFunction "coalesce" Nothing [CypherFunctionForm + "coalesce(input :: ANY) :: ANY" + "Returns the first non-null value in a list of expressions."], + CypherFunction "elementId" Nothing [ + CypherFunctionForm + "elementId(input :: NODE) :: STRING" + "Returns a node identifier, unique within a specific transaction and DBMS.", + CypherFunctionForm + "elementId(input :: RELATIONSHIP) :: STRING" + "Returns a relationship identifier, unique within a specific transaction and DBMS."], + CypherFunction "endNode" Nothing [CypherFunctionForm + "elementId(input :: RELATIONSHIP) :: STRING" + "Returns a relationship identifier, unique within a specific transaction and DBMS."], + CypherFunction "head" Nothing [CypherFunctionForm + "head(list :: LIST) :: ANY" + "Returns the first element in a LIST."], + CypherFunction "id" Nothing [ + CypherFunctionForm + "id(input :: NODE) :: INTEGER" + "[Deprecated] Returns the id of a NODE. Replaced by elementId().", + CypherFunctionForm + "id(input :: RELATIONSHIP) :: INTEGER" + "[Deprecated] Returns the id of a RELATIONSHIP. Replaced by elementId()."], + CypherFunction "last" Nothing [CypherFunctionForm + "last(list :: LIST) :: ANY" + "Returns the last element in a LIST."], + CypherFunction "length" Nothing [CypherFunctionForm + "length(input :: PATH) :: INTEGER" + "Returns the length of a PATH."], + CypherFunction "nullIf" Nothing [CypherFunctionForm + "nullIf(v1 :: ANY, v2 :: ANY) :: ANY" + "Returns null if the two given parameters are equivalent, otherwise returns the value of the first parameter."], + CypherFunction "properties" Nothing [ + CypherFunctionForm + "properties(input :: MAP) :: MAP" + "Returns a MAP containing all the properties of a MAP.", + CypherFunctionForm + "properties(input :: NODE) :: MAP" + "Returns a MAP containing all the properties of a NODE.", + CypherFunctionForm + "properties(input :: RELATIONSHIP) :: MAP" + "Returns a MAP containing all the properties of a RELATIONSHIP."], + CypherFunction "randomUUID" Nothing [CypherFunctionForm + "randomUUID() :: STRING" + "Generates a random UUID."], + CypherFunction "size" Nothing [ + CypherFunctionForm + "size(input :: LIST) :: INTEGER" + "Returns the number of items in a LIST.", + CypherFunctionForm + "size(input :: STRING) :: INTEGER" + "Returns the number of Unicode characters in a STRING."], + CypherFunction "startNode" Nothing [CypherFunctionForm + "startNode(input :: RELATIONSHIP) :: NODE" + "Returns the start NODE of a RELATIONSHIP."], + CypherFunction "toBoolean" Nothing [ + CypherFunctionForm + "toBoolean(input :: STRING) :: BOOLEAN" + "Converts a STRING value to a BOOLEAN value.", + CypherFunctionForm + "toBoolean(input :: BOOLEAN) :: BOOLEAN" + "Converts a BOOLEAN value to a BOOLEAN value.", + CypherFunctionForm + "toBoolean(input :: INTEGER) :: BOOLEAN" + "Converts an INTEGER value to a BOOLEAN value."], + CypherFunction "toBooleanOrNull" Nothing [CypherFunctionForm + "toBooleanOrNull(input :: ANY) :: BOOLEAN" + "Converts a value to a BOOLEAN value, or null if the value cannot be converted."], + CypherFunction "toFloat" Nothing [ + CypherFunctionForm + "toFloat(input :: INTEGER | FLOAT) :: FLOAT" + "Converts an INTEGER value to a FLOAT value.", + CypherFunctionForm + "toFloat(input :: STRING) :: FLOAT" + "Converts a STRING value to a FLOAT value."], + CypherFunction "toFloatOrNull" Nothing [CypherFunctionForm + "toFloatOrNull(input :: ANY) :: FLOAT" + "Converts a value to a FLOAT value, or null if the value cannot be converted."], + CypherFunction "toInteger" Nothing [ + CypherFunctionForm + "toInteger(input :: INTEGER | FLOAT) :: INTEGER" + "Converts a FLOAT value to an INTEGER value.", + CypherFunctionForm + "toInteger(input :: BOOLEAN) :: INTEGER" + "Converts a BOOLEAN value to an INTEGER value.", + CypherFunctionForm + "toInteger(input :: STRING) :: INTEGER" + "Converts a STRING value to an INTEGER value."], + CypherFunction "toIntegerOrNull" Nothing [CypherFunctionForm + "toIntegerOrNull(input :: ANY) :: INTEGER" + "Converts a value to an INTEGER value, or null if the value cannot be converted."], + CypherFunction "type" Nothing [CypherFunctionForm + "type(input :: RELATIONSHIP) :: STRING" + "Returns a STRING representation of the RELATIONSHIP type."], + CypherFunction "valueType" Nothing [CypherFunctionForm + "valueType(input :: ANY) :: STRING" + "Returns a STRING representation of the most precise value type that the given expression evaluates to."]], + + CypherLibrary "Spatial" "spatial functions" [ + CypherFunction "point.distance" Nothing [CypherFunctionForm + "point.distance(from :: POINT, to :: POINT) :: FLOAT" + "Returns a FLOAT representing the geodesic distance between any two points in the same CRS."], + CypherFunction "point" Nothing [ + CypherFunctionForm + "point(input :: MAP) :: POINT" + "Returns a 2D point object, given two coordinate values in the Cartesian coordinate system.", + CypherFunctionForm + "point(input :: MAP) :: POINT" + "Returns a 3D point object, given three coordinate values in the Cartesian coordinate system.", + CypherFunctionForm + "point(input :: MAP) :: POINT" + "Returns a 2D point object, given two coordinate values in the WGS 84 geographic coordinate system.", + CypherFunctionForm + "point(input :: MAP) :: POINT" + "Returns a 3D point object, given three coordinate values in the WGS 84 geographic coordinate system."], + CypherFunction "point.withinBBox" Nothing [CypherFunctionForm + "point.withinBBox(point :: POINT, lowerLeft :: POINT, upperRight :: POINT) :: BOOLEAN" + "Returns true if the provided point is within the bounding box defined by the two provided points, lowerLeft and upperRight."]], + + CypherLibrary "String" "string functions" [ + CypherFunction "btrim" Nothing [ + CypherFunctionForm + "btrim(original :: STRING) :: STRING" + "Returns the given STRING with leading and trailing whitespace removed.", + CypherFunctionForm + "btrim(input :: STRING, trimCharacterString :: STRING) :: STRING" + "Returns the given STRING with leading and trailing trimCharacterString characters removed. Introduced in 5.20."], + CypherFunction "left" Nothing [CypherFunctionForm + "left(original :: STRING, length :: INTEGER) :: STRING" + "Returns a STRING containing the specified number (INTEGER) of leftmost characters in the given STRING."], + CypherFunction "lower" Nothing [CypherFunctionForm + "lower(input :: STRING) :: STRING" + "Returns the given STRING in lowercase. This function is an alias to the toLower() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21."], + CypherFunction "ltrim" Nothing [ + CypherFunctionForm + "ltrim(input :: STRING) :: STRING" + "Returns the given STRING with leading whitespace removed.", + CypherFunctionForm + "ltrim(input :: STRING, trimCharacterString :: STRING) :: STRING" + "Returns the given STRING with leading trimCharacterString characters removed. Introduced in 5.20."], + CypherFunction "normalize" Nothing [ + CypherFunctionForm + "normalize(input :: STRING) :: STRING" + "Returns the given STRING normalized according to the normalization CypherFunctionForm NFC. Introduced in 5.17.", + CypherFunctionForm + "normalize(input :: STRING, normalForm = NFC :: [NFC, NFD, NFKC, NFKD]) :: STRING" + "Returns the given STRING normalized according to the specified normalization CypherFunctionForm. Introduced in 5.17."], + CypherFunction "replace" Nothing [CypherFunctionForm + "replace(original :: STRING, search :: STRING, replace :: STRING) :: STRING" + "Returns a STRING in which all occurrences of a specified search STRING in the given STRING have been replaced by another (specified) replacement STRING."], + CypherFunction "reverse" Nothing [CypherFunctionForm + "reverse(input :: STRING) :: STRING" + "Returns a STRING in which the order of all characters in the given STRING have been reversed."], + CypherFunction "right" Nothing [CypherFunctionForm + "right(original :: STRING, length :: INTEGER) :: STRING" + "Returns a STRING containing the specified number of rightmost characters in the given STRING."], + CypherFunction "rtrim" Nothing [ + CypherFunctionForm + "rtrim(input :: STRING) :: STRING" + "Returns the given STRING with trailing whitespace removed.", + CypherFunctionForm + "rtrim(input :: STRING, trimCharacterString :: STRING) :: STRING" + "Returns the given STRING with trailing trimCharacterString characters removed. Introduced in 5.20."], + CypherFunction "split" Nothing [ + CypherFunctionForm + "split(original :: STRING, splitDelimiter :: STRING) :: LIST" + "Returns a LIST resulting from the splitting of the given STRING around matches of the given delimiter.", + CypherFunctionForm + "split(original :: STRING, splitDelimiters :: LIST) :: LIST" + "Returns a LIST resulting from the splitting of the given STRING around matches of any of the given delimiters."], + CypherFunction "substring" Nothing [ + CypherFunctionForm + "substring(original :: STRING, start :: INTEGER) :: STRING" + "Returns a substring of the given STRING, beginning with a 0-based index start.", + CypherFunctionForm + "substring(original :: STRING, start :: INTEGER, length :: INTEGER) :: STRING" + "Returns a substring of a given length from the given STRING, beginning with a 0-based index start."], + CypherFunction "toLower" Nothing [CypherFunctionForm + "toLower(input :: STRING) :: STRING" + "Returns the given STRING in lowercase."], + CypherFunction "toString" Nothing [CypherFunctionForm + "toString(input :: ANY) :: STRING" + "Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING."], + CypherFunction "toStringOrNull" Nothing [CypherFunctionForm + "toStringOrNull(input :: ANY) :: STRING" + "Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING, or null if the value cannot be converted."], + CypherFunction "toUpper" Nothing [CypherFunctionForm + "toUpper(input :: STRING) :: STRING" + "Returns the given STRING in uppercase."], + CypherFunction "trim" Nothing [ + CypherFunctionForm + "trim(input :: STRING) :: STRING" + "Returns the given STRING with leading and trailing whitespace removed.", + CypherFunctionForm + "trim([LEADING | TRAILING | BOTH] [trimCharacterString :: STRING] FROM input :: STRING) :: STRING" + "Returns the given STRING with the leading and/or trailing trimCharacterString character removed. Introduced in 5.20."], + CypherFunction "upper" Nothing [CypherFunctionForm + "upper(input :: STRING) :: STRING" + "Returns the given STRING in uppercase. This function is an alias to the toUpper() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21."]], + + CypherLibrary "TemporalDuration" "temporal duration functions" [ + CypherFunction "duration" Nothing [CypherFunctionForm + "duration(input :: ANY) :: DURATION" + "Constructs a DURATION value."], + CypherFunction "duration.between" Nothing [CypherFunctionForm + "duration.between(from :: ANY, to :: ANY) :: DURATION" + "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in logical units."], + CypherFunction "duration.inDays" Nothing [CypherFunctionForm + "duration.inDays(from :: ANY, to :: ANY) :: DURATION" + "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in days."], + CypherFunction "duration.inMonths" Nothing [CypherFunctionForm + "duration.inMonths(from :: ANY, to :: ANY) :: DURATION" + "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in months."], + CypherFunction "duration.inSeconds" Nothing [CypherFunctionForm + "duration.inSeconds(from :: ANY, to :: ANY) :: DURATION" + "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in seconds."]], + + CypherLibrary "TemporalInstant" "temporal instant functions" [ + CypherFunction "date" Nothing [CypherFunctionForm + "date(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE" + "Creates a DATE instant."], + CypherFunction "date.realtime" Nothing [CypherFunctionForm + "date.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE" + "Returns the current DATE instant using the realtime clock."], + CypherFunction "date.statement" Nothing [CypherFunctionForm + "date.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE" + "Returns the current DATE instant using the statement clock."], + CypherFunction "date.transaction" Nothing [CypherFunctionForm + "date.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE" + "Returns the current DATE instant using the transaction clock."], + CypherFunction "date.truncate" Nothing [CypherFunctionForm + "date.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: DATE" + "Truncates the given temporal value to a DATE instant using the specified unit."], + CypherFunction "datetime" Nothing [CypherFunctionForm + "datetime(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME" + "Creates a ZONED DATETIME instant."], + CypherFunction "datetime.fromepoch" Nothing [CypherFunctionForm + "datetime.fromepoch(seconds :: INTEGER | FLOAT, nanoseconds :: INTEGER | FLOAT) :: ZONED DATETIME" + "Creates a ZONED DATETIME given the seconds and nanoseconds since the start of the epoch."], + CypherFunction "datetime.fromepochmillis" Nothing [CypherFunctionForm + "datetime.fromepochmillis(milliseconds :: INTEGER | FLOAT) :: ZONED DATETIME" + "Creates a ZONED DATETIME given the milliseconds since the start of the epoch."], + CypherFunction "datetime.realtime" Nothing [CypherFunctionForm + "datetime.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME" + "Returns the current ZONED DATETIME instant using the realtime clock."], + CypherFunction "datetime.statement" Nothing [CypherFunctionForm + "datetime.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME" + "Returns the current ZONED DATETIME instant using the statement clock."], + CypherFunction "datetime.transaction" Nothing [CypherFunctionForm + "datetime.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME" + "Returns the current ZONED DATETIME instant using the transaction clock."], + CypherFunction "datetime.truncate" Nothing [CypherFunctionForm + "datetime.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: ZONED DATETIME" + "Truncates the given temporal value to a ZONED DATETIME instant using the specified unit."], + CypherFunction "localdatetime" Nothing [CypherFunctionForm + "localdatetime(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME" + "Creates a LOCAL DATETIME instant."], + CypherFunction "localdatetime.realtime" Nothing [CypherFunctionForm + "localdatetime.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME" + "Returns the current LOCAL DATETIME instant using the realtime clock."], + CypherFunction "localdatetime.statement" Nothing [CypherFunctionForm + "localdatetime.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME" + "Returns the current LOCAL DATETIME instant using the statement clock."], + CypherFunction "localdatetime.transaction" Nothing [CypherFunctionForm + "localdatetime.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME" + "Returns the current LOCAL DATETIME instant using the transaction clock."], + CypherFunction "localdatetime.truncate" Nothing [CypherFunctionForm + "localdatetime.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: LOCAL DATETIME" + "Truncates the given temporal value to a LOCAL DATETIME instant using the specified unit."], + CypherFunction "localtime" Nothing [CypherFunctionForm + "localtime(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME" + "Creates a LOCAL TIME instant."], + CypherFunction "localtime.realtime" Nothing [CypherFunctionForm + "localtime.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME" + "Returns the current LOCAL TIME instant using the realtime clock."], + CypherFunction "localtime.statement" Nothing [CypherFunctionForm + "localtime.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME" + "Returns the current LOCAL TIME instant using the statement clock."], + CypherFunction "localtime.transaction" Nothing [CypherFunctionForm + "localtime.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME" + "Returns the current LOCAL TIME instant using the transaction clock."], + CypherFunction "localtime.truncate" Nothing [CypherFunctionForm + "localtime.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: LOCAL TIME" + "Truncates the given temporal value to a LOCAL TIME instant using the specified unit."], + CypherFunction "time" Nothing [CypherFunctionForm + "time(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME" + "Creates a ZONED TIME instant."], + CypherFunction "time.realtime" Nothing [CypherFunctionForm + "time.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME" + "Returns the current ZONED TIME instant using the realtime clock."], + CypherFunction "time.statement" Nothing [CypherFunctionForm + "time.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME" + "Returns the current ZONED TIME instant using the statement clock."], + CypherFunction "time.transaction" Nothing [CypherFunctionForm + "time.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME" + "Returns the current ZONED TIME instant using the transaction clock."], + CypherFunction "time.truncate" Nothing [CypherFunctionForm + "time.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: ZONED TIME" + "Truncates the given temporal value to a ZONED TIME instant using the specified unit."]], + + CypherLibrary "Trigonometric" "trigonometric functions" [ + CypherFunction "acos" Nothing [CypherFunctionForm + "acos(input :: FLOAT) :: FLOAT" + "Returns the arccosine of a FLOAT in radians."], + CypherFunction "asin" Nothing [CypherFunctionForm + "asin(input :: FLOAT) :: FLOAT" + "Returns the arcsine of a FLOAT in radians."], + CypherFunction "atan" Nothing [CypherFunctionForm + "atan(input :: FLOAT) :: FLOAT" + "Returns the arctangent of a FLOAT in radians."], + CypherFunction "atan2" Nothing [CypherFunctionForm + "atan2(y :: FLOAT, x :: FLOAT) :: FLOAT" + "Returns the arctangent2 of a set of coordinates in radians."], + CypherFunction "cos" Nothing [CypherFunctionForm + "cos(input :: FLOAT) :: FLOAT" + "Returns the cosine of a FLOAT."], + CypherFunction "cot" Nothing [CypherFunctionForm + "cot(input :: FLOAT) :: FLOAT" + "Returns the cotangent of a FLOAT."], + CypherFunction "degrees" Nothing [CypherFunctionForm + "degrees(input :: FLOAT) :: FLOAT" + "Converts radians to degrees."], + CypherFunction "haversin" Nothing [CypherFunctionForm + "haversin(input :: FLOAT) :: FLOAT" + "Returns half the versine of a number."], + CypherFunction "pi" Nothing [CypherFunctionForm + "pi() :: FLOAT" + "Returns the mathematical constant pi."], + CypherFunction "radians" Nothing [CypherFunctionForm + "radians(input :: FLOAT) :: FLOAT" + "Converts degrees to radians."], + CypherFunction "sin" Nothing [CypherFunctionForm + "sin(input :: FLOAT) :: FLOAT" + "Returns the sine of a FLOAT."], + CypherFunction "tan" Nothing [CypherFunctionForm + "tan(input :: FLOAT) :: FLOAT" + "Returns the tangent of a FLOAT."]], + + CypherLibrary "Vector" "vector functions" [ + CypherFunction "vector.similarity.cosine" Nothing [CypherFunctionForm + "vector.similarity.cosine(a :: LIST, b :: LIST) :: FLOAT" + "Returns a FLOAT representing the similarity between the argument vectors based on their cosine."], + CypherFunction "vector.similarity.euclidean" Nothing [CypherFunctionForm + "vector.similarity.euclidean(a :: LIST, b :: LIST) :: FLOAT" + "Returns a FLOAT representing the similarity between the argument vectors based on their Euclidean distance."]]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/OpenCypher.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/OpenCypher.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/OpenCypher.hs @@ -0,0 +1,1049 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Cypher.OpenCypher where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +openCypherModule :: Module +openCypherModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at:\n" ++ + " https://opencypher.org/resources/") + where + ns = Namespace "hydra/ext/cypher/openCypher" + def = datatype ns + cypher = typeref ns + + elements = [ + +-- Cypher = [SP], Statement, [[SP], ';'], [SP], EOI ; +-- +-- Statement = Query ; +-- +-- Query = RegularQuery +-- | StandaloneCall +-- ; + + def "Query" $ + union [ + "regular">: cypher "RegularQuery", + "standalone">: cypher "StandaloneCall"], + +-- RegularQuery = SingleQuery, { [SP], Union } ; + + def "RegularQuery" $ + record [ + "head">: cypher "SingleQuery", + "rest">: list $ cypher "Union"], + +-- Union = ((U,N,I,O,N), SP, (A,L,L), [SP], SingleQuery) +-- | ((U,N,I,O,N), [SP], SingleQuery) +-- ; + + def "Union" $ + record [ + "all">: boolean, + "query">: cypher "SingleQuery"], + +-- SingleQuery = SinglePartQuery +-- | MultiPartQuery +-- ; + def "SingleQuery" $ + union [ + "singlePart">: cypher "SinglePartQuery", + "multiPart">: cypher "MultiPartQuery"], + +-- SinglePartQuery = ({ ReadingClause, [SP] }, Return) +-- | ({ ReadingClause, [SP] }, UpdatingClause, { [SP], UpdatingClause }, [[SP], Return]) +-- ; + + def "SinglePartQuery" $ + record [ + "reading">: list $ cypher "ReadingClause", + "updating">: list $ cypher "UpdatingClause", + "return">: optional $ cypher "Return"], + +-- MultiPartQuery = { { ReadingClause, [SP] }, { UpdatingClause, [SP] }, With, [SP] }-, SinglePartQuery ; + + def "WithClause" $ + record [ + "reading">: list $ cypher "ReadingClause", + "updating">: list $ cypher "UpdatingClause", + "with">: cypher "With"], + + def "MultiPartQuery" $ + record [ + "with">: list $ cypher "WithClause", + "body">: cypher "SinglePartQuery"], + +-- UpdatingClause = Create +-- | Merge +-- | Delete +-- | Set +-- | Remove +-- ; + + def "UpdatingClause" $ + union [ + "create">: cypher "Create", + "merge">: cypher "Merge", + "delete">: cypher "Delete", + "set">: cypher "Set", + "remove">: cypher "Remove"], + +-- ReadingClause = Match +-- | Unwind +-- | InQueryCall +-- ; + + def "ReadingClause" $ + union [ + "match">: cypher "Match", + "unwind">: cypher "Unwind", + "inQueryCall">: cypher "InQueryCall"], + +-- Match = [(O,P,T,I,O,N,A,L), SP], (M,A,T,C,H), [SP], Pattern, [[SP], Where] ; + + def "Match" $ + record [ + "optional">: boolean, + "pattern">: cypher "Pattern", + "where">: optional $ cypher "Where"], + +-- Unwind = (U,N,W,I,N,D), [SP], Expression, SP, (A,S), SP, Variable ; + + def "Unwind" $ + record [ + "expression">: cypher "Expression", + "variable">: cypher "Variable"], + +-- Merge = (M,E,R,G,E), [SP], PatternPart, { SP, MergeAction } ; + + def "Merge" $ + record [ + "patternPart">: cypher "PatternPart", + "actions">: list $ cypher "MergeAction"], + +-- MergeAction = ((O,N), SP, (M,A,T,C,H), SP, Set) +-- | ((O,N), SP, (C,R,E,A,T,E), SP, Set) +-- ; + + def "MatchOrCreate" $ + enum ["match", "create"], + + def "MergeAction" $ + record [ + "action">: cypher "MatchOrCreate", + "set">: cypher "Set"], + +-- Create = (C,R,E,A,T,E), [SP], Pattern ; + + def "Create" $ cypher "Pattern", + +-- Set = (S,E,T), [SP], SetItem, { [SP], ',', [SP], SetItem } ; + + def "Set" $ + nonemptyList $ cypher "SetItem", + +-- SetItem = (PropertyExpression, [SP], '=', [SP], Expression) +-- | (Variable, [SP], '=', [SP], Expression) +-- | (Variable, [SP], '+=', [SP], Expression) +-- | (Variable, [SP], NodeLabels) +-- ; + + def "SetItem" $ + union [ + "property">: cypher "PropertyEquals", + "variableEqual">: cypher "VariableEquals", + "variablePlusEqual">: cypher "VariablePlusEquals", + "variableLabels">: cypher "VariableAndNodeLabels"], + + def "PropertyEquals" $ + record [ + "lhs">: cypher "PropertyExpression", + "rhs">: cypher "Expression"], + + def "VariableEquals" $ + record [ + "lhs">: cypher "Variable", + "rhs">: cypher "Expression"], + + def "VariablePlusEquals" $ + record [ + "lhs">: cypher "Variable", + "rhs">: cypher "Expression"], + + def "VariableAndNodeLabels" $ + record [ + "variable">: cypher "Variable", + "labels">: cypher "NodeLabels"], + +-- Delete = [(D,E,T,A,C,H), SP], (D,E,L,E,T,E), [SP], Expression, { [SP], ',', [SP], Expression } ; + + def "Delete" $ + record [ + "detach">: boolean, + "expressions">: nonemptyList $ cypher "Expression"], + +-- Remove = (R,E,M,O,V,E), SP, RemoveItem, { [SP], ',', [SP], RemoveItem } ; + + def "Remove" $ + nonemptyList $ cypher "RemoveItem", + +-- RemoveItem = (Variable, NodeLabels) +-- | PropertyExpression +-- ; + + def "RemoveItem" $ + union [ + "variableLabels">: cypher "VariableAndNodeLabels", + "property">: cypher "PropertyExpression"], + +-- InQueryCall = (C,A,L,L), SP, ExplicitProcedureInvocation, [[SP], (Y,I,E,L,D), SP, YieldItems] ; + + def "InQueryCall" $ + record [ + "call">: cypher "ExplicitProcedureInvocation", + "yieldItems">: optional $ cypher "YieldItems"], + +-- StandaloneCall = (C,A,L,L), SP, (ExplicitProcedureInvocation | ImplicitProcedureInvocation), [[SP], (Y,I,E,L,D), SP, ('*' | YieldItems)] ; + + def "ProcedureInvocation" $ + union [ + "explicit">: cypher "ExplicitProcedureInvocation", + "implicit">: cypher "ImplicitProcedureInvocation"], + + def "StarOrYieldItems" $ + union [ + "star">: unit, + "items">: cypher "YieldItems"], + + def "StandaloneCall" $ + record [ + "call">: cypher "ProcedureInvocation", + "yieldItems">: optional $ cypher "StarOrYieldItems"], + +-- YieldItems = YieldItem, { [SP], ',', [SP], YieldItem }, [[SP], Where] ; + + def "YieldItems" $ + record [ + "items">: nonemptyList $ cypher "YieldItem", + "where">: optional $ cypher "Where"], + +-- YieldItem = [ProcedureResultField, SP, (A,S), SP], Variable ; + + def "YieldItem" $ + record [ + "field">: optional $ cypher "ProcedureResultField", + "variable">: cypher "Variable"], + +-- With = (W,I,T,H), ProjectionBody, [[SP], Where] ; + + def "With" $ + record [ + "projection">: cypher "ProjectionBody", + "where">: optional $ cypher "Where"], + +-- Return = (R,E,T,U,R,N), ProjectionBody ; + + def "Return" $ + cypher "ProjectionBody", + +-- ProjectionBody = [[SP], (D,I,S,T,I,N,C,T)], SP, ProjectionItems, [SP, Order], [SP, Skip], [SP, Limit] ; + + def "ProjectionBody" $ + record [ + "distinct">: boolean, + "projectionItems">: cypher "ProjectionItems", + "order">: optional $ cypher "Order", + "skip">: optional $ cypher "Skip", + "limit">: optional $ cypher "Limit"], + +-- ProjectionItems = ('*', { [SP], ',', [SP], ProjectionItem }) +-- | (ProjectionItem, { [SP], ',', [SP], ProjectionItem }) +-- ; + + def "ProjectionItems" $ + record [ + "star">: boolean, + "explicit">: list $ cypher "ProjectionItem"], + +-- ProjectionItem = (Expression, SP, (A,S), SP, Variable) +-- | Expression +-- ; + + def "ProjectionItem" $ + record [ + "expression">: cypher "Expression", + "variable">: optional $ cypher "Variable"], + +-- Order = (O,R,D,E,R), SP, (B,Y), SP, SortItem, { ',', [SP], SortItem } ; + + def "Order" $ + nonemptyList $ cypher "SortItem", + +-- Skip = (S,K,I,P), SP, Expression ; + + def "Skip" $ + cypher "Expression", + +-- Limit = (L,I,M,I,T), SP, Expression ; + + def "Limit" $ + cypher "Expression", + +-- SortItem = Expression, [[SP], ((A,S,C,E,N,D,I,N,G) | (A,S,C) | (D,E,S,C,E,N,D,I,N,G) | (D,E,S,C))] ; + + def "SortOrder" $ + enum ["ascending", "descending"], + + def "SortItem" $ + record [ + "expression">: cypher "Expression", + "order">: optional $ cypher "SortOrder"], + +-- Where = (W,H,E,R,E), SP, Expression ; + + def "Where" $ + cypher "Expression", + +-- Pattern = PatternPart, { [SP], ',', [SP], PatternPart } ; + + def "Pattern" $ + nonemptyList $ cypher "PatternPart", + +-- PatternPart = (Variable, [SP], '=', [SP], AnonymousPatternPart) +-- | AnonymousPatternPart +-- ; + + def "PatternPart" $ + record [ + "variable">: optional $ cypher "Variable", + "pattern">: cypher "AnonymousPatternPart"], + +-- AnonymousPatternPart = PatternElement ; + + def "AnonymousPatternPart" $ + cypher "PatternElement", + +-- PatternElement = (NodePattern, { [SP], PatternElementChain }) +-- | ('(', PatternElement, ')') +-- ; + + def "NodePatternChain" $ + record [ + "nodePattern">: cypher "NodePattern", + "chain">: list $ cypher "PatternElementChain"], + + def "PatternElement" $ + union [ + "chained">: cypher "NodePatternChain", + "parenthesized">: cypher "PatternElement"], + +-- RelationshipsPattern = NodePattern, { [SP], PatternElementChain }- ; + + def "RelationshipsPattern" $ + record [ + "nodePattern">: cypher "NodePattern", + "chain">: nonemptyList $ cypher "PatternElementChain"], + +-- NodePattern = '(', [SP], [Variable, [SP]], [NodeLabels, [SP]], [Properties, [SP]], ')' ; + def "NodePattern" $ + record [ + "variable">: optional $ cypher "Variable", + "labels">: optional $ cypher "NodeLabels", + "properties">: optional $ cypher "Properties"], + +-- PatternElementChain = RelationshipPattern, [SP], NodePattern ; + + def "PatternElementChain" $ + record [ + "relationship">: cypher "RelationshipPattern", + "node">: cypher "NodePattern"], + +-- RelationshipPattern = (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead) +-- | (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash) +-- | (Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead) +-- | (Dash, [SP], [RelationshipDetail], [SP], Dash) +-- ; + + def "RelationshipPattern" $ + record [ + "leftArrow">: boolean, + "detail">: optional $ cypher "RelationshipDetail", + "rightArrow">: boolean], + +-- RelationshipDetail = '[', [SP], [Variable, [SP]], [RelationshipTypes, [SP]], [RangeLiteral], [Properties, [SP]], ']' ; + + def "RelationshipDetail" $ + record [ + "variable">: optional $ cypher "Variable", + "types">: optional $ cypher "RelationshipTypes", + "range">: optional $ cypher "RangeLiteral", + "properties">: optional $ cypher "Properties"], + +-- Properties = MapLiteral +-- | Parameter +-- ; + + def "Properties" $ + union [ + "map">: cypher "MapLiteral", + "parameter">: cypher "Parameter"], + +-- RelationshipTypes = ':', [SP], RelTypeName, { [SP], '|', [':'], [SP], RelTypeName } ; + + -- TODO: check whether the slight difference in colon syntax is significant + def "RelationshipTypes" $ nonemptyList $ cypher "RelTypeName", + +-- NodeLabels = NodeLabel, { [SP], NodeLabel } ; + + def "NodeLabels" $ nonemptyList $ cypher "NodeLabel", + +-- NodeLabel = ':', [SP], LabelName ; + + def "NodeLabel" string, + +-- RangeLiteral = '*', [SP], [IntegerLiteral, [SP]], ['..', [SP], [IntegerLiteral, [SP]]] ; + + def "RangeLiteral" $ + record [ + "start">: optional bigint, + "end">: optional bigint], + +-- LabelName = SchemaName ; +-- +-- RelTypeName = SchemaName ; + + def "RelTypeName" string, + +-- PropertyExpression = Atom, { [SP], PropertyLookup }- ; + + def "PropertyExpression" $ + record [ + "atom">: cypher "Atom", + "lookups">: nonemptyList $ cypher "PropertyLookup"], + +-- Expression = OrExpression ; + + def "Expression" $ cypher "OrExpression", + +-- OrExpression = XorExpression, { SP, (O,R), SP, XorExpression } ; + + def "OrExpression" $ nonemptyList $ cypher "XorExpression", + +-- XorExpression = AndExpression, { SP, (X,O,R), SP, AndExpression } ; + + def "XorExpression" $ nonemptyList $ cypher "AndExpression", + +-- AndExpression = NotExpression, { SP, (A,N,D), SP, NotExpression } ; + + def "AndExpression" $ nonemptyList $ cypher "NotExpression", + +-- NotExpression = { (N,O,T), [SP] }, ComparisonExpression ; + + def "NotExpression" $ + record [ + "not">: boolean, + "expression">: cypher "ComparisonExpression"], + +-- ComparisonExpression = StringListNullPredicateExpression, { [SP], PartialComparisonExpression } ; + + def "ComparisonExpression" $ + record [ + "left">: cypher "StringListNullPredicateExpression", + "right">: list $ cypher "PartialComparisonExpression"], + +-- PartialComparisonExpression = ('=', [SP], StringListNullPredicateExpression) +-- | ('<>', [SP], StringListNullPredicateExpression) +-- | ('<', [SP], StringListNullPredicateExpression) +-- | ('>', [SP], StringListNullPredicateExpression) +-- | ('<=', [SP], StringListNullPredicateExpression) +-- | ('>=', [SP], StringListNullPredicateExpression) +-- ; + + def "ComparisonOperator" $ + enum [ + "eq", + "neq", + "lt", + "gt", + "lte", + "gte"], + + def "PartialComparisonExpression" $ + record [ + "operator">: cypher "ComparisonOperator", + "right">: cypher "StringListNullPredicateExpression"], + +-- StringListNullPredicateExpression = AddOrSubtractExpression, { StringPredicateExpression | ListPredicateExpression | NullPredicateExpression } ; + + def "StringListNullPredicateExpression" $ + record [ + "left">: cypher "AddOrSubtractExpression", + "right">: list $ cypher "StringListNullPredicateRightHandSide"], + + def "StringListNullPredicateRightHandSide" $ + union [ + "string">: cypher "StringPredicateExpression", + "list">: cypher "ListPredicateExpression", + "null">: cypher "NullPredicateExpression"], + +-- StringPredicateExpression = ((SP, (S,T,A,R,T,S), SP, (W,I,T,H)) | (SP, (E,N,D,S), SP, (W,I,T,H)) | (SP, (C,O,N,T,A,I,N,S))), [SP], AddOrSubtractExpression ; + + def "StringPredicateExpression" $ + record [ + "operator">: cypher "StringPredicateOperator", + "expression">: cypher "AddOrSubtractExpression"], + + def "StringPredicateOperator" $ + enum [ + "startsWith", + "endsWith", + "contains"], + +-- ListPredicateExpression = SP, (I,N), [SP], AddOrSubtractExpression ; + + def "ListPredicateExpression" $ + cypher "AddOrSubtractExpression", + +-- NullPredicateExpression = (SP, (I,S), SP, (N,U,L,L)) +-- | (SP, (I,S), SP, (N,O,T), SP, (N,U,L,L)) +-- ; + + def "NullPredicateExpression" $ + boolean, -- true: NULL, false: NOT NULL + +-- AddOrSubtractExpression = MultiplyDivideModuloExpression, { ([SP], '+', [SP], MultiplyDivideModuloExpression) | ([SP], '-', [SP], MultiplyDivideModuloExpression) } ; + + def "AddOrSubtractExpression" $ + record [ + "left">: cypher "MultiplyDivideModuloExpression", + "right">: list $ cypher "AddOrSubtractRightHandSide"], + + def "AddOrSubtractRightHandSide" $ + record [ + "operator">: cypher "AddOrSubtractOperator", + "expression">: cypher "MultiplyDivideModuloExpression"], + + def "AddOrSubtractOperator" $ + enum [ + "add", + "subtract"], + +-- MultiplyDivideModuloExpression = PowerOfExpression, { ([SP], '*', [SP], PowerOfExpression) | ([SP], '/', [SP], PowerOfExpression) | ([SP], '%', [SP], PowerOfExpression) } ; + + def "MultiplyDivideModuloExpression" $ + record [ + "left">: cypher "PowerOfExpression", + "right">: list $ cypher "MultiplyDivideModuloRightHandSide"], + + def "MultiplyDivideModuloRightHandSide" $ + record [ + "operator">: cypher "MultiplyDivideModuloOperator", + "expression">: cypher "PowerOfExpression"], + + def "MultiplyDivideModuloOperator" $ + enum [ + "multiply", + "divide", + "modulo"], + +-- PowerOfExpression = UnaryAddOrSubtractExpression, { [SP], '^', [SP], UnaryAddOrSubtractExpression } ; + + def "PowerOfExpression" $ nonemptyList $ cypher "UnaryAddOrSubtractExpression", + +-- UnaryAddOrSubtractExpression = NonArithmeticOperatorExpression +-- | (('+' | '-'), [SP], NonArithmeticOperatorExpression) +-- ; + + def "UnaryAddOrSubtractExpression" $ + record [ + "operator">: optional $ cypher "AddOrSubtractOperator", + "expression">: cypher "NonArithmeticOperatorExpression"], + +-- NonArithmeticOperatorExpression = Atom, { ([SP], ListOperatorExpression) | ([SP], PropertyLookup) }, [[SP], NodeLabels] ; + + def "ListOperatorExpressionOrPropertyLookup" $ + union [ + "list">: cypher "ListOperatorExpression", + "property">: cypher "PropertyLookup"], + + def "NonArithmeticOperatorExpression" $ + record [ + "atom">: cypher "Atom", + "listsAndLookups">: list $ cypher "ListOperatorExpressionOrPropertyLookup", + "labels">: optional $ cypher "NodeLabels"], + +-- ListOperatorExpression = ('[', Expression, ']') +-- | ('[', [Expression], '..', [Expression], ']') +-- ; + + def "RangeExpression" $ + record [ + "start">: optional $ cypher "Expression", + "end">: optional $ cypher "Expression"], + + def "ListOperatorExpression" $ + union [ + "single">: cypher "Expression", + "range">: cypher "RangeExpression"], + +-- PropertyLookup = '.', [SP], (PropertyKeyName) ; + + def "PropertyLookup" $ + cypher "PropertyKeyName", + +-- Atom = Literal +-- | Parameter +-- | CaseExpression +-- | ((C,O,U,N,T), [SP], '(', [SP], '*', [SP], ')') +-- | ListComprehension +-- | PatternComprehension +-- | Quantifier +-- | PatternPredicate +-- | ParenthesizedExpression +-- | FunctionInvocation +-- | ExistentialSubquery +-- | Variable +-- ; + + def "Atom" $ + union [ + "literal">: cypher "Literal", + "parameter">: cypher "Parameter", + "case">: cypher "CaseExpression", + "countStar">: unit, + "listComprehension">: cypher "ListComprehension", + "patternComprehension">: cypher "PatternComprehension", + "quantifier">: cypher "Quantifier", + "patternPredicate">: cypher "PatternPredicate", + "parenthesized">: cypher "ParenthesizedExpression", + "functionInvocation">: cypher "FunctionInvocation", + "existentialSubquery">: cypher "ExistentialSubquery", + "variable">: cypher "Variable"], + +-- CaseExpression = (((C,A,S,E), { [SP], CaseAlternative }-) | ((C,A,S,E), [SP], Expression, { [SP], CaseAlternative }-)), [[SP], (E,L,S,E), [SP], Expression], [SP], (E,N,D) ; + + def "CaseExpression" $ + record [ + "expression">: optional $ cypher "Expression", + "alternatives">: nonemptyList $ cypher "CaseAlternative", + "else">: optional $ cypher "Expression"], + +-- CaseAlternative = (W,H,E,N), [SP], Expression, [SP], (T,H,E,N), [SP], Expression ; + + def "CaseAlternative" $ + record [ + "condition">: cypher "Expression", + "result">: cypher "Expression"], + +-- ListComprehension = '[', [SP], FilterExpression, [[SP], '|', [SP], Expression], [SP], ']' ; + + def "ListComprehension" $ + record [ + "left">: cypher "FilterExpression", + "right">: optional $ cypher "Expression"], + +-- PatternComprehension = '[', [SP], [Variable, [SP], '=', [SP]], RelationshipsPattern, [SP], [Where, [SP]], '|', [SP], Expression, [SP], ']' ; + + def "PatternComprehension" $ + record [ + "variable">: optional $ cypher "Variable", + "pattern">: cypher "RelationshipsPattern", + "where">: optional $ cypher "Where", + "right">: cypher "Expression"], + +-- Quantifier = ((A,L,L), [SP], '(', [SP], FilterExpression, [SP], ')') +-- | ((A,N,Y), [SP], '(', [SP], FilterExpression, [SP], ')') +-- | ((N,O,N,E), [SP], '(', [SP], FilterExpression, [SP], ')') +-- | ((S,I,N,G,L,E), [SP], '(', [SP], FilterExpression, [SP], ')') +-- ; + + def "Quantifier" $ + record [ + "operator">: cypher "QuantifierOperator", + "expression">: cypher "FilterExpression"], + + def "QuantifierOperator" $ + enum [ + "all", + "any", + "none", + "single"], + +-- FilterExpression = IdInColl, [[SP], Where] ; + + def "FilterExpression" $ + record [ + "idInColl">: cypher "IdInColl", + "where">: optional $ cypher "Where"], + +-- PatternPredicate = RelationshipsPattern ; + + def "PatternPredicate" $ cypher "RelationshipsPattern", + +-- ParenthesizedExpression = '(', [SP], Expression, [SP], ')' ; + + def "ParenthesizedExpression" $ cypher "Expression", + +-- IdInColl = Variable, SP, (I,N), SP, Expression ; + + def "IdInColl" $ + record [ + "variable">: cypher "Variable", + "expression">: cypher "Expression"], + +-- FunctionInvocation = FunctionName, [SP], '(', [SP], [(D,I,S,T,I,N,C,T), [SP]], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ; + + def "FunctionInvocation" $ + record [ + "name">: cypher "QualifiedName", + "distinct">: boolean, + "arguments">: list $ cypher "Expression"], + +-- FunctionName = Namespace, SymbolicName ; + + def "QualifiedName" $ + record [ + "namespace">: string, + "local">: string], + +-- ExistentialSubquery = (E,X,I,S,T,S), [SP], '{', [SP], (RegularQuery | (Pattern, [[SP], Where])), [SP], '}' ; + + def "PatternWhere" $ + record [ + "pattern">: cypher "Pattern", + "where">: optional $ cypher "Where"], + + def "ExistentialSubquery" $ + union [ + "regular">: cypher "RegularQuery", + "pattern">: cypher "PatternWhere"], + +-- ExplicitProcedureInvocation = ProcedureName, [SP], '(', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ; + + def "ExplicitProcedureInvocation" $ + record [ + "name">: cypher "QualifiedName", + "arguments">: list $ cypher "Expression"], + +-- ImplicitProcedureInvocation = ProcedureName ; + + def "ImplicitProcedureInvocation" $ cypher "QualifiedName", + +-- ProcedureResultField = SymbolicName ; + + def "ProcedureResultField" string, + +-- ProcedureName = Namespace, SymbolicName ; +-- +-- Namespace = { SymbolicName, '.' } ; +-- +-- Variable = SymbolicName ; + + def "Variable" string, + +-- Literal = BooleanLiteral +-- | (N,U,L,L) +-- | NumberLiteral +-- | StringLiteral +-- | ListLiteral +-- | MapLiteral +-- ; + + def "Literal" $ + union [ + "boolean">: boolean, + "null">: unit, + "number">: cypher "NumberLiteral", + "string">: cypher "StringLiteral", + "list">: cypher "ListLiteral", + "map">: cypher "MapLiteral"], + +-- BooleanLiteral = (T,R,U,E) +-- | (F,A,L,S,E) +-- ; +-- +-- NumberLiteral = DoubleLiteral +-- | IntegerLiteral +-- ; + + def "NumberLiteral" $ + union [ + "double">: float64, + "integer">: bigint], + +-- IntegerLiteral = HexInteger +-- | OctalInteger +-- | DecimalInteger +-- ; +-- +-- HexInteger = '0x', { HexDigit }- ; +-- +-- DecimalInteger = ZeroDigit +-- | (NonZeroDigit, { Digit }) +-- ; +-- +-- OctalInteger = '0o', { OctDigit }- ; +-- +-- HexLetter = (A) +-- | (B) +-- | (C) +-- | (D) +-- | (E) +-- | (F) +-- ; +-- +-- HexDigit = Digit +-- | HexLetter +-- ; +-- +-- Digit = ZeroDigit +-- | NonZeroDigit +-- ; +-- +-- NonZeroDigit = NonZeroOctDigit +-- | '8' +-- | '9' +-- ; +-- +-- NonZeroOctDigit = '1' +-- | '2' +-- | '3' +-- | '4' +-- | '5' +-- | '6' +-- | '7' +-- ; +-- +-- OctDigit = ZeroDigit +-- | NonZeroOctDigit +-- ; +-- +-- ZeroDigit = '0' ; +-- +-- DoubleLiteral = ExponentDecimalReal +-- | RegularDecimalReal +-- ; +-- +-- ExponentDecimalReal = ({ Digit }- | ({ Digit }-, '.', { Digit }-) | ('.', { Digit }-)), (E), ['-'], { Digit }- ; +-- +-- RegularDecimalReal = { Digit }, '.', { Digit }- ; +-- +-- StringLiteral = ('"', { ANY - ('"' | '\') | EscapedChar }, '"') +-- | ("'", { ANY - ("'" | '\') | EscapedChar }, "'") +-- ; + + def "StringLiteral" string, + +-- EscapedChar = '\', ('\' | "'" | '"' | (B) | (F) | (N) | (R) | (T) | ((U), 4 * HexDigit) | ((U), 8 * HexDigit)) ; +-- +-- ListLiteral = '[', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ']' ; + + def "ListLiteral" $ + list $ cypher "Expression", + +-- MapLiteral = '{', [SP], [PropertyKeyName, [SP], ':', [SP], Expression, [SP], { ',', [SP], PropertyKeyName, [SP], ':', [SP], Expression, [SP] }], '}' ; + + def "MapLiteral" $ + list $ cypher "KeyValuePair", + + def "KeyValuePair" $ + record [ + "key">: cypher "PropertyKeyName", + "value">: cypher "Expression"], + +-- PropertyKeyName = SchemaName ; + + def "PropertyKeyName" string, + +-- Parameter = '$', (SymbolicName | DecimalInteger) ; + + def "Parameter" $ + union [ + "symbolic">: string, + "integer">: bigint]] + +-- SchemaName = SymbolicName +-- | ReservedWord +-- ; +-- +-- ReservedWord = (A,L,L) +-- | (A,S,C) +-- | (A,S,C,E,N,D,I,N,G) +-- | (B,Y) +-- | (C,R,E,A,T,E) +-- | (D,E,L,E,T,E) +-- | (D,E,S,C) +-- | (D,E,S,C,E,N,D,I,N,G) +-- | (D,E,T,A,C,H) +-- | (E,X,I,S,T,S) +-- | (L,I,M,I,T) +-- | (M,A,T,C,H) +-- | (M,E,R,G,E) +-- | (O,N) +-- | (O,P,T,I,O,N,A,L) +-- | (O,R,D,E,R) +-- | (R,E,M,O,V,E) +-- | (R,E,T,U,R,N) +-- | (S,E,T) +-- | (S,K,I,P) +-- | (W,H,E,R,E) +-- | (W,I,T,H) +-- | (U,N,I,O,N) +-- | (U,N,W,I,N,D) +-- | (A,N,D) +-- | (A,S) +-- | (C,O,N,T,A,I,N,S) +-- | (D,I,S,T,I,N,C,T) +-- | (E,N,D,S) +-- | (I,N) +-- | (I,S) +-- | (N,O,T) +-- | (O,R) +-- | (S,T,A,R,T,S) +-- | (X,O,R) +-- | (F,A,L,S,E) +-- | (T,R,U,E) +-- | (N,U,L,L) +-- | (C,O,N,S,T,R,A,I,N,T) +-- | (D,O) +-- | (F,O,R) +-- | (R,E,Q,U,I,R,E) +-- | (U,N,I,Q,U,E) +-- | (C,A,S,E) +-- | (W,H,E,N) +-- | (T,H,E,N) +-- | (E,L,S,E) +-- | (E,N,D) +-- | (M,A,N,D,A,T,O,R,Y) +-- | (S,C,A,L,A,R) +-- | (O,F) +-- | (A,D,D) +-- | (D,R,O,P) +-- ; +-- +-- SymbolicName = UnescapedSymbolicName +-- | EscapedSymbolicName +-- | HexLetter +-- | (C,O,U,N,T) +-- | (F,I,L,T,E,R) +-- | (E,X,T,R,A,C,T) +-- | (A,N,Y) +-- | (N,O,N,E) +-- | (S,I,N,G,L,E) +-- ; +-- +-- UnescapedSymbolicName = IdentifierStart, { IdentifierPart } ; +-- +-- (* Based on the unicode identifier and pattern syntax +-- * (http://www.unicode.org/reports/tr31/) +-- * And extended with a few characters. +-- *)IdentifierStart = ID_Start +-- | Pc +-- ; +-- +-- (* Based on the unicode identifier and pattern syntax +-- * (http://www.unicode.org/reports/tr31/) +-- * And extended with a few characters. +-- *)IdentifierPart = ID_Continue +-- | Sc +-- ; +-- +-- (* Any character except "`", enclosed within `backticks`. Backticks are escaped with double backticks. +-- *)EscapedSymbolicName = { '`', { ANY - ('`') }, '`' }- ; +-- +-- SP = { whitespace }- ; +-- +-- whitespace = SPACE +-- | TAB +-- | LF +-- | VT +-- | FF +-- | CR +-- | FS +-- | GS +-- | RS +-- | US +-- | ' ' +-- | '᠎' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | ' ' +-- | '
' +-- | '
' +-- | ' ' +-- | '　' +-- | ' ' +-- | ' ' +-- | ' ' +-- | Comment +-- ; +-- +-- Comment = ('/*', { ANY - ('*') | ('*', ANY - ('/')) }, '*/') +-- | ('//', { ANY - (LF | CR) }, [CR], (LF | EOI)) +-- ; +-- +-- LeftArrowHead = '<' +-- | '⟨' +-- | '〈' +-- | '﹤' +-- | '＜' +-- ; +-- +-- RightArrowHead = '>' +-- | '⟩' +-- | '〉' +-- | '﹥' +-- | '＞' +-- ; +-- +-- Dash = '-' +-- | '­' +-- | '‐' +-- | '‑' +-- | '‒' +-- | '–' +-- | '—' +-- | '―' +-- | '−' +-- | '﹘' +-- | '﹣' +-- | '－' +-- ; +-- +-- A = 'A' | 'a' ; +-- B = 'B' | 'b' ; +-- C = 'C' | 'c' ; +-- D = 'D' | 'd' ; +-- E = 'E' | 'e' ; +-- F = 'F' | 'f' ; +-- G = 'G' | 'g' ; +-- H = 'H' | 'h' ; +-- I = 'I' | 'i' ; +-- K = 'K' | 'k' ; +-- L = 'L' | 'l' ; +-- M = 'M' | 'm' ; +-- N = 'N' | 'n' ; +-- O = 'O' | 'o' ; +-- P = 'P' | 'p' ; +-- Q = 'Q' | 'q' ; +-- R = 'R' | 'r' ; +-- S = 'S' | 's' ; +-- T = 'T' | 't' ; +-- U = 'U' | 'u' ; +-- V = 'V' | 'v' ; +-- W = 'W' | 'w' ; +-- X = 'X' | 'x' ; +-- Y = 'Y' | 'y' ; diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Graphql/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Graphql/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Graphql/Syntax.hs @@ -0,0 +1,338 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Graphql.Syntax where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Grammars +import Hydra.Tools.GrammarToModule +import qualified Hydra.Grammar as G + + +and_ = terminal "&" +at_ = terminal "@" +bang_ = terminal "!" +colon_ = terminal ":" +directive_ = terminal "directive" +dollar_ = terminal "$" +ellipsis_ = terminal "..." +enum_ = terminal "enum" +equal_ = terminal "=" +extend_ = terminal "extend" +false_ = terminal "false" +implements_ = terminal "implements" +input_ = terminal "input" +interface_ = terminal "interface" +lbracket_ = terminal "[" +lcurly_ = terminal "{" +lparen_ = terminal "(" +null_ = terminal "null" +on_ = terminal "on" +or_ = terminal "or" +rbracket_ = terminal "]" +rcurly_ = terminal "}" +repeatable_ = terminal "repeatable" +rparen_ = terminal ")" +scalar_ = terminal "scalar" +schema_ = terminal "schema" +true_ = terminal "true" +type_ = terminal "type" +union_ = terminal "union" + +descriptionOpt = opt"Description" +directivesConst = "Directives" -- Directives_[Const] +directivesConstOpt = opt"Directives" -- Directives_[Const]opt + +graphqlSyntaxModule :: Module +graphqlSyntaxModule = grammarToModule ns graphqlGrammar $ + Just ("A GraphQL model. Based on the (extended) BNF at:\n" ++ + " https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary") + where + ns = Namespace "hydra/ext/org/graphql/syntax" + +graphqlGrammar :: G.Grammar +graphqlGrammar = G.Grammar $ tokenDefinitions ++ documentDefinitions + +tokenDefinitions :: [G.Production] +tokenDefinitions = [ + define "Name" [regex "[A-Za-z][A-Za-z0-9]*"], + define "IntValue" [regex "-?(0|[1-9][0-9]*)"], + define "FloatValue" [regex "-?(0|[1-9][0-9]*)([.][0-9]+|[eE][+-]?[0-9]+)"], + define "StringValue" [regex "[\"].*[\"]"]] -- TODO: the actual expression includes Unicode escape sequences + +documentDefinitions :: [G.Production] +documentDefinitions = [ + define "Document" [ + star"Definition"], + + define "Definition" [ + "executable">: "ExecutableDefinition", + "typeSystem">: "TypeSystemDefinitionOrExtension"], + + define "ExecutableDocument" [ + star"ExecutableDefinition"], + + define "ExecutableDefinition" [ + "operation">: "OperationDefinition", + "fragment">: "FragmentDefinition"], + + define "OperationDefinition" [ + list["OperationType", opt"Name", opt"VariablesDefinition", opt"Directives", "SelectionSet"], + "SelectionSet"], + + define "OperationType" [ + terminal "query", + terminal "mutation", + terminal "subscription"], + + define "SelectionSet" [ + list[lcurly_, star"Selection", rcurly_]], + + define "Selection" [ + "Field", + "FragmentSpread", + "InlineFragment"], + + define "Field" [ + list[opt"Alias", "Name", opt"Arguments", opt"Directives", opt"SelectionSet"]], + + define "Alias" [ + "Name", colon_], + + define "Arguments"{- [Const] -} [ + list[lparen_, star"Argument"{- [?Const] -}, rparen_]], + + define "Argument"{- [Const] -} [ + list["Name", colon_, "Value"{- [?Const] -}]], + + define "FragmentSpread" [ + list[ellipsis_, "FragmentName", opt"Directives"]], + + define "InlineFragment" [ + list[ellipsis_, opt"TypeCondition", opt"Directives", "SelectionSet"]], + + define "FragmentDefinition" [ + list[terminal "fragment", "FragmentName", "TypeCondition", opt"Directives", "SelectionSet"]], + + define "FragmentName" [ + "Name" {- but not on_ -}], + + define "TypeCondition" [ + on_, "NamedType"], + + define "Value"{- [Const] -} [ + {- [if not Const] -} "Variable", + "int">: "IntValue", + "float">: "FloatValue", + "string">: "StringValue", + "boolean">: "BooleanValue", + "null">: "NullValue", + "enum">: "EnumValue", + "list">: "ListValue"{- [?Const] -}, + "object">: "ObjectValue"{- [?Const] -}], + + define "BooleanValue" [ + true_, + false_], + + define "NullValue" [ + null_], + + define "EnumValue" [ + list["Name" {- but not true_ or false_ or null_ -}]], + + define "ListValue"{- [Const] -} [ + list[lbracket_, rbracket_], + list[lbracket_, star"Value"{- [?Const] -}]], + + define "ObjectValue"{- [Const] -} [ + list[lcurly_, rcurly_], + list[star"ObjectField"{- [?Const] -}]], + + define "ObjectField"{- [Const] -} [ + list["Name", colon_, "Value"{- [?Const] -}]], + + define "VariablesDefinition" [ + list["Variable", colon_, "Type", opt"DefaultValue", directivesConstOpt]], + + define "Variable" [ + "Name"], + + define "DefaultValue" [ + list[equal_, "Value"{- [Const] -}]], + + define "Type" [ + "named">: "NamedType", + "list">: "ListType", + "nonNull">: "NonNullType"], + + define "NamedType" [ + "Name"], + + define "ListType" [ + list[lbracket_, "Type", rbracket_]], + + define "NonNullType" [ + "named">: list["NamedType", bang_], + "list">: list["ListType", bang_]], + + define "Directives"{- [Const] -} [ + star("Directive"{- [?Const] -})], + + define "Directive"{- [Const] -} [ + list[at_, "Name", opt("Arguments"{- [?Const] -})]], + + define "TypeSystemDocment" [ + star"TypeSystemDefinition"], + + define "TypeSystemDefinition" [ + "schema">: "SchemaDefinition", + "type">: "TypeDefinition", + "directive">: "DirectiveDefinition"], + + define "TypeSystemExtensionDocument" [ + star"TypeSystemDefinitionOrExtension"], + + define "TypeSystemDefinitionOrExtension" [ + "definition">: "TypeSystemDefinition", + "extension">: "TypeSystemExtension"], + + define "TypeSystemExtension" [ + "schema">: "SchemaExtension", + "type">: "TypeExtension"], + + define "SchemaDefinition" [ + list[descriptionOpt, schema_, directivesConstOpt, lcurly_, "RootOperationTypeDefinition", rcurly_]], + + define "SchemaExtension" [ + list[extend_, schema_, directivesConstOpt, lcurly_, "RootOperationTypeDefinition", rcurly_], + list[extend_, schema_, directivesConst {- [lookahead != lcurly_] -}]], + + define "RootOperationTypeDefinition" [ + list["OperationType", colon_, "NamedType"]], + + define "Description" [ + "StringValue"], + + define "TypeDefinition" [ + "scalar">: "ScalarTypeDefinition", + "object">: "ObjectTypeDefinition", + "interface">: "InterfaceTypeDefinition", + "union">: "UnionTypeDefinition", + "enum">: "EnumTypeDefinition", + "inputObject">: "InputObjectTypeDefinition"], + + define "TypeExtension" [ + "scalar">: "ScalarTypeExtension", + "object">: "ObjectTypeExtension", + "interface">: "InterfaceTypeExtension", + "union">: "UnionTypeExtension", + "enum">: "EnumTypeExtension", + "inputObject">: "InputObjectTypeExtension"], + + define "ScalarTypeDefinition" [ + list[descriptionOpt, scalar_, "Name", directivesConstOpt ]], + + define "ScalarTypeExtension" [ + list[extend_, scalar_, "Name", directivesConst]], + + define "ObjectTypeDefinition" [ + list[descriptionOpt, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt, opt("FieldsDefinition") {- [lookahead != lcurly_] -}]], + + define "ObjectTypeExtension" [ + list[extend_, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"], + list[extend_, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt {- [lookahead != lcurly_] -}], + list[extend_, type_, "Name", "ImplementsInterfaces" {- [lookahead != lcurly_] -}]], + + define "ImplementsInterfaces" [ + list["ImplementsInterfaces", and_, "NamedType"], + list[implements_, opt(and_), "NamedType"]], + + define "FieldsDefinition" [ + list[lcurly_, star"FieldDefinition", rcurly_]], + + define "FieldDefinition" [ + list[descriptionOpt, "Name", opt"ArgumentsDefinition", colon_, "Type", directivesConstOpt]], + + define "ArgumentsDefinition" [ + list[lparen_, star"InputValueDefinition", rparen_]], + + define "InputValueDefinition" [ + list[descriptionOpt, "Name", colon_, "Type", opt"DefaultValue", directivesConstOpt]], + + define "InterfaceTypeDefinition" [ + list[descriptionOpt, interface_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"], + list[descriptionOpt, interface_, "Name", "ImplementsInterfaces", directivesConstOpt {- [lookahead != lcurly_] -}]], + + define "InterfaceTypeExtension" [ + list[extend_, interface_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"], + list[extend_, interface_, "Name", opt"ImplementsInterfaces", directivesConst {- [lookahead != lcurly_] -}], + list[extend_, interface_, "Name", "ImplementsInterfaces" {- [lookahead != lcurly_] -}]], + + define "UnionTypeDefinition" [ + list[descriptionOpt, union_, "Name", directivesConstOpt, opt"UnionMemberTypes"]], + + define "UnionMemberTypes" [ + list["UnionMemberTypes", or_, "NamedType"], + list[opt(or_), "NamedType"]], + + define "UnionTypeExtension" [ + list[extend_, union_, "Name", directivesConstOpt, "UnionMemberTypes"], + list[extend_, union_, "Name", directivesConst]], + + define "EnumTypeDefinition" [ + list[descriptionOpt, enum_, "Name", directivesConstOpt, opt("EnumValuesDefinition") {- [lookahead != lcurly_] -}]], + + define "EnumValuesDefinition" [ + list[lcurly_, star"EnumValueDefinition", rcurly_]], + + define "EnumValueDefinition" [ + list[descriptionOpt, "EnumValue", directivesConstOpt]], + + define "EnumTypeExtension" [ + list[extend_, enum_, "Name", directivesConstOpt, "EnumValuesDefinition"], + list[extend_, enum_, "Name", directivesConst {- [lookahead != lcurly_] -}]], + + define "InputObjectTypeDefinition" [ + list[descriptionOpt, input_, "Name", directivesConstOpt, "InputFieldsDefinition"], + list[descriptionOpt, input_, "Name", directivesConstOpt {- [lookahead != lcurly_] -}]], + + define "InputFieldsDefinition" [ + list[lcurly_, star"InputValueDefinition", rcurly_]], + + define "InputObjectTypeExtension" [ + list[extend_, input_, "Name", directivesConstOpt, "InputFieldsDefinition"], + list[extend_, input_, "Name", directivesConst {- [lookahead != lcurly_] -}]], + + define "DirectiveDefinition" [ + list[descriptionOpt, directive_, at_, "Name", opt"ArgumentsDefinition", opt(repeatable_), on_, "DirectiveLocations"]], + + define "DirectiveLocations" [ + list["DirectiveLocations", or_, "DirectiveLocation"], + list[opt(or_), "DirectiveLocation"]], + + define "DirectiveLocation" [ + "executable">: "ExecutableDirectiveLocation", + "typeSystem">: "TypeSystemDirectiveLocation"], + + define "ExecutableDirectiveLocation" $ terminal <$> [ + "QUERY", + "MUTATION", + "SUBSCRIPTION", + "FIELD", + "FRAGMENT_DEFINITION", + "FRAGMENT_SPREAD", + "INLINE_FRAGMENT", + "VARIABLE_DEFINITION"], + + define "TypeSystemDirectiveLocation" $ terminal <$> [ + "SCHEMA", + "SCALAR", + "OBJECT", + "FIELD_DEFINITION", + "ARGUMENT_DEFINITION", + "INTERFACE", + "UNION", + "ENUM", + "ENUM_VALUE", + "INPUT_OBJECT", + "INPUT_FIELD_DEFINITION"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Haskell/Ast.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Haskell/Ast.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Haskell/Ast.hs @@ -0,0 +1,432 @@ +module Hydra.Sources.Tier4.Ext.Haskell.Ast where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +haskellAstModule :: Module +haskellAstModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just "A Haskell syntax model, loosely based on Language.Haskell.Tools.AST" + where + ns = Namespace "hydra/ext/haskell/ast" + def = datatype ns + ast = typeref ns + + elements = [ + + def "Alternative" $ -- UAlt + doc "A pattern-matching alternative" $ + record [ + "pattern">: ast "Pattern", + "rhs">: ast "CaseRhs", + "binds">: optional $ ast "LocalBindings"], + + def "Assertion" $ -- UAssertion (UClassAssert) + doc "A type assertion" $ + union [ + "class">: ast "Assertion.Class", + "tuple">: list $ ast "Assertion"], + -- omitted for now: implicit and infix assertions + + def "Assertion.Class" $ -- UClassAssert + record [ + "name">: ast "Name", + "types">: list $ ast "Type"], + + def "CaseRhs" $ -- UCaseRhs' + doc "The right-hand side of a pattern-matching alternative" $ + -- omitted for now: guarded + ast "Expression", + + def "Constructor" $ -- UConDecl + doc "A data constructor" $ + -- omitted for now: ordinary (positional), infix + union [ + "ordinary">: ast "Constructor.Ordinary", + "record">: ast "Constructor.Record"], + + def "Constructor.Ordinary" $ + doc "An ordinary (positional) data constructor" $ + record [ + "name">: ast "Name", + "fields">: list $ ast "Type"], + + def "Constructor.Record" $ + doc "A record-style data constructor" $ + record [ + "name">: ast "Name", + "fields">: list $ ast "FieldWithComments"], + + def "ConstructorWithComments" $ + doc "A data constructor together with any comments" $ + record [ + "body">: ast "Constructor", + "comments">: optional string], + + def "DataDeclaration" $ -- UDataDecl + doc "A data type declaration" $ + record [ + "keyword">: ast "DataDeclaration.Keyword", + "context">: list $ ast "Assertion", + "head">: ast "DeclarationHead", + "constructors">: list $ ast "ConstructorWithComments", + "deriving">: list $ ast "Deriving"], + + def "DataDeclaration.Keyword" $ + doc "The 'data' versus 'newtype keyword" $ + enum ["data", "newtype"], + + def "DeclarationWithComments" $ + doc "A data declaration together with any comments" $ + record [ + "body">: ast "Declaration", + "comments">: optional string], + + def "Declaration" $ -- UDecl + doc "A data or value declaration" $ + -- omitted for now: typeFamily, typeSignature, closedTypeFamily, gDataDecl, typeInst, dataInst, gDataInst, class, inst, + -- patternSynonym, deriv, fixity, default, patTypeSig, foreignImport, foreignExport, pragma, + -- role, splice + union [ + "data">: ast "DataDeclaration", + "type">: ast "TypeDeclaration", + "valueBinding">: ast "ValueBinding", + "typedBinding">: ast "TypedBinding"], + + def "DeclarationHead" $ -- UDeclHead + doc "The left-hand side of a declaration" $ + -- omitted for now: infix application + union [ + "application">: ast "DeclarationHead.Application", + "parens">: ast "DeclarationHead", + "simple">: ast "Name"], + + def "DeclarationHead.Application" $ + doc "An application-style declaration head" $ + record [ + "function">: ast "DeclarationHead", + "operand">: ast "Variable"], + + def "Deriving" $ -- UDeriving + doc "A 'deriving' statement" $ + -- omitted for now: infix, parenthesized, and application instance heads + list $ ast "Name", + + def "Export" $ -- UExportSpec + doc "An export statement" $ + union [ + "declaration">: ast "ImportExportSpec", + "module">: ast "ModuleName"], + + def "Expression" $ -- UExpr + doc "A data expression" $ + -- omitted for now: multi-if, unboxed tuple, tuple section, unboxed tuple section, parallel array, + -- enum, parallel array enum, list comp, parallel array comp, type application, + -- (all Template Haskell constructors), pragma, arrow definition, arrow application, + -- lambda cases, static, unboxed sum, hole + union [ + "application">: ast "Expression.Application", + "case">: ast "Expression.Case", + "constructRecord">: ast "Expression.ConstructRecord", + "do">: list $ ast "Statement", -- omitted for now: do vs. mdo + "if">: ast "Expression.If", + "infixApplication">: ast "Expression.InfixApplication", + "literal">: ast "Literal", + "lambda">: ast "Expression.Lambda", + "leftSection">: ast "Expression.Section", + "let">: ast "Expression.Let", + "list">: list $ ast "Expression", + "parens">: ast "Expression", + "prefixApplication">: ast "Expression.PrefixApplication", + "rightSection">: ast "Expression.Section", + "tuple">: list $ ast "Expression", + "typeSignature">: ast "Expression.TypeSignature", + "updateRecord">: ast "Expression.UpdateRecord", + "variable">: ast "Name"], + + def "Expression.Application" $ + doc "An application expression" $ + record [ + "function">: ast "Expression", + "argument">: ast "Expression"], + + def "Expression.Case" $ + doc "A case expression" $ + record [ + "case">: ast "Expression", + "alternatives">: list $ ast "Alternative"], + + def "Expression.ConstructRecord" $ + doc "A record constructor expression" $ + record [ + "name">: ast "Name", + "fields">: list $ ast "FieldUpdate"], + + def "Expression.If" $ + doc "An 'if' expression" $ + record [ + "condition">: ast "Expression", + "then">: ast "Expression", + "else">: ast "Expression"], + + def "Expression.InfixApplication" $ + doc "An infix application expression" $ + record [ + "lhs">: ast "Expression", + "operator">: ast "Operator", + "rhs">: ast "Expression"], + + def "Expression.Lambda" $ + doc "A lambda expression" $ + record [ + "bindings">: list $ ast "Pattern", + "inner">: ast "Expression"], + + def "Expression.Let" $ + doc "A 'let' expression" $ + record [ + "bindings">: list $ ast "LocalBinding", + "inner">: ast "Expression"], + + def "Expression.PrefixApplication" $ + doc "A prefix expression" $ + record [ + "operator">: ast "Operator", + "rhs">: ast "Expression"], + + def "Expression.Section" $ + doc "A section expression" $ + record [ + "operator">: ast "Operator", + "expression">: ast "Expression"], + + def "Expression.TypeSignature" $ + doc "A type signature expression" $ + record [ + "inner">: ast "Expression", + "type">: ast "Type"], + + def "Expression.UpdateRecord" $ + doc "An update record expression" $ + record [ + "inner">: ast "Expression", + "fields">: list $ ast "FieldUpdate"], + + def "Field" $ -- UFieldDecl + doc "A field (name/type pair)" $ + record [ + "name">: ast "Name", + "type">: ast "Type"], + + def "FieldWithComments" $ + doc "A field together with any comments" $ + record [ + "field">: ast "Field", + "comments">: optional string], + + def "FieldUpdate" $ -- UFieldUpdate + doc "A field name and value" $ + -- omitted for now: pun, wildcard + record [ + "name">: ast "Name", + "value">: ast "Expression"], + + def "Import" $ -- UImportDecl + doc "An import statement" $ + -- omitted for now: source, safe, pkg + record [ + "qualified">: boolean, + "module">: ast "ModuleName", + "as">: optional $ ast "ModuleName", + "spec">: optional $ ast "Import.Spec"], + + def "Import.Spec" $ + doc "An import specification" $ + union [ + "list">: list $ ast "ImportExportSpec", + "hiding">: list $ ast "ImportExportSpec"], + + def "ImportModifier" $ -- UImportModifier + doc "An import modifier ('pattern' or 'type')" $ + enum ["pattern", "type"], + + def "ImportExportSpec" $ -- UIESpec + doc "An import or export specification" $ + record [ + "modifier">: optional $ ast "ImportModifier", + "name">: ast "Name", + "subspec">: optional $ ast "ImportExportSpec.Subspec"], + + def "ImportExportSpec.Subspec" $ + union [ + "all">: unit, + "list">: list $ ast "Name"], + + def "Literal" $ -- ULiteral + doc "A literal value" $ + -- omitted for now: frac, primChar + union [ + "char">: uint16, + "double">: float64, + "float">: float32, + "int">: int32, + "integer">: bigint, + "string">: string], + + def "LocalBinding" $ -- ULocalBind + -- omitted for now: fixity, pragma + union [ + "signature">: ast "TypeSignature", + "value">: ast "ValueBinding"], + + def "LocalBindings" $ -- ULocalBinds + list $ ast "LocalBinding", + + def "Module" $ -- UModule + -- omitted for now: pragma + record [ + "head">: optional $ ast "ModuleHead", + "imports">: list $ ast "Import", + "declarations">: list $ ast "DeclarationWithComments"], + + def "ModuleHead" $ -- UModuleHead + -- omitted for now: pragma + record [ + "comments">: optional string, + "name">: ast "ModuleName", + "exports">: list $ ast "Export"], -- UExportSpecs + + def "ModuleName" -- UModuleName + string, + + def "Name" $ -- UName + union [ + "implicit">: ast "QualifiedName", + "normal">: ast "QualifiedName", + "parens">: ast "QualifiedName"], + + def "NamePart" -- UNamePart + string, + + def "Operator" $ -- UOperator + union [ + "backtick">: ast "QualifiedName", + "normal">: ast "QualifiedName"], + + def "Pattern" $ -- UPattern + -- omitted for now: unboxed tuples, parallel arrays, irrefutable, bang, view, splice, quasiquote, plusk, unboxed sum + union [ + "application">: ast "Pattern.Application", + "as">: ast "Pattern.As", + "list">: list $ ast "Pattern", + "literal">: ast "Literal", + "name">: ast "Name", + "parens">: ast "Pattern", + "record">: ast "Pattern.Record", + "tuple">: list $ ast "Pattern", + "typed">: ast "Pattern.Typed", + "wildcard">: unit], + + def "Pattern.Application" $ + record [ + "name">: ast "Name", + "args">: list $ ast "Pattern"], + + def "Pattern.As" $ + record [ + "name">: ast "Name", + "inner">: ast "Pattern"], + + def "Pattern.Record" $ + record [ + "name">: ast "Name", + "fields">: list $ ast "PatternField"], + + def "Pattern.Typed" $ + record [ + "inner">: ast "Pattern", + "type">: ast "Type"], + + def "PatternField" $ -- UPatternField + -- omitted for now: puns, wildcards + record [ + "name">: ast "Name", + "pattern">: ast "Pattern"], + + def "QualifiedName" $ -- UQualifiedName + record [ + "qualifiers">: list $ ast "NamePart", + "unqualified">: ast "NamePart"], + + def "RightHandSide" $ -- URhs + -- omitted for now: guarded rhs + ast "Expression", + + def "Statement" $ -- UStmt + ast "Expression", + + def "Type" $ -- UType + -- omitted for now: forall, unboxed tuple, parallel array, kinded, promoted, splice, quasiquote, bang, + -- lazy, unpack, nounpack, wildcard, named wildcard, sum + union [ + "application">: ast "Type.Application", + "ctx">: ast "Type.Context", + "function">: ast "Type.Function", + "infix">: ast "Type.Infix", + "list">: ast "Type", + "parens">: ast "Type", + "tuple">: list $ ast "Type", + "variable">: ast "Name"], + + def "Type.Application" $ + record [ + "context">: ast "Type", + "argument">: ast "Type"], + + def "Type.Context" $ + record [ + "ctx">: ast "Assertion", -- UContext + "type">: ast "Type"], + + def "Type.Function" $ + record [ + "domain">: ast "Type", + "codomain">: ast "Type"], + + def "Type.Infix" $ + record [ + "lhs">: ast "Type", + "operator">: ast "Operator", + "rhs">: ast "Operator"], + + def "TypeDeclaration" $ -- UTypeDecl + record [ + "name">: ast "DeclarationHead", + "type">: ast "Type"], + + def "TypeSignature" $ -- UTypeSignature + record [ + "name">: ast "Name", + "type">: ast "Type"], + + def "TypedBinding" $ -- Added for convenience + record [ + "typeSignature">: ast "TypeSignature", + "valueBinding">: ast "ValueBinding"], + + def "ValueBinding" $ -- UValueBind + -- omitted for now: funBind + union [ + "simple">: ast "ValueBinding.Simple"], + + def "ValueBinding.Simple" $ + record [ + "pattern">: ast "Pattern", + "rhs">: ast "RightHandSide", + "localBindings">: optional $ ast "LocalBindings"], + + def "Variable" $ + -- omitted for now: kind constraints + ast "Name"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Language.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Language.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Java.Language where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Base as Base +import Hydra.Dsl.Lib.Equality as Equality +import Hydra.Dsl.Lib.Flows as Flows +import Hydra.Dsl.Lib.Lists as Lists +import Hydra.Dsl.Lib.Logic as Logic +import Hydra.Dsl.Lib.Maps as Maps +import Hydra.Dsl.Lib.Sets as Sets +import Hydra.Dsl.Lib.Strings as Strings +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types + +import qualified Data.Set as S + + +javaLanguageDefinition :: String -> TTerm a -> TElement a +javaLanguageDefinition = definitionInModule javaLanguageModule + +javaLanguageModule :: Module +javaLanguageModule = Module ns elements [hydraCodersModule, hydraBasicsModule] tier0Modules $ + Just "Language constraints for Java" + where + ns = Namespace "hydra/ext/java/language" + elements = [ + el javaMaxTupleLengthDef, + el javaLanguageDef, + el reservedWordsDef + ] + +javaMaxTupleLengthDef :: TElement Int +javaMaxTupleLengthDef = javaLanguageDefinition "javaMaxTupleLength" $ + doc ("The maximum supported length of a tuple in Hydra-Java. " + <> "Note: if this constant is changed, also change Tuples.java correspondingly") $ + int32 9 + +javaLanguageDef :: TElement (Language) +javaLanguageDef = javaLanguageDefinition "javaLanguage" $ + doc "Language constraints for Java" $ + typed languageT $ + record _Language [ + _Language_name>>: wrap _LanguageName "hydra/ext/java", + _Language_constraints>>: record _LanguageConstraints [ + _LanguageConstraints_eliminationVariants>>: Sets.fromList @@ ref eliminationVariantsDef, + _LanguageConstraints_literalVariants>>: Sets.fromList @@ list (unitVariant _LiteralVariant <$> [ + _LiteralVariant_boolean, -- boolean + _LiteralVariant_float, -- (see float types) + _LiteralVariant_integer, -- (see integer types) + _LiteralVariant_string]), -- string + _LanguageConstraints_floatTypes>>: Sets.fromList @@ list (unitVariant _FloatType <$> [ + -- Bigfloat (e.g. as Java's BigDecimal) is excluded for now + _FloatType_float32, -- float + _FloatType_float64]), -- double + _LanguageConstraints_functionVariants>>: Sets.fromList @@ ref functionVariantsDef, + _LanguageConstraints_integerTypes>>: Sets.fromList @@ list (unitVariant _IntegerType <$> [ + _IntegerType_bigint, -- BigInteger + _IntegerType_int8, -- byte (signed, 8-bit) + _IntegerType_int16, -- short (signed, 16-bit) + _IntegerType_int32, -- int (signed, 32-bit) + _IntegerType_int64, -- long (signed, 64-bit) + _IntegerType_uint16]), -- char (unsigned, 16-bit) + _LanguageConstraints_termVariants>>: Sets.fromList @@ list (unitVariant _TermVariant <$> [ + _TermVariant_application, + _TermVariant_function, + _TermVariant_let, + _TermVariant_list, + _TermVariant_literal, + _TermVariant_map, + _TermVariant_optional, + _TermVariant_product, + _TermVariant_record, + _TermVariant_set, + _TermVariant_union, + _TermVariant_variable, + _TermVariant_wrap]), + _LanguageConstraints_typeVariants>>: Sets.fromList @@ list (unitVariant _TypeVariant <$> [ + _TypeVariant_annotated, + _TypeVariant_application, + _TypeVariant_function, + _TypeVariant_lambda, + _TypeVariant_list, + _TypeVariant_literal, + _TypeVariant_map, + _TypeVariant_optional, + _TypeVariant_product, + _TypeVariant_record, + _TypeVariant_set, + _TypeVariant_union, + _TypeVariant_variable, + _TypeVariant_wrap]), + _LanguageConstraints_types>>: match _Type (Just true) [ + _Type_product>>: lambda "types" $ Equality.ltInt32 @@ (Lists.length @@ var "types") @@ (ref javaMaxTupleLengthDef) + ]]] + +reservedWordsDef :: TElement (S.Set String) +reservedWordsDef = javaLanguageDefinition "reservedWords" $ + doc "A set of reserved words in Java" $ + typed (setT stringT) $ + (Sets.fromList @@ (Lists.concat @@ list [var "specialNames", var "classNames", var "keywords", var "literals"])) + `with` [ + "specialNames">: + doc "Special names reserved for use by Hydra" $ + list ["Elements"], + + "classNames">: + doc ("java.lang classes as of JDK 7\n" + <> "See: https://docs.oracle.com/javase/7/docs/api/java/lang/package-summary.html") $ + list [ + "AbstractMethodError", "Appendable", "ArithmeticException", "ArrayIndexOutOfBoundsException", + "ArrayStoreException", "AssertionError", "AutoCloseable", "Boolean", "BootstrapMethodError", "Byte", + "CharSequence", "Character", "Class", "ClassCastException", "ClassCircularityError", "ClassFormatError", + "ClassLoader", "ClassNotFoundException", "ClassValue", "CloneNotSupportedException", "Cloneable", "Comparable", + "Compiler", "Deprecated", "Double", "Enum", "EnumConstantNotPresentException", "Error", "Exception", + "ExceptionInInitializerError", "Float", "IllegalAccessError", "IllegalAccessException", + "IllegalArgumentException", "IllegalMonitorStateException", "IllegalStateException", + "IllegalThreadStateException", "IncompatibleClassChangeError", "IndexOutOfBoundsException", + "InheritableThreadLocal", "InstantiationError", "InstantiationException", "Integer", "InternalError", + "InterruptedException", "Iterable", "LinkageError", "Long", "Math", "NegativeArraySizeException", + "NoClassDefFoundError", "NoSuchFieldError", "NoSuchFieldException", "NoSuchMethodError", "NoSuchMethodException", + "NullPointerException", "Number", "NumberFormatException", "Object", "OutOfMemoryError", "Override", "Package", + "Process", "ProcessBuilder", "Readable", "ReflectiveOperationException", "Runnable", "Runtime", + "RuntimeException", "RuntimePermission", "SafeVarargs", "SecurityException", "SecurityManager", "Short", + "StackOverflowError", "StackTraceElement", "StrictMath", "String", "StringBuffer", "StringBuilder", + "StringIndexOutOfBoundsException", "SuppressWarnings", "System", "Thread", "ThreadDeath", + "ThreadGroup", "ThreadLocal", "Throwable", "TypeNotPresentException", + "UnknownError", "UnsatisfiedLinkError", "UnsupportedClassVersionError", + "UnsupportedOperationException", "VerifyError", "VirtualMachineError", "Void"], + + "keywords">: + doc ("Keywords and literals are taken from Oracle's Java Tutorials on 2022-05-27; said to be complete for Java 1.8 only\n" + <> "See: https://docs.oracle.com/javase/tutorial/java/nutsandbolts/_keywords.html") $ + list [ + "abstract", "assert", "boolean", "break", "byte", "case", "catch", "char", "class", "const", "continue", + "default", "do", "double", "else", "enum", "extends", "final", "finally", "float", "for", "goto", "if", + "implements", "import", "instanceof", "int", "interface", "long", "native", "new", "package", "private", + "protected", "public", "return", "short", "static", "strictfp", "super", "switch", "synchronized", "this", + "throw", "throws", "transient", "try", "void", "volatile", "while"], + + "literals">: + list ["false", "null", "true"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Syntax.hs @@ -0,0 +1,1742 @@ +module Hydra.Sources.Tier4.Ext.Java.Syntax where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Types as Types +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap + + +javaSyntaxModule :: Module +javaSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A Java syntax module. Based on the Oracle Java SE 12 BNF:\n" ++ + " https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html\n" ++ + "Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments.") + where + ns = Namespace "hydra/ext/java/syntax" + def = datatype ns + java = typeref ns + + elements = [ + +--Productions from §3 (Lexical Structure) + +--Identifier: +-- IdentifierChars but not a Keyword or BooleanLiteral or NullLiteral + def "Identifier" string, +--IdentifierChars: +-- JavaLetter {JavaLetterOrDigit} +-- +--JavaLetter: +-- any Unicode character that is a "Java letter" +-- +--JavaLetterOrDigit: +-- any Unicode character that is a "Java letter-or-digit" + +--TypeIdentifier: +-- Identifier but not var + def "TypeIdentifier" $ java "Identifier", + +--Literal: + def "Literal" $ + union [ +-- NullLiteral + "null">: unit, +-- IntegerLiteral + "integer">: java "IntegerLiteral", +-- FloatingPointLiteral + "floatingPoint">: java "FloatingPointLiteral", +-- BooleanLiteral + "boolean">: boolean, +-- CharacterLiteral + "character">: uint16, +-- StringLiteral + "string">: java "StringLiteral"], + def "IntegerLiteral" $ + doc "Note: this is an approximation which ignores encoding" + bigint, + def "FloatingPointLiteral" $ + doc "Note: this is an approximation which ignores encoding" + bigfloat, + def "StringLiteral" $ + doc "Note: this is an approximation which ignores encoding" + string, + +--Productions from §4 (Types, Values, and Variables) + +--Type: + def "Type" $ union [ +-- PrimitiveType + "primitive">: java "PrimitiveTypeWithAnnotations", +-- ReferenceType + "reference">: java "ReferenceType"], + +--PrimitiveType: + def "PrimitiveTypeWithAnnotations" $ record [ + "type">: java "PrimitiveType", + "annotations">: list $ java "Annotation"], + def "PrimitiveType" $ union [ +-- {Annotation} NumericType + "numeric">: java "NumericType", +-- {Annotation} boolean + "boolean">: unit], + +--NumericType: + def "NumericType" $ union [ +-- IntegralType + "integral">: java "IntegralType", +-- FloatingPointType + "floatingPoint">: java "FloatingPointType"], + +--IntegralType: + def "IntegralType" $ enum [ +-- (one of) +-- byte short int long char + "byte", "short", "int", "long", "char"], + +--FloatingPointType: + def "FloatingPointType" $ enum [ +-- (one of) +-- float double + "float", "double"], + +--ReferenceType: + def "ReferenceType" $ union [ +-- ClassOrInterfaceType + "classOrInterface">: java "ClassOrInterfaceType", +-- TypeVariable + "variable">: java "TypeVariable", +-- ArrayType + "array">: java "ArrayType"], + +--ClassOrInterfaceType: + def "ClassOrInterfaceType" $ union [ +-- ClassType + "class">: java "ClassType", +-- InterfaceType + "interface">: java "InterfaceType"], + +--ClassType: + def "ClassType" $ record [ + "annotations">: list $ java "Annotation", + "qualifier">: java "ClassTypeQualifier", + "identifier">: java "TypeIdentifier", + "arguments">: list $ java "TypeArgument"], + def "ClassTypeQualifier" $ union [ +-- {Annotation} TypeIdentifier [TypeArguments] + "none">: unit, +-- PackageName . {Annotation} TypeIdentifier [TypeArguments] + "package">: java "PackageName", +-- ClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments] + "parent">: java "ClassOrInterfaceType"], + +--InterfaceType: +-- ClassType + def "InterfaceType" $ java "ClassType", + +--TypeVariable: +-- {Annotation} TypeIdentifier + def "TypeVariable" $ record [ + "annotations">: list $ java "Annotation", + "identifier">: java "TypeIdentifier"], + +--ArrayType: + def "ArrayType" $ record [ + "dims">: java "Dims", + "variant">: java "ArrayType.Variant"], + def "ArrayType.Variant" $ union [ +-- PrimitiveType Dims + "primitive">: java "PrimitiveTypeWithAnnotations", +-- ClassOrInterfaceType Dims + "classOrInterface">: java "ClassOrInterfaceType", +-- TypeVariable Dims + "variable">: java "TypeVariable"], + +--Dims: +-- {Annotation} [ ] {{Annotation} [ ]} + def "Dims" $ list $ list $ java "Annotation", + +--TypeParameter: +-- {TypeParameterModifier} TypeIdentifier [TypeBound] + def "TypeParameter" $ record [ + "modifiers">: list $ java "TypeParameterModifier", + "identifier">: java "TypeIdentifier", + "bound">: optional $ java "TypeBound"], + +--TypeParameterModifier: +-- Annotation + def "TypeParameterModifier" $ java "Annotation", + +--TypeBound: + def "TypeBound" $ union [ +-- extends TypeVariable + "variable">: java "TypeVariable", +-- extends ClassOrInterfaceType {AdditionalBound} + "classOrInterface">: java "TypeBound.ClassOrInterface"], + def "TypeBound.ClassOrInterface" $ record [ + "type">: java "ClassOrInterfaceType", + "additional">: list $ java "AdditionalBound"], + +--AdditionalBound: +-- & InterfaceType + def "AdditionalBound" $ java "InterfaceType", + +--TypeArguments: +-- < TypeArgumentList > +--TypeArgumentList: +-- TypeArgument {, TypeArgument} + +--TypeArgument: + def "TypeArgument" $ union [ +-- ReferenceType + "reference">: java "ReferenceType", +-- Wildcard + "wildcard">: java "Wildcard"], + +--Wildcard: +-- {Annotation} ? [WildcardBounds] + def "Wildcard" $ record [ + "annotations">: list $ java "Annotation", + "wildcard">: optional $ java "WildcardBounds"], + +--WildcardBounds: + def "WildcardBounds" $ union [ +-- extends ReferenceType + "extends">: java "ReferenceType", +-- super ReferenceType + "super">: java "ReferenceType"], + +--Productions from §6 (Names) + +--ModuleName: + def "ModuleName" $ record [ +-- Identifier + "identifier">: java "Identifier", +-- ModuleName . Identifier + "name">: optional $ java "ModuleName"], + +--PackageName: +-- Identifier +-- PackageName . Identifier + def "PackageName" $ list $ java "Identifier", + +--TypeName: + def "TypeName" $ record [ +-- TypeIdentifier + "identifier">: java "TypeIdentifier", +-- PackageOrTypeName . TypeIdentifier + "qualifier">: optional $ java "PackageOrTypeName"], + +--ExpressionName: +-- Identifier +-- AmbiguousName . Identifier + def "ExpressionName" $ record [ + "qualifier">: optional $ java "AmbiguousName", + "identifier">: java "Identifier"], + +--MethodName: +-- Identifier + def "MethodName" $ java "Identifier", + +--PackageOrTypeName: +-- Identifier +-- PackageOrTypeName . Identifier + def "PackageOrTypeName" $ list $ java "Identifier", + +--AmbiguousName: +-- Identifier +-- AmbiguousName . Identifier + def "AmbiguousName" $ list $ java "Identifier", + +--Productions from §7 (Packages and Modules) + +--CompilationUnit: + def "CompilationUnit" $ union [ +-- OrdinaryCompilationUnit + "ordinary">: java "OrdinaryCompilationUnit", +-- ModularCompilationUnit + "modular">: java "ModularCompilationUnit"], + +--OrdinaryCompilationUnit: +-- [PackageDeclaration] {ImportDeclaration} {TypeDeclaration} + def "OrdinaryCompilationUnit" $ record [ + "package">: optional $ java "PackageDeclaration", + "imports">: list $ java "ImportDeclaration", + "types">: list $ java "TypeDeclarationWithComments"], + +--ModularCompilationUnit: +-- {ImportDeclaration} ModuleDeclaration + def "ModularCompilationUnit" $ record [ + "imports">: list $ java "ImportDeclaration", + "module">: java "ModuleDeclaration"], + +--PackageDeclaration: +-- {PackageModifier} package Identifier {. Identifier} ; + def "PackageDeclaration" $ record [ + "modifiers">: list $ java "PackageModifier", + "identifiers">: list $ java "Identifier"], + +--PackageModifier: +-- Annotation + def "PackageModifier" $ java "Annotation", + +--ImportDeclaration: + def "ImportDeclaration" $ union [ +-- SingleTypeImportDeclaration + "singleType">: java "SingleTypeImportDeclaration", +-- TypeImportOnDemandDeclaration + "typeImportOnDemand">: java "TypeImportOnDemandDeclaration", +-- SingleStaticImportDeclaration + "singleStaticImport">: java "SingleStaticImportDeclaration", +-- StaticImportOnDemandDeclaration + "staticImportOnDemand">: java "StaticImportOnDemandDeclaration"], + +--SingleTypeImportDeclaration: +-- import TypeName ; + def "SingleTypeImportDeclaration" $ java "TypeName", + +--TypeImportOnDemandDeclaration: +-- import PackageOrTypeName . * ; + def "TypeImportOnDemandDeclaration" $ java "PackageOrTypeName", + +--SingleStaticImportDeclaration: +-- import static TypeName . Identifier ; + def "SingleStaticImportDeclaration" $ record [ + "typeName">: java "TypeName", + "identifier">: java "Identifier"], + +--StaticImportOnDemandDeclaration: +-- import static TypeName . * ; + def "StaticImportOnDemandDeclaration" $ java "TypeName", + +--TypeDeclaration: + def "TypeDeclaration" $ union [ +-- ClassDeclaration + "class">: java "ClassDeclaration", +-- InterfaceDeclaration + "interface">: java "InterfaceDeclaration", +-- ; + "none">: unit], + def "TypeDeclarationWithComments" $ + record [ + "value">: java "TypeDeclaration", + "comments">: optional string], + +--ModuleDeclaration: +-- {Annotation} [open] module Identifier {. Identifier} { {ModuleDirective} } + def "ModuleDeclaration" $ record [ + "annotations">: list $ java "Annotation", + "open">: boolean, + "identifiers">: list $ java "Identifier", + "directives">: list $ list $ java "ModuleDirective"], + +--ModuleDirective: + def "ModuleDirective" $ union [ +-- requires {RequiresModifier} ModuleName ; + "requires">: java "ModuleDirective.Requires", +-- exports PackageName [to ModuleName {, ModuleName}] ; + "exports">: java "ModuleDirective.ExportsOrOpens", +-- opens PackageName [to ModuleName {, ModuleName}] ; + "opens">: java "ModuleDirective.ExportsOrOpens", +-- uses TypeName ; + "uses">: java "TypeName", +-- provides TypeName with TypeName {, TypeName} ; + "provides">: java "ModuleDirective.Provides"], + def "ModuleDirective.Requires" $ record [ + "modifiers">: list $ java "RequiresModifier", + "module">: java "ModuleName"], + def "ModuleDirective.ExportsOrOpens" $ record [ + "package">: java "PackageName", + "modules">: + doc "At least one module" $ + list $ java "ModuleName"], + def "ModuleDirective.Provides" $ record [ + "to">: java "TypeName", + "with">: + doc "At least one type" $ + list $ java "TypeName"], + +--RequiresModifier: + def "RequiresModifier" $ enum [ +-- (one of) +-- transitive static + "transitive", "static"], + +--Productions from §8 (Classes) + +--ClassDeclaration: + def "ClassDeclaration" $ union [ +-- NormalClassDeclaration + "normal">: java "NormalClassDeclaration", +-- EnumDeclaration + "enum">: java "EnumDeclaration"], + +--NormalClassDeclaration: +-- {ClassModifier} class TypeIdentifier [TypeParameters] [Superclass] [Superinterfaces] ClassBody + def "NormalClassDeclaration" $ record [ + "modifiers">: list $ java "ClassModifier", + "identifier">: java "TypeIdentifier", + "parameters">: list $ java "TypeParameter", + "extends">: optional $ java "ClassType", + "implements">: list $ java "InterfaceType", + "body">: java "ClassBody"], + +--ClassModifier: + def "ClassModifier" $ union [ +-- (one of) +-- Annotation public protected private +-- abstract static final strictfp + "annotation">: java "Annotation", + "public">: unit, + "protected">: unit, + "private">: unit, + "abstract">: unit, + "static">: unit, + "final">: unit, + "strictfp">: unit], + +--TypeParameters: +-- < TypeParameterList > +--TypeParameterList: +-- TypeParameter {, TypeParameter} +--Superclass: +-- extends ClassType +--Superinterfaces: +-- implements InterfaceTypeList +--InterfaceTypeList: +-- InterfaceType {, InterfaceType} + +--ClassBody: +-- { {ClassBodyDeclaration} } + def "ClassBody" $ list $ java "ClassBodyDeclarationWithComments", + +--ClassBodyDeclaration: + def "ClassBodyDeclaration" $ union [ +-- ClassMemberDeclaration + "classMember">: java "ClassMemberDeclaration", +-- InstanceInitializer + "instanceInitializer">: java "InstanceInitializer", +-- StaticInitializer + "staticInitializer">: java "StaticInitializer", +-- ConstructorDeclaration + "constructorDeclaration">: java "ConstructorDeclaration"], + def "ClassBodyDeclarationWithComments" $ + record [ + "value">: java "ClassBodyDeclaration", + "comments">: optional string], + +--ClassMemberDeclaration: + def "ClassMemberDeclaration" $ union [ +-- FieldDeclaration + "field">: java "FieldDeclaration", +-- MethodDeclaration + "method">: java "MethodDeclaration", +-- ClassDeclaration + "class">: java "ClassDeclaration", +-- InterfaceDeclaration + "interface">: java "InterfaceDeclaration", +-- ; + "none">: unit], + +--FieldDeclaration: +-- {FieldModifier} UnannType VariableDeclaratorList ; + def "FieldDeclaration" $ record [ + "modifiers">: list $ java "FieldModifier", + "unannType">: java "UnannType", + "variableDeclarators">: nonemptyList $ java "VariableDeclarator"], + +--FieldModifier: +-- (one of) + def "FieldModifier" $ union [ +-- Annotation public protected private +-- static final transient volatile + "annotation">: java "Annotation", + "public">: unit, + "protected">: unit, + "private">: unit, + "static">: unit, + "final">: unit, + "transient">: unit, + "volatile">: unit], + +--VariableDeclaratorList: +-- VariableDeclarator {, VariableDeclarator} +--VariableDeclarator: +-- VariableDeclaratorId [= VariableInitializer] + def "VariableDeclarator" $ record [ + "id">: java "VariableDeclaratorId", + "initializer">: optional $ java "VariableInitializer"], + +--VariableDeclaratorId: +-- Identifier [Dims] + def "VariableDeclaratorId" $ record [ + "identifier">: java "Identifier", + "dims">: optional $ java "Dims"], + +--VariableInitializer: + def "VariableInitializer" $ union [ +-- Expression + "expression">: java "Expression", +-- ArrayInitializer + "arrayInitializer">: java "ArrayInitializer"], + +--UnannType: +-- UnannPrimitiveType +-- UnannReferenceType + def "UnannType" $ + doc "A Type which does not allow annotations" $ + java "Type", +--UnannPrimitiveType: +-- NumericType +-- boolean +--UnannReferenceType: +-- UnannClassOrInterfaceType +-- UnannTypeVariable +-- UnannArrayType +--UnannClassOrInterfaceType: +-- UnannClassType +-- UnannInterfaceType +--UnannClassType: +-- TypeIdentifier [TypeArguments] +-- PackageName . {Annotation} TypeIdentifier [TypeArguments] +-- UnannClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments] + def "UnannClassType" $ + doc "A ClassType which does not allow annotations" $ + java "ClassType", +--UnannInterfaceType: +-- UnannClassType +--UnannTypeVariable: +-- TypeIdentifier +--UnannArrayType: +-- UnannPrimitiveType Dims +-- UnannClassOrInterfaceType Dims +-- UnannTypeVariable Dims + +--MethodDeclaration: +-- {MethodModifier} MethodHeader MethodBody + def "MethodDeclaration" $ record [ + "annotations">: + doc "Note: simple methods cannot have annotations" $ + list $ java "Annotation", + "modifiers">: list $ java "MethodModifier", + "header">: java "MethodHeader", + "body">: java "MethodBody"], + +--MethodModifier: +-- (one of) + def "MethodModifier" $ union [ +-- Annotation public protected private +-- abstract static final synchronized native strictfp + "annotation">: java "Annotation", + "public">: unit, + "protected">: unit, + "private">: unit, + "abstract">: unit, + "static">: unit, + "final">: unit, + "synchronized">: unit, + "native">: unit, + "strictfb">: unit], + +--MethodHeader: +-- Result MethodDeclarator [Throws] +-- TypeParameters {Annotation} Result MethodDeclarator [Throws] + def "MethodHeader" $ record [ + "parameters">: list $ java "TypeParameter", + "result">: java "Result", + "declarator">: java "MethodDeclarator", + "throws">: optional $ java "Throws"], + +--Result: + def "Result" $ union [ +-- UnannType + "type">: java "UnannType", +-- void + "void">: unit], + +--MethodDeclarator: +-- Identifier ( [ReceiverParameter ,] [FormalParameterList] ) [Dims] + def "MethodDeclarator" $ record [ + "identifier">: java "Identifier", + "receiverParameter">: optional $ java "ReceiverParameter", + "formalParameters">: nonemptyList $ java "FormalParameter"], + +--ReceiverParameter: +-- {Annotation} UnannType [Identifier .] this + def "ReceiverParameter" $ record [ + "annotations">: list $ java "Annotation", + "unannType">: java "UnannType", + "identifier">: optional $ java "Identifier"], + +--FormalParameterList: +-- FormalParameter {, FormalParameter} +--FormalParameter: + def "FormalParameter" $ union [ +-- {VariableModifier} UnannType VariableDeclaratorId + "simple">: java "FormalParameter.Simple", +-- VariableArityParameter + "variableArity">: java "VariableArityParameter"], + def "FormalParameter.Simple" $ record [ + "modifiers">: list $ java "VariableModifier", + "type">: java "UnannType", + "id">: java "VariableDeclaratorId"], + +--VariableArityParameter: +-- {VariableModifier} UnannType {Annotation} ... Identifier + def "VariableArityParameter" $ record [ + "modifiers">: java "VariableModifier", + "type">: java "UnannType", + "annotations">: list $ java "Annotation", + "identifier">: java "Identifier"], + +--VariableModifier: + def "VariableModifier" $ union [ +-- Annotation + "annotation">: java "Annotation", +-- final + "final">: unit], + +--Throws: +-- throws ExceptionTypeList + def "Throws" $ nonemptyList $ java "ExceptionType", + +--ExceptionTypeList: +-- ExceptionType {, ExceptionType} +--ExceptionType: + def "ExceptionType" $ union [ +-- ClassType + "class">: java "ClassType", +-- TypeVariable + "variable">: java "TypeVariable"], + +--MethodBody: + def "MethodBody" $ union [ +-- Block + "block">: java "Block", +-- ; + "none">: unit], + +--InstanceInitializer: +-- Block + def "InstanceInitializer" $ java "Block", + +--StaticInitializer: +-- static Block + def "StaticInitializer" $ java "Block", + +--ConstructorDeclaration: +-- {ConstructorModifier} ConstructorDeclarator [Throws] ConstructorBody + def "ConstructorDeclaration" $ record [ + "modifiers">: list $ java "ConstructorModifier", + "constructor">: java "ConstructorDeclarator", + "throws">: optional $ java "Throws", + "body">: java "ConstructorBody"], + +--ConstructorModifier: +-- (one of) + def "ConstructorModifier" $ union [ +-- Annotation public protected private + "annotation">: java "Annotation", + "public">: unit, + "protected">: unit, + "private">: unit], + +--ConstructorDeclarator: +-- [TypeParameters] SimpleTypeName ( [ReceiverParameter ,] [FormalParameterList] ) + def "ConstructorDeclarator" $ record [ + "parameters">: list $ java "TypeParameter", + "name">: java "SimpleTypeName", + "receiverParameter">: optional $ java "ReceiverParameter", + "formalParameters">: nonemptyList $ java "FormalParameter"], + +--SimpleTypeName: +-- TypeIdentifier + def "SimpleTypeName" $ java "TypeIdentifier", + +--ConstructorBody: +-- { [ExplicitConstructorInvocation] [BlockStatements] } + def "ConstructorBody" $ record [ + "invocation">: optional $ java "ExplicitConstructorInvocation", + "statements">: list $ java "BlockStatement"], + +--ExplicitConstructorInvocation: + def "ExplicitConstructorInvocation" $ record [ + "typeArguments">: list $ java "TypeArgument", + "arguments">: list $ java "Expression", + "variant">: java "ExplicitConstructorInvocation.Variant"], + def "ExplicitConstructorInvocation.Variant" $ union [ +-- [TypeArguments] this ( [ArgumentList] ) ; + "this">: unit, +-- [TypeArguments] super ( [ArgumentList] ) ; +-- ExpressionName . [TypeArguments] super ( [ArgumentList] ) ; + "super">: optional $ java "ExpressionName", +-- Primary . [TypeArguments] super ( [ArgumentList] ) ; + "primary">: java "Primary"], + +--EnumDeclaration: +-- {ClassModifier} enum TypeIdentifier [Superinterfaces] EnumBody + def "EnumDeclaration" $ record [ + "modifiers">: list $ java "ClassModifier", + "identifier">: java "TypeIdentifier", + "implements">: list $ java "InterfaceType", + "body">: java "EnumBody"], + +--EnumBody: +-- { [EnumConstantList] [,] [EnumBodyDeclarations] } + def "EnumBody" $ list $ java "EnumBody.Element", + def "EnumBody.Element" $ record [ + "constants">: list $ java "EnumConstant", + "bodyDeclarations">: list $ java "ClassBodyDeclaration"], + +--EnumConstantList: +-- EnumConstant {, EnumConstant} +--EnumConstant: +-- {EnumConstantModifier} Identifier [( [ArgumentList] )] [ClassBody] + def "EnumConstant" $ record [ + "modifiers">: list $ java "EnumConstantModifier", + "identifier">: java "Identifier", + "arguments">: list $ list $ java "Expression", + "body">: optional $ java "ClassBody"], + +--EnumConstantModifier: +-- Annotation + def "EnumConstantModifier" $ java "Annotation", + +--EnumBodyDeclarations: +-- ; {ClassBodyDeclaration} + +--Productions from §9 (Interfaces) + +--InterfaceDeclaration: + def "InterfaceDeclaration" $ union [ +-- NormalInterfaceDeclaration + "normalInterface">: java "NormalInterfaceDeclaration", +-- AnnotationTypeDeclaration + "annotationType">: java "AnnotationTypeDeclaration"], + +--NormalInterfaceDeclaration: +-- {InterfaceModifier} interface TypeIdentifier [TypeParameters] [ExtendsInterfaces] InterfaceBody + def "NormalInterfaceDeclaration" $ record [ + "modifiers">: list $ java "InterfaceModifier", + "identifier">: java "TypeIdentifier", + "parameters">: list $ java "TypeParameter", + "extends">: list $ java "InterfaceType", + "body">: java "InterfaceBody"], + +--InterfaceModifier: +-- (one of) + def "InterfaceModifier" $ union [ +-- Annotation public protected private +-- abstract static strictfp + "annotation">: java "Annotation", + "public">: unit, + "protected">: unit, + "private">: unit, + "abstract">: unit, + "static">: unit, + "strictfb">: unit], + +--ExtendsInterfaces: +-- extends InterfaceTypeList + +--InterfaceBody: +-- { {InterfaceMemberDeclaration} } + def "InterfaceBody" $ list $ java "InterfaceMemberDeclaration", + +--InterfaceMemberDeclaration: + def "InterfaceMemberDeclaration" $ union [ +-- ConstantDeclaration + "constant">: java "ConstantDeclaration", +-- InterfaceMethodDeclaration + "interfaceMethod">: java "InterfaceMethodDeclaration", +-- ClassDeclaration + "class">: java "ClassDeclaration", +-- InterfaceDeclaration + "interface">: java "InterfaceDeclaration"], +-- ; + +--ConstantDeclaration: +-- {ConstantModifier} UnannType VariableDeclaratorList ; + def "ConstantDeclaration" $ record [ + "modifiers">: list $ java "ConstantModifier", + "type">: java "UnannType", + "variables">: nonemptyList $ java "VariableDeclarator"], + +--ConstantModifier: +-- (one of) + def "ConstantModifier" $ union [ +-- Annotation public +-- static final + "annotation">: java "Annotation", + "public">: unit, + "static">: unit, + "final">: unit], + +--InterfaceMethodDeclaration: +-- {InterfaceMethodModifier} MethodHeader MethodBody + def "InterfaceMethodDeclaration" $ record [ + "modifiers">: list $ java "InterfaceMethodModifier", + "header">: java "MethodHeader", + "body">: java "MethodBody"], + +--InterfaceMethodModifier: +-- (one of) + def "InterfaceMethodModifier" $ union [ +-- Annotation public private +-- abstract default static strictfp + "annotation">: java "Annotation", + "public">: unit, + "private">: unit, + "abstract">: unit, + "default">: unit, + "static">: unit, + "strictfp">: unit], + +--AnnotationTypeDeclaration: +-- {InterfaceModifier} @ interface TypeIdentifier AnnotationTypeBody + def "AnnotationTypeDeclaration" $ record [ + "modifiers">: list $ java "InterfaceModifier", + "identifier">: java "TypeIdentifier", + "body">: java "AnnotationTypeBody"], + +--AnnotationTypeBody: +-- { {AnnotationTypeMemberDeclaration} } + def "AnnotationTypeBody" $ list $ list $ java "AnnotationTypeMemberDeclaration", + +--AnnotationTypeMemberDeclaration: + def "AnnotationTypeMemberDeclaration" $ union [ +-- AnnotationTypeElementDeclaration + "annotationType">: java "AnnotationTypeElementDeclaration", +-- ConstantDeclaration + "constant">: java "ConstantDeclaration", +-- ClassDeclaration + "class">: java "ClassDeclaration", +-- InterfaceDeclaration + "interface">: java "InterfaceDeclaration"], +-- ; + +--AnnotationTypeElementDeclaration: +-- {AnnotationTypeElementModifier} UnannType Identifier ( ) [Dims] [DefaultValue] ; + def "AnnotationTypeElementDeclaration" $ record [ + "modifiers">: list $ java "AnnotationTypeElementModifier", + "type">: java "UnannType", + "identifier">: java "Identifier", + "dims">: optional $ java "Dims", + "default">: optional $ java "DefaultValue"], + +--AnnotationTypeElementModifier: +-- (one of) + def "AnnotationTypeElementModifier" $ union [ +-- Annotation public + "public">: java "Annotation", +-- abstract + "abstract">: unit], + +--DefaultValue: +-- default ElementValue + def "DefaultValue" $ java "ElementValue", + +--Annotation: + def "Annotation" $ union [ +-- NormalAnnotation + "normal">: java "NormalAnnotation", +-- MarkerAnnotation + "marker">: java "MarkerAnnotation", +-- SingleElementAnnotation + "singleElement">: java "SingleElementAnnotation"], + +--NormalAnnotation: +-- @ TypeName ( [ElementValuePairList] ) + def "NormalAnnotation" $ record [ + "typeName">: java "TypeName", + "pairs">: list $ java "ElementValuePair"], + +--ElementValuePairList: +-- ElementValuePair {, ElementValuePair} +--ElementValuePair: +-- Identifier = ElementValue + def "ElementValuePair" $ record [ + "key">: java "Identifier", + "value">: java "ElementValue"], + +--ElementValue: + def "ElementValue" $ union [ +-- ConditionalExpression + "conditionalExpression">: java "ConditionalExpression", +-- ElementValueArrayInitializer + "elementValueArrayInitializer">: java "ElementValueArrayInitializer", +-- Annotation + "annotation">: java "Annotation"], + +--ElementValueArrayInitializer: +-- { [ElementValueList] [,] } + def "ElementValueArrayInitializer" $ list $ java "ElementValue", +--ElementValueList: +-- ElementValue {, ElementValue} + +--MarkerAnnotation: +-- @ TypeName + def "MarkerAnnotation" $ java "TypeName", + +--SingleElementAnnotation: + def "SingleElementAnnotation" $ record [ +-- @ TypeName ( ElementValue ) + "name">: java "TypeName", + "value">: optional $ java "ElementValue"], + +-- Productions from §10 (Arrays) + +--ArrayInitializer: +-- { [VariableInitializerList] [,] } + def "ArrayInitializer" $ list $ list $ java "VariableInitializer", +--VariableInitializerList: +-- VariableInitializer {, VariableInitializer} + +--Productions from §14 (Blocks and Statements) + +--Block: +-- { [BlockStatements] } + def "Block" $ list $ java "BlockStatement", + +--BlockStatements: +-- BlockStatement {BlockStatement} +--BlockStatement: + def "BlockStatement" $ union [ +-- LocalVariableDeclarationStatement + "localVariableDeclaration">: java "LocalVariableDeclarationStatement", +-- ClassDeclaration + "class">: java "ClassDeclaration", +-- Statement + "statement">: java "Statement"], + +--LocalVariableDeclarationStatement: +-- LocalVariableDeclaration ; + def "LocalVariableDeclarationStatement" $ java "LocalVariableDeclaration", + +--LocalVariableDeclaration: +-- {VariableModifier} LocalVariableType VariableDeclaratorList + def "LocalVariableDeclaration" $ record [ + "modifiers">: list $ java "VariableModifier", + "type">: java "LocalVariableType", + "declarators">: nonemptyList $ java "VariableDeclarator"], + +--LocalVariableType: + def "LocalVariableType" $ union [ +-- UnannType + "type">: java "UnannType", +-- var + "var">: unit], + +--Statement: + def "Statement" $ union [ +-- StatementWithoutTrailingSubstatement + "withoutTrailing">: java "StatementWithoutTrailingSubstatement", +-- LabeledStatement + "labeled">: java "LabeledStatement", +-- IfThenStatement + "ifThen">: java "IfThenStatement", +-- IfThenElseStatement + "ifThenElse">: java "IfThenElseStatement", +-- WhileStatement + "while">: java "WhileStatement", +-- ForStatement + "for">: java "ForStatement"], + +--StatementNoShortIf: + def "StatementNoShortIf" $ union [ +-- StatementWithoutTrailingSubstatement + "withoutTrailing">: java "StatementWithoutTrailingSubstatement", +-- LabeledStatementNoShortIf + "labeled">: java "LabeledStatementNoShortIf", +-- IfThenElseStatementNoShortIf + "ifThenElse">: java "IfThenElseStatementNoShortIf", +-- WhileStatementNoShortIf + "while">: java "WhileStatementNoShortIf", +-- ForStatementNoShortIf + "for">: java "ForStatementNoShortIf"], + +--StatementWithoutTrailingSubstatement: + def "StatementWithoutTrailingSubstatement" $ union [ +-- Block + "block">: java "Block", +-- EmptyStatement + "empty">: java "EmptyStatement", +-- ExpressionStatement + "expression">: java "ExpressionStatement", +-- AssertStatement + "assert">: java "AssertStatement", +-- SwitchStatement + "switch">: java "SwitchStatement", +-- DoStatement + "do">: java "DoStatement", +-- BreakStatement + "break">: java "BreakStatement", +-- ContinueStatement + "continue">: java "ContinueStatement", +-- ReturnStatement + "return">: java "ReturnStatement", +-- SynchronizedStatement + "synchronized">: java "SynchronizedStatement", +-- ThrowStatement + "throw">: java "ThrowStatement", +-- TryStatement + "try">: java "TryStatement"], + +--EmptyStatement: +-- ; + def "EmptyStatement" unit, + +--LabeledStatement: +-- Identifier : Statement + def "LabeledStatement" $ record [ + "identifier">: java "Identifier", + "statement">: java "Statement"], + +--LabeledStatementNoShortIf: +-- Identifier : StatementNoShortIf + def "LabeledStatementNoShortIf" $ record [ + "identifier">: java "Identifier", + "statement">: java "StatementNoShortIf"], + +--ExpressionStatement: +-- StatementExpression ; + def "ExpressionStatement" $ java "StatementExpression", + +--StatementExpression: + def "StatementExpression" $ union [ +-- Assignment + "assignment">: java "Assignment", +-- PreIncrementExpression + "preIncrement">: java "PreIncrementExpression", +-- PreDecrementExpression + "preDecrement">: java "PreDecrementExpression", +-- PostIncrementExpression + "postIncrement">: java "PostIncrementExpression", +-- PostDecrementExpression + "postDecrement">: java "PostDecrementExpression", +-- MethodInvocation + "methodInvocation">: java "MethodInvocation", +-- ClassInstanceCreationExpression + "classInstanceCreation">: java "ClassInstanceCreationExpression"], + +--IfThenStatement: +-- if ( Expression ) Statement + def "IfThenStatement" $ record [ + "expression">: java "Expression", + "statement">: java "Statement"], + +--IfThenElseStatement: +-- if ( Expression ) StatementNoShortIf else Statement + def "IfThenElseStatement" $ record [ + "cond">: optional $ java "Expression", + "then">: java "StatementNoShortIf", + "else">: java "Statement"], + +--IfThenElseStatementNoShortIf: +-- if ( Expression ) StatementNoShortIf else StatementNoShortIf + def "IfThenElseStatementNoShortIf" $ record [ + "cond">: optional $ java "Expression", + "then">: java "StatementNoShortIf", + "else">: java "StatementNoShortIf"], + +--AssertStatement: + def "AssertStatement" $ union [ +-- assert Expression ; + "single">: java "Expression", +-- assert Expression : Expression ; + "pair">: java "AssertStatement.Pair"], + def "AssertStatement.Pair" $ record [ + "first">: java "Expression", + "second">: java "Expression"], + +--SwitchStatement: +-- switch ( Expression ) SwitchBlock + def "SwitchStatement" $ record [ + "cond">: java "Expression", + "block">: java "SwitchBlock"], + +--SwitchBlock: +-- { {SwitchBlockStatementGroup} {SwitchLabel} } + def "SwitchBlock" $ list $ java "SwitchBlock.Pair", + def "SwitchBlock.Pair" $ record [ + "statements">: list $ java "SwitchBlockStatementGroup", + "labels">: list $ java "SwitchLabel"], + +--SwitchBlockStatementGroup: +-- SwitchLabels BlockStatements + def "SwitchBlockStatementGroup" $ record [ + "labels">: nonemptyList $ java "SwitchLabel", + "statements">: nonemptyList $ java "BlockStatement"], + +--SwitchLabels: +-- SwitchLabel {SwitchLabel} +--SwitchLabel: + def "SwitchLabel" $ union [ +-- case ConstantExpression : + "constant">: java "ConstantExpression", +-- case EnumConstantName : + "enumConstant">: java "EnumConstantName", +-- default : + "default">: unit], + +--EnumConstantName: +-- Identifier + def "EnumConstantName" $ java "Identifier", + +--WhileStatement: +-- while ( Expression ) Statement + def "WhileStatement" $ record [ + "cond">: optional $ java "Expression", + "body">: java "Statement"], + +--WhileStatementNoShortIf: +-- while ( Expression ) StatementNoShortIf + def "WhileStatementNoShortIf" $ record [ + "cond">: optional $ java "Expression", + "body">: java "StatementNoShortIf"], + +--DoStatement: +-- do Statement while ( Expression ) ; + def "DoStatement" $ record [ + "body">: java "Statement", + "conde">: optional $ java "Expression"], + +--ForStatement: + def "ForStatement" $ union [ +-- BasicForStatement + "basic">: java "BasicForStatement", +-- EnhancedForStatement + "enhanced">: java "EnhancedForStatement"], + +--ForStatementNoShortIf: + def "ForStatementNoShortIf" $ union [ +-- BasicForStatementNoShortIf + "basic">: java "BasicForStatementNoShortIf", +-- EnhancedForStatementNoShortIf + "enhanced">: java "EnhancedForStatementNoShortIf"], + +--BasicForStatement: +-- for ( [ForInit] ; [Expression] ; [ForUpdate] ) Statement + def "BasicForStatement" $ record [ + "cond">: java "ForCond", + "body">: java "Statement"], + def "ForCond" $ record [ + "init">: optional $ java "ForInit", + "cond">: optional $ java "Expression", + "update">: optional $ java "ForUpdate"], +--BasicForStatementNoShortIf: +-- for ( [ForInit] ; [Expression] ; [ForUpdate] ) StatementNoShortIf + def "BasicForStatementNoShortIf" $ record [ + "cond">: java "ForCond", + "body">: java "StatementNoShortIf"], + +--ForInit: + def "ForInit" $ union [ +-- StatementExpressionList + "statements">: nonemptyList $ java "StatementExpression", +-- LocalVariableDeclaration + "localVariable">: java "LocalVariableDeclaration"], + +--ForUpdate: +-- StatementExpressionList + def "ForUpdate" $ nonemptyList $ java "StatementExpression", +-- StatementExpressionList: +-- StatementExpression {, StatementExpression} + +--EnhancedForStatement: + def "EnhancedForStatement" $ record [ +-- for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) Statement + "cond">: java "EnhancedForCond", + "body">: java "Statement"], + def "EnhancedForCond" $ record [ + "modifiers">: list $ java "VariableModifier", + "type">: java "LocalVariableType", + "id">: java "VariableDeclaratorId", + "expression">: java "Expression"], +--EnhancedForStatementNoShortIf: +-- for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) StatementNoShortIf + def "EnhancedForStatementNoShortIf" $ record [ + "cond">: java "EnhancedForCond", + "body">: java "StatementNoShortIf"], + +--BreakStatement: +-- break [Identifier] ; + def "BreakStatement" $ optional $ java "Identifier", + +--ContinueStatement: +-- continue [Identifier] ; + def "ContinueStatement" $ optional $ java "Identifier", + +--ReturnStatement: +-- return [Expression] ; + def "ReturnStatement" $ optional $ java "Expression", + +--ThrowStatement: +-- throw Expression ; + def "ThrowStatement" $ java "Expression", + +--SynchronizedStatement: +-- synchronized ( Expression ) Block + def "SynchronizedStatement" $ record [ + "expression">: java "Expression", + "block">: java "Block"], + +--TryStatement: + def "TryStatement" $ union [ +-- try Block Catches + "simple">: java "TryStatement.Simple", +-- try Block [Catches] Finally + "withFinally">: java "TryStatement.WithFinally", +-- TryWithResourcesStatement + "withResources">: java "TryWithResourcesStatement"], + def "TryStatement.Simple" $ record [ + "block">: java "Block", + "catches">: java "Catches"], + def "TryStatement.WithFinally" $ record [ + "block">: java "Block", + "catches">: optional $ java "Catches", + "finally">: java "Finally"], + +--Catches: +-- CatchClause {CatchClause} + def "Catches" $ list $ java "CatchClause", + +--CatchClause: +-- catch ( CatchFormalParameter ) Block + def "CatchClause" $ record [ + "parameter">: optional $ java "CatchFormalParameter", + "block">: java "Block"], + +--CatchFormalParameter: +-- {VariableModifier} CatchType VariableDeclaratorId + def "CatchFormalParameter" $ record [ + "modifiers">: list $ java "VariableModifier", + "type">: java "CatchType", + "id">: java "VariableDeclaratorId"], + +--CatchType: +-- UnannClassType {| ClassType} + def "CatchType" $ record [ + "type">: java "UnannClassType", + "types">: list $ java "ClassType"], + +--Finally: +-- finally Block + def "Finally" $ java "Block", + +--TryWithResourcesStatement: +-- try ResourceSpecification Block [Catches] [Finally] + def "TryWithResourcesStatement" $ record [ + "resourceSpecification">: java "ResourceSpecification", + "block">: java "Block", + "catches">: optional $ java "Catches", + "finally">: optional $ java "Finally"], + +--ResourceSpecification: +-- ( ResourceList [;] ) + def "ResourceSpecification" $ list $ java "Resource", + +--ResourceList: +-- Resource {; Resource} +--Resource: + def "Resource" $ union [ +-- {VariableModifier} LocalVariableType Identifier = Expression + "local">: java "Resource.Local", +-- VariableAccess + "variable">: java "VariableAccess"], + def "Resource.Local" $ record [ + "modifiers">: list $ java "VariableModifier", + "type">: java "LocalVariableType", + "identifier">: java "Identifier", + "expression">: java "Expression"], + +--VariableAccess: + def "VariableAccess" $ union [ +-- ExpressionName + "expressionName">: java "ExpressionName", +-- FieldAccess + "fieldAccess">: java "FieldAccess"], + +--Productions from §15 (Expressions) + +--Primary: + def "Primary" $ union [ +-- PrimaryNoNewArray + "noNewArray">: java "PrimaryNoNewArray", +-- ArrayCreationExpression + "arrayCreation">: java "ArrayCreationExpression"], + +--PrimaryNoNewArray: + def "PrimaryNoNewArray" $ union [ +-- Literal + "literal">: java "Literal", +-- ClassLiteral + "classLiteral">: java "ClassLiteral", +-- this + "this">: unit, +-- TypeName . this + "dotThis">: java "TypeName", +-- ( Expression ) + "parens">: java "Expression", +-- ClassInstanceCreationExpression + "classInstance">: java "ClassInstanceCreationExpression", +-- FieldAccess + "fieldAccess">: java "FieldAccess", +-- ArrayAccess + "arrayAccess">: java "ArrayAccess", +-- MethodInvocation + "methodInvocation">: java "MethodInvocation", +-- MethodReference + "methodReference">: java "MethodReference"], + +--ClassLiteral: + def "ClassLiteral" $ union [ +-- TypeName {[ ]} . class + "type">: java "TypeNameArray", +-- NumericType {[ ]} . class + "numericType">: java "NumericTypeArray", +-- boolean {[ ]} . class + "boolean">: java "BooleanArray", +-- void . class + "void">: unit], + def "TypeNameArray" $ union [ + "simple">: java "TypeName", + "array">: java "TypeNameArray"], + def "NumericTypeArray" $ union [ + "simple">: java "NumericType", + "array">: java "NumericTypeArray"], + def "BooleanArray" $ union [ + "simple">: unit, + "array">: java "BooleanArray"], + +--ClassInstanceCreationExpression: +-- UnqualifiedClassInstanceCreationExpression +-- ExpressionName . UnqualifiedClassInstanceCreationExpression +-- Primary . UnqualifiedClassInstanceCreationExpression + def "ClassInstanceCreationExpression" $ record [ + "qualifier">: optional $ java "ClassInstanceCreationExpression.Qualifier", + "expression">: java "UnqualifiedClassInstanceCreationExpression"], + def "ClassInstanceCreationExpression.Qualifier" $ union [ + "expression">: java "ExpressionName", + "primary">: java "Primary"], + +--UnqualifiedClassInstanceCreationExpression: +-- new [TypeArguments] ClassOrInterfaceTypeToInstantiate ( [ArgumentList] ) [ClassBody] + def "UnqualifiedClassInstanceCreationExpression" $ record [ + "typeArguments">: list $ java "TypeArgument", + "classOrInterface">: java "ClassOrInterfaceTypeToInstantiate", + "arguments">: list $ java "Expression", + "body">: optional $ java "ClassBody"], + +--ClassOrInterfaceTypeToInstantiate: +-- {Annotation} Identifier {. {Annotation} Identifier} [TypeArgumentsOrDiamond] + def "ClassOrInterfaceTypeToInstantiate" $ record [ + "identifiers">: nonemptyList $ java "AnnotatedIdentifier", + "typeArguments">: optional $ java "TypeArgumentsOrDiamond"], + def "AnnotatedIdentifier" $ record [ + "annotations">: list $ java "Annotation", + "identifier">: java "Identifier"], + +--TypeArgumentsOrDiamond: + def "TypeArgumentsOrDiamond" $ union [ +-- TypeArguments + "arguments">: nonemptyList $ java "TypeArgument", +-- <> + "diamond">: unit], + +--FieldAccess: + def "FieldAccess" $ record [ + "qualifier">: java "FieldAccess.Qualifier", + "identifier">: java "Identifier"], + def "FieldAccess.Qualifier" $ union [ +-- Primary . Identifier + "primary">: java "Primary", +-- super . Identifier + "super">: unit, +-- TypeName . super . Identifier + "typed">: java "TypeName"], + +--ArrayAccess: + def "ArrayAccess" $ record [ + "expression">: optional $ java "Expression", + "variant">: java "ArrayAccess.Variant"], + def "ArrayAccess.Variant" $ union [ +-- ExpressionName [ Expression ] + "name">: java "ExpressionName", +-- PrimaryNoNewArray [ Expression ] + "primary">: java "PrimaryNoNewArray"], + +--MethodInvocation: + def "MethodInvocation" $ record [ + "header">: java "MethodInvocation.Header", + "arguments">: list $ java "Expression"], + def "MethodInvocation.Header" $ union [ +-- MethodName ( [ArgumentList] ) + "simple">: java "MethodName", + "complex">: java "MethodInvocation.Complex"], + def "MethodInvocation.Complex" $ record [ + "variant">: java "MethodInvocation.Variant", + "typeArguments">: list $ java "TypeArgument", + "identifier">: java "Identifier"], + def "MethodInvocation.Variant" $ union [ +-- TypeName . [TypeArguments] Identifier ( [ArgumentList] ) + "type">: java "TypeName", +-- ExpressionName . [TypeArguments] Identifier ( [ArgumentList] ) + "expression">: java "ExpressionName", +-- Primary . [TypeArguments] Identifier ( [ArgumentList] ) + "primary">: java "Primary", +-- super . [TypeArguments] Identifier ( [ArgumentList] ) + "super">: unit, +-- TypeName . super . [TypeArguments] Identifier ( [ArgumentList] ) + "typeSuper">: java "TypeName"], + +--ArgumentList: +-- Expression {, Expression} + +--MethodReference: + def "MethodReference" $ union [ +-- ExpressionName :: [TypeArguments] Identifier + "expression">: java "MethodReference.Expression", +-- Primary :: [TypeArguments] Identifier + "primary">: java "MethodReference.Primary", +-- ReferenceType :: [TypeArguments] Identifier + "referenceType">: java"MethodReference.ReferenceType", +-- super :: [TypeArguments] Identifier +-- TypeName . super :: [TypeArguments] Identifier + "super">: java "MethodReference.Super", +-- ClassType :: [TypeArguments] new + "new">: java "MethodReference.New", +-- ArrayType :: new + "array">: java "MethodReference.Array"], + def "MethodReference.Expression" $ record [ + "name">: java "ExpressionName", + "typeArguments">: list $ java "TypeArgument", + "identifier">: java "Identifier"], + def "MethodReference.Primary" $ record [ + "primary">: java "Primary", + "typeArguments">: list $ java "TypeArgument", + "identifier">: java "Identifier"], + def "MethodReference.ReferenceType" $ record [ + "referenceType">: java "ReferenceType", + "typeArguments">: list $ java "TypeArgument", + "identifier">: java "Identifier"], + def "MethodReference.Super" $ record [ + "typeArguments">: list $ java "TypeArgument", + "identifier">: java "Identifier", + "super">: boolean], + def "MethodReference.New" $ record [ + "classType">: java "ClassType", + "typeArguments">: list $ java "TypeArgument"], + def "MethodReference.Array" $ java "ArrayType", + +--ArrayCreationExpression: + def "ArrayCreationExpression" $ union [ +-- new PrimitiveType DimExprs [Dims] + "primitive">: java "ArrayCreationExpression.Primitive", +-- new ClassOrInterfaceType DimExprs [Dims] + "classOrInterface">: java "ArrayCreationExpression.ClassOrInterface", +-- new PrimitiveType Dims ArrayInitializer + "primitiveArray">: java "ArrayCreationExpression.PrimitiveArray", +-- new ClassOrInterfaceType Dims ArrayInitializer + "classOrInterfaceArray">: java "ArrayCreationExpression.ClassOrInterfaceArray"], + def "ArrayCreationExpression.Primitive" $ record [ + "type">: java "PrimitiveTypeWithAnnotations", + "dimExprs">: nonemptyList $ java "DimExpr", + "dims">: optional $ java "Dims"], + def "ArrayCreationExpression.ClassOrInterface" $ record [ + "type">: java "ClassOrInterfaceType", + "dimExprs">: nonemptyList $ java "DimExpr", + "dims">: optional $ java "Dims"], + def "ArrayCreationExpression.PrimitiveArray" $ record [ + "type">: java "PrimitiveTypeWithAnnotations", + "dims">: nonemptyList $ java "Dims", + "array">: java "ArrayInitializer"], + def "ArrayCreationExpression.ClassOrInterfaceArray" $ record [ + "type">: java "ClassOrInterfaceType", + "dims">: nonemptyList $ java "Dims", + "array">: java "ArrayInitializer"], + +--DimExprs: +-- DimExpr {DimExpr} +--DimExpr: +-- {Annotation} [ Expression ] + def "DimExpr" $ record [ + "annotations">: list $ java "Annotation", + "expression">: optional $ java "Expression"], + +--Expression: + def "Expression" $ union [ +-- LambdaExpression + "lambda">: java "LambdaExpression", +-- AssignmentExpression + "assignment">: java "AssignmentExpression"], + +--LambdaExpression: +-- LambdaParameters -> LambdaBody + def "LambdaExpression" $ record [ + "parameters">: java "LambdaParameters", + "body">: java "LambdaBody"], + +--LambdaParameters: +-- ( [LambdaParameterList] ) +-- Identifier + def "LambdaParameters" $ union [ + "tuple">: list $ java "LambdaParameters", + "single">: java "Identifier"], + +--LambdaParameterList: +-- LambdaParameter {, LambdaParameter} +-- Identifier {, Identifier} +--LambdaParameter: + def "LambdaParameter" $ union [ +-- {VariableModifier} LambdaParameterType VariableDeclaratorId + "normal">: java "LambdaParameter.Normal", +-- VariableArityParameter + "variableArity">: java "VariableArityParameter"], + def "LambdaParameter.Normal" $ record [ + "modifiers">: list $ java "VariableModifier", + "type">: java "LambdaParameterType", + "id">: java "VariableDeclaratorId"], + +--LambdaParameterType: + def "LambdaParameterType" $ union [ +-- UnannType + "type">: java "UnannType", +-- var + "var">: unit], + +--LambdaBody: + def "LambdaBody" $ union [ +-- Expression + "expression">: java "Expression", +-- Block + "block">: java "Block"], + +--AssignmentExpression: + def "AssignmentExpression" $ union [ +-- ConditionalExpression + "conditional">: java "ConditionalExpression", +-- Assignment + "assignment">: java "Assignment"], + +--Assignment: +-- LeftHandSide AssignmentOperator Expression + def "Assignment" $ record [ + "lhs">: java "LeftHandSide", + "op">: java "AssignmentOperator", + "expression">: java "Expression"], + +--LeftHandSide: + def "LeftHandSide" $ union [ +-- ExpressionName + "expressionName">: java "ExpressionName", +-- FieldAccess + "fieldAccess">: java "FieldAccess", +-- ArrayAccess + "arrayAccess">: java "ArrayAccess"], + +--AssignmentOperator: +-- (one of) + def "AssignmentOperator" $ enum [ +-- = *= /= %= += -= <<= >>= >>>= &= ^= |= + "simple", "times", "div", "mod", "plus", "minus", + "shiftLeft", "shiftRight", "shiftRightZeroFill", "and", "xor", "or"], + +--ConditionalExpression: + def "ConditionalExpression" $ union [ +-- ConditionalOrExpression + "simple">: java "ConditionalOrExpression", +-- ConditionalOrExpression ? Expression : ConditionalExpression + "ternaryCond">: java "ConditionalExpression.TernaryCond", +-- ConditionalOrExpression ? Expression : LambdaExpression + "ternaryLambda">: java "ConditionalExpression.TernaryLambda"], + def "ConditionalExpression.TernaryCond" $ record [ + "cond">: java "ConditionalOrExpression", + "ifTrue">: java "Expression", + "ifFalse">: java "ConditionalExpression"], + def "ConditionalExpression.TernaryLambda" $ record [ + "cond">: java "ConditionalOrExpression", + "ifTrue">: java "Expression", + "ifFalse">: java "LambdaExpression"], + +--ConditionalOrExpression: +-- ConditionalAndExpression +-- ConditionalOrExpression || ConditionalAndExpression + def "ConditionalOrExpression" $ nonemptyList $ java "ConditionalAndExpression", + +--ConditionalAndExpression: +-- InclusiveOrExpression +-- ConditionalAndExpression && InclusiveOrExpression + def "ConditionalAndExpression" $ nonemptyList $ java "InclusiveOrExpression", + +--InclusiveOrExpression: +-- ExclusiveOrExpression +-- InclusiveOrExpression | ExclusiveOrExpression + def "InclusiveOrExpression" $ nonemptyList $ java "ExclusiveOrExpression", + +--ExclusiveOrExpression: +-- AndExpression +-- ExclusiveOrExpression ^ AndExpression + def "ExclusiveOrExpression" $ nonemptyList $ java "AndExpression", + +--AndExpression: +-- EqualityExpression +-- AndExpression & EqualityExpression + def "AndExpression" $ nonemptyList $ java "EqualityExpression", + +--EqualityExpression: + def "EqualityExpression" $ union [ +-- RelationalExpression + "unary">: java "RelationalExpression", +-- EqualityExpression == RelationalExpression + "equal">: java "EqualityExpression.Binary", +-- EqualityExpression != RelationalExpression + "notEqual">: java "EqualityExpression.Binary"], + def "EqualityExpression.Binary" $ record [ + "lhs">: java "EqualityExpression", + "rhs">: java "RelationalExpression"], + +--RelationalExpression: + def "RelationalExpression" $ union [ +-- ShiftExpression + "simple">: java "ShiftExpression", +-- RelationalExpression < ShiftExpression + "lessThan">: java "RelationalExpression.LessThan", +-- RelationalExpression > ShiftExpression + "greaterThan">: java "RelationalExpression.GreaterThan", +-- RelationalExpression <= ShiftExpression + "lessThanEqual">: java "RelationalExpression.LessThanEqual", +-- RelationalExpression >= ShiftExpression + "greaterThanEqual">: java "RelationalExpression.GreaterThanEqual", +-- RelationalExpression instanceof ReferenceType + "instanceof">: java "RelationalExpression.InstanceOf"], + def "RelationalExpression.LessThan" $ record [ + "lhs">: java "RelationalExpression", + "rhs">: java "ShiftExpression"], + def "RelationalExpression.GreaterThan" $ record [ + "lhs">: java "RelationalExpression", + "rhs">: java "ShiftExpression"], + def "RelationalExpression.LessThanEqual" $ record [ + "lhs">: java "RelationalExpression", + "rhs">: java "ShiftExpression"], + def "RelationalExpression.GreaterThanEqual" $ record [ + "lhs">: java "RelationalExpression", + "rhs">: java "ShiftExpression"], + def "RelationalExpression.InstanceOf" $ record [ + "lhs">: java "RelationalExpression", + "rhs">: java "ReferenceType"], + +--ShiftExpression: + def "ShiftExpression" $ union [ +-- AdditiveExpression + "unary">: java "AdditiveExpression", +-- ShiftExpression << AdditiveExpression + "shiftLeft">: java "ShiftExpression.Binary", +-- ShiftExpression >> AdditiveExpression + "shiftRight">: java "ShiftExpression.Binary", +-- ShiftExpression >>> AdditiveExpression + "shiftRightZeroFill">: java "ShiftExpression.Binary"], + def "ShiftExpression.Binary" $ record [ + "lhs">: java "ShiftExpression", + "rhs">: java "AdditiveExpression"], + +--AdditiveExpression: + def "AdditiveExpression" $ union [ +-- MultiplicativeExpression + "unary">: java "MultiplicativeExpression", +-- AdditiveExpression + MultiplicativeExpression + "plus">: java "AdditiveExpression.Binary", +-- AdditiveExpression - MultiplicativeExpression + "minus">: java "AdditiveExpression.Binary"], + def "AdditiveExpression.Binary" $ record [ + "lhs">: java "AdditiveExpression", + "rhs">: java "MultiplicativeExpression"], + +--MultiplicativeExpression: + def "MultiplicativeExpression" $ union [ +-- UnaryExpression + "unary">: java "UnaryExpression", +-- MultiplicativeExpression * UnaryExpression + "times">: java "MultiplicativeExpression.Binary", +-- MultiplicativeExpression / UnaryExpression + "divide">: java "MultiplicativeExpression.Binary", +-- MultiplicativeExpression % UnaryExpression + "mod">: java "MultiplicativeExpression.Binary"], + def "MultiplicativeExpression.Binary" $ record [ + "lhs">: java "MultiplicativeExpression", + "rhs">: java "UnaryExpression"], + +--UnaryExpression: + def "UnaryExpression" $ union [ +-- PreIncrementExpression + "preIncrement">: java "PreIncrementExpression", +-- PreDecrementExpression + "preDecrement">: java "PreDecrementExpression", +-- + UnaryExpression + "plus">: java "UnaryExpression", +-- - UnaryExpression + "minus">: java "UnaryExpression", +-- UnaryExpressionNotPlusMinus + "other">: java "UnaryExpressionNotPlusMinus"], + +--PreIncrementExpression: +-- ++ UnaryExpression + def "PreIncrementExpression" $ java "UnaryExpression", + +--PreDecrementExpression: +-- -- UnaryExpression + def "PreDecrementExpression" $ java "UnaryExpression", + +--UnaryExpressionNotPlusMinus: + def "UnaryExpressionNotPlusMinus" $ union [ +-- PostfixExpression + "postfix">: java "PostfixExpression", +-- ~ UnaryExpression + "tilde">: java "UnaryExpression", +-- ! UnaryExpression + "not">: java "UnaryExpression", +-- CastExpression + "cast">: java "CastExpression"], + +--PostfixExpression: + def "PostfixExpression" $ union [ +-- Primary + "primary">: java "Primary", +-- ExpressionName + "name">: java "ExpressionName", +-- PostIncrementExpression + "postIncrement">: java "PostIncrementExpression", +-- PostDecrementExpression + "postDecrement">: java "PostDecrementExpression"], + +--PostIncrementExpression: +-- PostfixExpression ++ + def "PostIncrementExpression" $ java "PostfixExpression", + +--PostDecrementExpression: +-- PostfixExpression -- + def "PostDecrementExpression" $ java "PostfixExpression", + +--CastExpression: + def "CastExpression" $ union [ +-- ( PrimitiveType ) UnaryExpression + "primitive">: java "CastExpression.Primitive", +-- ( ReferenceType {AdditionalBound} ) UnaryExpressionNotPlusMinus + "notPlusMinus">: java "CastExpression.NotPlusMinus", +-- ( ReferenceType {AdditionalBound} ) LambdaExpression + "lambda">: java "CastExpression.Lambda"], + def "CastExpression.Primitive" $ record [ + "type">: java "PrimitiveTypeWithAnnotations", + "expression">: java "UnaryExpression"], + def "CastExpression.NotPlusMinus" $ record [ + "refAndBounds">: java "CastExpression.RefAndBounds", + "expression">: java "UnaryExpression"], + def "CastExpression.Lambda" $ record [ + "refAndBounds">: java "CastExpression.RefAndBounds", + "expression">: java "LambdaExpression"], + def "CastExpression.RefAndBounds" $ record [ + "type">: java "ReferenceType", + "bounds">: list $ java "AdditionalBound"], + +--ConstantExpression: +-- Expression + def "ConstantExpression" $ java "Expression"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Json/Decoding.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Json/Decoding.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Json/Decoding.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Json.Decoding where + +-- TODO: standardized Tier-4 imports +import Prelude hiding ((++)) +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Hydra.Dsl.Base as Base +import qualified Hydra.Dsl.Core as Core +import qualified Hydra.Dsl.Graph as Graph +import qualified Hydra.Dsl.Lib.Equality as Equality +import qualified Hydra.Dsl.Lib.Flows as Flows +import qualified Hydra.Dsl.Lib.Io as Io +import qualified Hydra.Dsl.Lib.Lists as Lists +import qualified Hydra.Dsl.Lib.Literals as Literals +import qualified Hydra.Dsl.Lib.Logic as Logic +import qualified Hydra.Dsl.Lib.Maps as Maps +import qualified Hydra.Dsl.Lib.Math as Math +import qualified Hydra.Dsl.Lib.Optionals as Optionals +import qualified Hydra.Dsl.Lib.Sets as Sets +import Hydra.Dsl.Lib.Strings as Strings +import qualified Hydra.Dsl.Module as Module +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types +import Hydra.Sources.Tier2.All + +import qualified Hydra.Json as Json +import Hydra.Sources.Tier0.Json + + +jsonDecodingModule :: Module +jsonDecodingModule = Module (Namespace "hydra/ext/org/json/decoding") elements + [jsonModelModule, hydraCoreModule] (jsonModelModule:tier0Modules) $ + Just "Decoding functions for JSON data" + where + elements = [ + Base.el decodeStringDef, + Base.el decodeNumberDef, + Base.el decodeBooleanDef, + Base.el decodeArrayDef, + Base.el decodeObjectDef, + Base.el decodeFieldDef, + Base.el decodeOptionalFieldDef] + +jsonDecodingDefinition :: String -> TTerm a -> TElement a +jsonDecodingDefinition label = definitionInModule jsonDecodingModule ("decode" <> label) + +valueT = TypeVariable Json._Value + +decodeStringDef :: TElement (Json.Value -> Flow s String) +decodeStringDef = jsonDecodingDefinition "String" $ + function valueT (flowT sT stringT) $ + match Json._Value (Just $ Flows.fail @@ "expected a string") [ + Json._Value_string>>: Flows.pure] + +decodeNumberDef :: TElement (Json.Value -> Flow s Double) +decodeNumberDef = jsonDecodingDefinition "Number" $ + function valueT (flowT sT Types.bigfloat) $ + match Json._Value (Just $ Flows.fail @@ "expected a number") [ + Json._Value_number>>: Flows.pure] + +decodeBooleanDef :: TElement (Json.Value -> Flow s Bool) +decodeBooleanDef = jsonDecodingDefinition "Boolean" $ + function valueT (flowT sT booleanT) $ + match Json._Value (Just $ Flows.fail @@ "expected a boolean") [ + Json._Value_boolean>>: Flows.pure] + +decodeArrayDef :: TElement ((Json.Value -> Flow s a) -> Json.Value -> Flow s [a]) +decodeArrayDef = jsonDecodingDefinition "Array" $ + function (funT valueT (flowT sT aT)) (funT valueT (flowT sT (listT aT))) $ + lambda "decodeElem" $ match Json._Value (Just $ Flows.fail @@ "expected an array") [ + Json._Value_array>>: Flows.mapList @@ (var "decodeElem")] + +decodeObjectDef :: TElement (Json.Value -> Flow s (M.Map String Json.Value)) +decodeObjectDef = jsonDecodingDefinition "Object" $ + function valueT (flowT sT (mapT stringT valueT)) $ + match Json._Value (Just $ Flows.fail @@ "expected an object") [ + Json._Value_object>>: Flows.pure] + +decodeFieldDef :: TElement ((Json.Value -> Flow s a) -> String -> (M.Map String Json.Value) -> Flow s a) +decodeFieldDef = jsonDecodingDefinition "Field" $ + function (funT valueT (flowT sT aT)) (funT stringT (funT (mapT stringT valueT) (flowT sT aT))) $ + lambda "decodeValue" $ lambda "name" $ lambda "m" $ + Flows.bind + @@ (ref decodeOptionalFieldDef @@ var "decodeValue" @@ var "name" @@ var "m") + @@ (matchOpt (Flows.fail @@ ("missing field: " ++ var "name")) Flows.pure) + +decodeOptionalFieldDef :: TElement ((Json.Value -> Flow s a) -> String -> (M.Map String Json.Value) -> Flow s (Maybe a)) +decodeOptionalFieldDef = jsonDecodingDefinition "OptionalField" $ + function (funT valueT (flowT sT aT)) (funT stringT (funT (mapT stringT valueT) (flowT sT (Types.optional aT)))) $ + lambda "decodeValue" $ lambda "name" $ lambda "m" $ + (matchOpt (Flows.pure @@ nothing) (lambda "v" (Flows.map @@ (lambda "x" (just $ var "x")) @@ (var "decodeValue" @@ var "v")))) + @@ (Maps.lookup @@ var "name" @@ var "m") diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Pegasus/Pdl.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pegasus/Pdl.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pegasus/Pdl.hs @@ -0,0 +1,128 @@ +module Hydra.Sources.Tier4.Ext.Pegasus.Pdl where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +pegasusPdlModule :: Module +pegasusPdlModule = Module ns elements [jsonModelModule] tier0Modules $ + Just ("A model for PDL (Pegasus Data Language) schemas. Based on the specification at:\n" ++ + " https://linkedin.github.io/rest.li/pdl_schema") + where + ns = Namespace "hydra/ext/pegasus/pdl" + def = datatype ns + pdl = typeref ns + json = typeref $ moduleNamespace jsonModelModule + + elements = [ + + def "Annotations" $ + doc "Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas" $ + record [ + "doc">: optional string, + "deprecated">: boolean], + + def "EnumField" $ + record [ + "name">: pdl "EnumFieldName", + "annotations">: pdl "Annotations"], + + def "EnumFieldName" + string, + + def "EnumSchema" $ + record [ + "fields">: list $ pdl "EnumField"], + + def "FieldName" + string, + + def "NamedSchema" $ + record [ + "qualifiedName">: pdl "QualifiedName", + "type">: pdl "NamedSchema.Type", + "annotations">: pdl "Annotations"], + + def "NamedSchema.Type" $ + union [ + "record">: pdl "RecordSchema", + "enum">: pdl "EnumSchema", + "typeref">: pdl "Schema"], + + def "Name" + string, + + def "Namespace" + string, + + def "Package" + string, + + def "PrimitiveType" $ + enum [ + "boolean", + "bytes", + "double", + "float", + "int", + "long", + "string"], + + def "PropertyKey" + string, + + def "Property" $ + record [ + "key">: pdl "PropertyKey", + "value">: optional $ json "Value"], + + def "QualifiedName" $ + record [ + "name">: pdl "Name", + "namespace">: optional $ pdl "Namespace"], + + def "RecordField" $ + record [ + "name">: pdl "FieldName", + "value">: pdl "Schema", + "optional">: boolean, + -- Note: the default value for an enum-valued must be one of the enumerated string symbols + "default">: optional $ json "Value", + "annotations">: pdl "Annotations"], + + def "RecordSchema" $ + record [ + "fields">: list $ pdl "RecordField", + -- Note: all included schemas must be record schemas + "includes">: list $ pdl "NamedSchema"], + + def "Schema" $ + union [ + "array">: pdl "Schema", + "fixed">: int32, + "inline">: pdl "NamedSchema", + "map">: pdl "Schema", + "named">: pdl "QualifiedName", + "null">: unit, + "primitive">: pdl "PrimitiveType", + "union">: pdl "UnionSchema"], + + def "SchemaFile" $ + record [ + "namespace">: pdl "Namespace", + "package">: optional $ pdl "Package", + "imports">: list $ pdl "QualifiedName", + "schemas">: list $ pdl "NamedSchema"], + + def "UnionMember" $ + record [ + "alias">: optional $ pdl "FieldName", + "value">: pdl "Schema", + -- Note: annotations are only available for aliased members + "annotations">: pdl "Annotations"], + + -- Note: unions are not allowed as member types of other unions + def "UnionSchema" $ + list $ pdl "UnionMember"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Mapping.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Mapping.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Mapping.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Pg.Mapping where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Pg.Mapping +import qualified Hydra.Dsl.Terms as Terms +import Hydra.Dsl.Types as Types +import Hydra.Sources.Tier4.Ext.Pg.Model + + +pgMappingModule :: Module +pgMappingModule = Module ns elements + [pgModelModule, hydraCoreModule, hydraComputeModule] tier0Modules $ + Just "A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs" + where + ns = Namespace "hydra/pg/mapping" + mappings = typeref ns + compute = typeref $ moduleNamespace hydraComputeModule + core = typeref $ moduleNamespace hydraCoreModule + v3 = typeref $ moduleNamespace pgModelModule + def = datatype ns + toField (k, v) = Field k $ Terms.string v + + elements = [ + + def "AnnotationSchema" $ + doc "Configurable annotation keys for property graph mapping specifications" $ + record [ + "vertexLabel">: string, + "edgeLabel">: string, + "vertexId">: string, + "edgeId">: string, + "propertyKey">: string, + "propertyValue">: string, + "outVertex">: string, + "outVertexLabel">: string, + "inVertex">: string, + "inVertexLabel">: string, + "outEdge">: string, + "outEdgeLabel">: string, + "inEdge">: string, + "inEdgeLabel">: string, + "ignore">: string], + + def "EdgeSpec" $ + doc "A mapping specification producing edges of a specified label." $ + record [ + "label">: + doc "The label of the target edges, which must conform to the edge type associated with that label." $ + v3 "EdgeLabel", + "id">: + doc "A specification of the id of each target edge" $ + mappings "ValueSpec", + "out">: + doc "A specification of the out-vertex reference of each target edge" $ + mappings "ValueSpec", + "in">: + doc "A specification of the in-vertex reference of each target edge" $ + mappings "ValueSpec", + "properties">: + doc "Zero or more property specifications for each target edge" $ + list $ mappings "PropertySpec"], + + def "ElementSpec" $ + doc "Either a vertex specification or an edge specification" $ + union [ + "vertex">: mappings "VertexSpec", + "edge">: mappings "EdgeSpec"], + + def "PropertySpec" $ + doc "A mapping specification producing properties of a specified key, and values of the appropriate type." $ + record [ + "key">: + doc "The key of the target properties" $ + v3 "PropertyKey", + "value">: + doc "A specification of the value of each target property, which must conform to the type associated with the property key" $ + mappings "ValueSpec"], + + def "Schema" $ + doc "A set of mappings which translates between Hydra terms and annotations, and application-specific property graph types" $ + lambdas ["s", "t", "v"] $ + record [ + "vertexIdTypes">: compute "Coder" @@ "s" @@ "s" @@ core "Type" @@ "t", + "vertexIds">: compute "Coder" @@ "s" @@ "s" @@ core "Term" @@ "v", + "edgeIdTypes">: compute "Coder" @@ "s" @@ "s" @@ core "Type" @@ "t", + "edgeIds">: compute "Coder" @@ "s" @@ "s" @@ core "Term" @@ "v", + "propertyTypes">: compute "Coder" @@ "s" @@ "s" @@ core "Type" @@ "t", + "propertyValues">: compute "Coder" @@ "s" @@ "s" @@ core "Term" @@ "v", + "annotations">: mappings "AnnotationSchema", + "defaultVertexId">: "v", + "defaultEdgeId">: "v"], + + def "ValueSpec" $ + doc "A mapping specification producing values (usually literal values) whose type is understood in context" $ + union [ + "value">: + doc "A trivial no-op specification which passes the entire value" + unit, + "pattern">: + doc "A compact path representing the function, e.g. engine-${engineInfo/model/name}" + string], + + def "VertexSpec" $ + doc "A mapping specification producing vertices of a specified label" $ + record [ + "label">: + doc "The label of the target vertices, which must conform to the vertex type associated with that label." $ + v3 "VertexLabel", + "id">: + doc "A specification of the id of each target vertex" $ + mappings "ValueSpec", + "properties">: + doc "Zero or more property specifications for each target vertex" $ + list $ mappings "PropertySpec"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Model.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Model.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Model.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Pg.Model where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + +import Hydra.Sources.Core + + +pgModelModule :: Module +pgModelModule = Module ns elements [] tier0Modules $ + Just ("A typed property graph data model. " ++ + "Property graphs are parameterized a type for property and id values, " ++ + "while property graph schemas are parameterized by a type for property and id types") + where + ns = Namespace "hydra/pg/model" + pg = typeref ns + def = datatype ns + + elements = [ + + def "Direction" $ + doc "The direction of an edge or edge pattern" $ + enum ["out", "in", "both", "undirected"], + + def "Edge" $ + doc "An edge" $ + lambda "v" $ record [ + "label">: + doc "The label of the edge" $ + pg "EdgeLabel", + "id">: + doc "The unique identifier of the edge" + "v", + "out">: + doc "The id of the out-vertex (tail) of the edge" + "v", + "in">: + doc "The id of the in-vertex (head) of the edge" + "v", + "properties">: + doc "A key/value map of edge properties" $ + Types.map (pg "PropertyKey") "v"], + + def "EdgeLabel" $ + doc "The label of an edge" $ + string, + + def "EdgeType" $ + doc "The type of an edge" $ + lambda "t" $ record [ + "label">: + doc "The label of any edge of this edge type" $ + pg "EdgeLabel", + "id">: + doc "The type of the id of any edge of this edge type" + "t", + "out">: + doc "The label of the out-vertex (tail) of any edge of this edge type" $ + pg "VertexLabel", + "in">: + doc "The label of the in-vertex (head) of any edge of this edge type" $ + pg "VertexLabel", + "properties">: + doc "A list of property types. The types are ordered for the sake of applications in which property order is significant." $ + list (pg "PropertyType" @@ "t")], + + def "Element" $ + doc "Either a vertex or an edge" $ + lambda "v" $ union [ + "vertex">: pg "Vertex" @@ "v", + "edge">: pg "Edge" @@ "v"], + + def "ElementKind" $ + doc "The kind of an element: vertex or edge" $ + enum ["vertex", "edge"], + + def "ElementTree" $ + doc "An element together with its dependencies in some context" $ + lambda "v" $ record [ + "self">: pg "Element" @@ "v", + "dependencies">: Types.list $ pg "ElementTree" @@ "v"], + + def "ElementType" $ + doc "The type of a vertex or edge" $ + lambda "t" $ union [ + "vertex">: pg "VertexType" @@ "t", + "edge">: pg "EdgeType" @@ "t"], + + def "ElementTypeTree" $ + doc "An element type together with its dependencies in some context" $ + lambda "t" $ record [ + "self">: pg "ElementType" @@ "t", + "dependencies">: Types.list $ pg "ElementTypeTree" @@ "t"], + + def "Graph" $ + doc "A graph; a self-contained collection of vertices and edges" $ + lambda "v" $ record [ + "vertices">: Types.map "v" $ pg "Vertex" @@ "v", + "edges">: Types.map "v" $ pg "Edge" @@ "v"], + + def "GraphSchema" $ + doc "A graph schema; a vertex and edge types for the vertices and edges of a graph conforming to the schema" $ + lambda "t" $ record [ + "vertices">: + doc "A unique vertex type for each vertex label which may occur in a graph" $ + Types.map (pg "VertexLabel") (pg "VertexType" @@ "t"), + "edges">: + doc "A unique edge type for each edge label which may occur in a graph" $ + Types.map (pg "EdgeLabel") (pg "EdgeType" @@ "t")], + + def "Label" $ + doc "Either a vertex or edge label" $ + union [ + "vertex">: pg "VertexLabel", + "edge">: pg "EdgeLabel"], + + def "Property" $ + doc "A key/value property" $ + lambda "v" $ record [ + "key">: + doc "They key of the property" $ + pg "PropertyKey", + "value">: + doc "The value of the property" + "v"], + + def "PropertyKey" $ + doc "A property key" + string, + + def "PropertyType" $ + doc "The type of a property" $ + lambda "t" $ record [ + "key">: + doc "A property's key" $ + pg "PropertyKey", + "value">: + doc "The type of a property's value" + "t", + "required">: + doc "Whether the property is required; values may be omitted from a property map otherwise" + boolean], + + def "Vertex" $ + doc "A vertex" $ + lambda "v" $ record [ + "label">: + doc "The label of the vertex" $ + pg "VertexLabel", + "id">: + doc "The unique identifier of the vertex" + "v", + "properties">: + doc "A key/value map of vertex properties" $ + Types.map (pg "PropertyKey") "v"], + + def "VertexLabel" $ + doc "The label of a vertex. The default (null) vertex is represented by the empty string" $ + string, + + def "VertexType" $ + doc "The type of a vertex" $ + lambda "t" $ record [ + "label">: + doc "The label of any vertex of this vertex type" $ + pg "VertexLabel", + "id">: + doc "The type of the id of any vertex of this vertex type" + "t", + "properties">: + doc "A list of property types. The types are ordered for the sake of applications in which property order is significant." $ + list (pg "PropertyType" @@ "t")]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Query.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Query.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Query.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Pg.Query where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types +import Hydra.Sources.Core +import Hydra.Sources.Tier4.Ext.Pg.Model + + +pgQueryModule :: Module +pgQueryModule = Module ns elements [pgModelModule] tier0Modules $ + Just ("A common model for pattern-matching queries over property graphs") + where + ns = Namespace "hydra/pg/query" + pg = typeref $ moduleNamespace pgModelModule + q = typeref ns + def = datatype ns + + elements = [ + + -- table of bindings to list of integers + def "AggregationQuery" $ + union [ + "count">: unit], + + def "ApplicationQuery" $ + nonemptyList $ q "Query", + + def "AssociativeExpression" $ + record [ + "operator">: q "BinaryOperator", + "operands">: nonemptyList $ q "Expression"], + + def "BinaryExpression" $ + record [ + "left">: q "Expression", + "operator">: q "BinaryOperator", + "right">: q "Expression"], + + def "BinaryBooleanOperator" $ + enum ["and", "or", "xor"], + + def "BinaryOperator" $ + union [ + "boolean">: q "BinaryBooleanOperator", + "comparison">: q "ComparisonOperator", + "power">: unit], + + def "Binding" $ + record [ + "key">: q "Variable", + "value">: q "Query"], + + def "ComparisonOperator" $ + enum ["eq", "neq", "lt", "lte", "gt", "gte"], + + def "EdgeProjectionPattern" $ + record [ + "direction">: pg "Direction", + "label">: optional $ pg "EdgeLabel", + "properties">: list $ q "PropertyPattern", + "vertex">: optional $ q "VertexPattern"], + + def "Expression" $ + union [ + "associative">: q "AssociativeExpression", + "binary">: q "BinaryExpression", + "property">: q "PropertyProjection", + "unary">: q "UnaryExpression", + "variable">: q "Variable", + "vertex">: q "VertexPattern"], + + def "LetQuery" $ + record [ + "bindings">: list $ q "Binding", + "environment">: q "Query"], + + def "MatchQuery" $ + record [ + "optional">: boolean, + "pattern">: list $ q "Projection", + "where">: optional $ q "Expression"], + + def "Projection" $ + record [ + "value">: q "Expression", + "as">: optional $ q "Variable"], + + def "Projections" $ + record [ + "all">: boolean, + "explicit">: list $ q "Projection"], + + def "PropertyPattern" $ + record [ + "key">: pg "PropertyKey", + "value">: q "PropertyValuePattern"], + + def "PropertyProjection" $ + record [ + "base">: q "Expression", + "key">: pg "PropertyKey"], + + -- TODO: temporary + def "PropertyValue" $ string, + + def "PropertyValuePattern" $ + union [ + "variable">: pg "PropertyKey", + "value">: string], -- TODO: re-use pg property value parameter + + def "Query" $ + union [ + "application">: q "ApplicationQuery", + "aggregate">: q "AggregationQuery", + "LetQuery">: q "LetQuery", + "match">: q "MatchQuery", + "select">: q "SelectQuery", + "value">: string], + + def "SelectQuery" $ + record [ + "distinct">: boolean, + "projection">: q "Projections"], + + def "UnaryExpression" $ + record [ + "operator">: q "UnaryOperator", + "operand">: q "Expression"], + + def "UnaryOperator" $ + enum ["negate"], + + def "Variable" string, + + def "VertexPattern" $ + record [ + "variable">: optional $ q "Variable", + "label">: optional $ pg "VertexLabel", + "properties">: list $ q "PropertyPattern", + "edges">: list $ q "EdgeProjectionPattern"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Validation.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Validation.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Validation.hs @@ -0,0 +1,331 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Pg.Validation where + +import Prelude hiding ((++)) +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Hydra.Dsl.Base as Base +import qualified Hydra.Dsl.Core as Core +import qualified Hydra.Dsl.Graph as Graph +import qualified Hydra.Dsl.Lib.Equality as Equality +import qualified Hydra.Dsl.Lib.Flows as Flows +import qualified Hydra.Dsl.Lib.Io as Io +import qualified Hydra.Dsl.Lib.Lists as Lists +import qualified Hydra.Dsl.Lib.Literals as Literals +import qualified Hydra.Dsl.Lib.Logic as Logic +import qualified Hydra.Dsl.Lib.Maps as Maps +import qualified Hydra.Dsl.Lib.Math as Math +import qualified Hydra.Dsl.Lib.Optionals as Optionals +import qualified Hydra.Dsl.Lib.Sets as Sets +import Hydra.Dsl.Lib.Strings as Strings +import qualified Hydra.Dsl.Module as Module +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types + +import Hydra.Kernel hiding (Edge(..), _Edge, _Edge_in, _Edge_out, Element(..), _Element, Graph(..), _Graph) + +import Hydra.Pg.Model as PG +import Hydra.Sources.Tier4.Ext.Pg.Model + + +validationDefinition :: String -> TTerm a -> TElement a +validationDefinition = definitionInModule pgValidationModule + +pgValidationModule :: Module +pgValidationModule = Module (Namespace "hydra/pg/validation") elements + [] [pgModelModule] $ + Just "Utilities for validating property graphs against property graph schemas" + where + elements = [ + el validateEdgeDef, + el validateElementDef, + el validateGraphDef, + el validatePropertiesDef, + el validateVertexDef, + -- + el checkAllDef, + el edgeErrorDef, + el edgeLabelMismatchDef, + el prependDef, + el verifyDef, + el vertexErrorDef, + el vertexLabelMismatchDef] + +validateEdgeDef :: TElement ( + (t -> v -> Maybe String) + -> (v -> String) + -> Y.Maybe (v -> Y.Maybe PG.VertexLabel) + -> PG.EdgeType t + -> PG.Edge v + -> Y.Maybe String) +validateEdgeDef = validationDefinition "validateEdge" $ + functionN [ + funT tT (funT vT (optionalT stringT)), + funT vT stringT, + optionalT (funT vT (optionalT vertexLabelT)), + edgeTypeTT, + edgeVT, + optionalT stringT] $ + lambda "checkValue" $ lambda "showValue" $ lambda "labelForVertexId" $ lambda "typ" $ lambda "el" $ + (ref checkAllDef @@ list [var "checkLabel", var "checkId", var "checkProperties", var "checkOut", var "checkIn"] + `with` [ + "failWith">: typed (funT stringT stringT) $ + ref edgeErrorDef @@ var "showValue" @@ var "el", + "checkLabel">: (ref verifyDef + @@ (Equality.equalString + @@ (unwrap _EdgeLabel @@ var "actual") + @@ (unwrap _EdgeLabel @@ var "expected")) + @@ (var "failWith" @@ (ref prependDef @@ "Wrong label" @@ (ref edgeLabelMismatchDef @@ var "expected" @@ var "actual")))) + `with` [ + "expected">: project _EdgeType _EdgeType_label @@ var "typ", + "actual">: project _Edge _Edge_label @@ var "el"], + "checkId">: Optionals.map + @@ (var "failWith" <.> (ref prependDef @@ "Invalid id")) + @@ (var "checkValue" @@ (project _EdgeType _EdgeType_id @@ var "typ") @@ (project _Edge _Edge_id @@ var "el")), + "checkProperties">: Optionals.map + @@ (var "failWith" <.> (ref prependDef @@ "Invalid property")) + @@ (ref validatePropertiesDef + @@ var "checkValue" + @@ (project _EdgeType _EdgeType_properties @@ var "typ") + @@ (project _Edge _Edge_properties @@ var "el")), + "checkOut">: ifOpt (var "labelForVertexId") + nothing + (lambda "f" $ ifOpt (var "f" @@ (project _Edge _Edge_out @@ var "el")) + (just (var "failWith" @@ (ref prependDef @@ "Out-vertex does not exist" @@ (var "showValue" @@ (project _Edge _Edge_out @@ var "el"))))) + (lambda "label" $ ref verifyDef + @@ (Equality.equalString + @@ (unwrap _VertexLabel @@ var "label") + @@ (unwrap _VertexLabel @@ (project _EdgeType _EdgeType_out @@ var "typ"))) + @@ (var "failWith" @@ (ref prependDef @@ "Wrong out-vertex label" @@ (ref vertexLabelMismatchDef @@ (project _EdgeType _EdgeType_out @@ var "typ") @@ var "label"))))), + "checkIn">: ifOpt (var "labelForVertexId") + nothing + (lambda "f" $ ifOpt (var "f" @@ (project _Edge _Edge_in @@ var "el")) + (just (var "failWith" @@ (ref prependDef @@ "In-vertex does not exist" @@ (var "showValue" @@ (project _Edge _Edge_in @@ var "el"))))) + (lambda "label" $ ref verifyDef + @@ (Equality.equalString + @@ (unwrap _VertexLabel @@ var "label") + @@ (unwrap _VertexLabel @@ (project _EdgeType _EdgeType_in @@ var "typ"))) + @@ (var "failWith" @@ (ref prependDef @@ "Wrong in-vertex label" @@ (ref vertexLabelMismatchDef @@ (project _EdgeType _EdgeType_in @@ var "typ") @@ var "label")))))]) + +validateElementDef :: TElement ( + (t -> v -> Maybe String) + -> (v -> String) + -> Y.Maybe (v -> Y.Maybe PG.VertexLabel) + -> PG.ElementType t + -> PG.Element v + -> Y.Maybe String) +validateElementDef = validationDefinition "validateElement" $ + functionN [ + funT tT (funT vT (optionalT stringT)), + funT vT stringT, + optionalT (funT vT (optionalT vertexLabelT)), + elementTypeTT, + elementVT, + optionalT stringT] $ + lambda "checkValue" $ lambda "showValue" $ lambda "labelForVertexId" $ lambda "typ" $ lambda "el" $ + (match _ElementType Nothing [ + _ElementType_vertex>>: lambda "vt" $ (match _Element Nothing [ + _Element_edge>>: lambda "e" $ just (ref prependDef @@ "Edge instead of vertex" @@ (var "showValue" @@ (project _Edge _Edge_id @@ var "e"))), + _Element_vertex>>: lambda "vertex" $ ref validateVertexDef + @@ var "checkValue" + @@ var "showValue" + @@ var "vt" + @@ var "vertex"]) @@ var "el", +-- _ElementType_edge>>: constant nothing]) @@ var "typ" + _ElementType_edge>>: lambda "et" $ (match _Element Nothing [ + _Element_vertex>>: lambda "v" $ just (ref prependDef @@ "Vertex instead of edge" @@ (var "showValue" @@ (project _Vertex _Vertex_id @@ var "v"))), + _Element_edge>>: lambda "edge" $ ref validateEdgeDef + @@ var "checkValue" + @@ var "showValue" + @@ var "labelForVertexId" + @@ var "et" + @@ var "edge"]) @@ var "el"]) @@ var "typ" + +validateGraphDef :: TElement ( + (t -> v -> Maybe String) + -> (v -> String) + -> PG.GraphSchema t + -> PG.Graph v + -> Y.Maybe String) +validateGraphDef = validationDefinition "validateGraph" $ + functionNWithClasses [ + funT tT (funT vT (optionalT stringT)), + funT vT stringT, + graphSchemaTT, + graphVT, + optionalT stringT] ordV $ + lambda "checkValue" $ lambda "showValue" $ lambda "schema" $ lambda "graph" $ + (ref checkAllDef @@ list [var "checkVertices", var "checkEdges"]) + `with` [ + "checkVertices">: (ref checkAllDef + @@ (Lists.map @@ var "checkVertex" @@ (Maps.values @@ (project _Graph _Graph_vertices @@ var "graph")))) + `with` [ + "checkVertex">: lambda "el" $ ifOpt (Maps.lookup + @@ (project _Vertex _Vertex_label @@ var "el") + @@ (project _GraphSchema _GraphSchema_vertices @@ var "schema")) + (just (ref vertexErrorDef @@ var "showValue" @@ var "el" + @@ (ref prependDef @@ "Unexpected label" @@ (unwrap _VertexLabel @@ (project _Vertex _Vertex_label @@ var "el"))))) + (lambda "t" $ ref validateVertexDef + @@ var "checkValue" + @@ var "showValue" + @@ var "t" + @@ var "el")], + "checkEdges">: (ref checkAllDef + @@ (Lists.map @@ var "checkEdge" @@ (Maps.values @@ (project _Graph _Graph_edges @@ var "graph")))) + `with` [ + "checkEdge">: lambda "el" $ ifOpt (Maps.lookup + @@ (project _Edge _Edge_label @@ var "el") + @@ (project _GraphSchema _GraphSchema_edges @@ var "schema")) + (just (ref edgeErrorDef @@ var "showValue" @@ var "el" + @@ (ref prependDef @@ "Unexpected label" @@ (unwrap _EdgeLabel @@ (project _Edge _Edge_label @@ var "el"))))) + (lambda "t" $ ref validateEdgeDef + @@ var "checkValue" + @@ var "showValue" + @@ var "labelForVertexId" + @@ var "t" + @@ var "el"), + "labelForVertexId">: typed (optionalT (funT vT (optionalT vertexLabelT))) $ + just $ lambda "i" $ Optionals.map @@ (project _Vertex _Vertex_label) @@ (Maps.lookup @@ var "i" @@ (project _Graph _Graph_vertices @@ var "graph"))]] + +validatePropertiesDef :: TElement ( + (t -> v -> Maybe String) + -> [PG.PropertyType t] + -> M.Map PG.PropertyKey v + -> Y.Maybe String) +validatePropertiesDef = validationDefinition "validateProperties" $ + functionN [ + funT tT (funT vT (optionalT stringT)), + listT propertyTypeTT, + mapT propertyKeyT vT, + optionalT stringT] $ + lambda "checkValue" $ lambda "types" $ lambda "props" $ + ((ref checkAllDef @@ list [var "checkTypes", var "checkValues"]) + `with` [ + "checkTypes">: ref checkAllDef @@ (Lists.map @@ var "checkType" @@ var "types"), + "checkType">: + typed (funT propertyTypeTT $ optionalT stringT) $ + lambda "t" $ ifElse (project _PropertyType _PropertyType_required @@ var "t") + (ifOpt (Maps.lookup @@ (project _PropertyType _PropertyType_key @@ var "t") @@ var "props") + (just (ref prependDef @@ "Missing value for " @@ (unwrap _PropertyKey @@ (project _PropertyType _PropertyType_key @@ var "t")))) + (constant nothing)) + nothing, + "checkValues">: ((ref checkAllDef @@ (Lists.map @@ var "checkPair" @@ (Maps.toList @@ var "props"))) + `with` [ + "m">: typed (mapT propertyKeyT tT) $ + Maps.fromList @@ (Lists.map + @@ (lambda "p" $ pair + (project _PropertyType _PropertyType_key @@ var "p") + (project _PropertyType _PropertyType_value @@ var "p")) + @@ var "types"), + "checkPair">: lambda "pair" $ ((ifOpt (Maps.lookup @@ var "key" @@ var "m") + (just (ref prependDef @@ "Unexpected key" @@ (unwrap _PropertyKey @@ var "key"))) + (lambda "typ" $ Optionals.map + @@ (ref prependDef @@ "Invalid value") + @@ (var "checkValue" @@ var "typ" @@ var "val"))) + `with` [ + "key">: first @@ var "pair", + "val">: second @@ var "pair"])])]) + +validateVertexDef :: TElement ( + (t -> v -> Maybe String) + -> (v -> String) + -> PG.VertexType t + -> PG.Vertex v + -> Y.Maybe String) +validateVertexDef = validationDefinition "validateVertex" $ + functionN [ + funT tT (funT vT (optionalT stringT)), + funT vT stringT, + vertexTypeTT, + vertexVT, + optionalT stringT] $ + lambda "checkValue" $ lambda "showValue" $ lambda "typ" $ lambda "el" $ + ((ref checkAllDef @@ list [var "checkLabel", var "checkId", var "checkProperties"]) + `with` [ + "failWith">: typed (funT stringT stringT) $ + ref vertexErrorDef @@ var "showValue" @@ var "el", + "checkLabel">: (ref verifyDef + @@ (Equality.equalString + @@ (unwrap _VertexLabel @@ var "actual") + @@ (unwrap _VertexLabel @@ var "expected")) + @@ (var "failWith" @@ (ref prependDef @@ "Wrong label" @@ (ref vertexLabelMismatchDef @@ var "expected" @@ var "actual")))) + `with` [ + "expected">: project _VertexType _VertexType_label @@ var "typ", + "actual">: project _Vertex _Vertex_label @@ var "el"], + "checkId">: Optionals.map + @@ (var "failWith" <.> (ref prependDef @@ "Invalid id")) + @@ (var "checkValue" @@ (project _VertexType _VertexType_id @@ var "typ") @@ (project _Vertex _Vertex_id @@ var "el")), + "checkProperties">: Optionals.map + @@ (var "failWith" <.> (ref prependDef @@ "Invalid property")) + @@ (ref validatePropertiesDef + @@ var "checkValue" + @@ (project _VertexType _VertexType_properties @@ var "typ") + @@ (project _Vertex _Vertex_properties @@ var "el"))]) + +---- + +checkAllDef :: TElement ([Y.Maybe a] -> Y.Maybe a) +checkAllDef = validationDefinition "checkAll" $ + function (listT $ optionalT aT) (optionalT aT) $ + lambda "checks" ( + (Lists.safeHead @@ var "errors") + `with` [ + "errors">: Optionals.cat @@ var "checks"]) + +edgeErrorDef :: TElement ((v -> String) -> PG.Edge v -> String -> String) +edgeErrorDef = validationDefinition "edgeError" $ + functionN [funT vT stringT, edgeVT, stringT, stringT] $ + lambda "showValue" $ lambda "e" $ + ref prependDef @@ ("Invalid edge with id " ++ (var "showValue" @@ (project _Edge _Edge_id @@ var "e"))) + +edgeLabelMismatchDef :: TElement (PG.EdgeLabel -> PG.EdgeLabel -> String) +edgeLabelMismatchDef = validationDefinition "edgeLabelMismatch" $ + functionN [edgeLabelT, edgeLabelT, stringT] $ + lambda "expected" $ lambda "actual" $ + "expected " ++ (unwrap _EdgeLabel @@ var "expected") ++ ", found " ++ (unwrap _EdgeLabel @@ var "actual") + +prependDef :: TElement (String -> String -> String) +prependDef = validationDefinition "prepend" $ + functionN [stringT, stringT, stringT] $ + lambda "prefix" $ lambda "msg" $ + (var "prefix") ++ ": " ++ (var "msg") + +verifyDef :: TElement (Bool -> String -> Maybe String) +verifyDef = validationDefinition "verify" $ + functionN [booleanT, stringT, optionalT stringT] $ + lambda "b" $ lambda "err" $ + ifElse (var "b") + nothing + (just $ var "err") + +vertexErrorDef :: TElement ((v -> String) -> PG.Vertex v -> String -> String) +vertexErrorDef = validationDefinition "vertexError" $ + functionN [funT vT stringT, vertexVT, stringT, stringT] $ + lambda "showValue" $ lambda "v" $ + ref prependDef @@ ("Invalid vertex with id " ++ (var "showValue" @@ (project _Vertex _Vertex_id @@ var "v"))) + +vertexLabelMismatchDef :: TElement (PG.VertexLabel -> PG.VertexLabel -> String) +vertexLabelMismatchDef = validationDefinition "vertexLabelMismatch" $ + functionN [vertexLabelT, vertexLabelT, stringT] $ + lambda "expected" $ lambda "actual" $ + "expected " ++ (unwrap _VertexLabel @@ var "expected") ++ ", found " ++ (unwrap _VertexLabel @@ var "actual") + +ordV = (M.fromList [(Name "v", S.fromList [TypeClassOrdering])]) + +edgeLabelT = TypeVariable _EdgeLabel +edgeTypeTT = Types.apply (TypeVariable _EdgeType) tT +edgeVT = Types.apply (TypeVariable _Edge) vT +elementTypeTT = Types.apply (TypeVariable _ElementType) tT +elementVT = Types.apply (TypeVariable _Element) vT +graphSchemaTT = Types.apply (TypeVariable _GraphSchema) tT +graphVT = Types.apply (TypeVariable _Graph) vT +propertyKeyT = TypeVariable _PropertyKey +propertyTypeTT = Types.apply (TypeVariable _PropertyType) tT +vertexLabelT = TypeVariable _VertexLabel +vertexTypeTT = Types.apply (TypeVariable _VertexType) tT +vertexVT = Types.apply (TypeVariable _Vertex) vT +tT = Types.var "t" +vT = Types.var "v" diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Any.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Any.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Any.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Protobuf.Any where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +pbAnyNs = Namespace "hydra/ext/protobuf/any" +pbAny = typeref pbAnyNs + +protobufAnyModule :: Module +protobufAnyModule = Module pbAnyNs elements [hydraCoreModule] tier0Modules $ + Just "Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/any.proto" + where + def = datatype pbAnyNs + + elements = [ +-- // `Any` contains an arbitrary serialized protocol buffer message along with a +-- // URL that describes the type of the serialized message. +-- // +-- // Protobuf library provides support to pack/unpack Any values in the form +-- // of utility functions or additional generated methods of the Any type. +-- // +-- // Example 1: Pack and unpack a message in C++. +-- // +-- // Foo foo = ...; +-- // Any any; +-- // any.PackFrom(foo); +-- // ... +-- // if (any.UnpackTo(&foo)) { +-- // ... +-- // } +-- // +-- // Example 2: Pack and unpack a message in Java. +-- // +-- // Foo foo = ...; +-- // Any any = Any.pack(foo); +-- // ... +-- // if (any.is(Foo.class)) { +-- // foo = any.unpack(Foo.class); +-- // } +-- // // or ... +-- // if (any.isSameTypeAs(Foo.getDefaultInstance())) { +-- // foo = any.unpack(Foo.getDefaultInstance()); +-- // } +-- // +-- // Example 3: Pack and unpack a message in Python. +-- // +-- // foo = Foo(...) +-- // any = Any() +-- // any.Pack(foo) +-- // ... +-- // if any.Is(Foo.DESCRIPTOR): +-- // any.Unpack(foo) +-- // ... +-- // +-- // Example 4: Pack and unpack a message in Go +-- // +-- // foo := &pb.Foo{...} +-- // any, err := anypb.New(foo) +-- // if err != nil { +-- // ... +-- // } +-- // ... +-- // foo := &pb.Foo{} +-- // if err := any.UnmarshalTo(foo); err != nil { +-- // ... +-- // } +-- // +-- // The pack methods provided by protobuf library will by default use +-- // 'type.googleapis.com/full.type.name' as the type URL and the unpack +-- // methods only use the fully qualified type name after the last '/' +-- // in the type URL, for example "foo.bar.com/x/y.z" will yield type +-- // name "y.z". +-- // +-- // JSON +-- // +-- // The JSON representation of an `Any` value uses the regular +-- // representation of the deserialized, embedded message, with an +-- // additional field `@type` which contains the type URL. Example: +-- // +-- // package google.profile; +-- // message Person { +-- // string first_name = 1; +-- // string last_name = 2; +-- // } +-- // +-- // { +-- // "@type": "type.googleapis.com/google.profile.Person", +-- // "firstName": , +-- // "lastName": +-- // } +-- // +-- // If the embedded message type is well-known and has a custom JSON +-- // representation, that representation will be embedded adding a field +-- // `value` which holds the custom JSON in addition to the `@type` +-- // field. Example (for message [google.protobuf.Duration][]): +-- // +-- // { +-- // "@type": "type.googleapis.com/google.protobuf.Duration", +-- // "value": "1.212s" +-- // } +-- // +-- message Any { + def "Any" $ + doc ("`Any` contains an arbitrary serialized protocol buffer message along with a " ++ + "URL that describes the type of the serialized message.") $ + record [ +-- // A URL/resource name that uniquely identifies the type of the serialized +-- // protocol buffer message. This string must contain at least +-- // one "/" character. The last segment of the URL's path must represent +-- // the fully qualified name of the type (as in +-- // `path/google.protobuf.Duration`). The name should be in a canonical form +-- // (e.g., leading "." is not accepted). +-- // +-- // In practice, teams usually precompile into the binary all types that they +-- // expect it to use in the context of Any. However, for URLs which use the +-- // scheme `http`, `https`, or no scheme, one can optionally set up a type +-- // server that maps type URLs to message definitions as follows: +-- // +-- // * If no scheme is provided, `https` is assumed. +-- // * An HTTP GET on the URL must yield a [google.protobuf.Type][] +-- // value in binary format, or produce an error. +-- // * Applications are allowed to cache lookup results based on the +-- // URL, or have them precompiled into a binary to avoid any +-- // lookup. Therefore, binary compatibility needs to be preserved +-- // on changes to types. (Use versioned type names to manage +-- // breaking changes.) +-- // +-- // Note: this functionality is not currently available in the official +-- // protobuf release, and it is not used for type URLs beginning with +-- // type.googleapis.com. +-- // +-- // Schemes other than `http`, `https` (or the empty scheme) might be +-- // used with implementation specific semantics. +-- // +-- string type_url = 1; + "typeUrl">: + doc ("A URL/resource name that uniquely identifies the type of the serialized " ++ + "protocol buffer message.") + string, +-- +-- // Must be a valid serialized protocol buffer of the above specified type. +-- bytes value = 2; + "value">: + doc "Must be a valid serialized protocol buffer of the above specified type." + binary]] +-- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Language.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Language.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Language.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Protobuf.Language (protobufLanguageModule) where + +-- Standard Tier-4 imports +import Prelude hiding ((++)) +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Maybe as Y +import Hydra.Dsl.Base as Base +import qualified Hydra.Dsl.Core as Core +import qualified Hydra.Dsl.Graph as Graph +import qualified Hydra.Dsl.Lib.Equality as Equality +import qualified Hydra.Dsl.Lib.Flows as Flows +import qualified Hydra.Dsl.Lib.Io as Io +import qualified Hydra.Dsl.Lib.Lists as Lists +import qualified Hydra.Dsl.Lib.Literals as Literals +import qualified Hydra.Dsl.Lib.Logic as Logic +import qualified Hydra.Dsl.Lib.Maps as Maps +import qualified Hydra.Dsl.Lib.Math as Math +import qualified Hydra.Dsl.Lib.Optionals as Optionals +import qualified Hydra.Dsl.Lib.Sets as Sets +import Hydra.Dsl.Lib.Strings as Strings +import qualified Hydra.Dsl.Module as Module +import qualified Hydra.Dsl.Terms as Terms +import qualified Hydra.Dsl.Types as Types +import Hydra.Sources.Tier3.All + + +protobufLanguageDefinition :: String -> TTerm a -> TElement a +protobufLanguageDefinition = definitionInModule protobufLanguageModule + +protobufLanguageModule :: Module +protobufLanguageModule = Module ns elements [hydraCodersModule, hydraBasicsModule, hydraStripModule] tier0Modules $ + Just "Language constraints for Protobuf v3" + where + ns = Namespace "hydra/ext/protobuf/language" + elements = [ + el protobufLanguageDef, + el protobufReservedWordsDef] + +protobufLanguageDef :: TElement (Language) +protobufLanguageDef = protobufLanguageDefinition "protobufLanguage" $ + doc "Language constraints for Protocol Buffers v3" $ + typed languageT $ + record _Language [ + _Language_name>>: wrap _LanguageName "hydra/ext/protobuf", + _Language_constraints>>: record _LanguageConstraints [ + _LanguageConstraints_eliminationVariants>>: Sets.empty, + _LanguageConstraints_literalVariants>>: Sets.fromList @@ list (unitVariant _LiteralVariant <$> [ + _LiteralVariant_binary, + _LiteralVariant_boolean, + _LiteralVariant_float, + _LiteralVariant_integer, + _LiteralVariant_string]), + _LanguageConstraints_floatTypes>>: Sets.fromList @@ list (unitVariant _FloatType <$> [ + _FloatType_float32, + _FloatType_float64]), + _LanguageConstraints_functionVariants>>: Sets.empty, + _LanguageConstraints_integerTypes>>: Sets.fromList @@ list (unitVariant _IntegerType <$> [ + _IntegerType_int32, + _IntegerType_int64, + _IntegerType_uint32, + _IntegerType_uint64]), + _LanguageConstraints_termVariants>>: Sets.fromList @@ list (unitVariant _TermVariant <$> [ + _TermVariant_list, + _TermVariant_literal, + _TermVariant_map, + _TermVariant_optional, + _TermVariant_record, + _TermVariant_union]), + _LanguageConstraints_typeVariants>>: Sets.fromList @@ list (unitVariant _TypeVariant <$> [ + _TypeVariant_annotated, + _TypeVariant_list, + _TypeVariant_literal, + _TypeVariant_map, + _TypeVariant_optional, + _TypeVariant_record, + _TypeVariant_union, + _TypeVariant_variable]), + _LanguageConstraints_types>>: match _Type (Just true) [ + _Type_map>>: lambda "mt" (match _Type (Just true) [ + _Type_optional>>: constant false] @@ (ref stripTypeDef @@ (Core.mapTypeValues @@ var "mt")))]]] + +protobufReservedWordsDef :: TElement (S.Set String) +protobufReservedWordsDef = protobufLanguageDefinition "protobufReservedWords" $ + doc "A set of reserved words in Protobuf" $ + typed (setT stringT) $ + (Sets.fromList @@ (Lists.concat @@ list [var "fieldNames"])) + `with` [ + "fieldNames">: + doc "See: http://google.github.io/proto-lens/reserved-names.html" $ + list [ + "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl", + "infixr", "instance", "let", "mdo", "module", "newtype", "of", "pattern", "proc", "rec", "then", "type", "where"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Proto3.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Proto3.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Proto3.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Protobuf.Proto3 where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +proto3Ns = Namespace "hydra/ext/protobuf/proto3" +proto3 = typeref proto3Ns + +proto3Module :: Module +proto3Module = Module proto3Ns elements [hydraCoreModule] tier0Modules $ + Just ("A model for Protocol Buffers v3 enum and message types, designed as a target for transformations." + ++ "This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto," + ++ " as well as the proto3 reference documentation") + where + def = datatype proto3Ns + elements = [ + + def "Definition" $ + union [ + "enum">: proto3 "EnumDefinition", + "message">: proto3 "MessageDefinition"], + + def "EnumDefinition" $ + doc "Enum type definition" $ + record [ + "name">: + doc "Enum type name" $ + proto3 "TypeName", + "values">: + doc "Enum value definitions" $ + list $ proto3 "EnumValue", + "options">: + doc "Protocol buffer options" $ + list $ proto3 "Option"], + + def "EnumValue" $ + doc "Enum value definition" $ + record [ + "name">: + doc "Enum value name" $ + proto3 "EnumValueName", + "number">: + doc "Enum value number" + int32, + "options">: + doc "Protocol buffer options" $ + list $ proto3 "Option"], + + def "EnumValueName" string, + + def "Field" $ + doc "A single field of a message type" $ + record [ + "name">: + doc "The field name" $ + proto3 "FieldName", + "jsonName">: + doc "The field JSON name" $ + optional string, + "type">: + doc "The datatype of the field" $ + proto3 "FieldType", + "number">: + doc "The field number" + int32, + "options">: + doc "The protocol buffer options" $ + list $ proto3 "Option"], + + def "FieldName" $ + doc "The name of a field" + string, + + def "FieldType" $ + union [ + "map">: proto3 "SimpleType", + "oneof">: list $ proto3 "Field", + "repeated">: proto3 "SimpleType", + "simple">: proto3 "SimpleType"], + + def "FileReference" string, + + def "MessageDefinition" $ + doc "A protocol buffer message type" $ + record [ + "name">: + doc "The fully qualified message name" $ + proto3 "TypeName", + "fields">: + doc "The list of fields" $ + list $ proto3 "Field", + "options">: + doc "The protocol buffer options" $ + list $ proto3 "Option"], + + def "Option" $ + doc ("A protocol buffer option, which can be attached to a message, field, " ++ + "enumeration, etc") $ + record [ + "name">: + doc ("The option's name. For protobuf built-in options (options defined in " ++ + "descriptor.proto), this is the short name. For example, `\"map_entry\"`. " ++ + "For custom options, it should be the fully-qualified name. For example, " ++ + "`\"google.api.http\"`.") + string, + "value">: + doc ("The option's value") $ + proto3 "Value"], + + def "PackageName" string, + + def "ProtoFile" $ + doc "A .proto file, usually containing one or more enum or message type definitions" $ + record [ + "package">: proto3 "PackageName", + "imports">: list $ proto3 "FileReference", + "types">: list $ proto3 "Definition", + "options">: list $ proto3 "Option"], + + def "ScalarType" $ + doc "One of several Proto3 scalar types" $ + enum [ + "bool", + "bytes", + "double", + "fixed32", + "fixed64", + "float", + "int32", + "int64", + "sfixed32", + "sfixed64", + "sint32", + "sint64", + "string", + "uint32", + "uint64"], + + def "SimpleType" $ + doc "A scalar type or a reference to an enum type or message type" $ + union [ + "reference">: proto3 "TypeName", + "scalar">: proto3 "ScalarType"], + + def "TypeName" $ + doc "The local name of an enum type or message type" + string, + + def "TypeReference" $ + doc "A reference to an enum type or message type" + string, + + def "Value" $ + doc "A scalar value" $ + union [ + "boolean">: boolean, + "string">: string + -- Add other scalar value types as needed + ]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/SourceContext.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/SourceContext.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/SourceContext.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Protobuf.SourceContext where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Types as Types +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap + + +pbSourceContextNs = Namespace "hydra/ext/protobuf/sourceContext" +pbSourceContext = typeref pbSourceContextNs + +protobufSourceContextModule :: Module +protobufSourceContextModule = Module pbSourceContextNs elements [hydraCoreModule] tier0Modules $ + Just "Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/source_context.proto" + where + def = datatype pbSourceContextNs + + elements = [ +-- // `SourceContext` represents information about the source of a +-- // protobuf element, like the file in which it is defined. +-- message SourceContext { + def "SourceContext" $ + doc ("`SourceContext` represents information about the source of a " ++ + "protobuf element, like the file in which it is defined.") $ + record [ +-- // The path-qualified name of the .proto file that contained the associated +-- // protobuf element. For example: `"google/protobuf/source_context.proto"`. +-- string file_name = 1; + "fileName">: + doc ("The path-qualified name of the .proto file that contained the associated " ++ + "protobuf element. For example: `\"google/protobuf/source_context.proto\"`.") + string]] +-- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Rdf/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Rdf/Syntax.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Rdf/Syntax.hs @@ -0,0 +1,102 @@ +module Hydra.Sources.Tier4.Ext.Rdf.Syntax where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Types as Types +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap + + +rdfSyntaxModule :: Module +rdfSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just "An RDF 1.1 syntax model" + where + ns = Namespace "hydra/ext/org/w3/rdf/syntax" + def = datatype ns + rdf = typeref ns + + elements = [ + + def "BlankNode" string, + + def "RdfsClass" + $ doc "Stand-in for rdfs:Class" unit, + + def "Dataset" $ set $ rdf "Quad", + + def "Description" $ + doc "A graph of RDF statements together with a distinguished subject and/or object node" $ + record [ + "subject">: rdf "Node", + "graph">: rdf "Graph"], + + def "Graph" $ set $ rdf "Triple", + + def "Iri" $ + doc "An Internationalized Resource Identifier" + string, + + def "IriOrLiteral" $ + doc ("An IRI or a literal; " ++ + "this type is a convenience for downstream models like SHACL which may exclude blank nodes") $ + union [ + "iri">: rdf "Iri", + "literal">: rdf "Literal"], + + def "LangStrings" $ + doc "A convenience type which provides at most one string value per language, and optionally a value without a language" $ + Types.map (optional $ rdf "LanguageTag") string, + + def "LanguageTag" $ + doc "A BCP47 language tag" + string, + + def "Literal" $ + doc "A value such as a string, number, or date" $ + record [ + "lexicalForm">: + doc "a Unicode string, which should be in Normal Form C" + string, + "datatypeIri">: + doc "an IRI identifying a datatype that determines how the lexical form maps to a literal value" $ + rdf "Iri", + "languageTag">: + doc "An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString" $ + optional $ rdf "LanguageTag"], + + def "Node" $ + union [ + "iri">: rdf "Iri", + "bnode">: rdf "BlankNode", + "literal">: rdf "Literal"], + + def "Property" $ + doc "A type representing an RDF property, and encapsulating its domain, range, and subclass relationships" $ + record [ + "domain">: + doc "State that any resource that has a given property is an instance of one or more classes" $ + set $ rdf "RdfsClass", + "range">: + doc "States that the values of a property are instances of one or more classes" $ + set $ rdf "RdfsClass", + "subPropertyOf">: + set $ rdf "Property"], + + def "Quad" $ + doc "An RDF triple with an optional named graph component" $ + record [ + "subject">: rdf "Resource", + "predicate">: rdf "Iri", + "object">: rdf "Node", + "graph">: optional $ rdf "Iri"], + + def "Resource" $ + union [ + "iri">: rdf "Iri", + "bnode">: rdf "BlankNode"], + + def "Triple" $ + doc "An RDF triple defined by a subject, predicate, and object" $ + record [ + "subject">: rdf "Resource", + "predicate">: rdf "Iri", + "object">: rdf "Node"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/RelationalModel.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/RelationalModel.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/RelationalModel.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.RelationalModel where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +relationalModelModule :: Module +relationalModelModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("An interpretation of Codd's Relational Model, " ++ + "as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). " ++ + "Types ('domains') and values are parameterized so as to allow for application-specific implementations. " ++ + "No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.") + where + ns = Namespace "hydra/ext/relationalModel" + def = datatype ns + rm = typeref ns + + elements = [ + def "ColumnName" $ + doc "A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd" + string, + + def "ColumnSchema" $ + doc "An abstract specification of the domain represented by a column in a relation; a role" $ + lambda "t" $ record [ + "name">: + doc "A unique name for the column" $ + rm "ColumnName", + "domain">: + doc "The domain (type) of the column" $ + "t", + "isPrimaryKey">: + doc "Whether this column represents the primary key of its relation" + boolean], + + def "ForeignKey" $ + doc "A mapping from certain columns of a source relation to primary key columns of a target relation" $ + record [ + "foreignRelation">: + doc "The name of the target relation" $ + rm "RelationName", + "keys">: + Types.map (rm "ColumnName") (rm "ColumnName")], -- TODO: nonempty map + + def "PrimaryKey" $ + doc "A primary key of a relation, specified either as a single column, or as a list of columns" $ + list $ rm "ColumnName", -- TODO: non-empty list + + def "Relation" $ + doc "A set of distinct n-tuples; a table" $ + lambda "v" $ set $ list "v", + + def "RelationName" $ + doc "A unique relation (table) name" + string, + + def "RelationSchema" $ -- Note: this term is not in Codd + doc "An abstract relation; the name and columns of a relation without its actual data" $ + lambda "t" $ record [ + "name">: + doc "A unique name for the relation" $ + rm "RelationName", + "columns">: + doc "A list of column specifications" $ + list $ rm "ColumnSchema" @@ "t", + "primaryKeys">: + doc "Any number of primary keys for the relation, each of which must be valid for this relation" $ + list $ rm "PrimaryKey", + "foreignKeys">: + doc "Any number of foreign keys, each of which must be valid for both this relation and the target relation" $ + list $ rm "ForeignKey"], + + def "Relationship" $ + doc "A domain-unordered (string-indexed, rather than position-indexed) relation" $ + lambda "v" $ set $ Types.map (rm "ColumnName") "v", + + def "Row" $ + doc "An n-tuple which is an element of a given relation" $ + lambda "v" $ list "v"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Scala/Meta.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Scala/Meta.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Scala/Meta.hs @@ -0,0 +1,1372 @@ +module Hydra.Sources.Tier4.Ext.Scala.Meta where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +scalaMetaModule :: Module +scalaMetaModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just "A Scala syntax model based on Scalameta (https://scalameta.org)" + where + ns = Namespace "hydra/ext/scala/meta" + def = datatype ns + meta = typeref ns + + elements = [ + + def "PredefString" -- See scala/Predef.scala + string, + + def "ScalaSymbol" $ -- See scala/Symbol.scala + record [ + "name">: string], + +-- scala/meta/Trees.scala source below this line. Hydra type definitions inline + +-- package scala.meta +-- +-- import org.scalameta.invariants._ +-- import scala.meta.classifiers._ +-- import scala.meta.inputs._ +-- import scala.meta.tokens._ +-- import scala.meta.prettyprinters._ +-- import scala.meta.internal.trees._ +-- import scala.meta.internal.trees.Metadata.binaryCompatField +-- @root trait Tree extends InternalTree { + def "Tree" $ -- Note: ignoring fields of Tree and InternalTree for now + union [ + "ref">: meta "Ref", + "stat">: meta "Stat", + "type">: meta "Type", + "bounds">: meta "Type.Bounds", + "pat">: meta "Pat", + "member">: meta "Member", + "ctor">: meta "Ctor", + "template">: meta "Template", + "mod">: meta "Mod", + "enumerator">: meta "Enumerator", + "importer">: meta "Importer", + "importee">: meta "Importee", + "caseTree">: meta "CaseTree", + "source">: meta "Source", + "quasi">: meta "Quasi"], +-- def parent: Option[Tree] +-- def children: List[Tree] +-- +-- def pos: Position +-- def tokens(implicit dialect: Dialect): Tokens +-- +-- final override def canEqual(that: Any): Boolean = this eq that.asInstanceOf[AnyRef] +-- final override def equals(that: Any): Boolean = this eq that.asInstanceOf[AnyRef] +-- final override def hashCode: Int = System.identityHashCode(this) +-- final override def toString = scala.meta.internal.prettyprinters.TreeToString(this) +-- } +-- +-- object Tree extends InternalTreeXtensions { +-- implicit def classifiable[T <: Tree]: Classifiable[T] = null +-- implicit def showStructure[T <: Tree]: Structure[T] = +-- scala.meta.internal.prettyprinters.TreeStructure.apply[T] +-- implicit def showSyntax[T <: Tree](implicit dialect: Dialect): Syntax[T] = +-- scala.meta.internal.prettyprinters.TreeSyntax.apply[T](dialect) +-- } +-- +-- @branch trait Ref extends Tree + def "Ref" $ + union [ + "name">: meta "Name", + "init">: meta "Init"], +-- @branch trait Stat extends Tree + def "Stat" $ + union [ + "term">: meta "Data", + "decl">: meta "Decl", + "defn">: meta "Defn", + "importExport">: meta "ImportExportStat"], +-- +-- @branch trait Name extends Ref { def value: String } + def "Name" $ + union [ + "value">: string, + "anonymous">: unit, + "indeterminate">: meta "PredefString"], +-- object Name { +-- def apply(value: String): Name = if (value == "") Name.Anonymous() else Name.Indeterminate(value) +-- def unapply(name: Name): Option[String] = Some(name.value) +-- @ast class Anonymous() extends Name { +-- def value = "" +-- checkParent(ParentChecks.NameAnonymous) +-- } +-- @ast class Indeterminate(value: Predef.String @nonEmpty) extends Name +-- } +-- +-- @branch trait Lit extends Data with Pat with Type { + def "Lit" $ + union [ +-- def value: Any +-- } +-- object Lit { +-- def unapply(arg: Lit): Option[Any] = Some(arg.value) +-- @ast class Null() extends Lit { def value: Any = null } + "null">: unit, +-- @ast class Int(value: scala.Int) extends Lit + "int">: int32, +-- // NOTE: Lit.Double/Float are strings to work the same across JS/JVM. Example: +-- // 1.4f.toString == "1.399999976158142" // in JS +-- // 1.4f.toString == "1.4" // in JVM +-- // See https://www.scala-js.org/doc/semantics.html-- tostring-of-float-double-and-unit +-- @ast class Double(format: scala.Predef.String) extends Lit { val value = format.toDouble } + "double">: float64, +-- object Double { def apply(double: scala.Double): Double = Lit.Double(double.toString) } +-- @ast class Float(format: scala.Predef.String) extends Lit { val value = format.toFloat } + "float">: float32, +-- object Float { def apply(float: scala.Float): Float = Lit.Float(float.toString) } +-- @ast class Byte(value: scala.Byte) extends Lit + "byte">: int8, +-- @ast class Short(value: scala.Short) extends Lit + "short">: int16, +-- @ast class Char(value: scala.Char) extends Lit + "char">: uint16, +-- @ast class Long(value: scala.Long) extends Lit + "long">: int64, +-- @ast class Boolean(value: scala.Boolean) extends Lit + "boolean">: boolean, +-- @ast class Unit() extends Lit { def value: Any = () } + "unit">: unit, +-- @ast class String(value: scala.Predef.String) extends Lit + "string">: string, +-- @ast class Symbol(value: scala.Symbol) extends Lit + "symbol">: meta "ScalaSymbol"], +-- } +-- +-- @branch trait Data extends Stat + def "Data" $ + union [ + "lit">: meta "Lit", + "ref">: meta "Data.Ref", + "interpolate">: meta "Data.Interpolate", + "xml">: meta "Data.Xml", + "apply">: meta "Data.Apply", + "applyUsing">: meta "Data.ApplyUsing", + "applyType">: meta "Data.ApplyType", + "assign">: meta "Data.Assign", + "return">: meta "Data.Return", + "throw">: meta "Data.Throw", + "ascribe">: meta "Data.Ascribe", + "annotate">: meta "Data.Annotate", + "tuple">: meta "Data.Tuple", + "block">: meta "Data.Block", + "endMarker">: meta "Data.EndMarker", + "if">: meta "Data.If", + "quotedMacroExpr">: meta "Data.QuotedMacroExpr", + "quotedMacroType">: meta "Data.QuotedMacroType", + "splicedMacroExpr">: meta "Data.SplicedMacroExpr", + "match">: meta "Data.Match", + "try">: meta "Data.Try", + "tryWithHandler">: meta "Data.TryWithHandler", + "functionData">: meta "Data.FunctionData", + "polyFunction">: meta "Data.PolyFunction", + "partialFunction">: meta "Data.PartialFunction", + "while">: meta "Data.While", + "do">: meta "Data.Do", + "for">: meta "Data.For", + "forYield">: meta "Data.ForYield", + "new">: meta "Data.New", + "newAnonymous">: meta "Data.NewAnonymous", + "placeholder">: meta "Data.Placeholder", + "eta">: meta "Data.Eta", + "repeated">: meta "Data.Repeated", + "param">: meta "Data.Param"], +-- object Data { +-- @branch trait Ref extends Data with scala.meta.Ref + def "Data.Ref" $ + union [ + "this">: meta "Data.This", + "super">: meta "Data.Super", + "name">: meta "Data.Name", + "anonymous">: meta "Data.Anonymous", + "select">: meta "Data.Select", + "applyUnary">: meta "Data.ApplyUnary"], +-- @ast class This(qual: scala.meta.Name) extends Data.Ref + def "Data.This" + unit, +-- @ast class Super(thisp: scala.meta.Name, superp: scala.meta.Name) extends Data.Ref + def "Data.Super" $ + record [ + "thisp">: meta "Name", + "superp">: meta "Name"], +-- @ast class Name(value: Predef.String @nonEmpty) extends scala.meta.Name with Data.Ref with Pat + def "Data.Name" $ + record [ + "value">: meta "PredefString"], +-- @ast class Anonymous() extends scala.meta.Name with Data.Ref { + def "Data.Anonymous" + unit, +-- def value = "" +-- checkParent(ParentChecks.AnonymousImport) +-- } +-- @ast class Select(qual: Data, name: Data.Name) extends Data.Ref with Pat + def "Data.Select" $ + record [ + "qual">: meta "Data", + "name">: meta "Data.Name"], +-- @ast class Interpolate(prefix: Name, parts: List[Lit] @nonEmpty, args: List[Data]) extends Data { + def "Data.Interpolate" $ + record [ + "prefix">: meta "Data.Name", + "parts">: list $ meta "Lit", + "args">: list $ meta "Data"], +-- checkFields(parts.length == args.length + 1) +-- } +-- @ast class Xml(parts: List[Lit] @nonEmpty, args: List[Data]) extends Data { + def "Data.Xml" $ + record [ + "parts">: list $ meta "Lit", + "args">: list $ meta "Data"], +-- checkFields(parts.length == args.length + 1) +-- } +-- @ast class Apply(fun: Data, args: List[Data]) extends Data + def "Data.Apply" $ + record [ + "fun">: meta "Data", + "args">: list $ meta "Data"], +-- @ast class ApplyUsing(fun: Data, args: List[Data]) extends Data + def "Data.ApplyUsing" $ + record [ + "fun">: meta "Data", + "targs">: list $ meta "Data"], +-- @ast class ApplyType(fun: Data, targs: List[Type] @nonEmpty) extends Data + def "Data.ApplyType" $ + record [ + "lhs">: meta "Data", + "op">: meta "Data.Name", + "targs">: list $ meta "Type", + "args">: list $ meta "Data"], +-- @ast class ApplyInfix(lhs: Data, op: Name, targs: List[Type], args: List[Data]) extends Data + def "Data.ApplyInfix" $ + record [ + "lhs">: meta "Data", + "op">: meta "Data.Name", + "targs">: list $ meta "Type", + "args">: list $ meta "Data"], +-- @ast class ApplyUnary(op: Name, arg: Data) extends Data.Ref { + def "Data.ApplyUnary" $ + record [ + "op">: meta "Data.Name", + "arg">: meta "Data"], +-- checkFields(op.isUnaryOp) +-- } +-- @ast class Assign(lhs: Data, rhs: Data) extends Data { + def "Data.Assign" $ + record [ + "lhs">: meta "Data", + "rhs">: meta "Data"], +-- checkFields(lhs.is[Data.Quasi] || lhs.is[Data.Ref] || lhs.is[Data.Apply]) +-- checkParent(ParentChecks.DataAssign) +-- } +-- @ast class Return(expr: Data) extends Data + def "Data.Return" $ + record [ + "expr">: meta "Data"], +-- @ast class Throw(expr: Data) extends Data + def "Data.Throw" $ + record [ + "expr">: meta "Data"], +-- @ast class Ascribe(expr: Data, tpe: Type) extends Data + def "Data.Ascribe" $ + record [ + "expr">: meta "Data", + "tpe">: meta "Type"], +-- @ast class Annotate(expr: Data, annots: List[Mod.Annot] @nonEmpty) extends Data + def "Data.Annotate" $ + record [ + "expr">: meta "Data", + "annots">: list $ meta "Mod.Annot"], +-- @ast class Tuple(args: List[Data] @nonEmpty) extends Data { + def "Data.Tuple" $ + record [ + "args">: list $ meta "Data"], +-- // tuple must have more than one element +-- // however, this element may be Quasi with "hidden" list of elements inside +-- checkFields(args.length > 1 || (args.length == 1 && args.head.is[Data.Quasi])) +-- } +-- @ast class Block(stats: List[Stat]) extends Data { + def "Data.Block" $ + record [ + "stats">: list $ meta "Stat"], +-- // extension group block can have declarations without body too +-- checkFields(stats.forall(st => st.isBlockStat || st.is[Decl])) +-- } +-- @ast class EndMarker(name: Data.Name) extends Data + def "Data.EndMarker" $ + record [ + "name">: meta "Data.Name"], +-- @ast class If(cond: Data, thenp: Data, elsep: Data) extends Data { + def "Data.If" $ + record [ + "cond">: meta "Data", + "thenp">: meta "Data", + "elsep">: meta "Data"], +-- @binaryCompatField(since = "4.4.0") +-- private var _mods: List[Mod] = Nil +-- } +-- @ast class QuotedMacroExpr(body: Data) extends Data + def "Data.QuotedMacroExpr" $ + record [ + "body">: meta "Data"], +-- @ast class QuotedMacroType(tpe: Type) extends Data + def "Data.QuotedMacroType" $ + record [ + "tpe">: meta "Type"], +-- @ast class SplicedMacroExpr(body: Data) extends Data + def "Data.SplicedMacroExpr" $ + record [ + "body">: meta "Data"], +-- @ast class Match(expr: Data, cases: List[Case] @nonEmpty) extends Data { + def "Data.Match" $ + record [ + "expr">: meta "Data", + "cases">: list $ meta "Case"], +-- @binaryCompatField(since = "4.4.5") +-- private var _mods: List[Mod] = Nil +-- } +-- @ast class Try(expr: Data, catchp: List[Case], finallyp: Option[Data]) extends Data + def "Data.Try" $ + record [ + "expr">: meta "Data", + "catchp">: list $ meta "Case", + "finallyp">: optional $ meta "Data"], +-- @ast class TryWithHandler(expr: Data, catchp: Data, finallyp: Option[Data]) extends Data + def "Data.TryWithHandler" $ + record [ + "expr">: meta "Data", + "catchp">: meta "Data", + "finallyp">: optional $ meta "Data"], +-- +-- @branch trait FunctionData extends Data { + def "Data.FunctionData" $ + union [ + "contextFunction">: meta "Data.ContextFunction", + "function">: meta "Data.Function"], +-- def params: List[Data.Param] +-- def body: Data +-- } +-- @ast class ContextFunction(params: List[Data.Param], body: Data) extends FunctionData { + def "Data.ContextFunction" $ + record [ + "params">: list $ meta "Data.Param", + "body">: meta "Data"], +-- checkFields( +-- params.forall(param => +-- param.is[Data.Param.Quasi] || +-- (param.name.is[scala.meta.Name.Anonymous] ==> param.default.isEmpty) +-- ) +-- ) +-- } +-- @ast class Function(params: List[Data.Param], body: Data) extends FunctionData { + def "Data.Function" $ + record [ + "params">: list $ meta "Data.Param", + "body">: meta "Data"], +-- checkFields( +-- params.forall(param => +-- param.is[Data.Param.Quasi] || +-- (param.name.is[scala.meta.Name.Anonymous] ==> param.default.isEmpty) +-- ) +-- ) +-- checkFields( +-- params.exists(_.is[Data.Param.Quasi]) || +-- params.exists(_.mods.exists(_.is[Mod.Implicit])) ==> (params.length == 1) +-- ) +-- } +-- @ast class PolyFunction(tparams: List[Type.Param], body: Data) extends Data + def "Data.PolyFunction" $ + record [ + "tparams">: list $ meta "Type.Param", + "body">: meta "Data"], +-- @ast class PartialFunction(cases: List[Case] @nonEmpty) extends Data + def "Data.PartialFunction" $ + record [ + "cases">: list $ meta "Case"], +-- @ast class While(expr: Data, body: Data) extends Data + def "Data.While" $ + record [ + "expr">: meta "Data", + "body">: meta "Data"], +-- @ast class Do(body: Data, expr: Data) extends Data + def "Data.Do" $ + record [ + "body">: meta "Data", + "expr">: meta "Data"], +-- @ast class For(enums: List[Enumerator] @nonEmpty, body: Data) extends Data { + def "Data.For" $ + record [ + "enums">: list $ meta "Enumerator"], +-- checkFields( +-- enums.head.is[Enumerator.Generator] || enums.head.is[Enumerator.CaseGenerator] || enums.head +-- .is[Enumerator.Quasi] +-- ) +-- } +-- @ast class ForYield(enums: List[Enumerator] @nonEmpty, body: Data) extends Data + def "Data.ForYield" $ + record [ + "enums">: list $ meta "Enumerator"], +-- @ast class New(init: Init) extends Data + def "Data.New" $ + record [ + "init">: meta "Init"], +-- @ast class NewAnonymous(templ: Template) extends Data + def "Data.NewAnonymous" $ + record [ + "templ">: meta "Template"], +-- @ast class Placeholder() extends Data + def "Data.Placeholder" + unit, +-- @ast class Eta(expr: Data) extends Data + def "Data.Eta" $ + record [ + "expr">: meta "Data"], +-- @ast class Repeated(expr: Data) extends Data { + def "Data.Repeated" $ + record [ + "expr">: meta "Data"], +-- checkParent(ParentChecks.DataRepeated) +-- } +-- @ast class Param(mods: List[Mod], name: meta.Name, decltpe: Option[Type], default: Option[Data]) +-- extends Member + def "Data.Param" $ + record [ + "mods">: list $ meta "Mod", + "name">: meta "Name", + "decltpe">: optional $ meta "Type", + "default">: optional $ meta "Data"], +-- def fresh(): Data.Name = fresh("fresh") +-- def fresh(prefix: String): Data.Name = Data.Name(prefix + Fresh.nextId()) +-- } +-- +-- @branch trait Type extends Tree + def "Type" $ + union [ + "ref">: meta "Type.Ref", + "anonymousName">: meta "Type.AnonymousName", + "apply">: meta "Type.Apply", + "applyInfix">: meta "Type.ApplyInfix", + "functionType">: meta "Type.FunctionType", + "polyFunction">: meta "Type.PolyFunction", + "implicitFunction">: meta "Type.ImplicitFunction", + "tuple">: meta "Type.Tuple", + "with">: meta "Type.With", + "and">: meta "Type.And", + "or">: meta "Type.Or", + "refine">: meta "Type.Refine", + "existential">: meta "Type.Existential", + "annotate">: meta "Type.Annotate", + "lambda">: meta "Type.Lambda", + "macro">: meta "Type.Macro", + "method">: meta "Type.Method", + "placeholder">: meta "Type.Placeholder", + "byName">: meta "Type.ByName", + "repeated">: meta "Type.Repeated", + "var">: meta "Type.Var", + "typedParam">: meta "Type.TypedParam", + "match">: meta "Type.Match"], +-- object Type { +-- @branch trait Ref extends Type with scala.meta.Ref + def "Type.Ref" $ + union [ + "name">: meta "Type.Name", + "select">: meta "Type.Select", + "project">: meta "Type.Project", + "singleton">: meta "Type.Singleton"], +-- @ast class Name(value: String @nonEmpty) extends scala.meta.Name with Type.Ref + def "Type.Name" $ + record [ + "value">: string], +-- @ast class AnonymousName() extends Type + def "Type.AnonymousName" + unit, +-- @ast class Select(qual: Data.Ref, name: Type.Name) extends Type.Ref { + def "Type.Select" $ + record [ + "qual">: meta "Data.Ref", + "name">: meta "Type.Name"], +-- checkFields(qual.isPath || qual.is[Data.Super] || qual.is[Data.Ref.Quasi]) +-- } +-- @ast class Project(qual: Type, name: Type.Name) extends Type.Ref + def "Type.Project" $ + record [ + "qual">: meta "Type", + "name">: meta "Type.Name"], +-- @ast class Singleton(ref: Data.Ref) extends Type.Ref { + def "Type.Singleton" $ + record [ + "ref">: meta "Data.Ref"], +-- checkFields(ref.isPath || ref.is[Data.Super]) +-- } +-- @ast class Apply(tpe: Type, args: List[Type] @nonEmpty) extends Type + def "Type.Apply" $ + record [ + "tpe">: meta "Type", + "args">: list $ meta "Type"], +-- @ast class ApplyInfix(lhs: Type, op: Name, rhs: Type) extends Type + def "Type.ApplyInfix" $ + record [ + "lhs">: meta "Type", + "op">: meta "Type.Name", + "rhs">: meta "Type"], +-- @branch trait FunctionType extends Type { + def "Type.FunctionType" $ + union [ + "function">: meta "Type.Function", + "contextFunction">: meta "Type.ContextFunction"], +-- def params: List[Type] +-- def res: Type +-- } +-- @ast class Function(params: List[Type], res: Type) extends FunctionType + def "Type.Function" $ + record [ + "params">: list $ meta "Type", + "res">: meta "Type"], +-- @ast class PolyFunction(tparams: List[Type.Param], tpe: Type) extends Type + def "Type.PolyFunction" $ + record [ + "tparams">: list $ meta "Type.Param", + "tpe">: meta "Type"], +-- @ast class ContextFunction(params: List[Type], res: Type) extends FunctionType + def "Type.ContextFunction" $ + record [ + "params">: list $ meta "Type", + "res">: meta "Type"], +-- @ast @deprecated("Implicit functions are not supported in any dialect") +-- class ImplicitFunction( + def "Type.ImplicitFunction" $ + record [ +-- params: List[Type], + "params">: list $ meta "Type", +-- res: Type + "res">: meta "Type"], +-- ) extends Type +-- @ast class Tuple(args: List[Type] @nonEmpty) extends Type { + def "Type.Tuple" $ + record [ + "args">: list $ meta "Type"], +-- checkFields(args.length > 1 || (args.length == 1 && args.head.is[Type.Quasi])) +-- } +-- @ast class With(lhs: Type, rhs: Type) extends Type + def "Type.With" $ + record [ + "lhs">: meta "Type", + "rhs">: meta "Type"], +-- @ast class And(lhs: Type, rhs: Type) extends Type + def "Type.And" $ + record [ + "lhs">: meta "Type", + "rhs">: meta "Type"], +-- @ast class Or(lhs: Type, rhs: Type) extends Type + def "Type.Or" $ + record [ + "lhs">: meta "Type", + "rhs">: meta "Type"], +-- @ast class Refine(tpe: Option[Type], stats: List[Stat]) extends Type { + def "Type.Refine" $ + record [ + "tpe">: optional $ meta "Type", + "stats">: list $ meta "Stat"], +-- checkFields(stats.forall(_.isRefineStat)) +-- } +-- @ast class Existential(tpe: Type, stats: List[Stat] @nonEmpty) extends Type { + def "Type.Existential" $ + record [ + "tpe">: meta "Type", + "stats">: list $ meta "Stat"], +-- checkFields(stats.forall(_.isExistentialStat)) +-- } +-- @ast class Annotate(tpe: Type, annots: List[Mod.Annot] @nonEmpty) extends Type + def "Type.Annotate" $ + record [ + "tpe">: meta "Type", + "annots">: list $ meta "Mod.Annot"], +-- @ast class Lambda(tparams: List[Type.Param], tpe: Type) extends Type { + def "Type.Lambda" $ + record [ + "tparams">: list $ meta "Type.Param", + "tpe">: meta "Type"], +-- checkParent(ParentChecks.LambdaType) +-- } +-- @ast class Macro(body: Data) extends Type + def "Type.Macro" $ + record [ + "body">: meta "Data"], +-- @deprecated("Method type syntax is no longer supported in any dialect", "4.4.3") +-- @ast class Method(paramss: List[List[Data.Param]], tpe: Type) extends Type { + def "Type.Method" $ + record [ + "paramss">: list $ list $ meta "Data.Param", + "tpe">: meta "Type"], +-- checkParent(ParentChecks.TypeMethod) +-- } +-- @ast class Placeholder(bounds: Bounds) extends Type + def "Type.Placeholder" $ + record [ + "bounds">: meta "Type.Bounds"], +-- @ast class Bounds(lo: Option[Type], hi: Option[Type]) extends Tree + def "Type.Bounds" $ + record [ + "lo">: optional $ meta "Type", + "hi">: optional $ meta "Type"], +-- @ast class ByName(tpe: Type) extends Type { + def "Type.ByName" $ + record [ + "tpe">: meta "Type"], +-- checkParent(ParentChecks.TypeByName) +-- } +-- @ast class Repeated(tpe: Type) extends Type { + def "Type.Repeated" $ + record [ + "tpe">: meta "Type"], +-- checkParent(ParentChecks.TypeRepeated) +-- } +-- @ast class Var(name: Name) extends Type with Member.Type { + def "Type.Var" $ + record [ + "name">: meta "Type.Name"], +-- checkFields(name.value(0).isLower) +-- checkParent(ParentChecks.TypeVar) +-- } +-- +-- @ast class TypedParam(name: Name, typ: Type) extends Type with Member.Type + def "Type.TypedParam" $ + record [ + "name">: meta "Name", + "typ">: meta "Type"], +-- @ast class Param( + def "Type.Param" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: meta.Name, + "name">: meta "Name", +-- tparams: List[Type.Param], + "tparams">: list $ meta "Type.Param", +-- tbounds: Type.Bounds, + "tbounds">: list $ meta "Type.Bounds", +-- vbounds: List[Type], + "vbounds">: list $ meta "Type", +-- cbounds: List[Type] + "cbounds">: list $ meta "Type"], +-- ) extends Member +-- +-- @ast class Match(tpe: Type, cases: List[TypeCase] @nonEmpty) extends Type + def "Type.Match" $ + record [ + "tpe">: meta "Type", + "cases">: list $ meta "TypeCase"], +-- def fresh(): Type.Name = fresh("fresh") +-- def fresh(prefix: String): Type.Name = Type.Name(prefix + Fresh.nextId()) +-- } +-- +-- @branch trait Pat extends Tree + def "Pat" $ + union [ + "var">: meta "Pat.Var", + "wildcard">: unit, + "seqWildcard">: unit, + "bind">: meta "Pat.Bind", + "alternative">: meta "Pat.Alternative", + "tuple">: meta "Pat.Tuple", + "repeated">: meta "Pat.Repeated", + "extract">: meta "Pat.Extract", + "extractInfix">: meta "Pat.ExtractInfix", + "interpolate">: meta "Pat.Interpolate", + "xml">: meta "Pat.Xml", + "typed">: meta "Pat.Typed", + "macro">: meta "Pat.Macro", + "given">: meta "Pat.Given"], +-- object Pat { +-- @ast class Var(name: scala.meta.Data.Name) extends Pat with Member.Data { @ + def "Pat.Var" $ + record [ + "name">: meta "Data.Name"], +-- // NOTE: can't do this check here because of things like `val X = 2` +-- // checkFields(name.value(0).isLower) +-- checkParent(ParentChecks.PatVar) +-- } +-- @ast class Wildcard() extends Pat +-- @ast class SeqWildcard() extends Pat { +-- checkParent(ParentChecks.PatSeqWildcard) +-- } +-- @ast class Bind(lhs: Pat, rhs: Pat) extends Pat { + def "Pat.Bind" $ + record [ + "lhs">: meta "Pat", + "rhs">: meta "Pat"], +-- checkFields(lhs.is[Pat.Var] || lhs.is[Pat.Quasi]) +-- } +-- @ast class Alternative(lhs: Pat, rhs: Pat) extends Pat + def "Pat.Alternative" $ + record [ + "lhs">: meta "Pat", + "rhs">: meta "Pat"], +-- @ast class Tuple(args: List[Pat] @nonEmpty) extends Pat { + def "Pat.Tuple" $ + record [ + "args">: list $ meta "Pat"], +-- checkFields(args.length > 1 || (args.length == 1 && args.head.is[Pat.Quasi])) +-- } +-- @ast class Repeated(name: scala.meta.Data.Name) extends Pat + def "Pat.Repeated" $ + record [ + "name">: meta "Data.Name"], +-- @ast class Extract(fun: Data, args: List[Pat]) extends Pat { + def "Pat.Extract" $ + record [ + "fun">: meta "Data", + "args">: list $ meta "Pat"], +-- checkFields(fun.isExtractor) +-- } +-- @ast class ExtractInfix(lhs: Pat, op: Data.Name, rhs: List[Pat]) extends Pat + def "Pat.ExtractInfix" $ + record [ + "lhs">: meta "Pat", + "op">: meta "Data.Name", + "rhs">: list $ meta "Pat"], +-- @ast class Interpolate(prefix: Data.Name, parts: List[Lit] @nonEmpty, args: List[Pat]) + def "Pat.Interpolate" $ + record [ + "prefix">: meta "Data.Name", + "parts">: list $ meta "Lit"], +-- extends Pat { +-- checkFields(parts.length == args.length + 1) +-- } +-- @ast class Xml(parts: List[Lit] @nonEmpty, args: List[Pat]) extends Pat { + def "Pat.Xml" $ + record [ + "parts">: list $ meta "Lit", + "args">: list $ meta "Pat"], +-- checkFields(parts.length == args.length + 1) +-- } +-- @ast class Typed(lhs: Pat, rhs: Type) extends Pat { + def "Pat.Typed" $ + record [ + "lhs">: meta "Pat", + "rhs">: meta "Type"], +-- checkFields(!rhs.is[Type.Var] && !rhs.is[Type.Placeholder]) +-- } +-- @ast class Macro(body: Data) extends Pat { + def "Pat.Macro" $ + record [ + "body">: meta "Data"], +-- checkFields(body.is[Data.QuotedMacroExpr] || body.is[Data.QuotedMacroType]) +-- } +-- @ast class Given(tpe: Type) extends Pat + def "Pat.Given" $ + record [ + "tpe">: meta "Type"], +-- def fresh(): Pat.Var = Pat.Var(Data.fresh()) +-- def fresh(prefix: String): Pat.Var = Pat.Var(Data.fresh(prefix)) +-- } +-- +-- @branch trait Member extends Tree { + def "Member" $ + union [ + "term">: meta "Member.Data", + "type">: meta "Member.Type", + "termParam">: meta "Data.Param", + "typeParam">: meta "Type.Param", + "self">: meta "Self"], +-- def name: Name +-- } +-- object Member { +-- @branch trait Data extends Member { + def "Member.Data" $ + union [ + "pkg">: meta "Pkg", + "object">: meta "Pkg.Object"], +-- def name: scala.meta.Data.Name +-- } +-- @branch trait Type extends Member { + def "Member.Type" $ + record [ +-- def name: scala.meta.Type.Name + "name">: meta "Type.Name"], +-- } +-- } +-- +-- @branch trait Decl extends Stat + def "Decl" $ + union [ + "val">: meta "Decl.Val", + "var">: meta "Decl.Var", + "def">: meta "Decl.Def", + "type">: meta "Decl.Type", + "given">: meta "Decl.Given"], +-- object Decl { +-- @ast class Val(mods: List[Mod], pats: List[Pat] @nonEmpty, decltpe: scala.meta.Type) extends Decl + def "Decl.Val" $ + record [ + "mods">: list $ meta "Mod", + "pats">: list $ meta "Pat", + "decltpe">: meta "Type"], +-- @ast class Var(mods: List[Mod], pats: List[Pat] @nonEmpty, decltpe: scala.meta.Type) extends Decl + def "Decl.Var" $ + record [ + "mods">: list $ meta "Mod", + "pats">: list $ meta "Pat", + "decltpe">: meta "Type"], +-- @ast class Def( + def "Decl.Def" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: Data.Name, + "name">: meta "Data.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- paramss: List[List[Data.Param]], + "paramss">: list $ list $ meta "Data.Param", +-- decltpe: scala.meta.Type + "decltpe">: meta "Type"], +-- ) extends Decl with Member.Data @ + -- @ast class Type( + def "Decl.Type" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Type.Name, + "name">: meta "Type.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- bounds: scala.meta.Type.Bounds + "bounds">: meta "Type.Bounds"], +-- ) extends Decl with Member.Type +-- @ast class Given( + def "Decl.Given" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: Data.Name, + "name">: meta "Data.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- sparams: List[List[Data.Param]], + "sparams">: list $ list $ meta "Data.Param", +-- decltpe: scala.meta.Type + "decltpe">: meta "Type"], +-- ) extends Decl with Member.Data @ +-- } +-- +-- @branch trait Defn extends Stat + def "Defn" $ + union [ + "val">: meta "Defn.Val", + "var">: meta "Defn.Var", + "given">: meta "Defn.Given", + "enum">: meta "Defn.Enum", + "enumCase">: meta "Defn.EnumCase", + "repeatedEnumCase">: meta "Defn.RepeatedEnumCase", + "givenAlias">: meta "Defn.GivenAlias", + "extensionGroup">: meta "Defn.ExtensionGroup", + "def">: meta "Defn.Def", + "macro">: meta "Defn.Macro", + "type">: meta "Defn.Type", + "class">: meta "Defn.Class", + "trait">: meta "Defn.Trait", + "object">: meta "Defn.Object"], +-- object Defn { +-- @ast class Val( + def "Defn.Val" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- pats: List[Pat] @nonEmpty, + "pats">: list $ meta "Pat", +-- decltpe: Option[scala.meta.Type], + "decltpe">: optional $ meta "Type", +-- rhs: Data + "rhs">: meta "Data"], +-- ) extends Defn { +-- checkFields(pats.forall(!_.is[Data.Name])) +-- } +-- @ast class Var( + def "Defn.Var" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- pats: List[Pat] @nonEmpty, + "pats">: list $ meta "Pat", +-- decltpe: Option[scala.meta.Type], + "decltpe">: meta "Type", +-- rhs: Option[Data] + "rhs">: optional $ meta "Data"], +-- ) extends Defn { +-- checkFields(pats.forall(!_.is[Data.Name])) +-- checkFields(decltpe.nonEmpty || rhs.nonEmpty) +-- checkFields(rhs.isEmpty ==> pats.forall(_.is[Pat.Var])) +-- } +-- @ast class Given( + def "Defn.Given" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Name, + "name">: meta "Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ list $ meta "Type.Param", +-- sparams: List[List[Data.Param]], + "sparams">: list $ list $ meta "Data.Param", +-- templ: Template + "templ">: meta "Template"], +-- ) extends Defn +-- @ast class Enum( + def "Defn.Enum" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Type.Name, + "name">: meta "Type.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- ctor: Ctor.Primary, + "ctor">: meta "Ctor.Primary", +-- templ: Template + "template">: meta "Template"], +-- ) extends Defn with Member.Type +-- @ast class EnumCase( + def "Defn.EnumCase" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: Data.Name, + "name">: meta "Data.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- ctor: Ctor.Primary, + "ctor">: meta "Ctor.Primary", +-- inits: List[Init] + "inits">: list $ meta "Init"], +-- ) extends Defn with Member.Data { @ +-- checkParent(ParentChecks.EnumCase) +-- } +-- @ast class RepeatedEnumCase( + def "Defn.RepeatedEnumCase" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- cases: List[Data.Name] + "cases">: list $ meta "Data.Name"], +-- ) extends Defn { +-- checkParent(ParentChecks.EnumCase) +-- } +-- @ast class GivenAlias( + def "Defn.GivenAlias" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Name, + "name">: meta "Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ list $ meta "Type.Param", +-- sparams: List[List[Data.Param]], + "sparams">: list $ list $ meta "Data.Param", +-- decltpe: scala.meta.Type, + "decltpe">: meta "Type", +-- body: Data + "body">: meta "Data"], +-- ) extends Defn +-- @ast class ExtensionGroup( + def "Defn.ExtensionGroup" $ + record [ +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- paramss: List[List[Data.Param]], + "parmss">: list $ list $ meta "Data.Param", +-- body: Stat + "body">: meta "Stat"], +-- ) extends Defn +-- @ast class Def( + def "Defn.Def" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: Data.Name, + "name">: meta "Data.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- paramss: List[List[Data.Param]], + "paramss">: list $ list $ meta "Data.Param", +-- decltpe: Option[scala.meta.Type], + "decltpe">: optional $ meta "Type", +-- body: Data + "body">: meta "Data"], +-- ) extends Defn with Member.Data { @ +-- checkFields(paramss.forall(onlyLastParamCanBeRepeated)) +-- } +-- @ast class Macro( + def "Defn.Macro" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: Data.Name, + "name">: meta "Data.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- paramss: List[List[Data.Param]], + "paramss">: list $ list $ meta "Data.Param", +-- decltpe: Option[scala.meta.Type], + "decltpe">: optional $ meta "Type", +-- body: Data + "body">: meta "Data"], +-- ) extends Defn with Member.Data @ +-- @ast class Type( + def "Defn.Type" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Type.Name, + "name">: meta "Type.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- body: scala.meta.Type + "body">: meta "Type"], +-- ) extends Defn with Member.Type { +-- @binaryCompatField("4.4.0") +-- private var _bounds: scala.meta.Type.Bounds = scala.meta.Type.Bounds(None, None) +-- } +-- @ast class Class( + def "Defn.Class" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Type.Name, + "name">: meta "Type.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- ctor: Ctor.Primary, + "ctor">: meta "Ctor.Primary", +-- templ: Template + "template">: meta "Template"], +-- ) extends Defn with Member.Type +-- @ast class Trait( + def "Defn.Trait" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: scala.meta.Type.Name, + "name">: meta "Type.Name", +-- tparams: List[scala.meta.Type.Param], + "tparams">: list $ meta "Type.Param", +-- ctor: Ctor.Primary, + "ctor">: meta "Ctor.Primary", +-- templ: Template + "template">: meta "Template"], +-- ) extends Defn with Member.Type { +-- checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor])) +-- } +-- @ast class Object(mods: List[Mod], name: Data.Name, templ: Template) + def "Defn.Object" $ + record [ + "name">: meta "Data.Name"], -- from Member.Data +-- extends Defn with Member.Data { @ +-- checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor])) +-- } +-- } +-- +-- @ast class Pkg(ref: Data.Ref, stats: List[Stat]) extends Member.Data with Stat { @ + def "Pkg" $ + record [ + "name">: meta "Data.Name", -- from Member.Data + "ref">: meta "Data.Ref", + "stats">: list $ meta "Stat"], +-- checkFields(ref.isQualId) +-- def name: Data.Name = ref match { +-- case name: Data.Name => name +-- case Data.Select(_, name: Data.Name) => name +-- } +-- } +-- object Pkg { +-- @ast class Object(mods: List[Mod], name: Data.Name, templ: Template) +-- extends Member.Data with Stat { @ + def "Pkg.Object" $ + record [ + "mods">: list $ meta "Mod", + "name">: meta "Data.Name", + "template">: meta "Template"], +-- checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor])) +-- } +-- } +-- +-- // NOTE: The names of Ctor.Primary and Ctor.Secondary here is always Name.Anonymous. +-- // While seemingly useless, this name is crucial to one of the key principles behind the semantic API: +-- // "every definition and every reference should carry a name". +-- @branch trait Ctor extends Tree with Member + def "Ctor" $ + union [ + "primary">: meta "Ctor.Primary", + "secondary">: meta "Ctor.Secondary"], +-- object Ctor { +-- @ast class Primary(mods: List[Mod], name: Name, paramss: List[List[Data.Param]]) extends Ctor + def "Ctor.Primary" $ + record [ + "mods">: list $ meta "Mod", + "name">: meta "Name", + "paramss">: list $ list $ meta "Data.Param"], +-- @ast class Secondary( + def "Ctor.Secondary" $ + record [ +-- mods: List[Mod], + "mods">: list $ meta "Mod", +-- name: Name, + "name">: meta "Name", +-- paramss: List[List[Data.Param]] @nonEmpty, + "paramss">: list $ list $ meta "Data.Param", +-- init: Init, + "init">: meta "Init", +-- stats: List[Stat] + "stats">: list $ meta "Stat"], +-- ) extends Ctor with Stat { +-- checkFields(stats.forall(_.isBlockStat)) +-- } +-- } +-- +-- // NOTE: The name here is always Name.Anonymous. +-- // See comments to Ctor.Primary and Ctor.Secondary for justification. +-- @ast class Init(tpe: Type, name: Name, argss: List[List[Data]]) extends Ref { + def "Init" $ + record [ + "tpe">: meta "Type", + "name">: meta "Name", + "argss">: list $ list $ meta "Data"], +-- checkFields(tpe.isConstructable) +-- checkParent(ParentChecks.Init) +-- } +-- +-- @ast class Self(name: Name, decltpe: Option[Type]) extends Member + def "Self" + unit, +-- +-- @ast class Template( + def "Template" $ + record [ +-- early: List[Stat], + "early">: list $ meta "Stat", +-- inits: List[Init], + "inits">: list $ meta "Init", +-- self: Self, + "self">: meta "Self", +-- stats: List[Stat] + "stats">: list $ meta "Stat"], +-- ) extends Tree { +-- @binaryCompatField("4.4.0") +-- private var _derives: List[Type] = Nil +-- checkFields(early.forall(_.isEarlyStat && inits.nonEmpty)) +-- checkFields(stats.forall(_.isTemplateStat)) +-- } +-- +-- @branch trait Mod extends Tree + def "Mod" $ + union [ + "annot">: meta "Mod.Annot", + "private">: meta "Mod.Private", + "protected">: meta "Mod.Protected", + "implicit">: unit, + "final">: unit, + "sealed">: unit, + "open">: unit, + "super">: unit, + "override">: unit, + "case">: unit, + "abstract">: unit, + "covariant">: unit, + "contravariant">: unit, + "lazy">: unit, + "valParam">: unit, + "varParam">: unit, + "infix">: unit, + "inline">: unit, + "using">: unit, + "opaque">: unit, + "transparent">: unit], +-- object Mod { +-- @ast class Annot(init: Init) extends Mod { + def "Mod.Annot" $ + record [ + "init">: meta "Init"], +-- @deprecated("Use init instead", "1.9.0") +-- def body = init +-- } +-- @ast class Private(within: Ref) extends Mod { + def "Mod.Private" $ + record [ + "within">: meta "Ref"], +-- checkFields(within.isWithin) +-- } +-- @ast class Protected(within: Ref) extends Mod { + def "Mod.Protected" $ + record [ + "within">: meta "Ref"], +-- checkFields(within.isWithin) +-- } +-- @ast class Implicit() extends Mod +-- @ast class Final() extends Mod +-- @ast class Sealed() extends Mod +-- @ast class Open() extends Mod +-- @deprecated("Super traits introduced in dotty, but later removed.") +-- @ast class Super() extends Mod +-- @ast class Override() extends Mod +-- @ast class Case() extends Mod +-- @ast class Abstract() extends Mod +-- @ast class Covariant() extends Mod +-- @ast class Contravariant() extends Mod +-- @ast class Lazy() extends Mod +-- @ast class ValParam() extends Mod +-- @ast class VarParam() extends Mod +-- @ast class Infix() extends Mod +-- @ast class Inline() extends Mod +-- @ast class Using() extends Mod +-- @ast class Opaque() extends Mod +-- @ast class Transparent() extends Mod +-- } +-- +-- @branch trait Enumerator extends Tree + def "Enumerator" $ + union [ + "generator">: meta "Enumerator.Generator", + "caseGenerator">: meta "Enumerator.CaseGenerator", + "val">: meta "Enumerator.Val", + "guard">: meta "Enumerator.Guard"], +-- object Enumerator { +-- @ast class Generator(pat: Pat, rhs: Data) extends Enumerator + def "Enumerator.Generator" $ + record [ + "pat">: meta "Pat", + "rhs">: meta "Data"], +-- @ast class CaseGenerator(pat: Pat, rhs: Data) extends Enumerator + def "Enumerator.CaseGenerator" $ + record [ + "pat">: meta "Pat", + "rhs">: meta "Data"], +-- @ast class Val(pat: Pat, rhs: Data) extends Enumerator + def "Enumerator.Val" $ + record [ + "pat">: meta "Pat", + "rhs">: meta "Data"], +-- @ast class Guard(cond: Data) extends Enumerator + def "Enumerator.Guard" $ + record [ + "cond">: meta "Data"], +-- } +-- +-- @branch trait ImportExportStat extends Stat { + def "ImportExportStat" $ + union [ + "import">: meta "Import", + "export">: meta "Export"], +-- def importers: List[Importer] +-- } +-- @ast class Import(importers: List[Importer] @nonEmpty) extends ImportExportStat + def "Import" $ + record [ + "importers">: list $ meta "Importer"], +-- @ast class Export(importers: List[Importer] @nonEmpty) extends ImportExportStat + def "Export" $ + record [ + "importers">: list $ meta "Importer"], +-- +-- @ast class Importer(ref: Data.Ref, importees: List[Importee] @nonEmpty) extends Tree { + def "Importer" $ + record [ + "ref">: meta "Data.Ref", + "importees">: list $ meta "Importee"], +-- checkFields(ref.isStableId) +-- } +-- +-- @branch trait Importee extends Tree with Ref + def "Importee" $ + union [ + "wildcard">: unit, + "given">: meta "Importee.Given", + "givenAll">: unit, + "name">: meta "Importee.Name", + "rename">: meta "Importee.Rename", + "unimport">: meta "Importee.Unimport"], +-- object Importee { +-- @ast class Wildcard() extends Importee +-- @ast class Given(tpe: Type) extends Importee + def "Importee.Given" $ + record [ + "tpe">: meta "Type"], +-- @ast class GivenAll() extends Importee +-- @ast class Name(name: scala.meta.Name) extends Importee { + def "Importee.Name" $ + record [ + "name">: meta "Name"], +-- checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate]) +-- } +-- @ast class Rename(name: scala.meta.Name, rename: scala.meta.Name) extends Importee { + def "Importee.Rename" $ + record [ + "name">: meta "Name", + "rename">: meta "Name"], +-- checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate]) +-- checkFields(rename.is[scala.meta.Name.Quasi] || rename.is[scala.meta.Name.Indeterminate]) +-- } +-- @ast class Unimport(name: scala.meta.Name) extends Importee { + def "Importee.Unimport" $ + record [ + "name">: meta "Name"], +-- checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate]) +-- } +-- } +-- +-- @branch trait CaseTree extends Tree { + def "CaseTree" $ + union [ + "case">: meta "Case", + "typeCase">: meta "TypeCase"], +-- def pat: Tree +-- def body: Tree +-- } +-- @ast class Case(pat: Pat, cond: Option[Data], body: Data) extends CaseTree + def "Case" $ + record [ + "pat">: meta "Pat", + "cond">: optional $ meta "Data", + "body">: meta "Data"], +-- @ast class TypeCase(pat: Type, body: Type) extends CaseTree + def "TypeCase" $ + record [ + "pat">: meta "Type", + "body">: meta "Type"], +-- +-- @ast class Source(stats: List[Stat]) extends Tree { + def "Source" $ + record [ + "stats">: list $ meta "Stat"], +-- // NOTE: This validation has been removed to allow dialects with top-level terms. +-- // Ideally, we should push the validation into a dialect-specific prettyprinter when -- 220 is fixed. +-- // checkFields(stats.forall(_.isTopLevelStat)) +-- } +-- +-- package internal.trees { +-- // NOTE: Quasi is a base trait for a whole bunch of classes. +-- // Every root, branch and ast trait/class among scala.meta trees (except for quasis themselves) +-- // has a corresponding quasi, e.g. Data.Quasi or Type.Quasi. +-- // +-- // Here's how quasis represent unquotes +-- // (XXX below depends on the position where the unquote occurs, e.g. q"$x" will result in Data.Quasi): +-- // * $x => XXX.Quasi(0, XXX.Name("x")) +-- // * ..$xs => XXX.Quasi(1, XXX.Quasi(0, XXX.Name("xs")) +-- // * ...$xss => XXX.Quasi(2, XXX.Quasi(0, XXX.Name("xss")) +-- // * ..{$fs($args)} => Complex ellipses aren't supported yet +-- @branch trait Quasi extends Tree { + def "Quasi" -- TODO + unit] +-- def rank: Int +-- def tree: Tree +-- def pt: Class[_] +-- def become[T <: Quasi: AstInfo]: T +-- } +-- +-- @registry object All +-- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Shacl/Model.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Shacl/Model.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Shacl/Model.hs @@ -0,0 +1,273 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Shacl.Model where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Sources.Tier4.Ext.Rdf.Syntax +import Hydra.Dsl.Types as Types + + +shaclModelModule :: Module +shaclModelModule = Module ns elements [rdfSyntaxModule] tier0Modules $ + Just "A SHACL syntax model. See https://www.w3.org/TR/shacl" + where + ns = Namespace "hydra/ext/org/w3/shacl/model" + def = datatype ns + shacl = typeref ns + rdf = typeref $ moduleNamespace rdfSyntaxModule + + elements = [ + + def "Closed" $ + see "https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent" $ + record [ + "isClosed">: boolean, + "ignoredProperties">: optional $ set $ rdf "Property"], + + def "CommonConstraint" $ + doc "Any of a number of constraint parameters which can be applied either to node or property shapes" $ + union [ + "and">: + see "https://www.w3.org/TR/shacl/#AndConstraintComponent" $ + set $ shacl "Reference" @@ shacl "Shape", + + "closed">: + see "https://www.w3.org/TR/shacl/#ClosedConstraintComponent" $ + shacl "Closed", + + "class">: + see "https://www.w3.org/TR/shacl/#ClassConstraintComponent" $ + set $ rdf "RdfsClass", + + "datatype">: + see "https://www.w3.org/TR/shacl/#DatatypeConstraintComponent" $ + rdf "Iri", + + "disjoint">: + see "https://www.w3.org/TR/shacl/#DisjointConstraintComponent" $ + set $ rdf "Property", + + "equals">: + see "https://www.w3.org/TR/shacl/#EqualsConstraintComponent" $ + set $ rdf "Property", + + "hasValue">: + doc ("Specifies the condition that at least one value node is equal to the given RDF term. " ++ + "See https://www.w3.org/TR/shacl/#HasValueConstraintComponent") $ + set $ rdf "Node", + + "in">: + doc ("Specifies the condition that each value node is a member of a provided SHACL list. " ++ + "See https://www.w3.org/TR/shacl/#InConstraintComponent") $ + list $ rdf "Node", + + "languageIn">: + see "https://www.w3.org/TR/shacl/#LanguageInConstraintComponent" $ + set $ rdf "LanguageTag", + + "nodeKind">: + see "https://www.w3.org/TR/shacl/#NodeKindConstraintComponent" $ + shacl "NodeKind", + + "node">: + see "https://www.w3.org/TR/shacl/#NodeConstraintComponent" $ + set $ shacl "Reference" @@ shacl "NodeShape", + + "not">: + see "https://www.w3.org/TR/shacl/#NotConstraintComponent" $ + set $ shacl "Reference" @@ shacl "Shape", + + "maxExclusive">: + see "https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent" $ + rdf "Literal", + + "maxInclusive">: + see "https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent" $ + rdf "Literal", + + "maxLength">: + see "https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent" $ + bigint, + + "minExclusive">: + see "https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent" $ + rdf "Literal", + + "minInclusive">: + see "https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent" $ + rdf "Literal", + + "minLength">: + see "https://www.w3.org/TR/shacl/#MinLengthConstraintComponent" $ + bigint, + + "pattern">: + see "https://www.w3.org/TR/shacl/#PatternConstraintComponent" $ + shacl "Pattern", + + "property">: + see "https://www.w3.org/TR/shacl/#PropertyConstraintComponent" $ + set $ shacl "Reference" @@ shacl "PropertyShape", + + "or">: + see "https://www.w3.org/TR/shacl/#OrConstraintComponent" $ + set $ shacl "Reference" @@ shacl "Shape", + + "xone">: + see "https://www.w3.org/TR/shacl/#XoneConstraintComponent" $ + set $ shacl "Reference" @@ shacl "Shape"], + + def "CommonProperties" $ + doc "Common constraint parameters and other properties for SHACL shapes" $ + record [ + "constraints">: + doc "Common constraint parameters attached to this shape" + $ set $ shacl "CommonConstraint", + + "deactivated">: + see "https://www.w3.org/TR/shacl/#deactivated" $ + optional boolean, + + "message">: + see "https://www.w3.org/TR/shacl/#message" $ + rdf "LangStrings", + + "severity">: + see "https://www.w3.org/TR/shacl/#severity" $ + shacl "Severity", + + "targetClass">: + see "https://www.w3.org/TR/shacl/#targetClass" $ + set $ rdf "RdfsClass", + + "targetNode">: + see "https://www.w3.org/TR/shacl/#targetNode" $ + set $ rdf "IriOrLiteral", + + "targetObjectsOf">: + see "https://www.w3.org/TR/shacl/#targetObjectsOf" $ + set $ rdf "Property", + + "targetSubjectsOf">: + see "https://www.w3.org/TR/shacl/#targetSubjectsOf" $ + set $ rdf "Property"], + + def "Definition" $ + doc "An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance" $ + lambda "a" $ record [ + "iri">: rdf "Iri", + "target">: "a"], + + def "NodeKind" $ union [ + "blankNode">: doc "A blank node" unit, + "iri">: doc "An IRI" unit, + "literal">: doc "A literal" unit, + "blankNodeOrIri">: doc "A blank node or an IRI" unit, + "blankNodeOrLiteral">: doc "A blank node or a literal" unit, + "iriOrLiteral">: doc "An IRI or a literal" unit], + + def "NodeShape" $ + doc "A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes" $ + record [ + "common">: shacl "CommonProperties"], + + def "Pattern" $ + doc "A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent" $ + record [ + "regex">: string, + "flags">: optional string], + + def "PropertyShape" $ + doc "A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes" $ + record [ + "common">: shacl "CommonProperties", + + "constraints">: + doc "Any property shape -specific constraint parameters" $ + set $ shacl "PropertyShapeConstraint", + + "defaultValue">: + see "https://www.w3.org/TR/shacl/#defaultValue" $ + optional $ rdf "Node", + + "description">: + see "https://www.w3.org/TR/shacl/#name" $ + rdf "LangStrings", + + "name">: + see "https://www.w3.org/TR/shacl/#name" $ + rdf "LangStrings", + + "order">: + see "https://www.w3.org/TR/shacl/#order" $ + optional bigint, + + "path">: rdf "Iri"], -- TODO + -- Note: sh:group is omitted for now, for lack of a clear definition of PropertyGroup + + def "PropertyShapeConstraint" $ + doc "A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes" $ + union [ + + "lessThan">: + see "https://www.w3.org/TR/shacl/#LessThanConstraintComponent" $ + set $ rdf "Property", + + "lessThanOrEquals">: + see "https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent" $ + set $ rdf "Property", + + "maxCount">: + doc ("The maximum cardinality. Node shapes cannot have any value for sh:maxCount. " ++ + "See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent") $ + bigint, + + "minCount">: + doc ("The minimum cardinality. Node shapes cannot have any value for sh:minCount. " ++ + "See https://www.w3.org/TR/shacl/#MinCountConstraintComponent") $ + bigint, + + "uniqueLang">: + see "https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent" $ + boolean, + + "qualifiedValueShape">: + see "https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" $ + shacl "QualifiedValueShape"], + + def "QualifiedValueShape" $ + see "https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" $ + record [ + "qualifiedValueShape">: shacl "Reference" @@ shacl "Shape", + "qualifiedMaxCount">: bigint, + "qualifiedMinCount">: bigint, + "qualifiedValueShapesDisjoint">: optional boolean], + + def "Reference" $ + doc "Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type" $ + lambda "a" $ union [ + "named">: rdf "Iri", + "anonymous">: + doc "An anonymous instance" + "a", + "definition">: + doc "An inline definition" $ + shacl "Definition" @@ "a"], + + def "Severity" $ union [ + "info">: doc "A non-critical constraint violation indicating an informative message" unit, + "warning">: doc "A non-critical constraint violation indicating a warning" unit, + "violation">: doc "A constraint violation" unit], + + def "Shape" $ + doc "A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes" $ + union [ + "node">: shacl "NodeShape", + "property">: shacl "PropertyShape"], + + def "ShapesGraph" $ + doc ("An RDF graph containing zero or more shapes that is passed into a SHACL validation process " ++ + "so that a data graph can be validated against the shapes") $ + set $ shacl "Definition" @@ shacl "Shape"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Tabular.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Tabular.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Tabular.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hydra.Sources.Tier4.Ext.Tabular where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +tabularModule :: Module +tabularModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A simple, untyped tabular data model, suitable for CSVs and TSVs") + where + ns = Namespace "hydra/ext/tabular" + def = datatype ns + tabular = typeref ns + + elements = [ + def "DataRow" $ + doc "A data row, containing optional-valued cells; one per column" $ + lambda "v" $ + list $ optional "v", + + def "HeaderRow" $ + doc "A header row, containing column names (but no types or data)" $ + list string, + + def "Table" $ + doc "A simple table as in a CSV file, having an optional header row and any number of data rows" $ + lambda "v" $ record [ + "header">: + doc "The optional header row of the table. If present, the header must have the same number of cells as each data row." $ + optional $ tabular "HeaderRow", + "data">: + doc "The data rows of the table. Each row must have the same number of cells." $ + list (tabular "DataRow" @@ "v")]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Ext/Yaml/Model.hs b/src/main/haskell/Hydra/Sources/Tier4/Ext/Yaml/Model.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Hydra/Sources/Tier4/Ext/Yaml/Model.hs @@ -0,0 +1,76 @@ +module Hydra.Sources.Tier4.Ext.Yaml.Model where + +import Hydra.Sources.Tier3.All +import Hydra.Dsl.Annotations +import Hydra.Dsl.Bootstrap +import Hydra.Dsl.Types as Types + + +yamlModelModule :: Module +yamlModelModule = Module ns elements [hydraCoreModule] tier0Modules $ + Just ("A basic YAML representation model. Based on:\n" ++ + " https://yaml.org/spec/1.2/spec.html\n" ++ + "The Serialization and Presentation properties of YAML,\n" ++ + "including directives, comments, anchors, style, formatting, and aliases, are not supported by this model.\n" ++ + "In addition, tags are omitted from this model, and non-standard scalars are unsupported.") + where + ns = Namespace "hydra/ext/org/yaml/model" + def = datatype ns + model = typeref ns + + elements = [ + {- + Every YAML node has an optional scalar tag or non-specific tag (omitted from this model) + -} + def "Node" $ + doc "A YAML node (value)" $ + union [ + "mapping">: Types.map (model "Node") (model "Node"), -- Failsafe schema: tag:yaml.org,2002:map + "scalar">: model "Scalar", + "sequence">: list $ model "Node"], -- Failsafe schema: tag:yaml.org,2002:seq + + def "Scalar" $ + doc "A union of scalars supported in the YAML failsafe and JSON schemas. Other scalars are not supported here" $ + union [ + {- + Represents a true/false value + + JSON schema: tag:yaml.org,2002:bool + -} + "bool">: + doc "Represents a true/false value" + boolean, + {- + Represents an approximation to real numbers + + JSON schema: tag:yaml.org,2002:float + + In addition to arbitrary-precision floating-point numbers in scientific notation, + YAML allows for three special values, which are not supported here: + positive and negative infinity (.inf and -.inf), and "not a number (.nan) + -} + "float">: + doc "Represents an approximation to real numbers" + bigfloat, + {- + Represents arbitrary sized finite mathematical integers + + JSON schema: tag:yaml.org,2002:int + -} + "int">: + doc "Represents arbitrary sized finite mathematical integers" + bigint, + {- + Represents the lack of a value + + JSON schema: tag:yaml.org,2002:null + -} + "null">: + doc "Represents the lack of a value" + unit, + {- + Failsafe schema: tag:yaml.org,2002:str + -} + "str">: + doc "A string value" + string]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Avro/Schema.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Avro/Schema.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Avro/Schema.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Avro.Schema where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -avroSchemaModule :: Module -avroSchemaModule = Module ns elements [jsonModelModule] tier0Modules $ - Just ("A model for Avro schemas. Based on the Avro 1.11.1 specification:\n" ++ - " https://avro.apache.org/docs/1.11.1/specification") - where - ns = Namespace "hydra/langs/avro/schema" - def = datatype ns - avro = typeref ns - json = typeref $ moduleNamespace jsonModelModule - - elements = [ - def "Array" $ - record [ - "items">: avro "Schema"], - - def "Enum" $ - record [ - "symbols">: - doc ("a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; " ++ - "duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* " ++ - "(the same requirement as for names)") $ - list string, - "default">: - doc ("A default value for this enumeration, used during resolution when the reader encounters " ++ - "a symbol from the writer that isn’t defined in the reader’s schema. " ++ - "The value provided here must be a JSON string that’s a member of the symbols array") $ - optional string], - - def "Field" $ - record [ - "name">: - doc "a JSON string providing the name of the field" - string, - "doc">: - doc "a JSON string describing this field for users" $ - optional string, - "type">: - doc "a schema" $ - avro "Schema", - "default">: - doc "default value for this field, only used when reading instances that lack the field for schema evolution purposes" $ - optional $ json "Value", - "order">: - doc "specifies how this field impacts sort ordering of this record" $ - optional $ avro "Order", - "aliases">: - doc "a JSON array of strings, providing alternate names for this field" $ - optional $ list string, - "annotations">: - doc "Any additional key/value pairs attached to the field" $ - Types.map string $ json "Value"], - - def "Fixed" $ - record [ - "size">: - doc "an integer, specifying the number of bytes per value" - int32], - - def "Map" $ - record [ - "values">: avro "Schema"], - - def "Named" $ - record [ - "name">: - doc "a string naming this schema" - string, - "namespace">: - doc "a string that qualifies the name" $ - optional string, - "aliases">: - doc "a JSON array of strings, providing alternate names for this schema" $ - optional $ list string, - "doc">: - doc "a JSON string providing documentation to the user of this schema" $ - optional string, - "type">: avro "NamedType", - "annotations">: - doc "Any additional key/value pairs attached to the type" $ - Types.map string $ json "Value"], - - def "NamedType" $ - union [ - "enum">: avro "Enum", - "fixed">: avro "Fixed", - "record">: avro "Record"], - - def "Order" $ - enum ["ascending", "descending", "ignore"], - - def "Primitive" $ - union [ - "null">: - doc "no value" unit, - "boolean">: - doc "A binary value" unit, - "int">: - doc "32-bit signed integer" unit, - "long">: - doc "64-bit signed integer" unit, - "float">: - doc "single precision (32-bit) IEEE 754 floating-point number" unit, - "double">: - doc "double precision (64-bit) IEEE 754 floating-point number" unit, - "bytes">: - doc "sequence of 8-bit unsigned bytes" unit, - "string">: - doc "unicode character sequence" unit], - - def "Record" $ - record [ - "fields">: - doc "a JSON array, listing fields" $ - list $ avro "Field"], - - def "Schema" $ - union [ - "array">: avro "Array", - "map">: avro "Map", - "named">: avro "Named", - "primitive">: avro "Primitive", - "reference">: -- Note: "reference" is not described in the Avro specification; this has been added - doc "A reference by name to a previously defined type" string, - "union">: avro "Union" - ], - - def "Union" $ - list $ avro "Schema"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/Features.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/Features.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/Features.hs +++ /dev/null @@ -1,328 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Cypher.Features where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - -import qualified Control.Monad as CM -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Maybe as Y - - -openCypherFeaturesModule :: Module -openCypherFeaturesModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("A model for characterizing OpenCypher queries and implementations in terms of included features.") - where - ns = Namespace "hydra/langs/cypher/features" - cypherFeatures = typeref ns - def = datatype ns - defFeatureSet name desc fields = def (capitalize name ++ "Features") $ - doc ("A set of features for " ++ desc ++ ".") $ record fields - feature n s = featureField n $ "Whether to expect " ++ s ++ "." - featureField name comment = name>: doc comment boolean - featureSet name desc = name>: - doc ("Whether to expect " ++ desc ++ ", and if so, which specific features") $ - optional $ cypherFeatures $ capitalize name ++ "Features" - fixedFeature n s = featureField n $ "Whether to expect " ++ s ++ " (note: included by most if not all implementations)." - function name = feature name $ "the " ++ name ++ "() function" - functionWithKeyword name keyword = feature name $ "the " ++ name ++ "() / " ++ keyword ++ " aggregate function" - - elements = [ - - defFeatureSet "Aggregate" "aggregation functions" [ - functionWithKeyword "avg" "AVG", - functionWithKeyword "collect" "COLLECT", - functionWithKeyword "count" "COUNT", - functionWithKeyword "max" "MAX", - functionWithKeyword "min" "MIN", - function "percentileCont", - function "percentileDisc", - function "stdev", - functionWithKeyword "sum" "SUM"], - - defFeatureSet "Arithmetic" "arithmetic operations" [ - feature "plus" "the + operator", - feature "minus" "the - operator", - feature "multiply" "the * operator", - feature "divide" "the / operator", - feature "modulus" "the % operator", - feature "powerOf" "the ^ operator"], - - defFeatureSet "Atom" "various kinds of atomic expressions" [ - feature "caseExpression" "CASE expressions", - feature "count" "the COUNT (*) expression", - feature "existentialSubquery" "existential subqueries", - feature "functionInvocation" "function invocation", - featureSet "list" "lists", - featureSet "literal" "literal values", - feature "parameter" "parameter expressions", - feature "patternComprehension" "pattern comprehensions", - feature "patternPredicate" "relationship patterns as subexpressions", - featureSet "quantifier" "quantifier expressions", - fixedFeature "variable" "variable expressions"], - - defFeatureSet "Comparison" "comparison operators and functions" [ - feature "equal" "the = comparison operator", - feature "greaterThan" "the > comparison operator", - feature "greaterThanOrEqual" "the >= comparison operator", - feature "lessThan" "the < comparison operator", - feature "lessThanOrEqual" "the <= comparison operator", - feature "notEqual" "the <> comparison operator", - function "nullIf"], - - def "CypherFeatures" $ - doc ("A set of features which characterize an OpenCypher query or implementation. " - ++ "Any features which are omitted from the set are assumed to be unsupported or nonrequired.") $ - record [ - featureSet "aggregate" "aggregate functions", - featureSet "arithmetic" "arithmetic operations", - featureSet "atom" "atomic expressions", - featureSet "comparison" "comparison operations", - featureSet "delete" "delete operations", - featureSet "element" "element functions", - featureSet "logical" "logical operations", - featureSet "map" "property map functions", - featureSet "match" "match queries", - featureSet "merge" "merge operations", - featureSet "nodePattern" "node patterns", - featureSet "null" "IS NULL / IS NOT NULL checks", - featureSet "numeric" "numeric functions", - featureSet "path" "path functions", - featureSet "procedureCall" "procedure calls", - featureSet "projection" "projection operations", - featureSet "randomness" "random value generation", - featureSet "rangeLiteral" "range literals", - featureSet "reading" "reading operations", - featureSet "relationshipDirection" "relationship directions", - featureSet "relationshipPattern" "relationship patterns", - featureSet "remove" "remove operations", - featureSet "schema" "schema functions", - featureSet "set" "set operations", - featureSet "string" "string operations", - featureSet "updating" "updating operations"], - - defFeatureSet "Delete" "delete operations" [ - feature "delete" "the basic DELETE clause", - feature "detachDelete" "the DETACH DELETE clause"], - - defFeatureSet "Element" "element functions" [ - function "elementId", - function "endNode", - function "labels", - function "properties", - function "startNode"], - - defFeatureSet "List" "list functionality" [ - function "all", - function "any", - function "coalesce", - function "isEmpty", - function "head", - function "last", - feature "listComprehension" "basic list comprehensions", - feature "listRange" "list range comprehensions (e.g. [1..10])", - function "none", - function "reduce", - function "reverse", - function "single", - function "size", - function "tail", - function "toBooleanList", - function "toFloatList", - function "toIntegerList", - function "toStringList"], - - defFeatureSet "Literal" "various types of literal values" [ - fixedFeature "boolean" "boolean literals", - feature "double" "double-precision floating-point literals", - feature "integer" "integer literals", - feature "list" "list literals", - feature "map" "map literals", - feature "null" "the NULL literal", - fixedFeature "string" "string literals"], - - defFeatureSet "Logical" "logical operations" [ - feature "and" "the AND operator", - feature "not" "the NOT operator", - feature "or" "the OR operator", - feature "xor" "the XOR operator"], - - defFeatureSet "Map" "property map functions" [ - function "keys"], - - defFeatureSet "Match" "match queries" [ - feature "match" "the basic (non-optional) MATCH clause", - feature "optionalMatch" "OPTIONAL MATCH"], - - defFeatureSet "Merge" "merge operations" [ - feature "merge" "the basic MERGE clause", - feature "mergeOnCreate" "MERGE with the ON CREATE action", - feature "mergeOnMatch" "MERGE with the ON MATCH action"], - - defFeatureSet "NodePattern" "node patterns" [ - feature "multipleLabels" "specifying multiple labels in a node pattern", - feature "parameter" "specifying a parameter as part of a node pattern", - feature "propertyMap" "specifying a key/value map of properties in a node pattern", - fixedFeature "variableNode" "binding a variable to a node in a node pattern", - feature "wildcardLabel" "omitting labels from a node pattern"], - - defFeatureSet "Null" "IS NULL / IS NOT NULL checks" [ - feature "isNull" "the IS NULL operator", - feature "isNotNull" "the IS NOT NULL operator"], - - defFeatureSet "Numeric" "numeric functions" [ - function "abs", - function "ceil", - function "e", - function "exp", - function "floor", - function "isNaN", - function "log", - function "log10", - function "range", - function "round", - function "sign", - function "sqrt"], - - defFeatureSet "Path" "path functions" [ - function "length", - function "nodes", - function "relationships", - function "shortestPath"], - - defFeatureSet "ProcedureCall" "procedure calls" [ - feature "inQueryCall" "CALL within a query", - feature "standaloneCall" "standalone / top-level CALL", - -- Note: additional features are possible around YIELD - feature "yield" "the YIELD clause in CALL"], - - defFeatureSet "Projection" "projections" [ - feature "limit" "the LIMIT clause", - feature "orderBy" "the ORDER BY clause", - feature "projectDistinct" "the DISTINCT keyword", - feature "projectAll" "the * projection", - feature "projectAs" "the AS keyword", - feature "skip" "the SKIP clause", - feature "sortOrder" "the ASC/ASCENDING and DESC/DESCENDING keywords"], - - defFeatureSet "Quantifier" "quantifier expressions" [ - feature "all" "the ALL quantifier", - feature "any" "the ANY quantifier", - function "exists", - feature "none" "the NONE quantifier", - feature "single" "the SINGLE quantifier"], - - defFeatureSet "Randomness" "random value generation" [ - function "rand", - function "randomUUID"], - - defFeatureSet "RangeLiteral" "range literals within relationship patterns" [ - feature "bounds" "range literals with both lower and upper bounds", - feature "exactRange" "range literals providing an exact number of repetitions", - feature "lowerBound" "range literals with a lower bound (only)", - feature "starRange" "the * range literal", - feature "upperBound" "range literals with an upper bound (only)"], - - defFeatureSet "Reading" "specific syntax related to reading data from the graph." [ - feature "union" "the UNION operator", - feature "unionAll" "the UNION ALL operator", - feature "unwind" "the UNWIND clause"], - - defFeatureSet "RelationshipDirection" "relationship directions / arrow patterns" [ - feature "both" "the two-headed arrow (<-[]->) relationship direction", - feature "left" "the left arrow (<-[]-) relationship direction", - feature "neither" "the headless arrow (-[]-) relationship direction", - feature "right" "the right arrow (-[]->) relationship direction"], - - defFeatureSet "RelationshipPattern" "relationship patterns" [ - feature "multipleTypes" "specifying a disjunction of multiple types in a relationship pattern", - fixedFeature "variableRelationship" "binding a variable to a relationship in a relationship pattern", - feature "wildcardType" "omitting types from a relationship pattern"], - - defFeatureSet "Remove" "REMOVE operations" [ - feature "byLabel" "REMOVE Variable:NodeLabels", - feature "byProperty" "REMOVE PropertyExpression"], - - defFeatureSet "Schema" "schema functions" [ - function "type", - function "valueType"], - - defFeatureSet "Set" "set definitions" [ - feature "propertyEquals" "defining a set using PropertyExpression = Expression", - feature "variableEquals" "defining a set using Variable = Expression", - feature "variablePlusEquals" "defining a set using Variable += Expression", - feature "variableWithNodeLabels" "defining a set using Variable:NodeLabels"], - - defFeatureSet "String" "string functions" [ - function "char_length", - function "character_length", - functionWithKeyword "contains" "CONTAINS", - functionWithKeyword "endsWith" "ENDS WITH", - functionWithKeyword "in" "IN", - functionWithKeyword "startsWith" "STARTS WITH", - function "toBoolean", - function "toBooleanOrNull", - function "toFloat", - function "toFloatOrNull", - function "toInteger", - function "toIntegerOrNull"], - - defFeatureSet "Updating" "specific syntax related to updating data in the graph" [ - feature "create" "the CREATE clause", - feature "set" "the SET clause", - feature "with" "multi-part queries using WITH"]] - --- | An alternative model of (Open)Cypher features, flattened into an enumeration. --- Usage example: --- featuresMod <- fromFlowIo bootstrapGraph openCypherFeaturesEnumModule --- writeProtobuf "/tmp/proto" [featuresMod] ---openCypherFeaturesEnumModule :: Flow Graph Module -openCypherFeaturesEnumModule = do - enum <- openCypherFeaturesEnum - return $ Module ns (elements enum) [hydraCoreModule] tier0Modules $ - Just ("A model with an enumeration of (Open)Cypher features.") - where - ns = Namespace "hydra/org/opencypher/features" - def = datatype ns - elements enum = [ - def "CypherFeature" $ - doc "An enumeration of (Open)Cypher features." - enum] - ---openCypherFeaturesEnum :: Flow Graph Type -openCypherFeaturesEnum = do - let els = moduleElements openCypherFeaturesModule - types <- M.fromList <$> (CM.mapM toPair els) - pairs <- findPairs types - return $ union (toField <$> pairs) - where - toPair el = do - typ <- coreDecodeType $ elementData el - return (elementName el, typ) - - findPairs types = forVar "" (Name "hydra/langs/cypher/features.CypherFeatures") - where - forVar prefix ref = case M.lookup ref types of - Just typ -> forType prefix typ - Nothing -> fail "unknown type reference" - forType prefix features = case stripType features of - TypeRecord (RowType _ _ fields) -> do - pairs <- CM.mapM (forField prefix) fields - return $ L.concat pairs - forField prefix ft = do - mdesc <- getTypeDescription $ fieldTypeType ft - case stripType (fieldTypeType ft) of - TypeLiteral LiteralTypeBoolean -> pure [(fname, mdesc)] - TypeOptional (TypeVariable ref) -> forVar newPrefix ref - _ -> fail $ "unexpected field type: " ++ show ft - where - fname = prefix ++ (unName $ fieldTypeName ft) - newPrefix = fname ++ "_" - - toField (name, mdesc) = FieldType (Name name) $ case mdesc of - Nothing -> unit - Just desc -> doc desc unit diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/OpenCypher.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/OpenCypher.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/OpenCypher.hs +++ /dev/null @@ -1,1049 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Cypher.OpenCypher where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -openCypherModule :: Module -openCypherModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("A Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at:\n" ++ - " https://opencypher.org/resources/") - where - ns = Namespace "hydra/langs/cypher/openCypher" - def = datatype ns - cypher = typeref ns - - elements = [ - --- Cypher = [SP], Statement, [[SP], ';'], [SP], EOI ; --- --- Statement = Query ; --- --- Query = RegularQuery --- | StandaloneCall --- ; - - def "Query" $ - union [ - "regular">: cypher "RegularQuery", - "standalone">: cypher "StandaloneCall"], - --- RegularQuery = SingleQuery, { [SP], Union } ; - - def "RegularQuery" $ - record [ - "head">: cypher "SingleQuery", - "rest">: list $ cypher "Union"], - --- Union = ((U,N,I,O,N), SP, (A,L,L), [SP], SingleQuery) --- | ((U,N,I,O,N), [SP], SingleQuery) --- ; - - def "Union" $ - record [ - "all">: boolean, - "query">: cypher "SingleQuery"], - --- SingleQuery = SinglePartQuery --- | MultiPartQuery --- ; - def "SingleQuery" $ - union [ - "singlePart">: cypher "SinglePartQuery", - "multiPart">: cypher "MultiPartQuery"], - --- SinglePartQuery = ({ ReadingClause, [SP] }, Return) --- | ({ ReadingClause, [SP] }, UpdatingClause, { [SP], UpdatingClause }, [[SP], Return]) --- ; - - def "SinglePartQuery" $ - record [ - "reading">: list $ cypher "ReadingClause", - "updating">: list $ cypher "UpdatingClause", - "return">: optional $ cypher "Return"], - --- MultiPartQuery = { { ReadingClause, [SP] }, { UpdatingClause, [SP] }, With, [SP] }-, SinglePartQuery ; - - def "WithClause" $ - record [ - "reading">: list $ cypher "ReadingClause", - "updating">: list $ cypher "UpdatingClause", - "with">: cypher "With"], - - def "MultiPartQuery" $ - record [ - "with">: list $ cypher "WithClause", - "body">: cypher "SinglePartQuery"], - --- UpdatingClause = Create --- | Merge --- | Delete --- | Set --- | Remove --- ; - - def "UpdatingClause" $ - union [ - "create">: cypher "Create", - "merge">: cypher "Merge", - "delete">: cypher "Delete", - "set">: cypher "Set", - "remove">: cypher "Remove"], - --- ReadingClause = Match --- | Unwind --- | InQueryCall --- ; - - def "ReadingClause" $ - union [ - "match">: cypher "Match", - "unwind">: cypher "Unwind", - "inQueryCall">: cypher "InQueryCall"], - --- Match = [(O,P,T,I,O,N,A,L), SP], (M,A,T,C,H), [SP], Pattern, [[SP], Where] ; - - def "Match" $ - record [ - "optional">: boolean, - "pattern">: cypher "Pattern", - "where">: optional $ cypher "Where"], - --- Unwind = (U,N,W,I,N,D), [SP], Expression, SP, (A,S), SP, Variable ; - - def "Unwind" $ - record [ - "expression">: cypher "Expression", - "variable">: cypher "Variable"], - --- Merge = (M,E,R,G,E), [SP], PatternPart, { SP, MergeAction } ; - - def "Merge" $ - record [ - "patternPart">: cypher "PatternPart", - "actions">: list $ cypher "MergeAction"], - --- MergeAction = ((O,N), SP, (M,A,T,C,H), SP, Set) --- | ((O,N), SP, (C,R,E,A,T,E), SP, Set) --- ; - - def "MatchOrCreate" $ - enum ["match", "create"], - - def "MergeAction" $ - record [ - "action">: cypher "MatchOrCreate", - "set">: cypher "Set"], - --- Create = (C,R,E,A,T,E), [SP], Pattern ; - - def "Create" $ cypher "Pattern", - --- Set = (S,E,T), [SP], SetItem, { [SP], ',', [SP], SetItem } ; - - def "Set" $ - nonemptyList $ cypher "SetItem", - --- SetItem = (PropertyExpression, [SP], '=', [SP], Expression) --- | (Variable, [SP], '=', [SP], Expression) --- | (Variable, [SP], '+=', [SP], Expression) --- | (Variable, [SP], NodeLabels) --- ; - - def "SetItem" $ - union [ - "property">: cypher "PropertyEquals", - "variableEqual">: cypher "VariableEquals", - "variablePlusEqual">: cypher "VariablePlusEquals", - "variableLabels">: cypher "VariableAndNodeLabels"], - - def "PropertyEquals" $ - record [ - "lhs">: cypher "PropertyExpression", - "rhs">: cypher "Expression"], - - def "VariableEquals" $ - record [ - "lhs">: cypher "Variable", - "rhs">: cypher "Expression"], - - def "VariablePlusEquals" $ - record [ - "lhs">: cypher "Variable", - "rhs">: cypher "Expression"], - - def "VariableAndNodeLabels" $ - record [ - "variable">: cypher "Variable", - "labels">: cypher "NodeLabels"], - --- Delete = [(D,E,T,A,C,H), SP], (D,E,L,E,T,E), [SP], Expression, { [SP], ',', [SP], Expression } ; - - def "Delete" $ - record [ - "detach">: boolean, - "expressions">: nonemptyList $ cypher "Expression"], - --- Remove = (R,E,M,O,V,E), SP, RemoveItem, { [SP], ',', [SP], RemoveItem } ; - - def "Remove" $ - nonemptyList $ cypher "RemoveItem", - --- RemoveItem = (Variable, NodeLabels) --- | PropertyExpression --- ; - - def "RemoveItem" $ - union [ - "variableLabels">: cypher "VariableAndNodeLabels", - "property">: cypher "PropertyExpression"], - --- InQueryCall = (C,A,L,L), SP, ExplicitProcedureInvocation, [[SP], (Y,I,E,L,D), SP, YieldItems] ; - - def "InQueryCall" $ - record [ - "call">: cypher "ExplicitProcedureInvocation", - "yieldItems">: optional $ cypher "YieldItems"], - --- StandaloneCall = (C,A,L,L), SP, (ExplicitProcedureInvocation | ImplicitProcedureInvocation), [[SP], (Y,I,E,L,D), SP, ('*' | YieldItems)] ; - - def "ProcedureInvocation" $ - union [ - "explicit">: cypher "ExplicitProcedureInvocation", - "implicit">: cypher "ImplicitProcedureInvocation"], - - def "StarOrYieldItems" $ - union [ - "star">: unit, - "items">: cypher "YieldItems"], - - def "StandaloneCall" $ - record [ - "call">: cypher "ProcedureInvocation", - "yieldItems">: optional $ cypher "StarOrYieldItems"], - --- YieldItems = YieldItem, { [SP], ',', [SP], YieldItem }, [[SP], Where] ; - - def "YieldItems" $ - record [ - "items">: nonemptyList $ cypher "YieldItem", - "where">: optional $ cypher "Where"], - --- YieldItem = [ProcedureResultField, SP, (A,S), SP], Variable ; - - def "YieldItem" $ - record [ - "field">: optional $ cypher "ProcedureResultField", - "variable">: cypher "Variable"], - --- With = (W,I,T,H), ProjectionBody, [[SP], Where] ; - - def "With" $ - record [ - "projection">: cypher "ProjectionBody", - "where">: optional $ cypher "Where"], - --- Return = (R,E,T,U,R,N), ProjectionBody ; - - def "Return" $ - cypher "ProjectionBody", - --- ProjectionBody = [[SP], (D,I,S,T,I,N,C,T)], SP, ProjectionItems, [SP, Order], [SP, Skip], [SP, Limit] ; - - def "ProjectionBody" $ - record [ - "distinct">: boolean, - "projectionItems">: cypher "ProjectionItems", - "order">: optional $ cypher "Order", - "skip">: optional $ cypher "Skip", - "limit">: optional $ cypher "Limit"], - --- ProjectionItems = ('*', { [SP], ',', [SP], ProjectionItem }) --- | (ProjectionItem, { [SP], ',', [SP], ProjectionItem }) --- ; - - def "ProjectionItems" $ - record [ - "star">: boolean, - "explicit">: list $ cypher "ProjectionItem"], - --- ProjectionItem = (Expression, SP, (A,S), SP, Variable) --- | Expression --- ; - - def "ProjectionItem" $ - record [ - "expression">: cypher "Expression", - "variable">: optional $ cypher "Variable"], - --- Order = (O,R,D,E,R), SP, (B,Y), SP, SortItem, { ',', [SP], SortItem } ; - - def "Order" $ - nonemptyList $ cypher "SortItem", - --- Skip = (S,K,I,P), SP, Expression ; - - def "Skip" $ - cypher "Expression", - --- Limit = (L,I,M,I,T), SP, Expression ; - - def "Limit" $ - cypher "Expression", - --- SortItem = Expression, [[SP], ((A,S,C,E,N,D,I,N,G) | (A,S,C) | (D,E,S,C,E,N,D,I,N,G) | (D,E,S,C))] ; - - def "SortOrder" $ - enum ["ascending", "descending"], - - def "SortItem" $ - record [ - "expression">: cypher "Expression", - "order">: optional $ cypher "SortOrder"], - --- Where = (W,H,E,R,E), SP, Expression ; - - def "Where" $ - cypher "Expression", - --- Pattern = PatternPart, { [SP], ',', [SP], PatternPart } ; - - def "Pattern" $ - nonemptyList $ cypher "PatternPart", - --- PatternPart = (Variable, [SP], '=', [SP], AnonymousPatternPart) --- | AnonymousPatternPart --- ; - - def "PatternPart" $ - record [ - "variable">: optional $ cypher "Variable", - "pattern">: cypher "AnonymousPatternPart"], - --- AnonymousPatternPart = PatternElement ; - - def "AnonymousPatternPart" $ - cypher "PatternElement", - --- PatternElement = (NodePattern, { [SP], PatternElementChain }) --- | ('(', PatternElement, ')') --- ; - - def "NodePatternChain" $ - record [ - "nodePattern">: cypher "NodePattern", - "chain">: list $ cypher "PatternElementChain"], - - def "PatternElement" $ - union [ - "chained">: cypher "NodePatternChain", - "parenthesized">: cypher "PatternElement"], - --- RelationshipsPattern = NodePattern, { [SP], PatternElementChain }- ; - - def "RelationshipsPattern" $ - record [ - "nodePattern">: cypher "NodePattern", - "chain">: nonemptyList $ cypher "PatternElementChain"], - --- NodePattern = '(', [SP], [Variable, [SP]], [NodeLabels, [SP]], [Properties, [SP]], ')' ; - def "NodePattern" $ - record [ - "variable">: optional $ cypher "Variable", - "labels">: optional $ cypher "NodeLabels", - "properties">: optional $ cypher "Properties"], - --- PatternElementChain = RelationshipPattern, [SP], NodePattern ; - - def "PatternElementChain" $ - record [ - "relationship">: cypher "RelationshipPattern", - "node">: cypher "NodePattern"], - --- RelationshipPattern = (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead) --- | (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash) --- | (Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead) --- | (Dash, [SP], [RelationshipDetail], [SP], Dash) --- ; - - def "RelationshipPattern" $ - record [ - "leftArrow">: boolean, - "detail">: optional $ cypher "RelationshipDetail", - "rightArrow">: boolean], - --- RelationshipDetail = '[', [SP], [Variable, [SP]], [RelationshipTypes, [SP]], [RangeLiteral], [Properties, [SP]], ']' ; - - def "RelationshipDetail" $ - record [ - "variable">: optional $ cypher "Variable", - "types">: optional $ cypher "RelationshipTypes", - "range">: optional $ cypher "RangeLiteral", - "properties">: optional $ cypher "Properties"], - --- Properties = MapLiteral --- | Parameter --- ; - - def "Properties" $ - union [ - "map">: cypher "MapLiteral", - "parameter">: cypher "Parameter"], - --- RelationshipTypes = ':', [SP], RelTypeName, { [SP], '|', [':'], [SP], RelTypeName } ; - - -- TODO: check whether the slight difference in colon syntax is significant - def "RelationshipTypes" $ nonemptyList $ cypher "RelTypeName", - --- NodeLabels = NodeLabel, { [SP], NodeLabel } ; - - def "NodeLabels" $ nonemptyList $ cypher "NodeLabel", - --- NodeLabel = ':', [SP], LabelName ; - - def "NodeLabel" string, - --- RangeLiteral = '*', [SP], [IntegerLiteral, [SP]], ['..', [SP], [IntegerLiteral, [SP]]] ; - - def "RangeLiteral" $ - record [ - "start">: optional bigint, - "end">: optional bigint], - --- LabelName = SchemaName ; --- --- RelTypeName = SchemaName ; - - def "RelTypeName" string, - --- PropertyExpression = Atom, { [SP], PropertyLookup }- ; - - def "PropertyExpression" $ - record [ - "atom">: cypher "Atom", - "lookups">: nonemptyList $ cypher "PropertyLookup"], - --- Expression = OrExpression ; - - def "Expression" $ cypher "OrExpression", - --- OrExpression = XorExpression, { SP, (O,R), SP, XorExpression } ; - - def "OrExpression" $ nonemptyList $ cypher "XorExpression", - --- XorExpression = AndExpression, { SP, (X,O,R), SP, AndExpression } ; - - def "XorExpression" $ nonemptyList $ cypher "AndExpression", - --- AndExpression = NotExpression, { SP, (A,N,D), SP, NotExpression } ; - - def "AndExpression" $ nonemptyList $ cypher "NotExpression", - --- NotExpression = { (N,O,T), [SP] }, ComparisonExpression ; - - def "NotExpression" $ - record [ - "not">: boolean, - "expression">: cypher "ComparisonExpression"], - --- ComparisonExpression = StringListNullPredicateExpression, { [SP], PartialComparisonExpression } ; - - def "ComparisonExpression" $ - record [ - "left">: cypher "StringListNullPredicateExpression", - "right">: list $ cypher "PartialComparisonExpression"], - --- PartialComparisonExpression = ('=', [SP], StringListNullPredicateExpression) --- | ('<>', [SP], StringListNullPredicateExpression) --- | ('<', [SP], StringListNullPredicateExpression) --- | ('>', [SP], StringListNullPredicateExpression) --- | ('<=', [SP], StringListNullPredicateExpression) --- | ('>=', [SP], StringListNullPredicateExpression) --- ; - - def "ComparisonOperator" $ - enum [ - "eq", - "neq", - "lt", - "gt", - "lte", - "gte"], - - def "PartialComparisonExpression" $ - record [ - "operator">: cypher "ComparisonOperator", - "right">: cypher "StringListNullPredicateExpression"], - --- StringListNullPredicateExpression = AddOrSubtractExpression, { StringPredicateExpression | ListPredicateExpression | NullPredicateExpression } ; - - def "StringListNullPredicateExpression" $ - record [ - "left">: cypher "AddOrSubtractExpression", - "right">: list $ cypher "StringListNullPredicateRightHandSide"], - - def "StringListNullPredicateRightHandSide" $ - union [ - "string">: cypher "StringPredicateExpression", - "list">: cypher "ListPredicateExpression", - "null">: cypher "NullPredicateExpression"], - --- StringPredicateExpression = ((SP, (S,T,A,R,T,S), SP, (W,I,T,H)) | (SP, (E,N,D,S), SP, (W,I,T,H)) | (SP, (C,O,N,T,A,I,N,S))), [SP], AddOrSubtractExpression ; - - def "StringPredicateExpression" $ - record [ - "operator">: cypher "StringPredicateOperator", - "expression">: cypher "AddOrSubtractExpression"], - - def "StringPredicateOperator" $ - enum [ - "startsWith", - "endsWith", - "contains"], - --- ListPredicateExpression = SP, (I,N), [SP], AddOrSubtractExpression ; - - def "ListPredicateExpression" $ - cypher "AddOrSubtractExpression", - --- NullPredicateExpression = (SP, (I,S), SP, (N,U,L,L)) --- | (SP, (I,S), SP, (N,O,T), SP, (N,U,L,L)) --- ; - - def "NullPredicateExpression" $ - boolean, -- true: NULL, false: NOT NULL - --- AddOrSubtractExpression = MultiplyDivideModuloExpression, { ([SP], '+', [SP], MultiplyDivideModuloExpression) | ([SP], '-', [SP], MultiplyDivideModuloExpression) } ; - - def "AddOrSubtractExpression" $ - record [ - "left">: cypher "MultiplyDivideModuloExpression", - "right">: list $ cypher "AddOrSubtractRightHandSide"], - - def "AddOrSubtractRightHandSide" $ - record [ - "operator">: cypher "AddOrSubtractOperator", - "expression">: cypher "MultiplyDivideModuloExpression"], - - def "AddOrSubtractOperator" $ - enum [ - "add", - "subtract"], - --- MultiplyDivideModuloExpression = PowerOfExpression, { ([SP], '*', [SP], PowerOfExpression) | ([SP], '/', [SP], PowerOfExpression) | ([SP], '%', [SP], PowerOfExpression) } ; - - def "MultiplyDivideModuloExpression" $ - record [ - "left">: cypher "PowerOfExpression", - "right">: list $ cypher "MultiplyDivideModuloRightHandSide"], - - def "MultiplyDivideModuloRightHandSide" $ - record [ - "operator">: cypher "MultiplyDivideModuloOperator", - "expression">: cypher "PowerOfExpression"], - - def "MultiplyDivideModuloOperator" $ - enum [ - "multiply", - "divide", - "modulo"], - --- PowerOfExpression = UnaryAddOrSubtractExpression, { [SP], '^', [SP], UnaryAddOrSubtractExpression } ; - - def "PowerOfExpression" $ nonemptyList $ cypher "UnaryAddOrSubtractExpression", - --- UnaryAddOrSubtractExpression = NonArithmeticOperatorExpression --- | (('+' | '-'), [SP], NonArithmeticOperatorExpression) --- ; - - def "UnaryAddOrSubtractExpression" $ - record [ - "operator">: optional $ cypher "AddOrSubtractOperator", - "expression">: cypher "NonArithmeticOperatorExpression"], - --- NonArithmeticOperatorExpression = Atom, { ([SP], ListOperatorExpression) | ([SP], PropertyLookup) }, [[SP], NodeLabels] ; - - def "ListOperatorExpressionOrPropertyLookup" $ - union [ - "list">: cypher "ListOperatorExpression", - "property">: cypher "PropertyLookup"], - - def "NonArithmeticOperatorExpression" $ - record [ - "atom">: cypher "Atom", - "listsAndLookups">: list $ cypher "ListOperatorExpressionOrPropertyLookup", - "labels">: optional $ cypher "NodeLabels"], - --- ListOperatorExpression = ('[', Expression, ']') --- | ('[', [Expression], '..', [Expression], ']') --- ; - - def "RangeExpression" $ - record [ - "start">: optional $ cypher "Expression", - "end">: optional $ cypher "Expression"], - - def "ListOperatorExpression" $ - union [ - "single">: cypher "Expression", - "range">: cypher "RangeExpression"], - --- PropertyLookup = '.', [SP], (PropertyKeyName) ; - - def "PropertyLookup" $ - cypher "PropertyKeyName", - --- Atom = Literal --- | Parameter --- | CaseExpression --- | ((C,O,U,N,T), [SP], '(', [SP], '*', [SP], ')') --- | ListComprehension --- | PatternComprehension --- | Quantifier --- | PatternPredicate --- | ParenthesizedExpression --- | FunctionInvocation --- | ExistentialSubquery --- | Variable --- ; - - def "Atom" $ - union [ - "literal">: cypher "Literal", - "parameter">: cypher "Parameter", - "case">: cypher "CaseExpression", - "countStar">: unit, - "listComprehension">: cypher "ListComprehension", - "patternComprehension">: cypher "PatternComprehension", - "quantifier">: cypher "Quantifier", - "patternPredicate">: cypher "PatternPredicate", - "parenthesized">: cypher "ParenthesizedExpression", - "functionInvocation">: cypher "FunctionInvocation", - "existentialSubquery">: cypher "ExistentialSubquery", - "variable">: cypher "Variable"], - --- CaseExpression = (((C,A,S,E), { [SP], CaseAlternative }-) | ((C,A,S,E), [SP], Expression, { [SP], CaseAlternative }-)), [[SP], (E,L,S,E), [SP], Expression], [SP], (E,N,D) ; - - def "CaseExpression" $ - record [ - "expression">: optional $ cypher "Expression", - "alternatives">: nonemptyList $ cypher "CaseAlternative", - "else">: optional $ cypher "Expression"], - --- CaseAlternative = (W,H,E,N), [SP], Expression, [SP], (T,H,E,N), [SP], Expression ; - - def "CaseAlternative" $ - record [ - "condition">: cypher "Expression", - "result">: cypher "Expression"], - --- ListComprehension = '[', [SP], FilterExpression, [[SP], '|', [SP], Expression], [SP], ']' ; - - def "ListComprehension" $ - record [ - "left">: cypher "FilterExpression", - "right">: optional $ cypher "Expression"], - --- PatternComprehension = '[', [SP], [Variable, [SP], '=', [SP]], RelationshipsPattern, [SP], [Where, [SP]], '|', [SP], Expression, [SP], ']' ; - - def "PatternComprehension" $ - record [ - "variable">: optional $ cypher "Variable", - "pattern">: cypher "RelationshipsPattern", - "where">: optional $ cypher "Where", - "right">: cypher "Expression"], - --- Quantifier = ((A,L,L), [SP], '(', [SP], FilterExpression, [SP], ')') --- | ((A,N,Y), [SP], '(', [SP], FilterExpression, [SP], ')') --- | ((N,O,N,E), [SP], '(', [SP], FilterExpression, [SP], ')') --- | ((S,I,N,G,L,E), [SP], '(', [SP], FilterExpression, [SP], ')') --- ; - - def "Quantifier" $ - record [ - "operator">: cypher "QuantifierOperator", - "expression">: cypher "FilterExpression"], - - def "QuantifierOperator" $ - enum [ - "all", - "any", - "none", - "single"], - --- FilterExpression = IdInColl, [[SP], Where] ; - - def "FilterExpression" $ - record [ - "idInColl">: cypher "IdInColl", - "where">: optional $ cypher "Where"], - --- PatternPredicate = RelationshipsPattern ; - - def "PatternPredicate" $ cypher "RelationshipsPattern", - --- ParenthesizedExpression = '(', [SP], Expression, [SP], ')' ; - - def "ParenthesizedExpression" $ cypher "Expression", - --- IdInColl = Variable, SP, (I,N), SP, Expression ; - - def "IdInColl" $ - record [ - "variable">: cypher "Variable", - "expression">: cypher "Expression"], - --- FunctionInvocation = FunctionName, [SP], '(', [SP], [(D,I,S,T,I,N,C,T), [SP]], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ; - - def "FunctionInvocation" $ - record [ - "name">: cypher "QualifiedName", - "distinct">: boolean, - "arguments">: list $ cypher "Expression"], - --- FunctionName = Namespace, SymbolicName ; - - def "QualifiedName" $ - record [ - "namespace">: string, - "local">: string], - --- ExistentialSubquery = (E,X,I,S,T,S), [SP], '{', [SP], (RegularQuery | (Pattern, [[SP], Where])), [SP], '}' ; - - def "PatternWhere" $ - record [ - "pattern">: cypher "Pattern", - "where">: optional $ cypher "Where"], - - def "ExistentialSubquery" $ - union [ - "regular">: cypher "RegularQuery", - "pattern">: cypher "PatternWhere"], - --- ExplicitProcedureInvocation = ProcedureName, [SP], '(', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ; - - def "ExplicitProcedureInvocation" $ - record [ - "name">: cypher "QualifiedName", - "arguments">: list $ cypher "Expression"], - --- ImplicitProcedureInvocation = ProcedureName ; - - def "ImplicitProcedureInvocation" $ cypher "QualifiedName", - --- ProcedureResultField = SymbolicName ; - - def "ProcedureResultField" string, - --- ProcedureName = Namespace, SymbolicName ; --- --- Namespace = { SymbolicName, '.' } ; --- --- Variable = SymbolicName ; - - def "Variable" string, - --- Literal = BooleanLiteral --- | (N,U,L,L) --- | NumberLiteral --- | StringLiteral --- | ListLiteral --- | MapLiteral --- ; - - def "Literal" $ - union [ - "boolean">: boolean, - "null">: unit, - "number">: cypher "NumberLiteral", - "string">: cypher "StringLiteral", - "list">: cypher "ListLiteral", - "map">: cypher "MapLiteral"], - --- BooleanLiteral = (T,R,U,E) --- | (F,A,L,S,E) --- ; --- --- NumberLiteral = DoubleLiteral --- | IntegerLiteral --- ; - - def "NumberLiteral" $ - union [ - "double">: float64, - "integer">: bigint], - --- IntegerLiteral = HexInteger --- | OctalInteger --- | DecimalInteger --- ; --- --- HexInteger = '0x', { HexDigit }- ; --- --- DecimalInteger = ZeroDigit --- | (NonZeroDigit, { Digit }) --- ; --- --- OctalInteger = '0o', { OctDigit }- ; --- --- HexLetter = (A) --- | (B) --- | (C) --- | (D) --- | (E) --- | (F) --- ; --- --- HexDigit = Digit --- | HexLetter --- ; --- --- Digit = ZeroDigit --- | NonZeroDigit --- ; --- --- NonZeroDigit = NonZeroOctDigit --- | '8' --- | '9' --- ; --- --- NonZeroOctDigit = '1' --- | '2' --- | '3' --- | '4' --- | '5' --- | '6' --- | '7' --- ; --- --- OctDigit = ZeroDigit --- | NonZeroOctDigit --- ; --- --- ZeroDigit = '0' ; --- --- DoubleLiteral = ExponentDecimalReal --- | RegularDecimalReal --- ; --- --- ExponentDecimalReal = ({ Digit }- | ({ Digit }-, '.', { Digit }-) | ('.', { Digit }-)), (E), ['-'], { Digit }- ; --- --- RegularDecimalReal = { Digit }, '.', { Digit }- ; --- --- StringLiteral = ('"', { ANY - ('"' | '\') | EscapedChar }, '"') --- | ("'", { ANY - ("'" | '\') | EscapedChar }, "'") --- ; - - def "StringLiteral" string, - --- EscapedChar = '\', ('\' | "'" | '"' | (B) | (F) | (N) | (R) | (T) | ((U), 4 * HexDigit) | ((U), 8 * HexDigit)) ; --- --- ListLiteral = '[', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ']' ; - - def "ListLiteral" $ - list $ cypher "Expression", - --- MapLiteral = '{', [SP], [PropertyKeyName, [SP], ':', [SP], Expression, [SP], { ',', [SP], PropertyKeyName, [SP], ':', [SP], Expression, [SP] }], '}' ; - - def "MapLiteral" $ - list $ cypher "KeyValuePair", - - def "KeyValuePair" $ - record [ - "key">: cypher "PropertyKeyName", - "value">: cypher "Expression"], - --- PropertyKeyName = SchemaName ; - - def "PropertyKeyName" string, - --- Parameter = '$', (SymbolicName | DecimalInteger) ; - - def "Parameter" $ - union [ - "symbolic">: string, - "integer">: bigint]] - --- SchemaName = SymbolicName --- | ReservedWord --- ; --- --- ReservedWord = (A,L,L) --- | (A,S,C) --- | (A,S,C,E,N,D,I,N,G) --- | (B,Y) --- | (C,R,E,A,T,E) --- | (D,E,L,E,T,E) --- | (D,E,S,C) --- | (D,E,S,C,E,N,D,I,N,G) --- | (D,E,T,A,C,H) --- | (E,X,I,S,T,S) --- | (L,I,M,I,T) --- | (M,A,T,C,H) --- | (M,E,R,G,E) --- | (O,N) --- | (O,P,T,I,O,N,A,L) --- | (O,R,D,E,R) --- | (R,E,M,O,V,E) --- | (R,E,T,U,R,N) --- | (S,E,T) --- | (S,K,I,P) --- | (W,H,E,R,E) --- | (W,I,T,H) --- | (U,N,I,O,N) --- | (U,N,W,I,N,D) --- | (A,N,D) --- | (A,S) --- | (C,O,N,T,A,I,N,S) --- | (D,I,S,T,I,N,C,T) --- | (E,N,D,S) --- | (I,N) --- | (I,S) --- | (N,O,T) --- | (O,R) --- | (S,T,A,R,T,S) --- | (X,O,R) --- | (F,A,L,S,E) --- | (T,R,U,E) --- | (N,U,L,L) --- | (C,O,N,S,T,R,A,I,N,T) --- | (D,O) --- | (F,O,R) --- | (R,E,Q,U,I,R,E) --- | (U,N,I,Q,U,E) --- | (C,A,S,E) --- | (W,H,E,N) --- | (T,H,E,N) --- | (E,L,S,E) --- | (E,N,D) --- | (M,A,N,D,A,T,O,R,Y) --- | (S,C,A,L,A,R) --- | (O,F) --- | (A,D,D) --- | (D,R,O,P) --- ; --- --- SymbolicName = UnescapedSymbolicName --- | EscapedSymbolicName --- | HexLetter --- | (C,O,U,N,T) --- | (F,I,L,T,E,R) --- | (E,X,T,R,A,C,T) --- | (A,N,Y) --- | (N,O,N,E) --- | (S,I,N,G,L,E) --- ; --- --- UnescapedSymbolicName = IdentifierStart, { IdentifierPart } ; --- --- (* Based on the unicode identifier and pattern syntax --- * (http://www.unicode.org/reports/tr31/) --- * And extended with a few characters. --- *)IdentifierStart = ID_Start --- | Pc --- ; --- --- (* Based on the unicode identifier and pattern syntax --- * (http://www.unicode.org/reports/tr31/) --- * And extended with a few characters. --- *)IdentifierPart = ID_Continue --- | Sc --- ; --- --- (* Any character except "`", enclosed within `backticks`. Backticks are escaped with double backticks. --- *)EscapedSymbolicName = { '`', { ANY - ('`') }, '`' }- ; --- --- SP = { whitespace }- ; --- --- whitespace = SPACE --- | TAB --- | LF --- | VT --- | FF --- | CR --- | FS --- | GS --- | RS --- | US --- | ' ' --- | '᠎' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | ' ' --- | '
' --- | '
' --- | ' ' --- | '　' --- | ' ' --- | ' ' --- | ' ' --- | Comment --- ; --- --- Comment = ('/*', { ANY - ('*') | ('*', ANY - ('/')) }, '*/') --- | ('//', { ANY - (LF | CR) }, [CR], (LF | EOI)) --- ; --- --- LeftArrowHead = '<' --- | '⟨' --- | '〈' --- | '﹤' --- | '＜' --- ; --- --- RightArrowHead = '>' --- | '⟩' --- | '〉' --- | '﹥' --- | '＞' --- ; --- --- Dash = '-' --- | '­' --- | '‐' --- | '‑' --- | '‒' --- | '–' --- | '—' --- | '―' --- | '−' --- | '﹘' --- | '﹣' --- | '－' --- ; --- --- A = 'A' | 'a' ; --- B = 'B' | 'b' ; --- C = 'C' | 'c' ; --- D = 'D' | 'd' ; --- E = 'E' | 'e' ; --- F = 'F' | 'f' ; --- G = 'G' | 'g' ; --- H = 'H' | 'h' ; --- I = 'I' | 'i' ; --- K = 'K' | 'k' ; --- L = 'L' | 'l' ; --- M = 'M' | 'm' ; --- N = 'N' | 'n' ; --- O = 'O' | 'o' ; --- P = 'P' | 'p' ; --- Q = 'Q' | 'q' ; --- R = 'R' | 'r' ; --- S = 'S' | 's' ; --- T = 'T' | 't' ; --- U = 'U' | 'u' ; --- V = 'V' | 'v' ; --- W = 'W' | 'w' ; --- X = 'X' | 'x' ; --- Y = 'Y' | 'y' ; diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Graphql/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Graphql/Syntax.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Graphql/Syntax.hs +++ /dev/null @@ -1,338 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Graphql.Syntax where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Grammars -import Hydra.Tools.GrammarToModule -import qualified Hydra.Grammar as G - - -and_ = terminal "&" -at_ = terminal "@" -bang_ = terminal "!" -colon_ = terminal ":" -directive_ = terminal "directive" -dollar_ = terminal "$" -ellipsis_ = terminal "..." -enum_ = terminal "enum" -equal_ = terminal "=" -extend_ = terminal "extend" -false_ = terminal "false" -implements_ = terminal "implements" -input_ = terminal "input" -interface_ = terminal "interface" -lbracket_ = terminal "[" -lcurly_ = terminal "{" -lparen_ = terminal "(" -null_ = terminal "null" -on_ = terminal "on" -or_ = terminal "or" -rbracket_ = terminal "]" -rcurly_ = terminal "}" -repeatable_ = terminal "repeatable" -rparen_ = terminal ")" -scalar_ = terminal "scalar" -schema_ = terminal "schema" -true_ = terminal "true" -type_ = terminal "type" -union_ = terminal "union" - -descriptionOpt = opt"Description" -directivesConst = "Directives" -- Directives_[Const] -directivesConstOpt = opt"Directives" -- Directives_[Const]opt - -graphqlSyntaxModule :: Module -graphqlSyntaxModule = grammarToModule ns graphqlGrammar $ - Just ("A GraphQL model. Based on the (extended) BNF at:\n" ++ - " https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary") - where - ns = Namespace "hydra/langs/graphql/syntax" - -graphqlGrammar :: G.Grammar -graphqlGrammar = G.Grammar $ tokenDefinitions ++ documentDefinitions - -tokenDefinitions :: [G.Production] -tokenDefinitions = [ - define "Name" [regex "[A-Za-z][A-Za-z0-9]*"], - define "IntValue" [regex "-?(0|[1-9][0-9]*)"], - define "FloatValue" [regex "-?(0|[1-9][0-9]*)([.][0-9]+|[eE][+-]?[0-9]+)"], - define "StringValue" [regex "[\"].*[\"]"]] -- TODO: the actual expression includes Unicode escape sequences - -documentDefinitions :: [G.Production] -documentDefinitions = [ - define "Document" [ - star"Definition"], - - define "Definition" [ - "executable">: "ExecutableDefinition", - "typeSystem">: "TypeSystemDefinitionOrExtension"], - - define "ExecutableDocument" [ - star"ExecutableDefinition"], - - define "ExecutableDefinition" [ - "operation">: "OperationDefinition", - "fragment">: "FragmentDefinition"], - - define "OperationDefinition" [ - list["OperationType", opt"Name", opt"VariablesDefinition", opt"Directives", "SelectionSet"], - "SelectionSet"], - - define "OperationType" [ - terminal "query", - terminal "mutation", - terminal "subscription"], - - define "SelectionSet" [ - list[lcurly_, star"Selection", rcurly_]], - - define "Selection" [ - "Field", - "FragmentSpread", - "InlineFragment"], - - define "Field" [ - list[opt"Alias", "Name", opt"Arguments", opt"Directives", opt"SelectionSet"]], - - define "Alias" [ - "Name", colon_], - - define "Arguments"{- [Const] -} [ - list[lparen_, star"Argument"{- [?Const] -}, rparen_]], - - define "Argument"{- [Const] -} [ - list["Name", colon_, "Value"{- [?Const] -}]], - - define "FragmentSpread" [ - list[ellipsis_, "FragmentName", opt"Directives"]], - - define "InlineFragment" [ - list[ellipsis_, opt"TypeCondition", opt"Directives", "SelectionSet"]], - - define "FragmentDefinition" [ - list[terminal "fragment", "FragmentName", "TypeCondition", opt"Directives", "SelectionSet"]], - - define "FragmentName" [ - "Name" {- but not on_ -}], - - define "TypeCondition" [ - on_, "NamedType"], - - define "Value"{- [Const] -} [ - {- [if not Const] -} "Variable", - "int">: "IntValue", - "float">: "FloatValue", - "string">: "StringValue", - "boolean">: "BooleanValue", - "null">: "NullValue", - "enum">: "EnumValue", - "list">: "ListValue"{- [?Const] -}, - "object">: "ObjectValue"{- [?Const] -}], - - define "BooleanValue" [ - true_, - false_], - - define "NullValue" [ - null_], - - define "EnumValue" [ - list["Name" {- but not true_ or false_ or null_ -}]], - - define "ListValue"{- [Const] -} [ - list[lbracket_, rbracket_], - list[lbracket_, star"Value"{- [?Const] -}]], - - define "ObjectValue"{- [Const] -} [ - list[lcurly_, rcurly_], - list[star"ObjectField"{- [?Const] -}]], - - define "ObjectField"{- [Const] -} [ - list["Name", colon_, "Value"{- [?Const] -}]], - - define "VariablesDefinition" [ - list["Variable", colon_, "Type", opt"DefaultValue", directivesConstOpt]], - - define "Variable" [ - "Name"], - - define "DefaultValue" [ - list[equal_, "Value"{- [Const] -}]], - - define "Type" [ - "named">: "NamedType", - "list">: "ListType", - "nonNull">: "NonNullType"], - - define "NamedType" [ - "Name"], - - define "ListType" [ - list[lbracket_, "Type", rbracket_]], - - define "NonNullType" [ - "named">: list["NamedType", bang_], - "list">: list["ListType", bang_]], - - define "Directives"{- [Const] -} [ - star("Directive"{- [?Const] -})], - - define "Directive"{- [Const] -} [ - list[at_, "Name", opt("Arguments"{- [?Const] -})]], - - define "TypeSystemDocment" [ - star"TypeSystemDefinition"], - - define "TypeSystemDefinition" [ - "schema">: "SchemaDefinition", - "type">: "TypeDefinition", - "directive">: "DirectiveDefinition"], - - define "TypeSystemExtensionDocument" [ - star"TypeSystemDefinitionOrExtension"], - - define "TypeSystemDefinitionOrExtension" [ - "definition">: "TypeSystemDefinition", - "extension">: "TypeSystemExtension"], - - define "TypeSystemExtension" [ - "schema">: "SchemaExtension", - "type">: "TypeExtension"], - - define "SchemaDefinition" [ - list[descriptionOpt, schema_, directivesConstOpt, lcurly_, "RootOperationTypeDefinition", rcurly_]], - - define "SchemaExtension" [ - list[extend_, schema_, directivesConstOpt, lcurly_, "RootOperationTypeDefinition", rcurly_], - list[extend_, schema_, directivesConst {- [lookahead != lcurly_] -}]], - - define "RootOperationTypeDefinition" [ - list["OperationType", colon_, "NamedType"]], - - define "Description" [ - "StringValue"], - - define "TypeDefinition" [ - "scalar">: "ScalarTypeDefinition", - "object">: "ObjectTypeDefinition", - "interface">: "InterfaceTypeDefinition", - "union">: "UnionTypeDefinition", - "enum">: "EnumTypeDefinition", - "inputObject">: "InputObjectTypeDefinition"], - - define "TypeExtension" [ - "scalar">: "ScalarTypeExtension", - "object">: "ObjectTypeExtension", - "interface">: "InterfaceTypeExtension", - "union">: "UnionTypeExtension", - "enum">: "EnumTypeExtension", - "inputObject">: "InputObjectTypeExtension"], - - define "ScalarTypeDefinition" [ - list[descriptionOpt, scalar_, "Name", directivesConstOpt ]], - - define "ScalarTypeExtension" [ - list[extend_, scalar_, "Name", directivesConst]], - - define "ObjectTypeDefinition" [ - list[descriptionOpt, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt, opt("FieldsDefinition") {- [lookahead != lcurly_] -}]], - - define "ObjectTypeExtension" [ - list[extend_, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"], - list[extend_, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt {- [lookahead != lcurly_] -}], - list[extend_, type_, "Name", "ImplementsInterfaces" {- [lookahead != lcurly_] -}]], - - define "ImplementsInterfaces" [ - list["ImplementsInterfaces", and_, "NamedType"], - list[implements_, opt(and_), "NamedType"]], - - define "FieldsDefinition" [ - list[lcurly_, star"FieldDefinition", rcurly_]], - - define "FieldDefinition" [ - list[descriptionOpt, "Name", opt"ArgumentsDefinition", colon_, "Type", directivesConstOpt]], - - define "ArgumentsDefinition" [ - list[lparen_, star"InputValueDefinition", rparen_]], - - define "InputValueDefinition" [ - list[descriptionOpt, "Name", colon_, "Type", opt"DefaultValue", directivesConstOpt]], - - define "InterfaceTypeDefinition" [ - list[descriptionOpt, interface_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"], - list[descriptionOpt, interface_, "Name", "ImplementsInterfaces", directivesConstOpt {- [lookahead != lcurly_] -}]], - - define "InterfaceTypeExtension" [ - list[extend_, interface_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"], - list[extend_, interface_, "Name", opt"ImplementsInterfaces", directivesConst {- [lookahead != lcurly_] -}], - list[extend_, interface_, "Name", "ImplementsInterfaces" {- [lookahead != lcurly_] -}]], - - define "UnionTypeDefinition" [ - list[descriptionOpt, union_, "Name", directivesConstOpt, opt"UnionMemberTypes"]], - - define "UnionMemberTypes" [ - list["UnionMemberTypes", or_, "NamedType"], - list[opt(or_), "NamedType"]], - - define "UnionTypeExtension" [ - list[extend_, union_, "Name", directivesConstOpt, "UnionMemberTypes"], - list[extend_, union_, "Name", directivesConst]], - - define "EnumTypeDefinition" [ - list[descriptionOpt, enum_, "Name", directivesConstOpt, opt("EnumValuesDefinition") {- [lookahead != lcurly_] -}]], - - define "EnumValuesDefinition" [ - list[lcurly_, star"EnumValueDefinition", rcurly_]], - - define "EnumValueDefinition" [ - list[descriptionOpt, "EnumValue", directivesConstOpt]], - - define "EnumTypeExtension" [ - list[extend_, enum_, "Name", directivesConstOpt, "EnumValuesDefinition"], - list[extend_, enum_, "Name", directivesConst {- [lookahead != lcurly_] -}]], - - define "InputObjectTypeDefinition" [ - list[descriptionOpt, input_, "Name", directivesConstOpt, "InputFieldsDefinition"], - list[descriptionOpt, input_, "Name", directivesConstOpt {- [lookahead != lcurly_] -}]], - - define "InputFieldsDefinition" [ - list[lcurly_, star"InputValueDefinition", rcurly_]], - - define "InputObjectTypeExtension" [ - list[extend_, input_, "Name", directivesConstOpt, "InputFieldsDefinition"], - list[extend_, input_, "Name", directivesConst {- [lookahead != lcurly_] -}]], - - define "DirectiveDefinition" [ - list[descriptionOpt, directive_, at_, "Name", opt"ArgumentsDefinition", opt(repeatable_), on_, "DirectiveLocations"]], - - define "DirectiveLocations" [ - list["DirectiveLocations", or_, "DirectiveLocation"], - list[opt(or_), "DirectiveLocation"]], - - define "DirectiveLocation" [ - "executable">: "ExecutableDirectiveLocation", - "typeSystem">: "TypeSystemDirectiveLocation"], - - define "ExecutableDirectiveLocation" $ terminal <$> [ - "QUERY", - "MUTATION", - "SUBSCRIPTION", - "FIELD", - "FRAGMENT_DEFINITION", - "FRAGMENT_SPREAD", - "INLINE_FRAGMENT", - "VARIABLE_DEFINITION"], - - define "TypeSystemDirectiveLocation" $ terminal <$> [ - "SCHEMA", - "SCALAR", - "OBJECT", - "FIELD_DEFINITION", - "ARGUMENT_DEFINITION", - "INTERFACE", - "UNION", - "ENUM", - "ENUM_VALUE", - "INPUT_OBJECT", - "INPUT_FIELD_DEFINITION"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Haskell/Ast.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Haskell/Ast.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Haskell/Ast.hs +++ /dev/null @@ -1,432 +0,0 @@ -module Hydra.Sources.Tier4.Langs.Haskell.Ast where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -haskellAstModule :: Module -haskellAstModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just "A Haskell syntax model, loosely based on Language.Haskell.Tools.AST" - where - ns = Namespace "hydra/langs/haskell/ast" - def = datatype ns - ast = typeref ns - - elements = [ - - def "Alternative" $ -- UAlt - doc "A pattern-matching alternative" $ - record [ - "pattern">: ast "Pattern", - "rhs">: ast "CaseRhs", - "binds">: optional $ ast "LocalBindings"], - - def "Assertion" $ -- UAssertion (UClassAssert) - doc "A type assertion" $ - union [ - "class">: ast "Assertion.Class", - "tuple">: list $ ast "Assertion"], - -- omitted for now: implicit and infix assertions - - def "Assertion.Class" $ -- UClassAssert - record [ - "name">: ast "Name", - "types">: list $ ast "Type"], - - def "CaseRhs" $ -- UCaseRhs' - doc "The right-hand side of a pattern-matching alternative" $ - -- omitted for now: guarded - ast "Expression", - - def "Constructor" $ -- UConDecl - doc "A data constructor" $ - -- omitted for now: ordinary (positional), infix - union [ - "ordinary">: ast "Constructor.Ordinary", - "record">: ast "Constructor.Record"], - - def "Constructor.Ordinary" $ - doc "An ordinary (positional) data constructor" $ - record [ - "name">: ast "Name", - "fields">: list $ ast "Type"], - - def "Constructor.Record" $ - doc "A record-style data constructor" $ - record [ - "name">: ast "Name", - "fields">: list $ ast "FieldWithComments"], - - def "ConstructorWithComments" $ - doc "A data constructor together with any comments" $ - record [ - "body">: ast "Constructor", - "comments">: optional string], - - def "DataDeclaration" $ -- UDataDecl - doc "A data type declaration" $ - record [ - "keyword">: ast "DataDeclaration.Keyword", - "context">: list $ ast "Assertion", - "head">: ast "DeclarationHead", - "constructors">: list $ ast "ConstructorWithComments", - "deriving">: list $ ast "Deriving"], - - def "DataDeclaration.Keyword" $ - doc "The 'data' versus 'newtype keyword" $ - enum ["data", "newtype"], - - def "DeclarationWithComments" $ - doc "A data declaration together with any comments" $ - record [ - "body">: ast "Declaration", - "comments">: optional string], - - def "Declaration" $ -- UDecl - doc "A data or value declaration" $ - -- omitted for now: typeFamily, typeSignature, closedTypeFamily, gDataDecl, typeInst, dataInst, gDataInst, class, inst, - -- patternSynonym, deriv, fixity, default, patTypeSig, foreignImport, foreignExport, pragma, - -- role, splice - union [ - "data">: ast "DataDeclaration", - "type">: ast "TypeDeclaration", - "valueBinding">: ast "ValueBinding", - "typedBinding">: ast "TypedBinding"], - - def "DeclarationHead" $ -- UDeclHead - doc "The left-hand side of a declaration" $ - -- omitted for now: infix application - union [ - "application">: ast "DeclarationHead.Application", - "parens">: ast "DeclarationHead", - "simple">: ast "Name"], - - def "DeclarationHead.Application" $ - doc "An application-style declaration head" $ - record [ - "function">: ast "DeclarationHead", - "operand">: ast "Variable"], - - def "Deriving" $ -- UDeriving - doc "A 'deriving' statement" $ - -- omitted for now: infix, parenthesized, and application instance heads - list $ ast "Name", - - def "Export" $ -- UExportSpec - doc "An export statement" $ - union [ - "declaration">: ast "ImportExportSpec", - "module">: ast "ModuleName"], - - def "Expression" $ -- UExpr - doc "A data expression" $ - -- omitted for now: multi-if, unboxed tuple, tuple section, unboxed tuple section, parallel array, - -- enum, parallel array enum, list comp, parallel array comp, type application, - -- (all Template Haskell constructors), pragma, arrow definition, arrow application, - -- lambda cases, static, unboxed sum, hole - union [ - "application">: ast "Expression.Application", - "case">: ast "Expression.Case", - "constructRecord">: ast "Expression.ConstructRecord", - "do">: list $ ast "Statement", -- omitted for now: do vs. mdo - "if">: ast "Expression.If", - "infixApplication">: ast "Expression.InfixApplication", - "literal">: ast "Literal", - "lambda">: ast "Expression.Lambda", - "leftSection">: ast "Expression.Section", - "let">: ast "Expression.Let", - "list">: list $ ast "Expression", - "parens">: ast "Expression", - "prefixApplication">: ast "Expression.PrefixApplication", - "rightSection">: ast "Expression.Section", - "tuple">: list $ ast "Expression", - "typeSignature">: ast "Expression.TypeSignature", - "updateRecord">: ast "Expression.UpdateRecord", - "variable">: ast "Name"], - - def "Expression.Application" $ - doc "An application expression" $ - record [ - "function">: ast "Expression", - "argument">: ast "Expression"], - - def "Expression.Case" $ - doc "A case expression" $ - record [ - "case">: ast "Expression", - "alternatives">: list $ ast "Alternative"], - - def "Expression.ConstructRecord" $ - doc "A record constructor expression" $ - record [ - "name">: ast "Name", - "fields">: list $ ast "FieldUpdate"], - - def "Expression.If" $ - doc "An 'if' expression" $ - record [ - "condition">: ast "Expression", - "then">: ast "Expression", - "else">: ast "Expression"], - - def "Expression.InfixApplication" $ - doc "An infix application expression" $ - record [ - "lhs">: ast "Expression", - "operator">: ast "Operator", - "rhs">: ast "Expression"], - - def "Expression.Lambda" $ - doc "A lambda expression" $ - record [ - "bindings">: list $ ast "Pattern", - "inner">: ast "Expression"], - - def "Expression.Let" $ - doc "A 'let' expression" $ - record [ - "bindings">: list $ ast "LocalBinding", - "inner">: ast "Expression"], - - def "Expression.PrefixApplication" $ - doc "A prefix expression" $ - record [ - "operator">: ast "Operator", - "rhs">: ast "Expression"], - - def "Expression.Section" $ - doc "A section expression" $ - record [ - "operator">: ast "Operator", - "expression">: ast "Expression"], - - def "Expression.TypeSignature" $ - doc "A type signature expression" $ - record [ - "inner">: ast "Expression", - "type">: ast "Type"], - - def "Expression.UpdateRecord" $ - doc "An update record expression" $ - record [ - "inner">: ast "Expression", - "fields">: list $ ast "FieldUpdate"], - - def "Field" $ -- UFieldDecl - doc "A field (name/type pair)" $ - record [ - "name">: ast "Name", - "type">: ast "Type"], - - def "FieldWithComments" $ - doc "A field together with any comments" $ - record [ - "field">: ast "Field", - "comments">: optional string], - - def "FieldUpdate" $ -- UFieldUpdate - doc "A field name and value" $ - -- omitted for now: pun, wildcard - record [ - "name">: ast "Name", - "value">: ast "Expression"], - - def "Import" $ -- UImportDecl - doc "An import statement" $ - -- omitted for now: source, safe, pkg - record [ - "qualified">: boolean, - "module">: ast "ModuleName", - "as">: optional $ ast "ModuleName", - "spec">: optional $ ast "Import.Spec"], - - def "Import.Spec" $ - doc "An import specification" $ - union [ - "list">: list $ ast "ImportExportSpec", - "hiding">: list $ ast "ImportExportSpec"], - - def "ImportModifier" $ -- UImportModifier - doc "An import modifier ('pattern' or 'type')" $ - enum ["pattern", "type"], - - def "ImportExportSpec" $ -- UIESpec - doc "An import or export specification" $ - record [ - "modifier">: optional $ ast "ImportModifier", - "name">: ast "Name", - "subspec">: optional $ ast "ImportExportSpec.Subspec"], - - def "ImportExportSpec.Subspec" $ - union [ - "all">: unit, - "list">: list $ ast "Name"], - - def "Literal" $ -- ULiteral - doc "A literal value" $ - -- omitted for now: frac, primChar - union [ - "char">: uint16, - "double">: float64, - "float">: float32, - "int">: int32, - "integer">: bigint, - "string">: string], - - def "LocalBinding" $ -- ULocalBind - -- omitted for now: fixity, pragma - union [ - "signature">: ast "TypeSignature", - "value">: ast "ValueBinding"], - - def "LocalBindings" $ -- ULocalBinds - list $ ast "LocalBinding", - - def "Module" $ -- UModule - -- omitted for now: pragma - record [ - "head">: optional $ ast "ModuleHead", - "imports">: list $ ast "Import", - "declarations">: list $ ast "DeclarationWithComments"], - - def "ModuleHead" $ -- UModuleHead - -- omitted for now: pragma - record [ - "comments">: optional string, - "name">: ast "ModuleName", - "exports">: list $ ast "Export"], -- UExportSpecs - - def "ModuleName" -- UModuleName - string, - - def "Name" $ -- UName - union [ - "implicit">: ast "QualifiedName", - "normal">: ast "QualifiedName", - "parens">: ast "QualifiedName"], - - def "NamePart" -- UNamePart - string, - - def "Operator" $ -- UOperator - union [ - "backtick">: ast "QualifiedName", - "normal">: ast "QualifiedName"], - - def "Pattern" $ -- UPattern - -- omitted for now: unboxed tuples, parallel arrays, irrefutable, bang, view, splice, quasiquote, plusk, unboxed sum - union [ - "application">: ast "Pattern.Application", - "as">: ast "Pattern.As", - "list">: list $ ast "Pattern", - "literal">: ast "Literal", - "name">: ast "Name", - "parens">: ast "Pattern", - "record">: ast "Pattern.Record", - "tuple">: list $ ast "Pattern", - "typed">: ast "Pattern.Typed", - "wildcard">: unit], - - def "Pattern.Application" $ - record [ - "name">: ast "Name", - "args">: list $ ast "Pattern"], - - def "Pattern.As" $ - record [ - "name">: ast "Name", - "inner">: ast "Pattern"], - - def "Pattern.Record" $ - record [ - "name">: ast "Name", - "fields">: list $ ast "PatternField"], - - def "Pattern.Typed" $ - record [ - "inner">: ast "Pattern", - "type">: ast "Type"], - - def "PatternField" $ -- UPatternField - -- omitted for now: puns, wildcards - record [ - "name">: ast "Name", - "pattern">: ast "Pattern"], - - def "QualifiedName" $ -- UQualifiedName - record [ - "qualifiers">: list $ ast "NamePart", - "unqualified">: ast "NamePart"], - - def "RightHandSide" $ -- URhs - -- omitted for now: guarded rhs - ast "Expression", - - def "Statement" $ -- UStmt - ast "Expression", - - def "Type" $ -- UType - -- omitted for now: forall, unboxed tuple, parallel array, kinded, promoted, splice, quasiquote, bang, - -- lazy, unpack, nounpack, wildcard, named wildcard, sum - union [ - "application">: ast "Type.Application", - "ctx">: ast "Type.Context", - "function">: ast "Type.Function", - "infix">: ast "Type.Infix", - "list">: ast "Type", - "parens">: ast "Type", - "tuple">: list $ ast "Type", - "variable">: ast "Name"], - - def "Type.Application" $ - record [ - "context">: ast "Type", - "argument">: ast "Type"], - - def "Type.Context" $ - record [ - "ctx">: ast "Assertion", -- UContext - "type">: ast "Type"], - - def "Type.Function" $ - record [ - "domain">: ast "Type", - "codomain">: ast "Type"], - - def "Type.Infix" $ - record [ - "lhs">: ast "Type", - "operator">: ast "Operator", - "rhs">: ast "Operator"], - - def "TypeDeclaration" $ -- UTypeDecl - record [ - "name">: ast "DeclarationHead", - "type">: ast "Type"], - - def "TypeSignature" $ -- UTypeSignature - record [ - "name">: ast "Name", - "type">: ast "Type"], - - def "TypedBinding" $ -- Added for convenience - record [ - "typeSignature">: ast "TypeSignature", - "valueBinding">: ast "ValueBinding"], - - def "ValueBinding" $ -- UValueBind - -- omitted for now: funBind - union [ - "simple">: ast "ValueBinding.Simple"], - - def "ValueBinding.Simple" $ - record [ - "pattern">: ast "Pattern", - "rhs">: ast "RightHandSide", - "localBindings">: optional $ ast "LocalBindings"], - - def "Variable" $ - -- omitted for now: kind constraints - ast "Name"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Language.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Language.hs +++ /dev/null @@ -1,143 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Java.Language where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Base as Base -import Hydra.Dsl.Lib.Equality as Equality -import Hydra.Dsl.Lib.Flows as Flows -import Hydra.Dsl.Lib.Lists as Lists -import Hydra.Dsl.Lib.Logic as Logic -import Hydra.Dsl.Lib.Maps as Maps -import Hydra.Dsl.Lib.Sets as Sets -import Hydra.Dsl.Lib.Strings as Strings -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types - -import qualified Data.Set as S - - -javaLanguageDefinition :: String -> Datum a -> Definition a -javaLanguageDefinition = definitionInModule javaLanguageModule - -javaLanguageModule :: Module -javaLanguageModule = Module ns elements [hydraCodersModule, hydraBasicsModule] tier0Modules $ - Just "Language constraints for Java" - where - ns = Namespace "hydra/langs/java/language" - elements = [ - el javaMaxTupleLengthDef, - el javaLanguageDef, - el reservedWordsDef - ] - -javaMaxTupleLengthDef :: Definition Int -javaMaxTupleLengthDef = javaLanguageDefinition "javaMaxTupleLength" $ - doc ("The maximum supported length of a tuple in Hydra-Java. " - <> "Note: if this constant is changed, also change Tuples.java correspondingly") $ - int32 9 - -javaLanguageDef :: Definition (Language) -javaLanguageDef = javaLanguageDefinition "javaLanguage" $ - doc "Language constraints for Java" $ - typed languageT $ - record _Language [ - _Language_name>>: wrap _LanguageName "hydra/langs/java", - _Language_constraints>>: record _LanguageConstraints [ - _LanguageConstraints_eliminationVariants>>: Sets.fromList @@ ref eliminationVariantsDef, - _LanguageConstraints_literalVariants>>: Sets.fromList @@ list (unitVariant _LiteralVariant <$> [ - _LiteralVariant_boolean, -- boolean - _LiteralVariant_float, -- (see float types) - _LiteralVariant_integer, -- (see integer types) - _LiteralVariant_string]), -- string - _LanguageConstraints_floatTypes>>: Sets.fromList @@ list (unitVariant _FloatType <$> [ - -- Bigfloat (e.g. as Java's BigDecimal) is excluded for now - _FloatType_float32, -- float - _FloatType_float64]), -- double - _LanguageConstraints_functionVariants>>: Sets.fromList @@ ref functionVariantsDef, - _LanguageConstraints_integerTypes>>: Sets.fromList @@ list (unitVariant _IntegerType <$> [ - _IntegerType_bigint, -- BigInteger - _IntegerType_int16, -- short - _IntegerType_int32, -- int - _IntegerType_int64, -- long - _IntegerType_uint8, -- byte - _IntegerType_uint16]), -- char - _LanguageConstraints_termVariants>>: Sets.fromList @@ list (unitVariant _TermVariant <$> [ - _TermVariant_application, - _TermVariant_function, - _TermVariant_let, - _TermVariant_list, - _TermVariant_literal, - _TermVariant_map, - _TermVariant_optional, - _TermVariant_product, - _TermVariant_record, - _TermVariant_set, - _TermVariant_union, - _TermVariant_variable, - _TermVariant_wrap]), - _LanguageConstraints_typeVariants>>: Sets.fromList @@ list (unitVariant _TypeVariant <$> [ - _TypeVariant_annotated, - _TypeVariant_application, - _TypeVariant_function, - _TypeVariant_lambda, - _TypeVariant_list, - _TypeVariant_literal, - _TypeVariant_map, - _TypeVariant_optional, - _TypeVariant_product, - _TypeVariant_record, - _TypeVariant_set, - _TypeVariant_union, - _TypeVariant_variable, - _TypeVariant_wrap]), - _LanguageConstraints_types>>: match _Type (Just true) [ - _Type_product>>: lambda "types" $ Equality.ltInt32 @@ (Lists.length @@ var "types") @@ (ref javaMaxTupleLengthDef) - ]]] - -reservedWordsDef :: Definition (S.Set String) -reservedWordsDef = javaLanguageDefinition "reservedWords" $ - doc "A set of reserved words in Java" $ - typed (setT stringT) $ - (Sets.fromList @@ (Lists.concat @@ list [var "specialNames", var "classNames", var "keywords", var "literals"])) - `with` [ - "specialNames">: - doc "Special names reserved for use by Hydra" $ - list ["Elements"], - - "classNames">: - doc ("java.lang classes as of JDK 7\n" - <> "See: https://docs.oracle.com/javase/7/docs/api/java/lang/package-summary.html") $ - list [ - "AbstractMethodError", "Appendable", "ArithmeticException", "ArrayIndexOutOfBoundsException", - "ArrayStoreException", "AssertionError", "AutoCloseable", "Boolean", "BootstrapMethodError", "Byte", - "CharSequence", "Character", "Class", "ClassCastException", "ClassCircularityError", "ClassFormatError", - "ClassLoader", "ClassNotFoundException", "ClassValue", "CloneNotSupportedException", "Cloneable", "Comparable", - "Compiler", "Deprecated", "Double", "Enum", "EnumConstantNotPresentException", "Error", "Exception", - "ExceptionInInitializerError", "Float", "IllegalAccessError", "IllegalAccessException", - "IllegalArgumentException", "IllegalMonitorStateException", "IllegalStateException", - "IllegalThreadStateException", "IncompatibleClassChangeError", "IndexOutOfBoundsException", - "InheritableThreadLocal", "InstantiationError", "InstantiationException", "Integer", "InternalError", - "InterruptedException", "Iterable", "LinkageError", "Long", "Math", "NegativeArraySizeException", - "NoClassDefFoundError", "NoSuchFieldError", "NoSuchFieldException", "NoSuchMethodError", "NoSuchMethodException", - "NullPointerException", "Number", "NumberFormatException", "Object", "OutOfMemoryError", "Override", "Package", - "Process", "ProcessBuilder", "Readable", "ReflectiveOperationException", "Runnable", "Runtime", - "RuntimeException", "RuntimePermission", "SafeVarargs", "SecurityException", "SecurityManager", "Short", - "StackOverflowError", "StackTraceElement", "StrictMath", "String", "StringBuffer", "StringBuilder", - "StringIndexOutOfBoundsException", "SuppressWarnings", "System", "Thread", "ThreadDeath", - "ThreadGroup", "ThreadLocal", "Throwable", "TypeNotPresentException", - "UnknownError", "UnsatisfiedLinkError", "UnsupportedClassVersionError", - "UnsupportedOperationException", "VerifyError", "VirtualMachineError", "Void"], - - "keywords">: - doc ("Keywords and literals are taken from Oracle's Java Tutorials on 2022-05-27; said to be complete for Java 1.8 only\n" - <> "See: https://docs.oracle.com/javase/tutorial/java/nutsandbolts/_keywords.html") $ - list [ - "abstract", "assert", "boolean", "break", "byte", "case", "catch", "char", "class", "const", "continue", - "default", "do", "double", "else", "enum", "extends", "final", "finally", "float", "for", "goto", "if", - "implements", "import", "instanceof", "int", "interface", "long", "native", "new", "package", "private", - "protected", "public", "return", "short", "static", "strictfp", "super", "switch", "synchronized", "this", - "throw", "throws", "transient", "try", "void", "volatile", "while"], - - "literals">: - list ["false", "null", "true"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Syntax.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Syntax.hs +++ /dev/null @@ -1,1742 +0,0 @@ -module Hydra.Sources.Tier4.Langs.Java.Syntax where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Types as Types -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap - - -javaSyntaxModule :: Module -javaSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("A Java syntax module. Based on the Oracle Java SE 12 BNF:\n" ++ - " https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html\n" ++ - "Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments.") - where - ns = Namespace "hydra/langs/java/syntax" - def = datatype ns - java = typeref ns - - elements = [ - ---Productions from §3 (Lexical Structure) - ---Identifier: --- IdentifierChars but not a Keyword or BooleanLiteral or NullLiteral - def "Identifier" string, ---IdentifierChars: --- JavaLetter {JavaLetterOrDigit} --- ---JavaLetter: --- any Unicode character that is a "Java letter" --- ---JavaLetterOrDigit: --- any Unicode character that is a "Java letter-or-digit" - ---TypeIdentifier: --- Identifier but not var - def "TypeIdentifier" $ java "Identifier", - ---Literal: - def "Literal" $ - union [ --- NullLiteral - "null">: unit, --- IntegerLiteral - "integer">: java "IntegerLiteral", --- FloatingPointLiteral - "floatingPoint">: java "FloatingPointLiteral", --- BooleanLiteral - "boolean">: boolean, --- CharacterLiteral - "character">: uint16, --- StringLiteral - "string">: java "StringLiteral"], - def "IntegerLiteral" $ - doc "Note: this is an approximation which ignores encoding" - bigint, - def "FloatingPointLiteral" $ - doc "Note: this is an approximation which ignores encoding" - bigfloat, - def "StringLiteral" $ - doc "Note: this is an approximation which ignores encoding" - string, - ---Productions from §4 (Types, Values, and Variables) - ---Type: - def "Type" $ union [ --- PrimitiveType - "primitive">: java "PrimitiveTypeWithAnnotations", --- ReferenceType - "reference">: java "ReferenceType"], - ---PrimitiveType: - def "PrimitiveTypeWithAnnotations" $ record [ - "type">: java "PrimitiveType", - "annotations">: list $ java "Annotation"], - def "PrimitiveType" $ union [ --- {Annotation} NumericType - "numeric">: java "NumericType", --- {Annotation} boolean - "boolean">: unit], - ---NumericType: - def "NumericType" $ union [ --- IntegralType - "integral">: java "IntegralType", --- FloatingPointType - "floatingPoint">: java "FloatingPointType"], - ---IntegralType: - def "IntegralType" $ enum [ --- (one of) --- byte short int long char - "byte", "short", "int", "long", "char"], - ---FloatingPointType: - def "FloatingPointType" $ enum [ --- (one of) --- float double - "float", "double"], - ---ReferenceType: - def "ReferenceType" $ union [ --- ClassOrInterfaceType - "classOrInterface">: java "ClassOrInterfaceType", --- TypeVariable - "variable">: java "TypeVariable", --- ArrayType - "array">: java "ArrayType"], - ---ClassOrInterfaceType: - def "ClassOrInterfaceType" $ union [ --- ClassType - "class">: java "ClassType", --- InterfaceType - "interface">: java "InterfaceType"], - ---ClassType: - def "ClassType" $ record [ - "annotations">: list $ java "Annotation", - "qualifier">: java "ClassTypeQualifier", - "identifier">: java "TypeIdentifier", - "arguments">: list $ java "TypeArgument"], - def "ClassTypeQualifier" $ union [ --- {Annotation} TypeIdentifier [TypeArguments] - "none">: unit, --- PackageName . {Annotation} TypeIdentifier [TypeArguments] - "package">: java "PackageName", --- ClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments] - "parent">: java "ClassOrInterfaceType"], - ---InterfaceType: --- ClassType - def "InterfaceType" $ java "ClassType", - ---TypeVariable: --- {Annotation} TypeIdentifier - def "TypeVariable" $ record [ - "annotations">: list $ java "Annotation", - "identifier">: java "TypeIdentifier"], - ---ArrayType: - def "ArrayType" $ record [ - "dims">: java "Dims", - "variant">: java "ArrayType.Variant"], - def "ArrayType.Variant" $ union [ --- PrimitiveType Dims - "primitive">: java "PrimitiveTypeWithAnnotations", --- ClassOrInterfaceType Dims - "classOrInterface">: java "ClassOrInterfaceType", --- TypeVariable Dims - "variable">: java "TypeVariable"], - ---Dims: --- {Annotation} [ ] {{Annotation} [ ]} - def "Dims" $ list $ list $ java "Annotation", - ---TypeParameter: --- {TypeParameterModifier} TypeIdentifier [TypeBound] - def "TypeParameter" $ record [ - "modifiers">: list $ java "TypeParameterModifier", - "identifier">: java "TypeIdentifier", - "bound">: optional $ java "TypeBound"], - ---TypeParameterModifier: --- Annotation - def "TypeParameterModifier" $ java "Annotation", - ---TypeBound: - def "TypeBound" $ union [ --- extends TypeVariable - "variable">: java "TypeVariable", --- extends ClassOrInterfaceType {AdditionalBound} - "classOrInterface">: java "TypeBound.ClassOrInterface"], - def "TypeBound.ClassOrInterface" $ record [ - "type">: java "ClassOrInterfaceType", - "additional">: list $ java "AdditionalBound"], - ---AdditionalBound: --- & InterfaceType - def "AdditionalBound" $ java "InterfaceType", - ---TypeArguments: --- < TypeArgumentList > ---TypeArgumentList: --- TypeArgument {, TypeArgument} - ---TypeArgument: - def "TypeArgument" $ union [ --- ReferenceType - "reference">: java "ReferenceType", --- Wildcard - "wildcard">: java "Wildcard"], - ---Wildcard: --- {Annotation} ? [WildcardBounds] - def "Wildcard" $ record [ - "annotations">: list $ java "Annotation", - "wildcard">: optional $ java "WildcardBounds"], - ---WildcardBounds: - def "WildcardBounds" $ union [ --- extends ReferenceType - "extends">: java "ReferenceType", --- super ReferenceType - "super">: java "ReferenceType"], - ---Productions from §6 (Names) - ---ModuleName: - def "ModuleName" $ record [ --- Identifier - "identifier">: java "Identifier", --- ModuleName . Identifier - "name">: optional $ java "ModuleName"], - ---PackageName: --- Identifier --- PackageName . Identifier - def "PackageName" $ list $ java "Identifier", - ---TypeName: - def "TypeName" $ record [ --- TypeIdentifier - "identifier">: java "TypeIdentifier", --- PackageOrTypeName . TypeIdentifier - "qualifier">: optional $ java "PackageOrTypeName"], - ---ExpressionName: --- Identifier --- AmbiguousName . Identifier - def "ExpressionName" $ record [ - "qualifier">: optional $ java "AmbiguousName", - "identifier">: java "Identifier"], - ---MethodName: --- Identifier - def "MethodName" $ java "Identifier", - ---PackageOrTypeName: --- Identifier --- PackageOrTypeName . Identifier - def "PackageOrTypeName" $ list $ java "Identifier", - ---AmbiguousName: --- Identifier --- AmbiguousName . Identifier - def "AmbiguousName" $ list $ java "Identifier", - ---Productions from §7 (Packages and Modules) - ---CompilationUnit: - def "CompilationUnit" $ union [ --- OrdinaryCompilationUnit - "ordinary">: java "OrdinaryCompilationUnit", --- ModularCompilationUnit - "modular">: java "ModularCompilationUnit"], - ---OrdinaryCompilationUnit: --- [PackageDeclaration] {ImportDeclaration} {TypeDeclaration} - def "OrdinaryCompilationUnit" $ record [ - "package">: optional $ java "PackageDeclaration", - "imports">: list $ java "ImportDeclaration", - "types">: list $ java "TypeDeclarationWithComments"], - ---ModularCompilationUnit: --- {ImportDeclaration} ModuleDeclaration - def "ModularCompilationUnit" $ record [ - "imports">: list $ java "ImportDeclaration", - "module">: java "ModuleDeclaration"], - ---PackageDeclaration: --- {PackageModifier} package Identifier {. Identifier} ; - def "PackageDeclaration" $ record [ - "modifiers">: list $ java "PackageModifier", - "identifiers">: list $ java "Identifier"], - ---PackageModifier: --- Annotation - def "PackageModifier" $ java "Annotation", - ---ImportDeclaration: - def "ImportDeclaration" $ union [ --- SingleTypeImportDeclaration - "singleType">: java "SingleTypeImportDeclaration", --- TypeImportOnDemandDeclaration - "typeImportOnDemand">: java "TypeImportOnDemandDeclaration", --- SingleStaticImportDeclaration - "singleStaticImport">: java "SingleStaticImportDeclaration", --- StaticImportOnDemandDeclaration - "staticImportOnDemand">: java "StaticImportOnDemandDeclaration"], - ---SingleTypeImportDeclaration: --- import TypeName ; - def "SingleTypeImportDeclaration" $ java "TypeName", - ---TypeImportOnDemandDeclaration: --- import PackageOrTypeName . * ; - def "TypeImportOnDemandDeclaration" $ java "PackageOrTypeName", - ---SingleStaticImportDeclaration: --- import static TypeName . Identifier ; - def "SingleStaticImportDeclaration" $ record [ - "typeName">: java "TypeName", - "identifier">: java "Identifier"], - ---StaticImportOnDemandDeclaration: --- import static TypeName . * ; - def "StaticImportOnDemandDeclaration" $ java "TypeName", - ---TypeDeclaration: - def "TypeDeclaration" $ union [ --- ClassDeclaration - "class">: java "ClassDeclaration", --- InterfaceDeclaration - "interface">: java "InterfaceDeclaration", --- ; - "none">: unit], - def "TypeDeclarationWithComments" $ - record [ - "value">: java "TypeDeclaration", - "comments">: optional string], - ---ModuleDeclaration: --- {Annotation} [open] module Identifier {. Identifier} { {ModuleDirective} } - def "ModuleDeclaration" $ record [ - "annotations">: list $ java "Annotation", - "open">: boolean, - "identifiers">: list $ java "Identifier", - "directives">: list $ list $ java "ModuleDirective"], - ---ModuleDirective: - def "ModuleDirective" $ union [ --- requires {RequiresModifier} ModuleName ; - "requires">: java "ModuleDirective.Requires", --- exports PackageName [to ModuleName {, ModuleName}] ; - "exports">: java "ModuleDirective.ExportsOrOpens", --- opens PackageName [to ModuleName {, ModuleName}] ; - "opens">: java "ModuleDirective.ExportsOrOpens", --- uses TypeName ; - "uses">: java "TypeName", --- provides TypeName with TypeName {, TypeName} ; - "provides">: java "ModuleDirective.Provides"], - def "ModuleDirective.Requires" $ record [ - "modifiers">: list $ java "RequiresModifier", - "module">: java "ModuleName"], - def "ModuleDirective.ExportsOrOpens" $ record [ - "package">: java "PackageName", - "modules">: - doc "At least one module" $ - list $ java "ModuleName"], - def "ModuleDirective.Provides" $ record [ - "to">: java "TypeName", - "with">: - doc "At least one type" $ - list $ java "TypeName"], - ---RequiresModifier: - def "RequiresModifier" $ enum [ --- (one of) --- transitive static - "transitive", "static"], - ---Productions from §8 (Classes) - ---ClassDeclaration: - def "ClassDeclaration" $ union [ --- NormalClassDeclaration - "normal">: java "NormalClassDeclaration", --- EnumDeclaration - "enum">: java "EnumDeclaration"], - ---NormalClassDeclaration: --- {ClassModifier} class TypeIdentifier [TypeParameters] [Superclass] [Superinterfaces] ClassBody - def "NormalClassDeclaration" $ record [ - "modifiers">: list $ java "ClassModifier", - "identifier">: java "TypeIdentifier", - "parameters">: list $ java "TypeParameter", - "extends">: optional $ java "ClassType", - "implements">: list $ java "InterfaceType", - "body">: java "ClassBody"], - ---ClassModifier: - def "ClassModifier" $ union [ --- (one of) --- Annotation public protected private --- abstract static final strictfp - "annotation">: java "Annotation", - "public">: unit, - "protected">: unit, - "private">: unit, - "abstract">: unit, - "static">: unit, - "final">: unit, - "strictfp">: unit], - ---TypeParameters: --- < TypeParameterList > ---TypeParameterList: --- TypeParameter {, TypeParameter} ---Superclass: --- extends ClassType ---Superinterfaces: --- implements InterfaceTypeList ---InterfaceTypeList: --- InterfaceType {, InterfaceType} - ---ClassBody: --- { {ClassBodyDeclaration} } - def "ClassBody" $ list $ java "ClassBodyDeclarationWithComments", - ---ClassBodyDeclaration: - def "ClassBodyDeclaration" $ union [ --- ClassMemberDeclaration - "classMember">: java "ClassMemberDeclaration", --- InstanceInitializer - "instanceInitializer">: java "InstanceInitializer", --- StaticInitializer - "staticInitializer">: java "StaticInitializer", --- ConstructorDeclaration - "constructorDeclaration">: java "ConstructorDeclaration"], - def "ClassBodyDeclarationWithComments" $ - record [ - "value">: java "ClassBodyDeclaration", - "comments">: optional string], - ---ClassMemberDeclaration: - def "ClassMemberDeclaration" $ union [ --- FieldDeclaration - "field">: java "FieldDeclaration", --- MethodDeclaration - "method">: java "MethodDeclaration", --- ClassDeclaration - "class">: java "ClassDeclaration", --- InterfaceDeclaration - "interface">: java "InterfaceDeclaration", --- ; - "none">: unit], - ---FieldDeclaration: --- {FieldModifier} UnannType VariableDeclaratorList ; - def "FieldDeclaration" $ record [ - "modifiers">: list $ java "FieldModifier", - "unannType">: java "UnannType", - "variableDeclarators">: nonemptyList $ java "VariableDeclarator"], - ---FieldModifier: --- (one of) - def "FieldModifier" $ union [ --- Annotation public protected private --- static final transient volatile - "annotation">: java "Annotation", - "public">: unit, - "protected">: unit, - "private">: unit, - "static">: unit, - "final">: unit, - "transient">: unit, - "volatile">: unit], - ---VariableDeclaratorList: --- VariableDeclarator {, VariableDeclarator} ---VariableDeclarator: --- VariableDeclaratorId [= VariableInitializer] - def "VariableDeclarator" $ record [ - "id">: java "VariableDeclaratorId", - "initializer">: optional $ java "VariableInitializer"], - ---VariableDeclaratorId: --- Identifier [Dims] - def "VariableDeclaratorId" $ record [ - "identifier">: java "Identifier", - "dims">: optional $ java "Dims"], - ---VariableInitializer: - def "VariableInitializer" $ union [ --- Expression - "expression">: java "Expression", --- ArrayInitializer - "arrayInitializer">: java "ArrayInitializer"], - ---UnannType: --- UnannPrimitiveType --- UnannReferenceType - def "UnannType" $ - doc "A Type which does not allow annotations" $ - java "Type", ---UnannPrimitiveType: --- NumericType --- boolean ---UnannReferenceType: --- UnannClassOrInterfaceType --- UnannTypeVariable --- UnannArrayType ---UnannClassOrInterfaceType: --- UnannClassType --- UnannInterfaceType ---UnannClassType: --- TypeIdentifier [TypeArguments] --- PackageName . {Annotation} TypeIdentifier [TypeArguments] --- UnannClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments] - def "UnannClassType" $ - doc "A ClassType which does not allow annotations" $ - java "ClassType", ---UnannInterfaceType: --- UnannClassType ---UnannTypeVariable: --- TypeIdentifier ---UnannArrayType: --- UnannPrimitiveType Dims --- UnannClassOrInterfaceType Dims --- UnannTypeVariable Dims - ---MethodDeclaration: --- {MethodModifier} MethodHeader MethodBody - def "MethodDeclaration" $ record [ - "annotations">: - doc "Note: simple methods cannot have annotations" $ - list $ java "Annotation", - "modifiers">: list $ java "MethodModifier", - "header">: java "MethodHeader", - "body">: java "MethodBody"], - ---MethodModifier: --- (one of) - def "MethodModifier" $ union [ --- Annotation public protected private --- abstract static final synchronized native strictfp - "annotation">: java "Annotation", - "public">: unit, - "protected">: unit, - "private">: unit, - "abstract">: unit, - "static">: unit, - "final">: unit, - "synchronized">: unit, - "native">: unit, - "strictfb">: unit], - ---MethodHeader: --- Result MethodDeclarator [Throws] --- TypeParameters {Annotation} Result MethodDeclarator [Throws] - def "MethodHeader" $ record [ - "parameters">: list $ java "TypeParameter", - "result">: java "Result", - "declarator">: java "MethodDeclarator", - "throws">: optional $ java "Throws"], - ---Result: - def "Result" $ union [ --- UnannType - "type">: java "UnannType", --- void - "void">: unit], - ---MethodDeclarator: --- Identifier ( [ReceiverParameter ,] [FormalParameterList] ) [Dims] - def "MethodDeclarator" $ record [ - "identifier">: java "Identifier", - "receiverParameter">: optional $ java "ReceiverParameter", - "formalParameters">: nonemptyList $ java "FormalParameter"], - ---ReceiverParameter: --- {Annotation} UnannType [Identifier .] this - def "ReceiverParameter" $ record [ - "annotations">: list $ java "Annotation", - "unannType">: java "UnannType", - "identifier">: optional $ java "Identifier"], - ---FormalParameterList: --- FormalParameter {, FormalParameter} ---FormalParameter: - def "FormalParameter" $ union [ --- {VariableModifier} UnannType VariableDeclaratorId - "simple">: java "FormalParameter.Simple", --- VariableArityParameter - "variableArity">: java "VariableArityParameter"], - def "FormalParameter.Simple" $ record [ - "modifiers">: list $ java "VariableModifier", - "type">: java "UnannType", - "id">: java "VariableDeclaratorId"], - ---VariableArityParameter: --- {VariableModifier} UnannType {Annotation} ... Identifier - def "VariableArityParameter" $ record [ - "modifiers">: java "VariableModifier", - "type">: java "UnannType", - "annotations">: list $ java "Annotation", - "identifier">: java "Identifier"], - ---VariableModifier: - def "VariableModifier" $ union [ --- Annotation - "annotation">: java "Annotation", --- final - "final">: unit], - ---Throws: --- throws ExceptionTypeList - def "Throws" $ nonemptyList $ java "ExceptionType", - ---ExceptionTypeList: --- ExceptionType {, ExceptionType} ---ExceptionType: - def "ExceptionType" $ union [ --- ClassType - "class">: java "ClassType", --- TypeVariable - "variable">: java "TypeVariable"], - ---MethodBody: - def "MethodBody" $ union [ --- Block - "block">: java "Block", --- ; - "none">: unit], - ---InstanceInitializer: --- Block - def "InstanceInitializer" $ java "Block", - ---StaticInitializer: --- static Block - def "StaticInitializer" $ java "Block", - ---ConstructorDeclaration: --- {ConstructorModifier} ConstructorDeclarator [Throws] ConstructorBody - def "ConstructorDeclaration" $ record [ - "modifiers">: list $ java "ConstructorModifier", - "constructor">: java "ConstructorDeclarator", - "throws">: optional $ java "Throws", - "body">: java "ConstructorBody"], - ---ConstructorModifier: --- (one of) - def "ConstructorModifier" $ union [ --- Annotation public protected private - "annotation">: java "Annotation", - "public">: unit, - "protected">: unit, - "private">: unit], - ---ConstructorDeclarator: --- [TypeParameters] SimpleTypeName ( [ReceiverParameter ,] [FormalParameterList] ) - def "ConstructorDeclarator" $ record [ - "parameters">: list $ java "TypeParameter", - "name">: java "SimpleTypeName", - "receiverParameter">: optional $ java "ReceiverParameter", - "formalParameters">: nonemptyList $ java "FormalParameter"], - ---SimpleTypeName: --- TypeIdentifier - def "SimpleTypeName" $ java "TypeIdentifier", - ---ConstructorBody: --- { [ExplicitConstructorInvocation] [BlockStatements] } - def "ConstructorBody" $ record [ - "invocation">: optional $ java "ExplicitConstructorInvocation", - "statements">: list $ java "BlockStatement"], - ---ExplicitConstructorInvocation: - def "ExplicitConstructorInvocation" $ record [ - "typeArguments">: list $ java "TypeArgument", - "arguments">: list $ java "Expression", - "variant">: java "ExplicitConstructorInvocation.Variant"], - def "ExplicitConstructorInvocation.Variant" $ union [ --- [TypeArguments] this ( [ArgumentList] ) ; - "this">: unit, --- [TypeArguments] super ( [ArgumentList] ) ; --- ExpressionName . [TypeArguments] super ( [ArgumentList] ) ; - "super">: optional $ java "ExpressionName", --- Primary . [TypeArguments] super ( [ArgumentList] ) ; - "primary">: java "Primary"], - ---EnumDeclaration: --- {ClassModifier} enum TypeIdentifier [Superinterfaces] EnumBody - def "EnumDeclaration" $ record [ - "modifiers">: list $ java "ClassModifier", - "identifier">: java "TypeIdentifier", - "implements">: list $ java "InterfaceType", - "body">: java "EnumBody"], - ---EnumBody: --- { [EnumConstantList] [,] [EnumBodyDeclarations] } - def "EnumBody" $ list $ java "EnumBody.Element", - def "EnumBody.Element" $ record [ - "constants">: list $ java "EnumConstant", - "bodyDeclarations">: list $ java "ClassBodyDeclaration"], - ---EnumConstantList: --- EnumConstant {, EnumConstant} ---EnumConstant: --- {EnumConstantModifier} Identifier [( [ArgumentList] )] [ClassBody] - def "EnumConstant" $ record [ - "modifiers">: list $ java "EnumConstantModifier", - "identifier">: java "Identifier", - "arguments">: list $ list $ java "Expression", - "body">: optional $ java "ClassBody"], - ---EnumConstantModifier: --- Annotation - def "EnumConstantModifier" $ java "Annotation", - ---EnumBodyDeclarations: --- ; {ClassBodyDeclaration} - ---Productions from §9 (Interfaces) - ---InterfaceDeclaration: - def "InterfaceDeclaration" $ union [ --- NormalInterfaceDeclaration - "normalInterface">: java "NormalInterfaceDeclaration", --- AnnotationTypeDeclaration - "annotationType">: java "AnnotationTypeDeclaration"], - ---NormalInterfaceDeclaration: --- {InterfaceModifier} interface TypeIdentifier [TypeParameters] [ExtendsInterfaces] InterfaceBody - def "NormalInterfaceDeclaration" $ record [ - "modifiers">: list $ java "InterfaceModifier", - "identifier">: java "TypeIdentifier", - "parameters">: list $ java "TypeParameter", - "extends">: list $ java "InterfaceType", - "body">: java "InterfaceBody"], - ---InterfaceModifier: --- (one of) - def "InterfaceModifier" $ union [ --- Annotation public protected private --- abstract static strictfp - "annotation">: java "Annotation", - "public">: unit, - "protected">: unit, - "private">: unit, - "abstract">: unit, - "static">: unit, - "strictfb">: unit], - ---ExtendsInterfaces: --- extends InterfaceTypeList - ---InterfaceBody: --- { {InterfaceMemberDeclaration} } - def "InterfaceBody" $ list $ java "InterfaceMemberDeclaration", - ---InterfaceMemberDeclaration: - def "InterfaceMemberDeclaration" $ union [ --- ConstantDeclaration - "constant">: java "ConstantDeclaration", --- InterfaceMethodDeclaration - "interfaceMethod">: java "InterfaceMethodDeclaration", --- ClassDeclaration - "class">: java "ClassDeclaration", --- InterfaceDeclaration - "interface">: java "InterfaceDeclaration"], --- ; - ---ConstantDeclaration: --- {ConstantModifier} UnannType VariableDeclaratorList ; - def "ConstantDeclaration" $ record [ - "modifiers">: list $ java "ConstantModifier", - "type">: java "UnannType", - "variables">: nonemptyList $ java "VariableDeclarator"], - ---ConstantModifier: --- (one of) - def "ConstantModifier" $ union [ --- Annotation public --- static final - "annotation">: java "Annotation", - "public">: unit, - "static">: unit, - "final">: unit], - ---InterfaceMethodDeclaration: --- {InterfaceMethodModifier} MethodHeader MethodBody - def "InterfaceMethodDeclaration" $ record [ - "modifiers">: list $ java "InterfaceMethodModifier", - "header">: java "MethodHeader", - "body">: java "MethodBody"], - ---InterfaceMethodModifier: --- (one of) - def "InterfaceMethodModifier" $ union [ --- Annotation public private --- abstract default static strictfp - "annotation">: java "Annotation", - "public">: unit, - "private">: unit, - "abstract">: unit, - "default">: unit, - "static">: unit, - "strictfp">: unit], - ---AnnotationTypeDeclaration: --- {InterfaceModifier} @ interface TypeIdentifier AnnotationTypeBody - def "AnnotationTypeDeclaration" $ record [ - "modifiers">: list $ java "InterfaceModifier", - "identifier">: java "TypeIdentifier", - "body">: java "AnnotationTypeBody"], - ---AnnotationTypeBody: --- { {AnnotationTypeMemberDeclaration} } - def "AnnotationTypeBody" $ list $ list $ java "AnnotationTypeMemberDeclaration", - ---AnnotationTypeMemberDeclaration: - def "AnnotationTypeMemberDeclaration" $ union [ --- AnnotationTypeElementDeclaration - "annotationType">: java "AnnotationTypeElementDeclaration", --- ConstantDeclaration - "constant">: java "ConstantDeclaration", --- ClassDeclaration - "class">: java "ClassDeclaration", --- InterfaceDeclaration - "interface">: java "InterfaceDeclaration"], --- ; - ---AnnotationTypeElementDeclaration: --- {AnnotationTypeElementModifier} UnannType Identifier ( ) [Dims] [DefaultValue] ; - def "AnnotationTypeElementDeclaration" $ record [ - "modifiers">: list $ java "AnnotationTypeElementModifier", - "type">: java "UnannType", - "identifier">: java "Identifier", - "dims">: optional $ java "Dims", - "default">: optional $ java "DefaultValue"], - ---AnnotationTypeElementModifier: --- (one of) - def "AnnotationTypeElementModifier" $ union [ --- Annotation public - "public">: java "Annotation", --- abstract - "abstract">: unit], - ---DefaultValue: --- default ElementValue - def "DefaultValue" $ java "ElementValue", - ---Annotation: - def "Annotation" $ union [ --- NormalAnnotation - "normal">: java "NormalAnnotation", --- MarkerAnnotation - "marker">: java "MarkerAnnotation", --- SingleElementAnnotation - "singleElement">: java "SingleElementAnnotation"], - ---NormalAnnotation: --- @ TypeName ( [ElementValuePairList] ) - def "NormalAnnotation" $ record [ - "typeName">: java "TypeName", - "pairs">: list $ java "ElementValuePair"], - ---ElementValuePairList: --- ElementValuePair {, ElementValuePair} ---ElementValuePair: --- Identifier = ElementValue - def "ElementValuePair" $ record [ - "key">: java "Identifier", - "value">: java "ElementValue"], - ---ElementValue: - def "ElementValue" $ union [ --- ConditionalExpression - "conditionalExpression">: java "ConditionalExpression", --- ElementValueArrayInitializer - "elementValueArrayInitializer">: java "ElementValueArrayInitializer", --- Annotation - "annotation">: java "Annotation"], - ---ElementValueArrayInitializer: --- { [ElementValueList] [,] } - def "ElementValueArrayInitializer" $ list $ java "ElementValue", ---ElementValueList: --- ElementValue {, ElementValue} - ---MarkerAnnotation: --- @ TypeName - def "MarkerAnnotation" $ java "TypeName", - ---SingleElementAnnotation: - def "SingleElementAnnotation" $ record [ --- @ TypeName ( ElementValue ) - "name">: java "TypeName", - "value">: optional $ java "ElementValue"], - --- Productions from §10 (Arrays) - ---ArrayInitializer: --- { [VariableInitializerList] [,] } - def "ArrayInitializer" $ list $ list $ java "VariableInitializer", ---VariableInitializerList: --- VariableInitializer {, VariableInitializer} - ---Productions from §14 (Blocks and Statements) - ---Block: --- { [BlockStatements] } - def "Block" $ list $ java "BlockStatement", - ---BlockStatements: --- BlockStatement {BlockStatement} ---BlockStatement: - def "BlockStatement" $ union [ --- LocalVariableDeclarationStatement - "localVariableDeclaration">: java "LocalVariableDeclarationStatement", --- ClassDeclaration - "class">: java "ClassDeclaration", --- Statement - "statement">: java "Statement"], - ---LocalVariableDeclarationStatement: --- LocalVariableDeclaration ; - def "LocalVariableDeclarationStatement" $ java "LocalVariableDeclaration", - ---LocalVariableDeclaration: --- {VariableModifier} LocalVariableType VariableDeclaratorList - def "LocalVariableDeclaration" $ record [ - "modifiers">: list $ java "VariableModifier", - "type">: java "LocalVariableType", - "declarators">: nonemptyList $ java "VariableDeclarator"], - ---LocalVariableType: - def "LocalVariableType" $ union [ --- UnannType - "type">: java "UnannType", --- var - "var">: unit], - ---Statement: - def "Statement" $ union [ --- StatementWithoutTrailingSubstatement - "withoutTrailing">: java "StatementWithoutTrailingSubstatement", --- LabeledStatement - "labeled">: java "LabeledStatement", --- IfThenStatement - "ifThen">: java "IfThenStatement", --- IfThenElseStatement - "ifThenElse">: java "IfThenElseStatement", --- WhileStatement - "while">: java "WhileStatement", --- ForStatement - "for">: java "ForStatement"], - ---StatementNoShortIf: - def "StatementNoShortIf" $ union [ --- StatementWithoutTrailingSubstatement - "withoutTrailing">: java "StatementWithoutTrailingSubstatement", --- LabeledStatementNoShortIf - "labeled">: java "LabeledStatementNoShortIf", --- IfThenElseStatementNoShortIf - "ifThenElse">: java "IfThenElseStatementNoShortIf", --- WhileStatementNoShortIf - "while">: java "WhileStatementNoShortIf", --- ForStatementNoShortIf - "for">: java "ForStatementNoShortIf"], - ---StatementWithoutTrailingSubstatement: - def "StatementWithoutTrailingSubstatement" $ union [ --- Block - "block">: java "Block", --- EmptyStatement - "empty">: java "EmptyStatement", --- ExpressionStatement - "expression">: java "ExpressionStatement", --- AssertStatement - "assert">: java "AssertStatement", --- SwitchStatement - "switch">: java "SwitchStatement", --- DoStatement - "do">: java "DoStatement", --- BreakStatement - "break">: java "BreakStatement", --- ContinueStatement - "continue">: java "ContinueStatement", --- ReturnStatement - "return">: java "ReturnStatement", --- SynchronizedStatement - "synchronized">: java "SynchronizedStatement", --- ThrowStatement - "throw">: java "ThrowStatement", --- TryStatement - "try">: java "TryStatement"], - ---EmptyStatement: --- ; - def "EmptyStatement" unit, - ---LabeledStatement: --- Identifier : Statement - def "LabeledStatement" $ record [ - "identifier">: java "Identifier", - "statement">: java "Statement"], - ---LabeledStatementNoShortIf: --- Identifier : StatementNoShortIf - def "LabeledStatementNoShortIf" $ record [ - "identifier">: java "Identifier", - "statement">: java "StatementNoShortIf"], - ---ExpressionStatement: --- StatementExpression ; - def "ExpressionStatement" $ java "StatementExpression", - ---StatementExpression: - def "StatementExpression" $ union [ --- Assignment - "assignment">: java "Assignment", --- PreIncrementExpression - "preIncrement">: java "PreIncrementExpression", --- PreDecrementExpression - "preDecrement">: java "PreDecrementExpression", --- PostIncrementExpression - "postIncrement">: java "PostIncrementExpression", --- PostDecrementExpression - "postDecrement">: java "PostDecrementExpression", --- MethodInvocation - "methodInvocation">: java "MethodInvocation", --- ClassInstanceCreationExpression - "classInstanceCreation">: java "ClassInstanceCreationExpression"], - ---IfThenStatement: --- if ( Expression ) Statement - def "IfThenStatement" $ record [ - "expression">: java "Expression", - "statement">: java "Statement"], - ---IfThenElseStatement: --- if ( Expression ) StatementNoShortIf else Statement - def "IfThenElseStatement" $ record [ - "cond">: optional $ java "Expression", - "then">: java "StatementNoShortIf", - "else">: java "Statement"], - ---IfThenElseStatementNoShortIf: --- if ( Expression ) StatementNoShortIf else StatementNoShortIf - def "IfThenElseStatementNoShortIf" $ record [ - "cond">: optional $ java "Expression", - "then">: java "StatementNoShortIf", - "else">: java "StatementNoShortIf"], - ---AssertStatement: - def "AssertStatement" $ union [ --- assert Expression ; - "single">: java "Expression", --- assert Expression : Expression ; - "pair">: java "AssertStatement.Pair"], - def "AssertStatement.Pair" $ record [ - "first">: java "Expression", - "second">: java "Expression"], - ---SwitchStatement: --- switch ( Expression ) SwitchBlock - def "SwitchStatement" $ record [ - "cond">: java "Expression", - "block">: java "SwitchBlock"], - ---SwitchBlock: --- { {SwitchBlockStatementGroup} {SwitchLabel} } - def "SwitchBlock" $ list $ java "SwitchBlock.Pair", - def "SwitchBlock.Pair" $ record [ - "statements">: list $ java "SwitchBlockStatementGroup", - "labels">: list $ java "SwitchLabel"], - ---SwitchBlockStatementGroup: --- SwitchLabels BlockStatements - def "SwitchBlockStatementGroup" $ record [ - "labels">: nonemptyList $ java "SwitchLabel", - "statements">: nonemptyList $ java "BlockStatement"], - ---SwitchLabels: --- SwitchLabel {SwitchLabel} ---SwitchLabel: - def "SwitchLabel" $ union [ --- case ConstantExpression : - "constant">: java "ConstantExpression", --- case EnumConstantName : - "enumConstant">: java "EnumConstantName", --- default : - "default">: unit], - ---EnumConstantName: --- Identifier - def "EnumConstantName" $ java "Identifier", - ---WhileStatement: --- while ( Expression ) Statement - def "WhileStatement" $ record [ - "cond">: optional $ java "Expression", - "body">: java "Statement"], - ---WhileStatementNoShortIf: --- while ( Expression ) StatementNoShortIf - def "WhileStatementNoShortIf" $ record [ - "cond">: optional $ java "Expression", - "body">: java "StatementNoShortIf"], - ---DoStatement: --- do Statement while ( Expression ) ; - def "DoStatement" $ record [ - "body">: java "Statement", - "conde">: optional $ java "Expression"], - ---ForStatement: - def "ForStatement" $ union [ --- BasicForStatement - "basic">: java "BasicForStatement", --- EnhancedForStatement - "enhanced">: java "EnhancedForStatement"], - ---ForStatementNoShortIf: - def "ForStatementNoShortIf" $ union [ --- BasicForStatementNoShortIf - "basic">: java "BasicForStatementNoShortIf", --- EnhancedForStatementNoShortIf - "enhanced">: java "EnhancedForStatementNoShortIf"], - ---BasicForStatement: --- for ( [ForInit] ; [Expression] ; [ForUpdate] ) Statement - def "BasicForStatement" $ record [ - "cond">: java "ForCond", - "body">: java "Statement"], - def "ForCond" $ record [ - "init">: optional $ java "ForInit", - "cond">: optional $ java "Expression", - "update">: optional $ java "ForUpdate"], ---BasicForStatementNoShortIf: --- for ( [ForInit] ; [Expression] ; [ForUpdate] ) StatementNoShortIf - def "BasicForStatementNoShortIf" $ record [ - "cond">: java "ForCond", - "body">: java "StatementNoShortIf"], - ---ForInit: - def "ForInit" $ union [ --- StatementExpressionList - "statements">: nonemptyList $ java "StatementExpression", --- LocalVariableDeclaration - "localVariable">: java "LocalVariableDeclaration"], - ---ForUpdate: --- StatementExpressionList - def "ForUpdate" $ nonemptyList $ java "StatementExpression", --- StatementExpressionList: --- StatementExpression {, StatementExpression} - ---EnhancedForStatement: - def "EnhancedForStatement" $ record [ --- for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) Statement - "cond">: java "EnhancedForCond", - "body">: java "Statement"], - def "EnhancedForCond" $ record [ - "modifiers">: list $ java "VariableModifier", - "type">: java "LocalVariableType", - "id">: java "VariableDeclaratorId", - "expression">: java "Expression"], ---EnhancedForStatementNoShortIf: --- for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) StatementNoShortIf - def "EnhancedForStatementNoShortIf" $ record [ - "cond">: java "EnhancedForCond", - "body">: java "StatementNoShortIf"], - ---BreakStatement: --- break [Identifier] ; - def "BreakStatement" $ optional $ java "Identifier", - ---ContinueStatement: --- continue [Identifier] ; - def "ContinueStatement" $ optional $ java "Identifier", - ---ReturnStatement: --- return [Expression] ; - def "ReturnStatement" $ optional $ java "Expression", - ---ThrowStatement: --- throw Expression ; - def "ThrowStatement" $ java "Expression", - ---SynchronizedStatement: --- synchronized ( Expression ) Block - def "SynchronizedStatement" $ record [ - "expression">: java "Expression", - "block">: java "Block"], - ---TryStatement: - def "TryStatement" $ union [ --- try Block Catches - "simple">: java "TryStatement.Simple", --- try Block [Catches] Finally - "withFinally">: java "TryStatement.WithFinally", --- TryWithResourcesStatement - "withResources">: java "TryWithResourcesStatement"], - def "TryStatement.Simple" $ record [ - "block">: java "Block", - "catches">: java "Catches"], - def "TryStatement.WithFinally" $ record [ - "block">: java "Block", - "catches">: optional $ java "Catches", - "finally">: java "Finally"], - ---Catches: --- CatchClause {CatchClause} - def "Catches" $ list $ java "CatchClause", - ---CatchClause: --- catch ( CatchFormalParameter ) Block - def "CatchClause" $ record [ - "parameter">: optional $ java "CatchFormalParameter", - "block">: java "Block"], - ---CatchFormalParameter: --- {VariableModifier} CatchType VariableDeclaratorId - def "CatchFormalParameter" $ record [ - "modifiers">: list $ java "VariableModifier", - "type">: java "CatchType", - "id">: java "VariableDeclaratorId"], - ---CatchType: --- UnannClassType {| ClassType} - def "CatchType" $ record [ - "type">: java "UnannClassType", - "types">: list $ java "ClassType"], - ---Finally: --- finally Block - def "Finally" $ java "Block", - ---TryWithResourcesStatement: --- try ResourceSpecification Block [Catches] [Finally] - def "TryWithResourcesStatement" $ record [ - "resourceSpecification">: java "ResourceSpecification", - "block">: java "Block", - "catches">: optional $ java "Catches", - "finally">: optional $ java "Finally"], - ---ResourceSpecification: --- ( ResourceList [;] ) - def "ResourceSpecification" $ list $ java "Resource", - ---ResourceList: --- Resource {; Resource} ---Resource: - def "Resource" $ union [ --- {VariableModifier} LocalVariableType Identifier = Expression - "local">: java "Resource.Local", --- VariableAccess - "variable">: java "VariableAccess"], - def "Resource.Local" $ record [ - "modifiers">: list $ java "VariableModifier", - "type">: java "LocalVariableType", - "identifier">: java "Identifier", - "expression">: java "Expression"], - ---VariableAccess: - def "VariableAccess" $ union [ --- ExpressionName - "expressionName">: java "ExpressionName", --- FieldAccess - "fieldAccess">: java "FieldAccess"], - ---Productions from §15 (Expressions) - ---Primary: - def "Primary" $ union [ --- PrimaryNoNewArray - "noNewArray">: java "PrimaryNoNewArray", --- ArrayCreationExpression - "arrayCreation">: java "ArrayCreationExpression"], - ---PrimaryNoNewArray: - def "PrimaryNoNewArray" $ union [ --- Literal - "literal">: java "Literal", --- ClassLiteral - "classLiteral">: java "ClassLiteral", --- this - "this">: unit, --- TypeName . this - "dotThis">: java "TypeName", --- ( Expression ) - "parens">: java "Expression", --- ClassInstanceCreationExpression - "classInstance">: java "ClassInstanceCreationExpression", --- FieldAccess - "fieldAccess">: java "FieldAccess", --- ArrayAccess - "arrayAccess">: java "ArrayAccess", --- MethodInvocation - "methodInvocation">: java "MethodInvocation", --- MethodReference - "methodReference">: java "MethodReference"], - ---ClassLiteral: - def "ClassLiteral" $ union [ --- TypeName {[ ]} . class - "type">: java "TypeNameArray", --- NumericType {[ ]} . class - "numericType">: java "NumericTypeArray", --- boolean {[ ]} . class - "boolean">: java "BooleanArray", --- void . class - "void">: unit], - def "TypeNameArray" $ union [ - "simple">: java "TypeName", - "array">: java "TypeNameArray"], - def "NumericTypeArray" $ union [ - "simple">: java "NumericType", - "array">: java "NumericTypeArray"], - def "BooleanArray" $ union [ - "simple">: unit, - "array">: java "BooleanArray"], - ---ClassInstanceCreationExpression: --- UnqualifiedClassInstanceCreationExpression --- ExpressionName . UnqualifiedClassInstanceCreationExpression --- Primary . UnqualifiedClassInstanceCreationExpression - def "ClassInstanceCreationExpression" $ record [ - "qualifier">: optional $ java "ClassInstanceCreationExpression.Qualifier", - "expression">: java "UnqualifiedClassInstanceCreationExpression"], - def "ClassInstanceCreationExpression.Qualifier" $ union [ - "expression">: java "ExpressionName", - "primary">: java "Primary"], - ---UnqualifiedClassInstanceCreationExpression: --- new [TypeArguments] ClassOrInterfaceTypeToInstantiate ( [ArgumentList] ) [ClassBody] - def "UnqualifiedClassInstanceCreationExpression" $ record [ - "typeArguments">: list $ java "TypeArgument", - "classOrInterface">: java "ClassOrInterfaceTypeToInstantiate", - "arguments">: list $ java "Expression", - "body">: optional $ java "ClassBody"], - ---ClassOrInterfaceTypeToInstantiate: --- {Annotation} Identifier {. {Annotation} Identifier} [TypeArgumentsOrDiamond] - def "ClassOrInterfaceTypeToInstantiate" $ record [ - "identifiers">: nonemptyList $ java "AnnotatedIdentifier", - "typeArguments">: optional $ java "TypeArgumentsOrDiamond"], - def "AnnotatedIdentifier" $ record [ - "annotations">: list $ java "Annotation", - "identifier">: java "Identifier"], - ---TypeArgumentsOrDiamond: - def "TypeArgumentsOrDiamond" $ union [ --- TypeArguments - "arguments">: nonemptyList $ java "TypeArgument", --- <> - "diamond">: unit], - ---FieldAccess: - def "FieldAccess" $ record [ - "qualifier">: java "FieldAccess.Qualifier", - "identifier">: java "Identifier"], - def "FieldAccess.Qualifier" $ union [ --- Primary . Identifier - "primary">: java "Primary", --- super . Identifier - "super">: unit, --- TypeName . super . Identifier - "typed">: java "TypeName"], - ---ArrayAccess: - def "ArrayAccess" $ record [ - "expression">: optional $ java "Expression", - "variant">: java "ArrayAccess.Variant"], - def "ArrayAccess.Variant" $ union [ --- ExpressionName [ Expression ] - "name">: java "ExpressionName", --- PrimaryNoNewArray [ Expression ] - "primary">: java "PrimaryNoNewArray"], - ---MethodInvocation: - def "MethodInvocation" $ record [ - "header">: java "MethodInvocation.Header", - "arguments">: list $ java "Expression"], - def "MethodInvocation.Header" $ union [ --- MethodName ( [ArgumentList] ) - "simple">: java "MethodName", - "complex">: java "MethodInvocation.Complex"], - def "MethodInvocation.Complex" $ record [ - "variant">: java "MethodInvocation.Variant", - "typeArguments">: list $ java "TypeArgument", - "identifier">: java "Identifier"], - def "MethodInvocation.Variant" $ union [ --- TypeName . [TypeArguments] Identifier ( [ArgumentList] ) - "type">: java "TypeName", --- ExpressionName . [TypeArguments] Identifier ( [ArgumentList] ) - "expression">: java "ExpressionName", --- Primary . [TypeArguments] Identifier ( [ArgumentList] ) - "primary">: java "Primary", --- super . [TypeArguments] Identifier ( [ArgumentList] ) - "super">: unit, --- TypeName . super . [TypeArguments] Identifier ( [ArgumentList] ) - "typeSuper">: java "TypeName"], - ---ArgumentList: --- Expression {, Expression} - ---MethodReference: - def "MethodReference" $ union [ --- ExpressionName :: [TypeArguments] Identifier - "expression">: java "MethodReference.Expression", --- Primary :: [TypeArguments] Identifier - "primary">: java "MethodReference.Primary", --- ReferenceType :: [TypeArguments] Identifier - "referenceType">: java"MethodReference.ReferenceType", --- super :: [TypeArguments] Identifier --- TypeName . super :: [TypeArguments] Identifier - "super">: java "MethodReference.Super", --- ClassType :: [TypeArguments] new - "new">: java "MethodReference.New", --- ArrayType :: new - "array">: java "MethodReference.Array"], - def "MethodReference.Expression" $ record [ - "name">: java "ExpressionName", - "typeArguments">: list $ java "TypeArgument", - "identifier">: java "Identifier"], - def "MethodReference.Primary" $ record [ - "primary">: java "Primary", - "typeArguments">: list $ java "TypeArgument", - "identifier">: java "Identifier"], - def "MethodReference.ReferenceType" $ record [ - "referenceType">: java "ReferenceType", - "typeArguments">: list $ java "TypeArgument", - "identifier">: java "Identifier"], - def "MethodReference.Super" $ record [ - "typeArguments">: list $ java "TypeArgument", - "identifier">: java "Identifier", - "super">: boolean], - def "MethodReference.New" $ record [ - "classType">: java "ClassType", - "typeArguments">: list $ java "TypeArgument"], - def "MethodReference.Array" $ java "ArrayType", - ---ArrayCreationExpression: - def "ArrayCreationExpression" $ union [ --- new PrimitiveType DimExprs [Dims] - "primitive">: java "ArrayCreationExpression.Primitive", --- new ClassOrInterfaceType DimExprs [Dims] - "classOrInterface">: java "ArrayCreationExpression.ClassOrInterface", --- new PrimitiveType Dims ArrayInitializer - "primitiveArray">: java "ArrayCreationExpression.PrimitiveArray", --- new ClassOrInterfaceType Dims ArrayInitializer - "classOrInterfaceArray">: java "ArrayCreationExpression.ClassOrInterfaceArray"], - def "ArrayCreationExpression.Primitive" $ record [ - "type">: java "PrimitiveTypeWithAnnotations", - "dimExprs">: nonemptyList $ java "DimExpr", - "dims">: optional $ java "Dims"], - def "ArrayCreationExpression.ClassOrInterface" $ record [ - "type">: java "ClassOrInterfaceType", - "dimExprs">: nonemptyList $ java "DimExpr", - "dims">: optional $ java "Dims"], - def "ArrayCreationExpression.PrimitiveArray" $ record [ - "type">: java "PrimitiveTypeWithAnnotations", - "dims">: nonemptyList $ java "Dims", - "array">: java "ArrayInitializer"], - def "ArrayCreationExpression.ClassOrInterfaceArray" $ record [ - "type">: java "ClassOrInterfaceType", - "dims">: nonemptyList $ java "Dims", - "array">: java "ArrayInitializer"], - ---DimExprs: --- DimExpr {DimExpr} ---DimExpr: --- {Annotation} [ Expression ] - def "DimExpr" $ record [ - "annotations">: list $ java "Annotation", - "expression">: optional $ java "Expression"], - ---Expression: - def "Expression" $ union [ --- LambdaExpression - "lambda">: java "LambdaExpression", --- AssignmentExpression - "assignment">: java "AssignmentExpression"], - ---LambdaExpression: --- LambdaParameters -> LambdaBody - def "LambdaExpression" $ record [ - "parameters">: java "LambdaParameters", - "body">: java "LambdaBody"], - ---LambdaParameters: --- ( [LambdaParameterList] ) --- Identifier - def "LambdaParameters" $ union [ - "tuple">: list $ java "LambdaParameters", - "single">: java "Identifier"], - ---LambdaParameterList: --- LambdaParameter {, LambdaParameter} --- Identifier {, Identifier} ---LambdaParameter: - def "LambdaParameter" $ union [ --- {VariableModifier} LambdaParameterType VariableDeclaratorId - "normal">: java "LambdaParameter.Normal", --- VariableArityParameter - "variableArity">: java "VariableArityParameter"], - def "LambdaParameter.Normal" $ record [ - "modifiers">: list $ java "VariableModifier", - "type">: java "LambdaParameterType", - "id">: java "VariableDeclaratorId"], - ---LambdaParameterType: - def "LambdaParameterType" $ union [ --- UnannType - "type">: java "UnannType", --- var - "var">: unit], - ---LambdaBody: - def "LambdaBody" $ union [ --- Expression - "expression">: java "Expression", --- Block - "block">: java "Block"], - ---AssignmentExpression: - def "AssignmentExpression" $ union [ --- ConditionalExpression - "conditional">: java "ConditionalExpression", --- Assignment - "assignment">: java "Assignment"], - ---Assignment: --- LeftHandSide AssignmentOperator Expression - def "Assignment" $ record [ - "lhs">: java "LeftHandSide", - "op">: java "AssignmentOperator", - "expression">: java "Expression"], - ---LeftHandSide: - def "LeftHandSide" $ union [ --- ExpressionName - "expressionName">: java "ExpressionName", --- FieldAccess - "fieldAccess">: java "FieldAccess", --- ArrayAccess - "arrayAccess">: java "ArrayAccess"], - ---AssignmentOperator: --- (one of) - def "AssignmentOperator" $ enum [ --- = *= /= %= += -= <<= >>= >>>= &= ^= |= - "simple", "times", "div", "mod", "plus", "minus", - "shiftLeft", "shiftRight", "shiftRightZeroFill", "and", "xor", "or"], - ---ConditionalExpression: - def "ConditionalExpression" $ union [ --- ConditionalOrExpression - "simple">: java "ConditionalOrExpression", --- ConditionalOrExpression ? Expression : ConditionalExpression - "ternaryCond">: java "ConditionalExpression.TernaryCond", --- ConditionalOrExpression ? Expression : LambdaExpression - "ternaryLambda">: java "ConditionalExpression.TernaryLambda"], - def "ConditionalExpression.TernaryCond" $ record [ - "cond">: java "ConditionalOrExpression", - "ifTrue">: java "Expression", - "ifFalse">: java "ConditionalExpression"], - def "ConditionalExpression.TernaryLambda" $ record [ - "cond">: java "ConditionalOrExpression", - "ifTrue">: java "Expression", - "ifFalse">: java "LambdaExpression"], - ---ConditionalOrExpression: --- ConditionalAndExpression --- ConditionalOrExpression || ConditionalAndExpression - def "ConditionalOrExpression" $ nonemptyList $ java "ConditionalAndExpression", - ---ConditionalAndExpression: --- InclusiveOrExpression --- ConditionalAndExpression && InclusiveOrExpression - def "ConditionalAndExpression" $ nonemptyList $ java "InclusiveOrExpression", - ---InclusiveOrExpression: --- ExclusiveOrExpression --- InclusiveOrExpression | ExclusiveOrExpression - def "InclusiveOrExpression" $ nonemptyList $ java "ExclusiveOrExpression", - ---ExclusiveOrExpression: --- AndExpression --- ExclusiveOrExpression ^ AndExpression - def "ExclusiveOrExpression" $ nonemptyList $ java "AndExpression", - ---AndExpression: --- EqualityExpression --- AndExpression & EqualityExpression - def "AndExpression" $ nonemptyList $ java "EqualityExpression", - ---EqualityExpression: - def "EqualityExpression" $ union [ --- RelationalExpression - "unary">: java "RelationalExpression", --- EqualityExpression == RelationalExpression - "equal">: java "EqualityExpression.Binary", --- EqualityExpression != RelationalExpression - "notEqual">: java "EqualityExpression.Binary"], - def "EqualityExpression.Binary" $ record [ - "lhs">: java "EqualityExpression", - "rhs">: java "RelationalExpression"], - ---RelationalExpression: - def "RelationalExpression" $ union [ --- ShiftExpression - "simple">: java "ShiftExpression", --- RelationalExpression < ShiftExpression - "lessThan">: java "RelationalExpression.LessThan", --- RelationalExpression > ShiftExpression - "greaterThan">: java "RelationalExpression.GreaterThan", --- RelationalExpression <= ShiftExpression - "lessThanEqual">: java "RelationalExpression.LessThanEqual", --- RelationalExpression >= ShiftExpression - "greaterThanEqual">: java "RelationalExpression.GreaterThanEqual", --- RelationalExpression instanceof ReferenceType - "instanceof">: java "RelationalExpression.InstanceOf"], - def "RelationalExpression.LessThan" $ record [ - "lhs">: java "RelationalExpression", - "rhs">: java "ShiftExpression"], - def "RelationalExpression.GreaterThan" $ record [ - "lhs">: java "RelationalExpression", - "rhs">: java "ShiftExpression"], - def "RelationalExpression.LessThanEqual" $ record [ - "lhs">: java "RelationalExpression", - "rhs">: java "ShiftExpression"], - def "RelationalExpression.GreaterThanEqual" $ record [ - "lhs">: java "RelationalExpression", - "rhs">: java "ShiftExpression"], - def "RelationalExpression.InstanceOf" $ record [ - "lhs">: java "RelationalExpression", - "rhs">: java "ReferenceType"], - ---ShiftExpression: - def "ShiftExpression" $ union [ --- AdditiveExpression - "unary">: java "AdditiveExpression", --- ShiftExpression << AdditiveExpression - "shiftLeft">: java "ShiftExpression.Binary", --- ShiftExpression >> AdditiveExpression - "shiftRight">: java "ShiftExpression.Binary", --- ShiftExpression >>> AdditiveExpression - "shiftRightZeroFill">: java "ShiftExpression.Binary"], - def "ShiftExpression.Binary" $ record [ - "lhs">: java "ShiftExpression", - "rhs">: java "AdditiveExpression"], - ---AdditiveExpression: - def "AdditiveExpression" $ union [ --- MultiplicativeExpression - "unary">: java "MultiplicativeExpression", --- AdditiveExpression + MultiplicativeExpression - "plus">: java "AdditiveExpression.Binary", --- AdditiveExpression - MultiplicativeExpression - "minus">: java "AdditiveExpression.Binary"], - def "AdditiveExpression.Binary" $ record [ - "lhs">: java "AdditiveExpression", - "rhs">: java "MultiplicativeExpression"], - ---MultiplicativeExpression: - def "MultiplicativeExpression" $ union [ --- UnaryExpression - "unary">: java "UnaryExpression", --- MultiplicativeExpression * UnaryExpression - "times">: java "MultiplicativeExpression.Binary", --- MultiplicativeExpression / UnaryExpression - "divide">: java "MultiplicativeExpression.Binary", --- MultiplicativeExpression % UnaryExpression - "mod">: java "MultiplicativeExpression.Binary"], - def "MultiplicativeExpression.Binary" $ record [ - "lhs">: java "MultiplicativeExpression", - "rhs">: java "UnaryExpression"], - ---UnaryExpression: - def "UnaryExpression" $ union [ --- PreIncrementExpression - "preIncrement">: java "PreIncrementExpression", --- PreDecrementExpression - "preDecrement">: java "PreDecrementExpression", --- + UnaryExpression - "plus">: java "UnaryExpression", --- - UnaryExpression - "minus">: java "UnaryExpression", --- UnaryExpressionNotPlusMinus - "other">: java "UnaryExpressionNotPlusMinus"], - ---PreIncrementExpression: --- ++ UnaryExpression - def "PreIncrementExpression" $ java "UnaryExpression", - ---PreDecrementExpression: --- -- UnaryExpression - def "PreDecrementExpression" $ java "UnaryExpression", - ---UnaryExpressionNotPlusMinus: - def "UnaryExpressionNotPlusMinus" $ union [ --- PostfixExpression - "postfix">: java "PostfixExpression", --- ~ UnaryExpression - "tilde">: java "UnaryExpression", --- ! UnaryExpression - "not">: java "UnaryExpression", --- CastExpression - "cast">: java "CastExpression"], - ---PostfixExpression: - def "PostfixExpression" $ union [ --- Primary - "primary">: java "Primary", --- ExpressionName - "name">: java "ExpressionName", --- PostIncrementExpression - "postIncrement">: java "PostIncrementExpression", --- PostDecrementExpression - "postDecrement">: java "PostDecrementExpression"], - ---PostIncrementExpression: --- PostfixExpression ++ - def "PostIncrementExpression" $ java "PostfixExpression", - ---PostDecrementExpression: --- PostfixExpression -- - def "PostDecrementExpression" $ java "PostfixExpression", - ---CastExpression: - def "CastExpression" $ union [ --- ( PrimitiveType ) UnaryExpression - "primitive">: java "CastExpression.Primitive", --- ( ReferenceType {AdditionalBound} ) UnaryExpressionNotPlusMinus - "notPlusMinus">: java "CastExpression.NotPlusMinus", --- ( ReferenceType {AdditionalBound} ) LambdaExpression - "lambda">: java "CastExpression.Lambda"], - def "CastExpression.Primitive" $ record [ - "type">: java "PrimitiveTypeWithAnnotations", - "expression">: java "UnaryExpression"], - def "CastExpression.NotPlusMinus" $ record [ - "refAndBounds">: java "CastExpression.RefAndBounds", - "expression">: java "UnaryExpression"], - def "CastExpression.Lambda" $ record [ - "refAndBounds">: java "CastExpression.RefAndBounds", - "expression">: java "LambdaExpression"], - def "CastExpression.RefAndBounds" $ record [ - "type">: java "ReferenceType", - "bounds">: list $ java "AdditionalBound"], - ---ConstantExpression: --- Expression - def "ConstantExpression" $ java "Expression"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Json/Decoding.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Json/Decoding.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Json/Decoding.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Json.Decoding where - --- TODO: standardized Tier-4 imports -import Prelude hiding ((++)) -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y -import Hydra.Dsl.Base as Base -import qualified Hydra.Dsl.Core as Core -import qualified Hydra.Dsl.Graph as Graph -import qualified Hydra.Dsl.Lib.Equality as Equality -import qualified Hydra.Dsl.Lib.Flows as Flows -import qualified Hydra.Dsl.Lib.Io as Io -import qualified Hydra.Dsl.Lib.Lists as Lists -import qualified Hydra.Dsl.Lib.Literals as Literals -import qualified Hydra.Dsl.Lib.Logic as Logic -import qualified Hydra.Dsl.Lib.Maps as Maps -import qualified Hydra.Dsl.Lib.Math as Math -import qualified Hydra.Dsl.Lib.Optionals as Optionals -import qualified Hydra.Dsl.Lib.Sets as Sets -import Hydra.Dsl.Lib.Strings as Strings -import qualified Hydra.Dsl.Module as Module -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types -import Hydra.Sources.Tier2.All - -import qualified Hydra.Json as Json -import Hydra.Sources.Tier0.Json - - -jsonDecodingModule :: Module -jsonDecodingModule = Module (Namespace "hydra/langs/json/decoding") elements - [jsonModelModule, hydraCoreModule] (jsonModelModule:tier0Modules) $ - Just "Decoding functions for JSON data" - where - elements = [ - Base.el decodeStringDef, - Base.el decodeNumberDef, - Base.el decodeBooleanDef, - Base.el decodeArrayDef, - Base.el decodeObjectDef, - Base.el decodeFieldDef, - Base.el decodeOptionalFieldDef] - -jsonDecodingDefinition :: String -> Datum a -> Definition a -jsonDecodingDefinition label = definitionInModule jsonDecodingModule ("decode" <> label) - -valueT = TypeVariable Json._Value - -decodeStringDef :: Definition (Json.Value -> Flow s String) -decodeStringDef = jsonDecodingDefinition "String" $ - function valueT (flowT sT stringT) $ - match Json._Value (Just $ Flows.fail @@ "expected a string") [ - Json._Value_string>>: Flows.pure] - -decodeNumberDef :: Definition (Json.Value -> Flow s Double) -decodeNumberDef = jsonDecodingDefinition "Number" $ - function valueT (flowT sT Types.bigfloat) $ - match Json._Value (Just $ Flows.fail @@ "expected a number") [ - Json._Value_number>>: Flows.pure] - -decodeBooleanDef :: Definition (Json.Value -> Flow s Bool) -decodeBooleanDef = jsonDecodingDefinition "Boolean" $ - function valueT (flowT sT booleanT) $ - match Json._Value (Just $ Flows.fail @@ "expected a boolean") [ - Json._Value_boolean>>: Flows.pure] - -decodeArrayDef :: Definition ((Json.Value -> Flow s a) -> Json.Value -> Flow s [a]) -decodeArrayDef = jsonDecodingDefinition "Array" $ - function (funT valueT (flowT sT aT)) (funT valueT (flowT sT (listT aT))) $ - lambda "decodeElem" $ match Json._Value (Just $ Flows.fail @@ "expected an array") [ - Json._Value_array>>: Flows.mapList @@ (var "decodeElem")] - -decodeObjectDef :: Definition (Json.Value -> Flow s (M.Map String Json.Value)) -decodeObjectDef = jsonDecodingDefinition "Object" $ - function valueT (flowT sT (mapT stringT valueT)) $ - match Json._Value (Just $ Flows.fail @@ "expected an object") [ - Json._Value_object>>: Flows.pure] - -decodeFieldDef :: Definition ((Json.Value -> Flow s a) -> String -> (M.Map String Json.Value) -> Flow s a) -decodeFieldDef = jsonDecodingDefinition "Field" $ - function (funT valueT (flowT sT aT)) (funT stringT (funT (mapT stringT valueT) (flowT sT aT))) $ - lambda "decodeValue" $ lambda "name" $ lambda "m" $ - Flows.bind - @@ (ref decodeOptionalFieldDef @@ var "decodeValue" @@ var "name" @@ var "m") - @@ (matchOpt (Flows.fail @@ ("missing field: " ++ var "name")) Flows.pure) - -decodeOptionalFieldDef :: Definition ((Json.Value -> Flow s a) -> String -> (M.Map String Json.Value) -> Flow s (Maybe a)) -decodeOptionalFieldDef = jsonDecodingDefinition "OptionalField" $ - function (funT valueT (flowT sT aT)) (funT stringT (funT (mapT stringT valueT) (flowT sT (Types.optional aT)))) $ - lambda "decodeValue" $ lambda "name" $ lambda "m" $ - (matchOpt (Flows.pure @@ nothing) (lambda "v" (Flows.map @@ (lambda "x" (just $ var "x")) @@ (var "decodeValue" @@ var "v")))) - @@ (Maps.lookup @@ var "name" @@ var "m") diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Kusto/Kql.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Kusto/Kql.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Kusto/Kql.hs +++ /dev/null @@ -1,274 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Kusto.Kql where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -kqlModule :: Module -kqlModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("A partial KQL (Kusto Query Language) model, based on examples from the documentation. Not normative.") - where - ns = Namespace "hydra/langs/kusto/kql" - def = datatype ns - kql = typeref ns - - elements = [ - - def "BetweenExpression" $ - record [ - "not">: boolean, - "expression">: kql "Expression", - "lowerBound">: kql "Expression", - "upperBound">: kql "Expression"], - - def "BinaryExpression" $ - record [ - "left">: kql "Expression", - "operator">: kql "BinaryOperator", - "right">: kql "Expression"], - - def "BinaryOperator" $ - enum [ - "caseInsensitiveEqual", - "contains", - "divide", - "endsWith", - "equal", - "greater", - "greaterOrEqual", - "has", - "hasPrefix", - "hasSuffix", - "less", - "lessOrEqual", - "matchesRegex", - "minus", - "notEqual", - "plus", - "startsWith", - "times"], - - def "BuiltInFunction" $ - enum [ - "ago", - "bin", - "count", - "dcount", - "endofday", - "extract", - "format_datetime", - "materialize", - "now", - "range", - "startofday", - "strcat", - "todynamic"], - - def "ColumnAlias" $ - record [ - "column">: kql "ColumnName", - "alias">: kql "ColumnName"], - - def "ColumnAssignment" $ - record [ - "column">: kql "ColumnName", - "expression">: kql "Expression"], - - def "ColumnName" string, - - def "Columns" $ - union [ - "all">: unit, - "single">: kql "ColumnName"], - - def "Command" $ - union [ - "count">: unit, - "distinct">: - doc "See https://learn.microsoft.com/en-us/azure/data-explorer/kusto/query/distinct-operator" $ - nonemptyList $ kql "ColumnName", - "extend">: nonemptyList $ kql "ColumnAssignment", - "join">: kql "JoinCommand", - "limit">: int32, - "mvexpand">: kql "ColumnName", - "orderBy">: nonemptyList $ kql "SortBy", - "parse">: kql "ParseCommand", - "print">: kql "PrintCommand", - "project">: nonemptyList $ kql "Projection", - "projectAway">: nonemptyList $ kql "ColumnName", - "projectRename">: nonemptyList $ kql "ColumnAlias", - "render">: string, - "search">: kql "SearchCommand", - "sortBy">: nonemptyList $ kql "SortBy", - "summarize">: kql "SummarizeCommand", - "take">: - doc "Limit a search to a specified number of results" - int32, - "top">: kql "TopCommand", - "union">: kql "UnionCommand", - "where">: kql "Expression"], - - def "Datetime" string, - - def "Duration" $ - record [ - "value">: int32, - "unit">: kql "DurationUnit"], - - def "DurationUnit" $ - enum ["second", "minute", "hour"], - - def "Expression" $ - union [ - "and">: nonemptyList $ kql "Expression", - "any">: unit, - "between">: kql "BetweenExpression", - "binary">: kql "BinaryExpression", - "braces">: kql "Expression", -- TODO: what do braces represent? E.g. "let timeRange = {TimeRange}" - "column">: kql "ColumnName", - "dataset">: kql "TableName", - "index">: kql "IndexExpression", - "list">: list $ kql "Expression", - "literal">: kql "Literal", - "or">: nonemptyList $ kql "Expression", - "parentheses">: kql "Expression", - "property">: kql "PropertyExpression", - "unary">: kql "UnaryExpression"], - - def "Function" $ - union [ - "builtIn">: kql "BuiltInFunction", - "custom">: kql "FunctionName"], - - def "FunctionExpression" $ - record [ - "function">: kql "Function", - "arguments">: list $ kql "Expression"], - - def "FunctionName" string, - - def "IndexExpression" $ - record [ - "expression">: kql "Expression", - "index">: string], - - def "JoinCommand" $ - record [ - "kind">: kql "JoinKind", - "expression">: kql "TableName", - "on">: kql "Expression"], - - def "JoinKind" $ - enum ["leftouter", "leftsemi", "leftanti", "fullouter", "inner", "innerunique", "rightouter", "rightsemi", "rightanti"], - - def "KeyValuePair" $ - record [ - "key">: string, - "value">: kql "Expression"], - - def "LetBinding" $ - record [ - "name">: kql "ColumnName", - "expression">: kql "Expression"], - - def "LetExpression" $ - record [ - "bindings">: nonemptyList $ kql "LetBinding", - "expression">: kql "TabularExpression"], - - def "Literal" $ - union [ - "duration">: kql "Duration", - "datetime">: kql "Datetime", - "string">: string, - -- TODO: unverified - "int">: int32, - "long">: int64, - "double">: float64, - "boolean">: boolean], - - def "Order" $ - enum ["ascending", "descending"], - - def "Parameter" $ - record [ - "key">: string, - "value">: kql "Literal"], - - def "ParseCommand" $ - record [ - "column">: kql "ColumnName", - "pairs">: nonemptyList $ kql "KeyValuePair"], - - -- TODO: what are these expressions actually called in KQL? - def "PipelineExpression" $ - nonemptyList $ kql "TabularExpression", - - def "PrintCommand" $ - record [ - "column">: optional $ kql "ColumnName", - "expression">: kql "Expression"], - - def "Projection" $ - record [ - "expression">: kql "Expression", - "alias">: optional $ kql "ColumnName"], - - def "PropertyExpression" $ - record [ - "expression">: kql "Expression", - "property">: string], - - def "Query" $ kql "TabularExpression", - - def "SearchCommand" $ - doc "Search across all datasets and columns or, if provided, specific datasets and/or columns" $ - record [ - "datasets">: list $ kql "TableName", - "pattern">: kql "Expression"], - - def "SummarizeCommand" $ - record [ - "columns">: nonemptyList $ kql "ColumnAssignment", - "by">: list $ kql "ColumnName"], - - def "TableName" string, - - def "TopCommand" $ - record [ - "count">: int32, - "sort">: list $ kql "SortBy"], - - def "SortBy" $ - record [ - "column">: kql "ColumnName", - "order">: optional $ kql "Order"], - - def "TabularExpression" $ - union [ - "command">: kql "Command", - "pipeline">: kql "PipelineExpression", - "let">: kql "LetExpression", - "table">: kql "TableName"], - - def "UnaryExpression" $ - record [ - "operator">: kql "UnaryOperator", - "expression">: kql "Expression"], - - def "UnaryOperator" $ - enum ["not"], - - def "UnionCommand" $ - record [ - "parameters">: list $ kql "Parameter", - "kind">: optional $ kql "UnionKind", - "withSource">: optional $ kql "ColumnName", - "isFuzzy">: optional boolean, - "tables">: nonemptyList $ kql "TableName"], - - def "UnionKind" $ enum ["inner", "outer"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Owl/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Owl/Syntax.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Owl/Syntax.hs +++ /dev/null @@ -1,599 +0,0 @@ -module Hydra.Sources.Tier4.Langs.Owl.Syntax where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Sources.Tier4.Langs.Rdf.Syntax -import Hydra.Sources.Tier4.Langs.Xml.Schema -import Hydra.Dsl.Types as Types -import qualified Hydra.Dsl.Terms as Terms - - -key_iri :: String -key_iri = "iri" - -withIri :: String -> Type -> Type -withIri iriStr = annotateType key_iri (Just $ Terms.string iriStr) - -nonNegativeInteger :: Type -nonNegativeInteger = Types.bigint - -owlIri :: [Char] -> Type -> Type -owlIri local = withIri $ "http://www.w3.org/2002/07/owl#" ++ local - -owlSyntaxModule :: Module -owlSyntaxModule = Module ns elements [hydraCoreModule, rdfSyntaxModule, xmlSchemaModule] tier0Modules $ - Just "An OWL 2 syntax model. See https://www.w3.org/TR/owl2-syntax" - where - ns = Namespace "hydra/langs/owl/syntax" - def = datatype ns - - owl = typeref ns - rdf = typeref $ moduleNamespace rdfSyntaxModule - xsd = typeref $ moduleNamespace xmlSchemaModule - - objectPropertyConstraint lname = def lname $ record [ - "annotations">: list $ owl "Annotation", - "property">: owl "ObjectPropertyExpression"] - - simpleUnion names = union $ (\n -> FieldType (Name $ decapitalize n) $ owl n) <$> names - - withAnns fields = record $ - ("annotations">: list (owl "Annotation")):fields - - elements = generalDefinitions ++ owl2Definitions -- ++ instances - --- instances = [ --- inst "Nothing" (owl "Class") Terms.unit, --- inst "Thing" (owl "Class") Terms.unit] - - generalDefinitions = [ --- nonNegativeInteger := a nonempty finite sequence of digits between 0 and 9 --- quotedString := a finite sequence of characters in which " (U+22) and \ (U+5C) occur only in pairs of the form \" (U+5C, U+22) and \\ (U+5C, U+5C), enclosed in a pair of " (U+22) characters --- languageTag := @ (U+40) followed a nonempty sequence of characters matching the langtag production from [BCP 47] --- nodeID := a finite sequence of characters matching the BLANK_NODE_LABEL production of [SPARQL] --- fullIRI := an IRI as defined in [RFC3987], enclosed in a pair of < (U+3C) and > (U+3E) characters --- prefixName := a finite sequence of characters matching the as PNAME_NS production of [SPARQL] --- abbreviatedIRI := a finite sequence of characters matching the PNAME_LN production of [SPARQL] --- IRI := fullIRI | abbreviatedIRI --- ontologyDocument := { prefixDeclaration } Ontology --- prefixDeclaration := 'Prefix' '(' prefixName '=' fullIRI ')' - --- Ontology := --- 'Ontology' '(' [ ontologyIRI [ versionIRI ] ] --- directlyImportsDocuments --- ontologyAnnotations --- axioms --- ')' - def "Ontology" $ record [ -- note: omitting IRI and version - "directImports">: list $ owl "Ontology", - "annotations">: list $ owl "Annotation", - "axioms">: list $ owl "Axiom"], - --- ontologyIRI := IRI --- versionIRI := IRI --- directlyImportsDocuments := { 'Import' '(' IRI ')' } --- ontologyAnnotations := { Annotation } --- axioms := { Axiom } - --- Declaration := 'Declaration' '(' axiomAnnotations Entity ')' - def "Declaration" $ withAnns [ - "entity">: owl "Entity"], - --- Entity := --- 'Class' '(' Class ')' | --- 'Datatype' '(' Datatype ')' | --- 'ObjectProperty' '(' ObjectProperty ')' | --- 'DataProperty' '(' DataProperty ')' | --- 'AnnotationProperty' '(' AnnotationProperty ')' | --- 'NamedIndividual' '(' NamedIndividual ')' - def "Entity" $ simpleUnion [ - "AnnotationProperty", - "Class", - "DataProperty", - "Datatype", - "NamedIndividual", - "ObjectProperty"], - --- AnnotationSubject := IRI | AnonymousIndividual - def "AnnotationSubject" $ union [ - "iri">: rdf "Iri", - "anonymousIndividual">: owl "AnonymousIndividual"], - --- AnnotationValue := AnonymousIndividual | IRI | Literal - def "AnnotationValue" $ union [ - "anonymousIndividual">: owl "AnonymousIndividual", - "iri">: rdf "Iri", - "literal">: rdf "Literal"], - --- axiomAnnotations := { Annotation } - --- Annotation := 'Annotation' '(' annotationAnnotations AnnotationProperty AnnotationValue ')' - def "Annotation" $ withAnns [ - "property">: owl "AnnotationProperty", - "value">: owl "AnnotationValue"], - --- annotationAnnotations := { Annotation } - --- AnnotationAxiom := AnnotationAssertion | SubAnnotationPropertyOf | AnnotationPropertyDomain | AnnotationPropertyRange - def "AnnotationAxiom" $ simpleUnion [ - "AnnotationAssertion", - "AnnotationPropertyDomain", - "AnnotationPropertyRange", - "SubAnnotationPropertyOf"], - --- AnnotationAssertion := 'AnnotationAssertion' '(' axiomAnnotations AnnotationProperty AnnotationSubject AnnotationValue ')' - def "AnnotationAssertion" $ withAnns [ - "property">: owl "AnnotationProperty", - "subject">: owl "AnnotationSubject", - "value">: owl "AnnotationValue"], - --- SubAnnotationPropertyOf := 'SubAnnotationPropertyOf' '(' axiomAnnotations subAnnotationProperty superAnnotationProperty ')' - def "SubAnnotationPropertyOf" $ withAnns [ - "subProperty">: owl "AnnotationProperty", - "superProperty">: owl "AnnotationProperty"], - --- subAnnotationProperty := AnnotationProperty --- superAnnotationProperty := AnnotationProperty - --- AnnotationPropertyDomain := 'AnnotationPropertyDomain' '(' axiomAnnotations AnnotationProperty IRI ')' - def "AnnotationPropertyDomain" $ withAnns [ - "property">: owl "AnnotationProperty", - "iri">: rdf "Iri"], - --- AnnotationPropertyRange := 'AnnotationPropertyRange' '(' axiomAnnotations AnnotationProperty IRI ')' - def "AnnotationPropertyRange" $ withAnns [ - "property">: owl "AnnotationProperty", - "iri">: rdf "Iri"]] - - owl2Definitions = [ --- Class := IRI - def "Class" $ - see "https://www.w3.org/TR/owl2-syntax/#Classes" unit, - --- Datatype := IRI - def "Datatype" $ - see "https://www.w3.org/TR/owl2-syntax/#Datatypes" $ - union [ - "xmlSchema">: - note ("XML Schema datatypes are treated as a special case in this model " ++ - "(not in the OWL 2 specification itself) because they are particularly common") $ - xsd "Datatype", - "other">: rdf "Iri"], - --- ObjectProperty := IRI - def "ObjectProperty" $ - see "https://www.w3.org/TR/owl2-syntax/#Object_Properties" unit, - --- DataProperty := IRI - def "DataProperty" unit, - --- AnnotationProperty := IRI - def "AnnotationProperty" unit, - --- Individual := NamedIndividual | AnonymousIndividual - def "Individual" $ union [ - "named">: owl "NamedIndividual", - "anonymous">: owl "AnonymousIndividual"], - --- NamedIndividual := IRI - def "NamedIndividual" unit, - --- AnonymousIndividual := nodeID - def "AnonymousIndividual" unit, - --- Literal := typedLiteral | stringLiteralNoLanguage | stringLiteralWithLanguage --- typedLiteral := lexicalForm '^^' Datatype --- lexicalForm := quotedString --- stringLiteralNoLanguage := quotedString --- stringLiteralWithLanguage := quotedString languageTag - --- ObjectPropertyExpression := ObjectProperty | InverseObjectProperty - def "ObjectPropertyExpression" $ union [ - "object">: owl "ObjectProperty", - "inverseObject">: owl "InverseObjectProperty"], - --- InverseObjectProperty := 'ObjectInverseOf' '(' ObjectProperty ')' - def "InverseObjectProperty" $ owl "ObjectProperty", - --- DataPropertyExpression := DataProperty - def "DataPropertyExpression" $ owl "DataProperty", - --- DataRange := --- Datatype | --- DataIntersectionOf | --- DataUnionOf | --- DataComplementOf | --- DataOneOf | --- DatatypeRestriction - def "DataRange" $ - see "https://www.w3.org/TR/owl2-syntax/#Data_Ranges" $ - simpleUnion [ - "DataComplementOf", - "DataIntersectionOf", - "DataOneOf", - "DataUnionOf", - "Datatype", - "DatatypeRestriction"], - --- DataIntersectionOf := 'DataIntersectionOf' '(' DataRange DataRange { DataRange } ')' - def "DataIntersectionOf" $ - see "https://www.w3.org/TR/owl2-syntax/#Intersection_of_Data_Ranges" $ - twoOrMoreList $ owl "DataRange", - --- DataUnionOf := 'DataUnionOf' '(' DataRange DataRange { DataRange } ')' - def "DataUnionOf" $ - see "https://www.w3.org/TR/owl2-syntax/#Union_of_Data_Ranges" $ - twoOrMoreList $ owl "DataRange", - --- DataComplementOf := 'DataComplementOf' '(' DataRange ')' - def "DataComplementOf" $ - see "https://www.w3.org/TR/owl2-syntax/#Complement_of_Data_Ranges" $ - owl "DataRange", - --- DataOneOf := 'DataOneOf' '(' Literal { Literal } ')' - def "DataOneOf" $ - see "https://www.w3.org/TR/owl2-syntax/#Enumeration_of_Literals" $ - nonemptyList $ rdf "Literal", - --- DatatypeRestriction := 'DatatypeRestriction' '(' Datatype constrainingFacet restrictionValue { constrainingFacet restrictionValue } ')' --- constrainingFacet := IRI --- restrictionValue := Literal - def "DatatypeRestriction" $ - see "https://www.w3.org/TR/owl2-syntax/#Datatype_Restrictions" $ - record [ - "datatype">: owl "Datatype", - "constraints">: nonemptyList $ owl "DatatypeRestriction.Constraint"], - - def "DatatypeRestriction.Constraint" $ record [ - "constrainingFacet">: owl "DatatypeRestriction.ConstrainingFacet", - "restrictionValue">: rdf "Literal"], - - def "DatatypeRestriction.ConstrainingFacet" $ - union [ - "xmlSchema">: - note ("XML Schema constraining facets are treated as a special case in this model " ++ - "(not in the OWL 2 specification itself) because they are particularly common") $ - xsd "ConstrainingFacet", - "other">: rdf "Iri"], - --- ClassExpression := --- Class | --- ObjectIntersectionOf | ObjectUnionOf | ObjectComplementOf | ObjectOneOf | --- ObjectSomeValuesFrom | ObjectAllValuesFrom | ObjectHasValue | ObjectHasSelf | --- ObjectMinCardinality | ObjectMaxCardinality | ObjectExactCardinality | --- DataSomeValuesFrom | DataAllValuesFrom | DataHasValue | --- DataMinCardinality | DataMaxCardinality | DataExactCardinality - def "ClassExpression" $ simpleUnion [ - "Class", - "DataSomeValuesFrom", - "DataAllValuesFrom", - "DataHasValue", - "DataMinCardinality", - "DataMaxCardinality", - "DataExactCardinality", - "ObjectAllValuesFrom", - "ObjectExactCardinality", - "ObjectHasSelf", - "ObjectHasValue", - "ObjectIntersectionOf", - "ObjectMaxCardinality", - "ObjectMinCardinality", - "ObjectOneOf", - "ObjectSomeValuesFrom", - "ObjectUnionOf"], - --- ObjectIntersectionOf := 'ObjectIntersectionOf' '(' ClassExpression ClassExpression { ClassExpression } ')' - def "ObjectIntersectionOf" $ twoOrMoreList $ owl "ClassExpression", - --- ObjectUnionOf := 'ObjectUnionOf' '(' ClassExpression ClassExpression { ClassExpression } ')' - def "ObjectUnionOf" $ twoOrMoreList $ owl "ClassExpression", - --- ObjectComplementOf := 'ObjectComplementOf' '(' ClassExpression ')' - def "ObjectComplementOf" $ owl "ClassExpression", - --- ObjectOneOf := 'ObjectOneOf' '(' Individual { Individual }')' - def "ObjectOneOf" $ nonemptyList $ owl "Individual", - --- ObjectSomeValuesFrom := 'ObjectSomeValuesFrom' '(' ObjectPropertyExpression ClassExpression ')' - def "ObjectSomeValuesFrom" $ record [ - "property">: owl "ObjectPropertyExpression", - "class">: owl "ClassExpression"], - --- ObjectAllValuesFrom := 'ObjectAllValuesFrom' '(' ObjectPropertyExpression ClassExpression ')' - def "ObjectAllValuesFrom" $ record [ - "property">: owl "ObjectPropertyExpression", - "class">: owl "ClassExpression"], - --- ObjectHasValue := 'ObjectHasValue' '(' ObjectPropertyExpression Individual ')' - def "ObjectHasValue" $ record [ - "property">: owl "ObjectPropertyExpression", - "individual">: owl "Individual"], - --- ObjectHasSelf := 'ObjectHasSelf' '(' ObjectPropertyExpression ')' - def "ObjectHasSelf" $ owl "ObjectPropertyExpression", - --- ObjectMinCardinality := 'ObjectMinCardinality' '(' nonNegativeInteger ObjectPropertyExpression [ ClassExpression ] ')' - def "ObjectMinCardinality" $ - see "https://www.w3.org/TR/owl2-syntax/#Minimum_Cardinality" $ - record [ - "bound">: nonNegativeInteger, - "property">: owl "ObjectPropertyExpression", - "class">: list $ owl "ClassExpression"], - --- ObjectMaxCardinality := 'ObjectMaxCardinality' '(' nonNegativeInteger ObjectPropertyExpression [ ClassExpression ] ')' - def "ObjectMaxCardinality" $ - see "https://www.w3.org/TR/owl2-syntax/#Maximum_Cardinality" $ - record [ - "bound">: nonNegativeInteger, - "property">: owl "ObjectPropertyExpression", - "class">: list $ owl "ClassExpression"], - --- ObjectExactCardinality := 'ObjectExactCardinality' '(' nonNegativeInteger ObjectPropertyExpression [ ClassExpression ] ')' - def "ObjectExactCardinality" $ - see "https://www.w3.org/TR/owl2-syntax/#Exact_Cardinality" $ - record [ - "bound">: nonNegativeInteger, - "property">: owl "ObjectPropertyExpression", - "class">: list $ owl "ClassExpression"], - --- DataSomeValuesFrom := 'DataSomeValuesFrom' '(' DataPropertyExpression { DataPropertyExpression } DataRange ')' - def "DataSomeValuesFrom" $ record [ - "property">: nonemptyList $ owl "DataPropertyExpression", - "range">: owl "DataRange"], - --- DataAllValuesFrom := 'DataAllValuesFrom' '(' DataPropertyExpression { DataPropertyExpression } DataRange ')' - def "DataAllValuesFrom" $ record [ - "property">: nonemptyList $ owl "DataPropertyExpression", - "range">: owl "DataRange"], - --- DataHasValue := 'DataHasValue' '(' DataPropertyExpression Literal ')' - def "DataHasValue" $ record [ - "property">: owl "DataPropertyExpression", - "value">: rdf "Literal"], - --- DataMinCardinality := 'DataMinCardinality' '(' nonNegativeInteger DataPropertyExpression [ DataRange ] ')' - def "DataMinCardinality" $ record [ - "bound">: nonNegativeInteger, - "property">: owl "DataPropertyExpression", - "range">: list $ owl "DataRange"], - --- DataMaxCardinality := 'DataMaxCardinality' '(' nonNegativeInteger DataPropertyExpression [ DataRange ] ')' - def "DataMaxCardinality" $ record [ - "bound">: nonNegativeInteger, - "property">: owl "DataPropertyExpression", - "range">: list $ owl "DataRange"], - --- DataExactCardinality := 'DataExactCardinality' '(' nonNegativeInteger DataPropertyExpression [ DataRange ] ')' - def "DataExactCardinality" $ record [ - "bound">: nonNegativeInteger, - "property">: owl "DataPropertyExpression", - "range">: list $ owl "DataRange"], - --- Axiom := Declaration | ClassAxiom | ObjectPropertyAxiom | DataPropertyAxiom | DatatypeDefinition | HasKey | Assertion | AnnotationAxiom - def "Axiom" $ - see "https://www.w3.org/TR/owl2-syntax/#Axioms" $ - simpleUnion [ - "AnnotationAxiom", - "Assertion", - "ClassAxiom", - "DataPropertyAxiom", - "DatatypeDefinition", - "Declaration", - "HasKey", - "ObjectPropertyAxiom"], - --- ClassAxiom := SubClassOf | EquivalentClasses | DisjointClasses | DisjointUnion - def "ClassAxiom" $ simpleUnion [ - "DisjointClasses", - "DisjointUnion", - "EquivalentClasses", - "SubClassOf"], - --- SubClassOf := 'SubClassOf' '(' axiomAnnotations subClassExpression superClassExpression ')' --- subClassExpression := ClassExpression --- superClassExpression := ClassExpression - def "SubClassOf" $ withAnns [ - "subClass">: owl "ClassExpression", - "superClass">: owl "ClassExpression"], - --- EquivalentClasses := 'EquivalentClasses' '(' axiomAnnotations ClassExpression ClassExpression { ClassExpression } ')' - def "EquivalentClasses" $ withAnns [ - "classes">: twoOrMoreList $ owl "ClassExpression"], - --- DisjointClasses := 'DisjointClasses' '(' axiomAnnotations ClassExpression ClassExpression { ClassExpression } ')' - def "DisjointClasses" $ withAnns [ - "classes">: twoOrMoreList $ owl "ClassExpression"], - --- DisjointUnion := 'DisjointUnion' '(' axiomAnnotations Class disjointClassExpressions ')' --- disjointClassExpressions := ClassExpression ClassExpression { ClassExpression } - def "DisjointUnion" $ - see "https://www.w3.org/TR/owl2-syntax/#Disjoint_Union_of_Class_Expressions" $ - withAnns [ - "class">: owl "Class", - "classes">: twoOrMoreList $ owl "ClassExpression"], - --- ObjectPropertyAxiom := --- SubObjectPropertyOf | EquivalentObjectProperties | --- DisjointObjectProperties | InverseObjectProperties | --- ObjectPropertyDomain | ObjectPropertyRange | --- FunctionalObjectProperty | InverseFunctionalObjectProperty | --- ReflexiveObjectProperty | IrreflexiveObjectProperty | --- SymmetricObjectProperty | AsymmetricObjectProperty | --- TransitiveObjectProperty - def "ObjectPropertyAxiom" $ simpleUnion [ - "AsymmetricObjectProperty", - "DisjointObjectProperties", - "EquivalentObjectProperties", - "FunctionalObjectProperty", - "InverseFunctionalObjectProperty", - "InverseObjectProperties", - "IrreflexiveObjectProperty", - "ObjectPropertyDomain", - "ObjectPropertyRange", - "ReflexiveObjectProperty", - "SubObjectPropertyOf", - "SymmetricObjectProperty", - "TransitiveObjectProperty"], - --- SubObjectPropertyOf := 'SubObjectPropertyOf' '(' axiomAnnotations subObjectPropertyExpression superObjectPropertyExpression ')' - def "SubObjectPropertyOf" $ withAnns [ - "subProperty">: nonemptyList $ owl "ObjectPropertyExpression", - "superProperty">: owl "ObjectPropertyExpression"], --- subObjectPropertyExpression := ObjectPropertyExpression | propertyExpressionChain --- propertyExpressionChain := 'ObjectPropertyChain' '(' ObjectPropertyExpression ObjectPropertyExpression { ObjectPropertyExpression } ')' --- superObjectPropertyExpression := ObjectPropertyExpression - --- EquivalentObjectProperties := 'EquivalentObjectProperties' '(' axiomAnnotations ObjectPropertyExpression ObjectPropertyExpression { ObjectPropertyExpression } ')' - def "EquivalentObjectProperties" $ withAnns [ - "properties">: twoOrMoreList $ owl "ObjectPropertyExpression"], - --- DisjointObjectProperties := 'DisjointObjectProperties' '(' axiomAnnotations ObjectPropertyExpression ObjectPropertyExpression { ObjectPropertyExpression } ')' - def "DisjointObjectProperties" $ withAnns [ - "properties">: twoOrMoreList $ owl "ObjectPropertyExpression"], - --- ObjectPropertyDomain := 'ObjectPropertyDomain' '(' axiomAnnotations ObjectPropertyExpression ClassExpression ')' - def "ObjectPropertyDomain" $ - see "https://www.w3.org/TR/owl2-syntax/#Object_Property_Domain" $ - withAnns [ - "property">: owl "ObjectPropertyExpression", - "domain">: owl "ClassExpression"], - --- ObjectPropertyRange := 'ObjectPropertyRange' '(' axiomAnnotations ObjectPropertyExpression ClassExpression ')' - def "ObjectPropertyRange" $ - see "https://www.w3.org/TR/owl2-syntax/#Object_Property_Range" $ - withAnns [ - "property">: owl "ObjectPropertyExpression", - "range">: owl "ClassExpression"], - --- InverseObjectProperties := 'InverseObjectProperties' '(' axiomAnnotations ObjectPropertyExpression ObjectPropertyExpression ')' - def "InverseObjectProperties" $ withAnns [ - "property1">: owl "ObjectPropertyExpression", - "property2">: owl "ObjectPropertyExpression"], - --- FunctionalObjectProperty := 'FunctionalObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "FunctionalObjectProperty", - --- InverseFunctionalObjectProperty := 'InverseFunctionalObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "InverseFunctionalObjectProperty", - --- ReflexiveObjectProperty := 'ReflexiveObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "ReflexiveObjectProperty", - --- IrreflexiveObjectProperty := 'IrreflexiveObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "IrreflexiveObjectProperty", - --- SymmetricObjectProperty := 'SymmetricObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "SymmetricObjectProperty", - --- AsymmetricObjectProperty := 'AsymmetricObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "AsymmetricObjectProperty", - --- TransitiveObjectProperty := 'TransitiveObjectProperty' '(' axiomAnnotations ObjectPropertyExpression ')' - objectPropertyConstraint "TransitiveObjectProperty", - --- DataPropertyAxiom := --- SubDataPropertyOf | EquivalentDataProperties | DisjointDataProperties | --- DataPropertyDomain | DataPropertyRange | FunctionalDataProperty - def "DataPropertyAxiom" $ simpleUnion [ - "DataPropertyAxiom", - "DataPropertyRange", - "DisjointDataProperties", - "EquivalentDataProperties", - "FunctionalDataProperty", - "SubDataPropertyOf"], - --- SubDataPropertyOf := 'SubDataPropertyOf' '(' axiomAnnotations subDataPropertyExpression superDataPropertyExpression ')' - def "SubDataPropertyOf" $ withAnns [ - "subProperty">: owl "DataPropertyExpression", - "superProperty">: owl "DataPropertyExpression"], --- subDataPropertyExpression := DataPropertyExpression --- superDataPropertyExpression := DataPropertyExpression - --- EquivalentDataProperties := 'EquivalentDataProperties' '(' axiomAnnotations DataPropertyExpression DataPropertyExpression { DataPropertyExpression } ')' - def "EquivalentDataProperties" $ withAnns [ - "properties">: twoOrMoreList $ owl "DataPropertyExpression"], - --- DisjointDataProperties := 'DisjointDataProperties' '(' axiomAnnotations DataPropertyExpression DataPropertyExpression { DataPropertyExpression } ')' - def "DisjointDataProperties" $ withAnns [ - "properties">: twoOrMoreList $ owl "DataPropertyExpression"], - --- DataPropertyDomain := 'DataPropertyDomain' '(' axiomAnnotations DataPropertyExpression ClassExpression ')' - def "DataPropertyDomain" $ withAnns [ - "property">: owl "DataPropertyExpression", - "domain">: owl "ClassExpression"], - --- DataPropertyRange := 'DataPropertyRange' '(' axiomAnnotations DataPropertyExpression DataRange ')' - def "DataPropertyRange" $ withAnns [ - "property">: owl "DataPropertyExpression", - "range">: owl "ClassExpression"], - --- FunctionalDataProperty := 'FunctionalDataProperty' '(' axiomAnnotations DataPropertyExpression ')' - def "FunctionalDataProperty" $ withAnns [ - "property">: owl "DataPropertyExpression"], - --- DatatypeDefinition := 'DatatypeDefinition' '(' axiomAnnotations Datatype DataRange ')' - def "DatatypeDefinition" $ withAnns [ - "datatype">: owl "Datatype", - "range">: owl "DataRange"], - --- HasKey := 'HasKey' '(' axiomAnnotations ClassExpression '(' { ObjectPropertyExpression } ')' '(' { DataPropertyExpression } ')' ')' - def "HasKey" $ - see "https://www.w3.org/TR/owl2-syntax/#Keys" $ - withAnns [ - "class">: owl "ClassExpression", - "objectProperties">: list $ owl "ObjectPropertyExpression", - "dataProperties">: list $ owl "DataPropertyExpression"], - --- Assertion := --- SameIndividual | DifferentIndividuals | ClassAssertion | --- ObjectPropertyAssertion | NegativeObjectPropertyAssertion | --- DataPropertyAssertion | NegativeDataPropertyAssertion - def "Assertion" $ simpleUnion [ - "ClassAssertion", - "DataPropertyAssertion", - "DifferentIndividuals", - "ObjectPropertyAssertion", - "NegativeDataPropertyAssertion", - "NegativeObjectPropertyAssertion", - "SameIndividual"], - --- sourceIndividual := Individual --- targetIndividual := Individual --- targetValue := Literal --- SameIndividual := 'SameIndividual' '(' axiomAnnotations Individual Individual { Individual } ')' - def "SameIndividual" $ withAnns [ - "individuals">: twoOrMoreList $ owl "Individual"], - --- DifferentIndividuals := 'DifferentIndividuals' '(' axiomAnnotations Individual Individual { Individual } ')' - def "DifferentIndividuals" $ withAnns [ - "individuals">: twoOrMoreList $ owl "Individual"], - --- ClassAssertion := 'ClassAssertion' '(' axiomAnnotations ClassExpression Individual ')' - def "ClassAssertion"$ withAnns [ - "class">: owl "ClassExpression", - "individual">: owl "Individual"], - --- ObjectPropertyAssertion := 'ObjectPropertyAssertion' '(' axiomAnnotations ObjectPropertyExpression sourceIndividual targetIndividual ')' - def "ObjectPropertyAssertion" $ withAnns [ - "property">: owl "ObjectPropertyExpression", - "source">: owl "Individual", - "target">: owl "Individual"], - --- NegativeObjectPropertyAssertion := 'NegativeObjectPropertyAssertion' '(' axiomAnnotations ObjectPropertyExpression sourceIndividual targetIndividual ')' - def "NegativeObjectPropertyAssertion" $ withAnns [ - "property">: owl "ObjectPropertyExpression", - "source">: owl "Individual", - "target">: owl "Individual"], - --- DataPropertyAssertion := 'DataPropertyAssertion' '(' axiomAnnotations DataPropertyExpression sourceIndividual targetValue ')' - def "DataPropertyAssertion" $ withAnns [ - "property">: owl "DataPropertyExpression", - "source">: owl "Individual", - "target">: owl "Individual"], - --- NegativeDataPropertyAssertion := 'NegativeDataPropertyAssertion' '(' axiomAnnotations DataPropertyExpression sourceIndividual targetValue ')' - def "NegativeDataPropertyAssertion" $ withAnns [ - "property">: owl "DataPropertyExpression", - "source">: owl "Individual", - "target">: owl "Individual"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Delta.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Delta.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Delta.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Parquet.Delta where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -deltaParquetModule :: Module -deltaParquetModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("A partial Delta Parquet model") - where - ns = Namespace "hydra/langs/parquet/delta" - def = datatype ns - delta = typeref ns - - elements = [ - def "ArrayType" $ - record [ - "elementType">: delta "DataType", - "containsNull">: boolean], - - def "DataType" $ - union [ - "array">: delta "ArrayType", - "binary">: unit, - "boolean">: unit, - "byte">: unit, - "date">: unit, - "decimal">: delta "DecimalType", - "double">: unit, - "float">: unit, - "integer">: unit, - "long">: unit, - "map">: delta "MapType", - "null">: unit, - "short">: unit, - "string">: unit, - "struct">: delta "StructType"], - - def "DecimalType" $ - record [ - "precision">: int32, - "scale">: int32], - - def "MapType" $ - record [ - "keyType">: delta "DataType", - "valueType">: delta "DataType", - "valueContainsNull">: boolean], - - def "StructField" $ - record [ - "name">: string, - "dataType">: delta "DataType", - "nullable">: boolean], - - def "StructType" $ - record [ - "fields">: list $ delta "StructField"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Format.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Format.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Format.hs +++ /dev/null @@ -1,1758 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Parquet.Format where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - --- Note: deprecated and trivial/empty type definitions are excluded from this model -parquetFormatModule :: Module -parquetFormatModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("A model for the Parquet format. Based on the Thrift-based specification at:\n" ++ - " https://github.com/apache/parquet-format/blob/master/src/main/thrift/parquet.thrift") - where - ns = Namespace "hydra/langs/parquet/format" - def = datatype ns - parquet = typeref ns - - elements = [ --- /** --- * Types supported by Parquet. These types are intended to be used in combination --- * with the encodings to control the on disk storage format. --- * For example INT16 is not included as a type since a good encoding of INT32 --- * would handle this. --- */ --- enum Type { - def "Type" $ - doc ("Types supported by Parquet. These types are intended to be used in combination " ++ - "with the encodings to control the on disk storage format. " ++ - "For example INT16 is not included as a type since a good encoding of INT32 " ++ - "would handle this.") $ - enum [ --- BOOLEAN = 0; - "boolean", --- INT32 = 1; - "int32", --- INT64 = 2; - "int64", --- INT96 = 3; // deprecated, only used by legacy implementations. --- FLOAT = 4; - "float", --- DOUBLE = 5; - "double", --- BYTE_ARRAY = 6; - "byteArray", --- FIXED_LEN_BYTE_ARRAY = 7; - "fixedLenByteArray"], --- } - --- /** --- * DEPRECATED: Common types used by frameworks(e.g. hive, pig) using parquet. --- * ConvertedType is superseded by LogicalType. This enum should not be extended. --- * --- * See LogicalTypes.md for conversion between ConvertedType and LogicalType. --- */ --- enum ConvertedType { --- /** a BYTE_ARRAY actually contains UTF8 encoded chars */ --- UTF8 = 0; --- --- /** a map is converted as an optional field containing a repeated key/value pair */ --- MAP = 1; --- --- /** a key/value pair is converted into a group of two fields */ --- MAP_KEY_VALUE = 2; --- --- /** a list is converted into an optional field containing a repeated field for its --- * values */ --- LIST = 3; --- --- /** an enum is converted into a binary field */ --- ENUM = 4; --- --- /** --- * A decimal value. --- * --- * This may be used to annotate binary or fixed primitive types. The --- * underlying byte array stores the unscaled value encoded as two's --- * complement using big-endian byte order (the most significant byte is the --- * zeroth element). The value of the decimal is the value * 10^{-scale}. --- * --- * This must be accompanied by a (maximum) precision and a scale in the --- * SchemaElement. The precision specifies the number of digits in the decimal --- * and the scale stores the location of the decimal point. For example 1.23 --- * would have precision 3 (3 total digits) and scale 2 (the decimal point is --- * 2 digits over). --- */ --- DECIMAL = 5; --- --- /** --- * A Date --- * --- * Stored as days since Unix epoch, encoded as the INT32 physical type. --- * --- */ --- DATE = 6; --- --- /** --- * A time --- * --- * The total number of milliseconds since midnight. The value is stored --- * as an INT32 physical type. --- */ --- TIME_MILLIS = 7; --- --- /** --- * A time. --- * --- * The total number of microseconds since midnight. The value is stored as --- * an INT64 physical type. --- */ --- TIME_MICROS = 8; --- --- /** --- * A date/time combination --- * --- * Date and time recorded as milliseconds since the Unix epoch. Recorded as --- * a physical type of INT64. --- */ --- TIMESTAMP_MILLIS = 9; --- --- /** --- * A date/time combination --- * --- * Date and time recorded as microseconds since the Unix epoch. The value is --- * stored as an INT64 physical type. --- */ --- TIMESTAMP_MICROS = 10; --- --- --- /** --- * An unsigned integer value. --- * --- * The number describes the maximum number of meaningful data bits in --- * the stored value. 8, 16 and 32 bit values are stored using the --- * INT32 physical type. 64 bit values are stored using the INT64 --- * physical type. --- * --- */ --- UINT_8 = 11; --- UINT_16 = 12; --- UINT_32 = 13; --- UINT_64 = 14; --- --- /** --- * A signed integer value. --- * --- * The number describes the maximum number of meaningful data bits in --- * the stored value. 8, 16 and 32 bit values are stored using the --- * INT32 physical type. 64 bit values are stored using the INT64 --- * physical type. --- * --- */ --- INT_8 = 15; --- INT_16 = 16; --- INT_32 = 17; --- INT_64 = 18; --- --- /** --- * An embedded JSON document --- * --- * A JSON document embedded within a single UTF8 column. --- */ --- JSON = 19; --- --- /** --- * An embedded BSON document --- * --- * A BSON document embedded within a single BINARY column. --- */ --- BSON = 20; --- --- /** --- * An interval of time --- * --- * This type annotates data stored as a FIXED_LEN_BYTE_ARRAY of length 12 --- * This data is composed of three separate little endian unsigned --- * integers. Each stores a component of a duration of time. The first --- * integer identifies the number of months associated with the duration, --- * the second identifies the number of days associated with the duration --- * and the third identifies the number of milliseconds associated with --- * the provided duration. This duration of time is independent of any --- * particular timezone or date. --- */ --- INTERVAL = 21; ---} - --- /** --- * Representation of Schemas --- */ --- enum FieldRepetitionType { - def "FieldRepetitionType" $ - doc "Representation of Schemas" $ - union [ --- /** This field is required (can not be null) and each record has exactly 1 value. */ --- REQUIRED = 0; - "required">: doc "This field is required (can not be null) and each record has exactly 1 value." unit, --- --- /** The field is optional (can be null) and each record has 0 or 1 values. */ --- OPTIONAL = 1; - "optional">: doc "The field is optional (can be null) and each record has 0 or 1 values." unit, --- --- /** The field is repeated and can contain 0 or more values */ --- REPEATED = 2; - "repeated">: doc "The field is repeated and can contain 0 or more values" unit], --- } - --- /** --- * Statistics per row group and per page --- * All fields are optional. --- */ --- struct Statistics { - def "Statistics" $ - doc "Statistics per row group and per page. All fields are optional." $ - record [ --- /** --- * DEPRECATED: min and max value of the column. Use min_value and max_value. --- * --- * Values are encoded using PLAIN encoding, except that variable-length byte --- * arrays do not include a length prefix. --- * --- * These fields encode min and max values determined by signed comparison --- * only. New files should use the correct order for a column's logical type --- * and store the values in the min_value and max_value fields. --- * --- * To support older readers, these may be set when the column order is --- * signed. --- */ --- 1: optional binary max; --- 2: optional binary min; --- /** count of null value in the column */ --- 3: optional i64 null_count; - "nullCount">: optional uint64, --- /** count of distinct values occurring */ --- 4: optional i64 distinct_count; - "distinctCount">: optional uint64, --- /** --- * Min and max values for the column, determined by its ColumnOrder. --- * --- * Values are encoded using PLAIN encoding, except that variable-length byte --- * arrays do not include a length prefix. --- */ --- 5: optional binary max_value; - "maxValue">: - doc ("Max value for the column, determined by its ColumnOrder. " ++ - "Values are encoded using PLAIN encoding, except that variable-length byte " ++ - "arrays do not include a length prefix.") $ - optional binary, --- 6: optional binary min_value; - "minValue">: - doc ("Max value for the column, determined by its ColumnOrder. " ++ - "Values are encoded using PLAIN encoding, except that variable-length byte " ++ - "arrays do not include a length prefix.") $ - optional binary], --- } - --- /** Empty structs to use as logical type annotations */ --- struct StringType {} // allowed for BINARY, must be encoded with UTF-8 --- struct UUIDType {} // allowed for FIXED[16], must encoded raw UUID bytes --- struct MapType {} // see LogicalTypes.md --- struct ListType {} // see LogicalTypes.md --- struct EnumType {} // allowed for BINARY, must be encoded with UTF-8 --- struct DateType {} // allowed for INT32 --- /** --- * Logical type to annotate a column that is always null. --- * --- * Sometimes when discovering the schema of existing data, values are always --- * null and the physical type can't be determined. This annotation signals --- * the case where the physical type was guessed from all null values. --- */ --- struct NullType {} // allowed for any physical type, only null values stored --- /** --- * Decimal logical type annotation --- * --- * To maintain forward-compatibility in v1, implementations using this logical --- * type must also set scale and precision on the annotated SchemaElement. --- * --- * Allowed for physical types: INT32, INT64, FIXED, and BINARY --- */ --- struct DecimalType { - def "DecimalType" $ - doc ("Decimal logical type annotation. " ++ - "To maintain forward-compatibility in v1, implementations using this logical " ++ - "type must also set scale and precision on the annotated SchemaElement. " ++ - "Allowed for physical types: INT32, INT64, FIXED, and BINARY") $ - record [ --- 1: required i32 scale - "scale">: int32, --- 2: required i32 precision - "precision">: int32], --- } - --- /** Time units for logical types */ --- struct MilliSeconds {} --- struct MicroSeconds {} --- struct NanoSeconds {} --- union TimeUnit { - def "TimeUnit" $ - enum [ --- 1: MilliSeconds MILLIS - "millis", --- 2: MicroSeconds MICROS - "micros", --- 3: NanoSeconds NANOS - "nanos"], --- } - --- /** --- * Timestamp logical type annotation --- * --- * Allowed for physical types: INT64 --- */ --- struct TimestampType { - def "TimestampType" $ - doc ("Timestamp logical type annotation. " ++ - "Allowed for physical types: INT64") $ - record [ --- 1: required bool isAdjustedToUTC - "isAdjustedToUtc">: boolean, --- 2: required TimeUnit unit - "unit">: parquet "TimeUnit"], --- } - --- /** --- * Time logical type annotation --- * --- * Allowed for physical types: INT32 (millis), INT64 (micros, nanos) --- */ --- struct TimeType { - def "TimeType" $ - doc ("Time logical type annotation. " ++ - "Allowed for physical types: INT32 (millis), INT64 (micros, nanos)") $ - record [ --- 1: required bool isAdjustedToUTC - "isAdjustedToUtc">: boolean, --- 2: required TimeUnit unit - "unit">: parquet "TimeUnit"], --- } - --- /** --- * Integer logical type annotation --- * --- * bitWidth must be 8, 16, 32, or 64. --- * --- * Allowed for physical types: INT32, INT64 --- */ --- struct IntType { - def "IntType" $ - doc ("Integer logical type annotation. " ++ - "bitWidth must be 8, 16, 32, or 64. " ++ - "Allowed for physical types: INT32, INT64") $ - record [ --- 1: required i8 bitWidth - "bitWidth">: uint8, --- 2: required bool isSigned - "isSigned">: boolean], --- } - --- /** --- * Embedded JSON logical type annotation --- * --- * Allowed for physical types: BINARY --- */ --- struct JsonType { --- } --- --- /** --- * Embedded BSON logical type annotation --- * --- * Allowed for physical types: BINARY --- */ --- struct BsonType { --- } --- --- /** --- * LogicalType annotations to replace ConvertedType. --- * --- * To maintain compatibility, implementations using LogicalType for a --- * SchemaElement aust also set the corresponding ConvertedType (if any) --- * from the following table. --- */ --- union LogicalType { - def "LogicalType" $ - doc ("LogicalType annotations to replace ConvertedType. " ++ - "To maintain compatibility, implementations using LogicalType for a " ++ - "SchemaElement aust also set the corresponding ConvertedType (if any) " ++ - "from the following table.") $ - union [ --- 1: StringType STRING // use ConvertedType UTF8 - "string">: doc "use ConvertedType UTF8" unit, --- 2: MapType MAP // use ConvertedType MAP - "map">: doc "use ConvertedType MAP" unit, --- 3: ListType LIST // use ConvertedType LIST - "list">: doc "use ConvertedType LIST" unit, --- 4: EnumType ENUM // use ConvertedType ENUM - "enum">: doc "use ConvertedType ENUM" unit, --- 5: DecimalType DECIMAL // use ConvertedType DECIMAL + SchemaElement.{scale, precision} - "decimal">: - doc "use ConvertedType DECIMAL + SchemaElement.{scale, precision}" $ - parquet "DecimalType", --- 6: DateType DATE // use ConvertedType DATE - "date">: doc "use ConvertedType DATE" unit, --- --- // use ConvertedType TIME_MICROS for TIME(isAdjustedToUTC = *, unit = MICROS) --- // use ConvertedType TIME_MILLIS for TIME(isAdjustedToUTC = *, unit = MILLIS) --- 7: TimeType TIME - "time">: - doc ("use ConvertedType TIME_MICROS for TIME(isAdjustedToUTC = *, unit = MICROS). " ++ - "use ConvertedType TIME_MILLIS for TIME(isAdjustedToUTC = *, unit = MILLIS)") $ - parquet "TimeType", --- --- // use ConvertedType TIMESTAMP_MICROS for TIMESTAMP(isAdjustedToUTC = *, unit = MICROS) --- // use ConvertedType TIMESTAMP_MILLIS for TIMESTAMP(isAdjustedToUTC = *, unit = MILLIS) --- 8: TimestampType TIMESTAMP - "timestamp">: - doc ("use ConvertedType TIMESTAMP_MICROS for TIMESTAMP(isAdjustedToUTC = *, unit = MICROS). " ++ - "use ConvertedType TIMESTAMP_MILLIS for TIMESTAMP(isAdjustedToUTC = *, unit = MILLIS)") $ - parquet "TimestampType", --- --- // 9: reserved for INTERVAL --- 10: IntType INTEGER // use ConvertedType INT_* or UINT_* - "integer">: - doc "use ConvertedType INT_* or UINT_*" $ - parquet "IntType", --- 11: NullType UNKNOWN // no compatible ConvertedType - "unknown">: - doc "no compatible ConvertedType" unit, --- 12: JsonType JSON // use ConvertedType JSON - "json">: doc "use ConvertedType JSON" unit, --- 13: BsonType BSON // use ConvertedType BSON - "bson">: doc "use ConvertedType BSON" unit, --- 14: UUIDType UUID // no compatible ConvertedType - "uuid">: doc "no compatible ConvertedType" unit], --- } - --- /** --- * Represents a element inside a schema definition. --- * - if it is a group (inner node) then type is undefined and num_children is defined --- * - if it is a primitive type (leaf) then type is defined and num_children is undefined --- * the nodes are listed in depth first traversal order. --- */ --- struct SchemaElement { - def "SchemaElement" $ - doc ("Represents a element inside a schema definition.\n" ++ - "- if it is a group (inner node) then type is undefined and num_children is defined\n" ++ - "- if it is a primitive type (leaf) then type is defined and num_children is undefined\n" ++ - "the nodes are listed in depth first traversal order.") $ - record [ --- /** Data type for this field. Not set if the current element is a non-leaf node */ --- 1: optional Type type; - "type">: - doc "Data type for this field. Not set if the current element is a non-leaf node" $ - optional $ parquet "Type", --- --- /** If type is FIXED_LEN_BYTE_ARRAY, this is the byte length of the vales. --- * Otherwise, if specified, this is the maximum bit length to store any of the values. --- * (e.g. a low cardinality INT col could have this set to 3). Note that this is --- * in the schema, and therefore fixed for the entire file. --- */ --- 2: optional i32 type_length; - "typeLength">: - doc ("If type is FIXED_LEN_BYTE_ARRAY, this is the byte length of the values. " ++ - "Otherwise, if specified, this is the maximum bit length to store any of the values. " ++ - "(e.g. a low cardinality INT col could have this set to 3). Note that this is " ++ - "in the schema, and therefore fixed for the entire file.") $ - optional int32, --- --- /** repetition of the field. The root of the schema does not have a repetition_type. --- * All other nodes must have one */ --- 3: optional FieldRepetitionType repetition_type; - "repetitionType">: - doc ("repetition of the field. The root of the schema does not have a repetition_type. " ++ - "All other nodes must have one") $ - optional $ parquet "FieldRepetitionType", --- --- /** Name of the field in the schema */ --- 4: required string name; - "name">: - doc "Name of the field in the schema" - string, --- --- /** Nested fields. Since thrift does not support nested fields, --- * the nesting is flattened to a single list by a depth-first traversal. --- * The children count is used to construct the nested relationship. --- * This field is not set when the element is a primitive type --- */ --- 5: optional i32 num_children; - "numChildren">: - doc ("Nested fields. Since thrift does not support nested fields, " ++ - "the nesting is flattened to a single list by a depth-first traversal. " ++ - "The children count is used to construct the nested relationship. " ++ - "This field is not set when the element is a primitive type") $ - optional int32, --- --- /** --- * DEPRECATED: When the schema is the result of a conversion from another model. --- * Used to record the original type to help with cross conversion. --- * --- * This is superseded by logicalType. --- */ --- 6: optional ConvertedType converted_type; --- --- /** --- * DEPRECATED: Used when this column contains decimal data. --- * See the DECIMAL converted type for more details. --- * --- * This is superseded by using the DecimalType annotation in logicalType. --- */ --- 7: optional i32 scale --- 8: optional i32 precision --- --- /** When the original schema supports field ids, this will save the --- * original field id in the parquet schema --- */ --- 9: optional i32 field_id; - "fieldId">: - doc ("When the original schema supports field ids, this will save the " ++ - "original field id in the parquet schema") $ - optional int32, --- --- /** --- * The logical type of this SchemaElement --- * --- * LogicalType replaces ConvertedType, but ConvertedType is still required --- * for some logical types to ensure forward-compatibility in format v1. --- */ --- 10: optional LogicalType logicalType - "logicalType">: - doc ("The logical type of this SchemaElement. " ++ - "LogicalType replaces ConvertedType, but ConvertedType is still required " ++ - "for some logical types to ensure forward-compatibility in format v1.") $ - optional $ parquet "LogicalType"], --- } - --- /** --- * Encodings supported by Parquet. Not all encodings are valid for all types. These --- * enums are also used to specify the encoding of definition and repetition levels. --- * See the accompanying doc for the details of the more complicated encodings. --- */ --- enum Encoding { - def "Encoding" $ - doc ("Encodings supported by Parquet. Not all encodings are valid for all types. These " ++ - "enums are also used to specify the encoding of definition and repetition levels. " ++ - "See the accompanying doc for the details of the more complicated encodings.") $ - union [ --- /** Default encoding. --- * BOOLEAN - 1 bit per value. 0 is false; 1 is true. --- * INT32 - 4 bytes per value. Stored as little-endian. --- * INT64 - 8 bytes per value. Stored as little-endian. --- * FLOAT - 4 bytes per value. IEEE. Stored as little-endian. --- * DOUBLE - 8 bytes per value. IEEE. Stored as little-endian. --- * BYTE_ARRAY - 4 byte length stored as little endian, followed by bytes. --- * FIXED_LEN_BYTE_ARRAY - Just the bytes. --- */ --- PLAIN = 0; - "plain">: - doc ("Default encoding.\n" ++ - "BOOLEAN - 1 bit per value. 0 is false; 1 is true.\n" ++ - "INT32 - 4 bytes per value. Stored as little-endian.\n" ++ - "INT64 - 8 bytes per value. Stored as little-endian.\n" ++ - "FLOAT - 4 bytes per value. IEEE. Stored as little-endian.\n" ++ - "DOUBLE - 8 bytes per value. IEEE. Stored as little-endian.\n" ++ - "BYTE_ARRAY - 4 byte length stored as little endian, followed by bytes.\n" ++ - "FIXED_LEN_BYTE_ARRAY - Just the bytes.") $ - unit, --- --- /** Group VarInt encoding for INT32/INT64. --- * This encoding is deprecated. It was never used --- */ --- // GROUP_VAR_INT = 1; --- --- /** --- * Deprecated: Dictionary encoding. The values in the dictionary are encoded in the --- * plain type. --- * in a data page use RLE_DICTIONARY instead. --- * in a Dictionary page use PLAIN instead --- */ --- PLAIN_DICTIONARY = 2; --- --- /** Group packed run length encoding. Usable for definition/repetition levels --- * encoding and Booleans (on one bit: 0 is false; 1 is true.) --- */ --- RLE = 3; - "rle">: - doc ("Group packed run length encoding. Usable for definition/repetition levels " ++ - "encoding and Booleans (on one bit: 0 is false; 1 is true.)") unit, --- --- /** Bit packed encoding. This can only be used if the data has a known max --- * width. Usable for definition/repetition levels encoding. --- */ --- BIT_PACKED = 4; - "bitPacked">: - doc ("Bit packed encoding. This can only be used if the data has a known max " ++ - "width. Usable for definition/repetition levels encoding.") unit, --- --- /** Delta encoding for integers. This can be used for int columns and works best --- * on sorted data --- */ --- DELTA_BINARY_PACKED = 5; - "deltaBinaryPacked">: - doc ("Delta encoding for integers. This can be used for int columns and works best " ++ - "on sorted data") unit, --- --- /** Encoding for byte arrays to separate the length values and the data. The lengths --- * are encoded using DELTA_BINARY_PACKED --- */ --- DELTA_LENGTH_BYTE_ARRAY = 6; - "deltaLengthByteArray">: - doc ("Encoding for byte arrays to separate the length values and the data. The lengths " ++ - "are encoded using DELTA_BINARY_PACKED") unit, --- --- /** Incremental-encoded byte array. Prefix lengths are encoded using DELTA_BINARY_PACKED. --- * Suffixes are stored as delta length byte arrays. --- */ --- DELTA_BYTE_ARRAY = 7; - "deltaByteArray">: - doc ("Incremental-encoded byte array. Prefix lengths are encoded using DELTA_BINARY_PACKED. " ++ - "Suffixes are stored as delta length byte arrays.") unit, --- --- /** Dictionary encoding: the ids are encoded using the RLE encoding --- */ --- RLE_DICTIONARY = 8; - "rleDictionary">: - doc ("Dictionary encoding: the ids are encoded using the RLE encoding") unit, --- --- /** Encoding for floating-point data. --- K byte-streams are created where K is the size in bytes of the data type. --- The individual bytes of an FP value are scattered to the corresponding stream and --- the streams are concatenated. --- This itself does not reduce the size of the data but can lead to better compression --- afterwards. --- */ --- BYTE_STREAM_SPLIT = 9; - "byteStreamSplit">: - doc ("Encoding for floating-point data. " ++ - "K byte-streams are created where K is the size in bytes of the data type. " ++ - "The individual bytes of an FP value are scattered to the corresponding stream and " ++ - "the streams are concatenated. " ++ - "This itself does not reduce the size of the data but can lead to better compression " ++ - "afterwards.") unit], --- } - --- /** --- * Supported compression algorithms. --- * --- * Codecs added in format version X.Y can be read by readers based on X.Y and later. --- * Codec support may vary between readers based on the format version and --- * libraries available at runtime. --- * --- * See Compression.md for a detailed specification of these algorithms. --- */ --- enum CompressionCodec { - def "CompressionCodec" $ - doc ("Supported compression algorithms. " ++ - "Codecs added in format version X.Y can be read by readers based on X.Y and later. " ++ - "Codec support may vary between readers based on the format version and " ++ - "libraries available at runtime. " ++ - "See Compression.md for a detailed specification of these algorithms.") $ - union [ --- UNCOMPRESSED = 0; - "uncompressed">: unit, --- SNAPPY = 1; - "snappy">: unit, --- GZIP = 2; - "gzip">: unit, --- LZO = 3; - "lzo">: unit, --- BROTLI = 4; // Added in 2.4 - "brotli">: - doc "Added in 2.4" unit, --- LZ4 = 5; // DEPRECATED (Added in 2.4) --- ZSTD = 6; // Added in 2.4 - "zstd">: - doc "Added in 2.4" unit, --- LZ4_RAW = 7; // Added in 2.9 - "lz4Raw">: - doc "Added in 2.9" unit], --- } - --- enum PageType { - def "PageType" $ - enum [ --- DATA_PAGE = 0; - "dataPage", --- INDEX_PAGE = 1; - "indexPage", --- DICTIONARY_PAGE = 2; - "dictionaryPage", --- DATA_PAGE_V2 = 3; - "dataPageV2"], --- } - --- /** --- * Enum to annotate whether lists of min/max elements inside ColumnIndex --- * are ordered and if so, in which direction. --- */ --- enum BoundaryOrder { - def "BoundaryOrder" $ - doc ("Enum to annotate whether lists of min/max elements inside ColumnIndex " ++ - "are ordered and if so, in which direction.") $ - enum [ --- UNORDERED = 0; - "unordered", --- ASCENDING = 1; - "ascending", --- DESCENDING = 2; - "descending"], --- } - --- /** Data page header */ --- struct DataPageHeader { - def "DataPageHeader" $ - doc "Data page header" $ - record [ --- /** Number of values, including NULLs, in this data page. **/ --- 1: required i32 num_values - "numValues">: - doc "Number of values, including NULLs, in this data page." - int32, --- --- /** Encoding used for this data page **/ --- 2: required Encoding encoding - "encoding">: - doc "Encoding used for this data page" $ - parquet "Encoding", --- --- /** Encoding used for definition levels **/ --- 3: required Encoding definition_level_encoding; - "definitionLevelEncoding">: - doc "Encoding used for definition levels" $ - parquet "Encoding", --- --- /** Encoding used for repetition levels **/ --- 4: required Encoding repetition_level_encoding; - "repetitionLevelEncoding">: - doc "Encoding used for repetition levels" $ - parquet "Encoding", --- --- /** Optional statistics for the data in this page**/ --- 5: optional Statistics statistics; - "statistics">: - doc "Optional statistics for the data in this page" $ - optional $ parquet "Statistics"], --- } --- --- struct IndexPageHeader { - def "IndexPageHeader" $ record [], --- // TODO --- } - --- /** --- * The dictionary page must be placed at the first position of the column chunk --- * if it is partly or completely dictionary encoded. At most one dictionary page --- * can be placed in a column chunk. --- **/ --- struct DictionaryPageHeader { - def "DictionaryPageHeader" $ - doc ("The dictionary page must be placed at the first position of the column chunk " ++ - "if it is partly or completely dictionary encoded. At most one dictionary page " ++ - "can be placed in a column chunk.") $ - record [ --- /** Number of values in the dictionary **/ --- 1: required i32 num_values; - "numValues">: - doc "Number of values in the dictionary" $ - int32, --- --- /** Encoding using this dictionary page **/ --- 2: required Encoding encoding - "encoding">: - doc "Encoding using this dictionary page" $ - parquet "Encoding", --- --- /** If true, the entries in the dictionary are sorted in ascending order **/ --- 3: optional bool is_sorted; - "isSorted">: - doc "If true, the entries in the dictionary are sorted in ascending order" $ - optional boolean], --- } - --- /** --- * New page format allowing reading levels without decompressing the data --- * Repetition and definition levels are uncompressed --- * The remaining section containing the data is compressed if is_compressed is true --- **/ --- struct DataPageHeaderV2 { - def "DataPageHeaderV2" $ - doc ("New page format allowing reading levels without decompressing the data " ++ - "Repetition and definition levels are uncompressed " ++ - "The remaining section containing the data is compressed if is_compressed is true") $ - record [ --- /** Number of values, including NULLs, in this data page. **/ --- 1: required i32 num_values - "numValues">: - doc "Number of values, including NULLs, in this data page." $ - int32, --- /** Number of NULL values, in this data page. --- Number of non-null = num_values - num_nulls which is also the number of values in the data section **/ --- 2: required i32 num_nulls - "numNulls">: - doc ("Number of NULL values, in this data page. " ++ - "Number of non-null = num_values - num_nulls which is also the number of values in the data section") $ - int32, --- /** Number of rows in this data page. which means pages change on record boundaries (r = 0) **/ --- 3: required i32 num_rows - "numRows">: - doc "Number of rows in this data page. which means pages change on record boundaries (r = 0)" $ - int32, --- /** Encoding used for data in this page **/ --- 4: required Encoding encoding - "encoding">: - doc "Encoding used for data in this page" $ - parquet "Encoding", --- --- // repetition levels and definition levels are always using RLE (without size in it) --- --- /** length of the definition levels */ --- 5: required i32 definition_levels_byte_length; - "definitionLevelsByteLength">: - doc "length of the definition levels" $ - int32, --- /** length of the repetition levels */ --- 6: required i32 repetition_levels_byte_length; - "repetitionLevelsByteLength">: - doc "length of the repetition levels" $ - int32, --- --- /** whether the values are compressed. --- Which means the section of the page between --- definition_levels_byte_length + repetition_levels_byte_length + 1 and compressed_page_size (included) --- is compressed with the compression_codec. --- If missing it is considered compressed */ --- 7: optional bool is_compressed = 1; - "isCompressed">: - doc ("whether the values are compressed. " ++ - "Which means the section of the page between " ++ - "definition_levels_byte_length + repetition_levels_byte_length + 1 and compressed_page_size (included) " ++ - "is compressed with the compression_codec. " ++ - "If missing it is considered compressed") $ - optional boolean, --- --- /** optional statistics for the data in this page **/ --- 8: optional Statistics statistics; - "statistics">: - doc "optional statistics for the data in this page" $ - optional $ parquet "Statistics"], --- } - --- /** Block-based algorithm type annotation. **/ --- struct SplitBlockAlgorithm {} --- /** The algorithm used in Bloom filter. **/ --- union BloomFilterAlgorithm { - def "BloomFilterAlgorithm" $ - doc "The algorithm used in Bloom filter." $ - union [ --- /** Block-based Bloom filter. **/ --- 1: SplitBlockAlgorithm BLOCK; - "block">: - doc "Block-based Bloom filter." unit], --- } - --- /** Hash strategy type annotation. xxHash is an extremely fast non-cryptographic hash --- * algorithm. It uses 64 bits version of xxHash. --- **/ --- struct XxHash {} --- --- /** --- * The hash function used in Bloom filter. This function takes the hash of a column value --- * using plain encoding. --- **/ --- union BloomFilterHash { - def "BloomFilterHash" $ - doc ("The hash function used in Bloom filter. This function takes the hash of a column value " ++ - "using plain encoding.") $ - union [ --- /** xxHash Strategy. **/ --- 1: XxHash XXHASH; - "xxhash">: - doc "xxHash Strategy." unit], --- } - --- /** --- * The compression used in the Bloom filter. --- **/ --- struct Uncompressed {} --- union BloomFilterCompression { - def "BloomFilterCompression" $ - doc "The compression used in the Bloom filter." $ - enum [ --- 1: Uncompressed UNCOMPRESSED; - "uncompressed"], --- } - --- /** --- * Bloom filter header is stored at beginning of Bloom filter data of each column --- * and followed by its bitset. --- **/ --- struct BloomFilterHeader { - def "BloomFilterHeader" $ - doc ("Bloom filter header is stored at beginning of Bloom filter data of each column " ++ - "and followed by its bitset.") $ - record [ --- /** The size of bitset in bytes **/ --- 1: required i32 numBytes; - "numBytes">: - doc "The size of bitset in bytes" $ - int32, --- /** The algorithm for setting bits. **/ --- 2: required BloomFilterAlgorithm algorithm; - "algorithm">: - doc "The algorithm for setting bits." $ - parquet "BloomFilterAlgorithm", --- /** The hash function used for Bloom filter. **/ --- 3: required BloomFilterHash hash; - "hash">: - doc "The hash function used for Bloom filter." $ - parquet "BloomFilterHash", --- /** The compression used in the Bloom filter **/ --- 4: required BloomFilterCompression compression; - "compression">: - doc "The compression used in the Bloom filter" $ - parquet "BloomFilterCompression"], --- } - --- struct PageHeader { - def "PageHeader" $ - record [ --- /** the type of the page: indicates which of the *_header fields is set **/ --- 1: required PageType type - "type">: - doc "the type of the page: indicates which of the *_header fields is set" $ - parquet "PageType", --- --- /** Uncompressed page size in bytes (not including this header) **/ --- 2: required i32 uncompressed_page_size - "uncompressedPageSize">: - doc "Uncompressed page size in bytes (not including this header)" $ - int32, --- --- /** Compressed (and potentially encrypted) page size in bytes, not including this header **/ --- 3: required i32 compressed_page_size - "compressedPageSize">: - doc "Compressed (and potentially encrypted) page size in bytes, not including this header" $ - int32, --- --- /** The 32bit CRC for the page, to be be calculated as follows: --- * - Using the standard CRC32 algorithm --- * - On the data only, i.e. this header should not be included. 'Data' --- * hereby refers to the concatenation of the repetition levels, the --- * definition levels and the column value, in this exact order. --- * - On the encoded versions of the repetition levels, definition levels and --- * column values --- * - On the compressed versions of the repetition levels, definition levels --- * and column values where possible; --- * - For v1 data pages, the repetition levels, definition levels and column --- * values are always compressed together. If a compression scheme is --- * specified, the CRC shall be calculated on the compressed version of --- * this concatenation. If no compression scheme is specified, the CRC --- * shall be calculated on the uncompressed version of this concatenation. --- * - For v2 data pages, the repetition levels and definition levels are --- * handled separately from the data and are never compressed (only --- * encoded). If a compression scheme is specified, the CRC shall be --- * calculated on the concatenation of the uncompressed repetition levels, --- * uncompressed definition levels and the compressed column values. --- * If no compression scheme is specified, the CRC shall be calculated on --- * the uncompressed concatenation. --- * - In encrypted columns, CRC is calculated after page encryption; the --- * encryption itself is performed after page compression (if compressed) --- * If enabled, this allows for disabling checksumming in HDFS if only a few --- * pages need to be read. --- **/ --- 4: optional i32 crc - "crc">: - doc ("The 32bit CRC for the page, to be be calculated as follows:\n" ++ - "- Using the standard CRC32 algorithm\n" ++ - "- On the data only, i.e. this header should not be included. 'Data'\n" ++ - " hereby refers to the concatenation of the repetition levels, the\n" ++ - " definition levels and the column value, in this exact order.\n" ++ - "- On the encoded versions of the repetition levels, definition levels and\n" ++ - " column values\n" ++ - "- On the compressed versions of the repetition levels, definition levels\n" ++ - " and column values where possible;\n" ++ - " - For v1 data pages, the repetition levels, definition levels and column\n" ++ - " values are always compressed together. If a compression scheme is\n" ++ - " specified, the CRC shall be calculated on the compressed version of\n" ++ - " this concatenation. If no compression scheme is specified, the CRC\n" ++ - " shall be calculated on the uncompressed version of this concatenation.\n" ++ - " - For v2 data pages, the repetition levels and definition levels are\n" ++ - " handled separately from the data and are never compressed (only\n" ++ - " encoded). If a compression scheme is specified, the CRC shall be\n" ++ - " calculated on the concatenation of the uncompressed repetition levels,\n" ++ - " uncompressed definition levels and the compressed column values.\n" ++ - " If no compression scheme is specified, the CRC shall be calculated on\n" ++ - " the uncompressed concatenation.\n" ++ - "- In encrypted columns, CRC is calculated after page encryption; the\n" ++ - " encryption itself is performed after page compression (if compressed)\n" ++ - "If enabled, this allows for disabling checksumming in HDFS if only a few " ++ - "pages need to be read. ") $ - optional int32, --- --- // Headers for page specific data. One only will be set. --- 5: optional DataPageHeader data_page_header; - "dataPageHeader">: - optional $ parquet "DataPageHeader", --- 6: optional IndexPageHeader index_page_header; - "indexPageHeader">: - optional $ parquet "IndexPageHeader", --- 7: optional DictionaryPageHeader dictionary_page_header; - "dictionaryPageHeader">: - optional $ parquet "DictionaryPageHeader", --- 8: optional DataPageHeaderV2 data_page_header_v2; - "dataPageHeaderV2">: - optional $ parquet "DataPageHeaderV2"], --- } - --- /** --- * Wrapper struct to store key values --- */ --- struct KeyValue { - def "KeyValue" $ - doc "Wrapper struct to store key values" $ - record [ --- 1: required string key - "key">: string, --- 2: optional string value - "value">: optional string], --- } - --- /** --- * Wrapper struct to specify sort order --- */ --- struct SortingColumn { - def "SortingColumn" $ - doc "Wrapper struct to specify sort order" $ - record [ --- /** The column index (in this row group) **/ --- 1: required i32 column_idx - "columnIdx">: - doc "The column index (in this row group)" - int32, --- --- /** If true, indicates this column is sorted in descending order. **/ --- 2: required bool descending - "descending">: - doc "If true, indicates this column is sorted in descending order." - boolean, --- --- /** If true, nulls will come before non-null values, otherwise, --- * nulls go at the end. */ --- 3: required bool nulls_first - "nullsFirst">: - doc ("If true, nulls will come before non-null values, otherwise, " ++ - "nulls go at the end.") - boolean], --- } - --- /** --- * statistics of a given page type and encoding --- */ --- struct PageEncodingStats { - def "PageEncodingStats" $ - doc "statistics of a given page type and encoding" $ - record [ --- --- /** the page type (data/dic/...) **/ --- 1: required PageType page_type; - "pageType">: - doc "the page type (data/dic/...)" $ - parquet "PageType", --- --- /** encoding of the page **/ --- 2: required Encoding encoding; - "encoding">: - doc "encoding of the page" $ - parquet "Encoding", --- --- /** number of pages of this type with this encoding **/ --- 3: required i32 count; - "count">: - doc "number of pages of this type with this encoding" - int32], --- --- } - --- /** --- * Description for column metadata --- */ --- struct ColumnMetaData { - def "ColumnMetaData" $ - doc "Description for column metadata" $ - record [ --- /** Type of this column **/ --- 1: required Type type - "type">: - doc "Type of this column" $ - parquet "Type", --- --- /** Set of all encodings used for this column. The purpose is to validate --- * whether we can decode those pages. **/ --- 2: required list encodings - "encodings">: - doc ("Set of all encodings used for this column. The purpose is to validate " ++ - "whether we can decode those pages.") $ - list $ parquet "Encoding", --- --- /** Path in schema **/ --- 3: required list path_in_schema - "pathInSchema">: - doc "Path in schema" $ - list string, --- --- /** Compression codec **/ --- 4: required CompressionCodec codec - "codec">: - doc "Compression codec" $ - parquet "CompressionCodec", --- --- /** Number of values in this column **/ --- 5: required i64 num_values - "numValues">: - doc "Number of values in this column" - int64, --- --- /** total byte size of all uncompressed pages in this column chunk (including the headers) **/ --- 6: required i64 total_uncompressed_size - "totalUncompressedSize">: - doc "total byte size of all uncompressed pages in this column chunk (including the headers)" - int64, --- --- /** total byte size of all compressed, and potentially encrypted, pages --- * in this column chunk (including the headers) **/ --- 7: required i64 total_compressed_size - "totalCompressedSize">: - doc ("total byte size of all compressed, and potentially encrypted, pages " ++ - "in this column chunk (including the headers)") - int64, --- --- /** Optional key/value metadata **/ --- 8: optional list key_value_metadata - "keyValueMetadata">: - doc "Optional key/value metadata" $ - optional $ list $ parquet "KeyValue", --- --- /** Byte offset from beginning of file to first data page **/ --- 9: required i64 data_page_offset - "dataPageOffset">: - doc "Byte offset from beginning of file to first data page" - int64, --- --- /** Byte offset from beginning of file to root index page **/ --- 10: optional i64 index_page_offset - "indexPageOffset">: - doc "Byte offset from beginning of file to root index page" $ - optional int64, --- --- /** Byte offset from the beginning of file to first (only) dictionary page **/ --- 11: optional i64 dictionary_page_offset - "dictionaryPageOffset">: - doc "Byte offset from the beginning of file to first (only) dictionary page" $ - optional int64, --- --- /** optional statistics for this column chunk */ --- 12: optional Statistics statistics; - "statistics">: - doc "optional statistics for this column chunk" $ - optional $ parquet "Statistics", --- --- /** Set of all encodings used for pages in this column chunk. --- * This information can be used to determine if all data pages are --- * dictionary encoded for example **/ --- 13: optional list encoding_stats; - "encodingStats">: - doc ("Set of all encodings used for pages in this column chunk. " ++ - "This information can be used to determine if all data pages are " ++ - "dictionary encoded for example") $ - optional $ list $ parquet "PageEncodingStats", --- --- /** Byte offset from beginning of file to Bloom filter data. **/ --- 14: optional i64 bloom_filter_offset; - "bloomFilterOffset">: - doc "Byte offset from beginning of file to Bloom filter data." $ - optional int64], --- } --- --- struct EncryptionWithFooterKey { - def "EncryptionWithFooterKey" $ record [], --- } --- --- struct EncryptionWithColumnKey { - def "EncryptionWithColumnKey" $ - record [ --- /** Column path in schema **/ --- 1: required list path_in_schema - "pathInSchema">: - doc "Column path in schema" $ - list string, --- --- /** Retrieval metadata of column encryption key **/ --- 2: optional binary key_metadata - "keyMetadata">: - doc "Retrieval metadata of column encryption key" $ - optional binary], --- } --- --- union ColumnCryptoMetaData { - def "ColumnCryptoMetaData" $ - union [ --- 1: EncryptionWithFooterKey ENCRYPTION_WITH_FOOTER_KEY - "encryptionWithFooterKey">: parquet "EncryptionWithFooterKey", --- 2: EncryptionWithColumnKey ENCRYPTION_WITH_COLUMN_KEY - "encryptionWithColumnKey">: parquet "EncryptionWithColumnKey"], --- } - --- struct ColumnChunk { - def "ColumnChunk" $ - record [ --- /** File where column data is stored. If not set, assumed to be same file as --- * metadata. This path is relative to the current file. --- **/ --- 1: optional string file_path - "filePath">: - doc ("File where column data is stored. If not set, assumed to be same file as " ++ - "metadata. This path is relative to the current file.") $ - optional string, --- --- /** Byte offset in file_path to the ColumnMetaData **/ --- 2: required i64 file_offset - "fileOffset">: - doc "Byte offset in file_path to the ColumnMetaData" - int64, --- --- /** Column metadata for this chunk. This is the same content as what is at --- * file_path/file_offset. Having it here has it replicated in the file --- * metadata. --- **/ --- 3: optional ColumnMetaData meta_data - "metaData">: - doc ("Column metadata for this chunk. This is the same content as what is at " ++ - "file_path/file_offset. Having it here has it replicated in the file " ++ - "metadata.") $ - optional $ parquet "ColumnMetaData", --- --- /** File offset of ColumnChunk's OffsetIndex **/ --- 4: optional i64 offset_index_offset - "offsetIndexOffset">: - doc "File offset of ColumnChunk's OffsetIndex" $ - optional int64, --- --- /** Size of ColumnChunk's OffsetIndex, in bytes **/ --- 5: optional i32 offset_index_length - "offsetIndexLength">: - doc "Size of ColumnChunk's OffsetIndex, in bytes" $ - optional int32, --- --- /** File offset of ColumnChunk's ColumnIndex **/ --- 6: optional i64 column_index_offset - "columnIndexOffset">: - doc "File offset of ColumnChunk's ColumnIndex" $ - optional int64, --- --- /** Size of ColumnChunk's ColumnIndex, in bytes **/ --- 7: optional i32 column_index_length - "columnIndexLength">: - doc "Size of ColumnChunk's ColumnIndex, in bytes" $ - optional int32, --- --- /** Crypto metadata of encrypted columns **/ --- 8: optional ColumnCryptoMetaData crypto_metadata - "cryptoMetadata">: - doc "Crypto metadata of encrypted columns" $ - optional $ parquet "ColumnCryptoMetaData", --- --- /** Encrypted column metadata for this chunk **/ --- 9: optional binary encrypted_column_metadata - "encryptedColumnMetadata">: - doc "Encrypted column metadata for this chunk" $ - optional binary], --- } - --- struct RowGroup { - def "RowGroup" $ - record [ --- /** Kvdata for each column chunk in this row group. --- * This list must have the same order as the SchemaElement list in FileMetaData. --- **/ --- 1: required list columns - "columns">: - doc ("Metadata for each column chunk in this row group. " ++ - "This list must have the same order as the SchemaElement list in FileMetaData.") $ - list $ parquet "ColumnChunk", --- --- /** Total byte size of all the uncompressed column data in this row group **/ --- 2: required i64 total_byte_size - "totalByteSize">: - doc "Total byte size of all the uncompressed column data in this row group" - int64, --- --- /** Number of rows in this row group **/ --- 3: required i64 num_rows - "numRows">: - doc "Number of rows in this row group" - int64, --- --- /** If set, specifies a sort ordering of the rows in this RowGroup. --- * The sorting columns can be a subset of all the columns. --- */ --- 4: optional list sorting_columns - "sortingColumns">: - doc ("If set, specifies a sort ordering of the rows in this RowGroup. " ++ - "The sorting columns can be a subset of all the columns.") $ - optional $ list $ parquet "SortingColumn", --- --- /** Byte offset from beginning of file to first page (data or dictionary) --- * in this row group **/ --- 5: optional i64 file_offset - "fileOffset">: - doc ("Byte offset from beginning of file to first page (data or dictionary) " ++ - "in this row group") $ - optional int64, --- --- /** Total byte size of all compressed (and potentially encrypted) column data --- * in this row group **/ --- 6: optional i64 total_compressed_size - "totalCompressedSize">: - doc ("Total byte size of all compressed (and potentially encrypted) column data " ++ - "in this row group") $ - optional int64, --- --- /** Row group ordinal in the file **/ --- 7: optional i16 ordinal - "ordinal">: - doc "Row group ordinal in the file" $ - optional int16], --- } --- --- /** Empty struct to signal the order defined by the physical or logical type */ --- struct TypeDefinedOrder {} --- --- /** --- * Union to specify the order used for the min_value and max_value fields for a --- * column. This union takes the role of an enhanced enum that allows rich --- * elements (which will be needed for a collation-based ordering in the future). --- * --- * Possible values are: --- * * TypeDefinedOrder - the column uses the order defined by its logical or --- * physical type (if there is no logical type). --- * --- * If the reader does not support the value of this union, min and max stats --- * for this column should be ignored. --- */ --- union ColumnOrder { - def "ColumnOrder" $ - doc ("Union to specify the order used for the min_value and max_value fields for a " ++ - "column. This union takes the role of an enhanced enum that allows rich " ++ - "elements (which will be needed for a collation-based ordering in the future). " ++ - "Possible values are:\n" ++ - "* TypeDefinedOrder - the column uses the order defined by its logical or " ++ - "physical type (if there is no logical type).\n" ++ - "If the reader does not support the value of this union, min and max stats " ++ - "for this column should be ignored. ") $ - union [ --- --- /** --- * The sort orders for logical types are: --- * UTF8 - unsigned byte-wise comparison --- * INT8 - signed comparison --- * INT16 - signed comparison --- * INT32 - signed comparison --- * INT64 - signed comparison --- * UINT8 - unsigned comparison --- * UINT16 - unsigned comparison --- * UINT32 - unsigned comparison --- * UINT64 - unsigned comparison --- * DECIMAL - signed comparison of the represented value --- * DATE - signed comparison --- * TIME_MILLIS - signed comparison --- * TIME_MICROS - signed comparison --- * TIMESTAMP_MILLIS - signed comparison --- * TIMESTAMP_MICROS - signed comparison --- * INTERVAL - unsigned comparison --- * JSON - unsigned byte-wise comparison --- * BSON - unsigned byte-wise comparison --- * ENUM - unsigned byte-wise comparison --- * LIST - undefined --- * MAP - undefined --- * --- * In the absence of logical types, the sort order is determined by the physical type: --- * BOOLEAN - false, true --- * INT32 - signed comparison --- * INT64 - signed comparison --- * INT96 (only used for legacy timestamps) - undefined --- * FLOAT - signed comparison of the represented value (*) --- * DOUBLE - signed comparison of the represented value (*) --- * BYTE_ARRAY - unsigned byte-wise comparison --- * FIXED_LEN_BYTE_ARRAY - unsigned byte-wise comparison --- * --- * (*) Because the sorting order is not specified properly for floating --- * point values (relations vs. total ordering) the following --- * compatibility rules should be applied when reading statistics: --- * - If the min is a NaN, it should be ignored. --- * - If the max is a NaN, it should be ignored. --- * - If the min is +0, the row group may contain -0 values as well. --- * - If the max is -0, the row group may contain +0 values as well. --- * - When looking for NaN values, min and max should be ignored. --- */ --- 1: TypeDefinedOrder TYPE_ORDER; - "typeOrder">: - doc ("The sort orders for logical types are:\n" ++ - " UTF8 - unsigned byte-wise comparison\n" ++ - " INT8 - signed comparison\n" ++ - " INT16 - signed comparison\n" ++ - " INT32 - signed comparison\n" ++ - " INT64 - signed comparison\n" ++ - " UINT8 - unsigned comparison\n" ++ - " UINT16 - unsigned comparison\n" ++ - " UINT32 - unsigned comparison\n" ++ - " UINT64 - unsigned comparison\n" ++ - " DECIMAL - signed comparison of the represented value\n" ++ - " DATE - signed comparison\n" ++ - " TIME_MILLIS - signed comparison\n" ++ - " TIME_MICROS - signed comparison\n" ++ - " TIMESTAMP_MILLIS - signed comparison\n" ++ - " TIMESTAMP_MICROS - signed comparison\n" ++ - " INTERVAL - unsigned comparison\n" ++ - " JSON - unsigned byte-wise comparison\n" ++ - " BSON - unsigned byte-wise comparison\n" ++ - " ENUM - unsigned byte-wise comparison\n" ++ - " LIST - undefined\n" ++ - " MAP - undefined\n" ++ - "In the absence of logical types, the sort order is determined by the physical type:\n" ++ - " BOOLEAN - false, true\n" ++ - " INT32 - signed comparison\n" ++ - " INT64 - signed comparison\n" ++ - " INT96 (only used for legacy timestamps) - undefined\n" ++ - " FLOAT - signed comparison of the represented value (*)\n" ++ - " DOUBLE - signed comparison of the represented value (*)\n" ++ - " BYTE_ARRAY - unsigned byte-wise comparison\n" ++ - " FIXED_LEN_BYTE_ARRAY - unsigned byte-wise comparison\n" ++ - "(*) Because the sorting order is not specified properly for floating\n" ++ - " point values (relations vs. total ordering) the following\n" ++ - " compatibility rules should be applied when reading statistics:\n" ++ - " - If the min is a NaN, it should be ignored.\n" ++ - " - If the max is a NaN, it should be ignored.\n" ++ - " - If the min is +0, the row group may contain -0 values as well.\n" ++ - " - If the max is -0, the row group may contain +0 values as well.\n" ++ - " - When looking for NaN values, min and max should be ignored.") unit], --- } - --- struct PageLocation { - def "PageLocation" $ - record [ --- /** Offset of the page in the file **/ --- 1: required i64 offset - "offset">: - doc "Offset of the page in the file" - int64, --- --- /** --- * Size of the page, including header. Sum of compressed_page_size and header --- * length --- */ --- 2: required i32 compressed_page_size - "compressedPageSize">: - doc ("Size of the page, including header. Sum of compressed_page_size and header " ++ - "length") - int32, --- --- /** --- * Index within the RowGroup of the first row of the page; this means pages --- * change on record boundaries (r = 0). --- */ --- 3: required i64 first_row_index - "firstRowIndex">: - doc ("Index within the RowGroup of the first row of the page; this means pages " ++ - "change on record boundaries (r = 0).") - int64], --- } --- --- struct OffsetIndex { - def "OffsetIndex" $ - record [ --- /** --- * PageLocations, ordered by increasing PageLocation.offset. It is required --- * that page_locations[i].first_row_index < page_locations[i+1].first_row_index. --- */ --- 1: required list page_locations - "pageLocations">: - doc ("PageLocations, ordered by increasing PageLocation.offset. It is required " ++ - "that page_locations[i].first_row_index < page_locations[i+1].first_row_index.") $ - list $ parquet "PageLocation"], --- } --- --- /** --- * Description for ColumnIndex. --- * Each [i] refers to the page at OffsetIndex.page_locations[i] --- */ --- struct ColumnIndex { - def "ColumnIndex" $ - doc ("Description for ColumnIndex. " ++ - "Each [i] refers to the page at OffsetIndex.page_locations[i]") $ - record [ --- /** --- * A list of Boolean values to determine the validity of the corresponding --- * min and max values. If true, a page contains only null values, and writers --- * have to set the corresponding entries in min_values and max_values to --- * byte[0], so that all lists have the same length. If false, the --- * corresponding entries in min_values and max_values must be valid. --- */ --- 1: required list null_pages - "nullPages">: - doc ("A list of Boolean values to determine the validity of the corresponding " ++ - "min and max values. If true, a page contains only null values, and writers " ++ - "have to set the corresponding entries in min_values and max_values to " ++ - "byte[0], so that all lists have the same length. If false, the " ++ - "corresponding entries in min_values and max_values must be valid.") $ - list boolean, --- --- /** --- * Two lists containing lower and upper bounds for the values of each page --- * determined by the ColumnOrder of the column. These may be the actual --- * minimum and maximum values found on a page, but can also be (more compact) --- * values that do not exist on a page. For example, instead of storing ""Blart --- * Versenwald III", a writer may set min_values[i]="B", max_values[i]="C". --- * Such more compact values must still be valid values within the column's --- * logical type. Readers must make sure that list entries are populated before --- * using them by inspecting null_pages. --- */ --- 2: required list min_values - "minValues">: - doc ("minValues and maxValues are lists containing lower and upper bounds for the values of each page " ++ - "determined by the ColumnOrder of the column. These may be the actual " ++ - "minimum and maximum values found on a page, but can also be (more compact) " ++ - "values that do not exist on a page. For example, instead of storing \"Blart " ++ - "Versenwald III\", a writer may set min_values[i]=\"B\", max_values[i]=\"C\". " ++ - "Such more compact values must still be valid values within the column's " ++ - "logical type. Readers must make sure that list entries are populated before " ++ - "using them by inspecting null_pages.") $ - list binary, --- 3: required list max_values - "maxValues">: list binary, --- --- /** --- * Stores whether both min_values and max_values are orderd and if so, in --- * which direction. This allows readers to perform binary searches in both --- * lists. Readers cannot assume that max_values[i] <= min_values[i+1], even --- * if the lists are ordered. --- */ --- 4: required BoundaryOrder boundary_order - "boundaryOrder">: - doc ("Stores whether both min_values and max_values are orderd and if so, in " ++ - "which direction. This allows readers to perform binary searches in both " ++ - "lists. Readers cannot assume that max_values[i] <= min_values[i+1], even " ++ - "if the lists are ordered.") $ - parquet "BoundaryOrder", --- --- /** A list containing the number of null values for each page **/ --- 5: optional list null_counts - "nullCounts">: - doc "A list containing the number of null values for each page" $ - optional $ list int64], --- } - --- struct AesGcmV1 { - def "AesGcmV1" $ - record [ --- /** AAD prefix **/ --- 1: optional binary aad_prefix - "aadPrefix">: - doc "AAD prefix" $ - optional binary, --- --- /** Unique file identifier part of AAD suffix **/ --- 2: optional binary aad_file_unique - "aadFileUnique">: - doc "Unique file identifier part of AAD suffix" $ - optional binary, --- --- /** In files encrypted with AAD prefix without storing it, --- * readers must supply the prefix **/ --- 3: optional bool supply_aad_prefix - "supplyAadPrefix">: - doc ("In files encrypted with AAD prefix without storing it, " ++ - "readers must supply the prefix") $ - optional boolean], --- } - --- struct AesGcmCtrV1 { - def "AesGcmCtrV1" $ - record [ --- /** AAD prefix **/ --- 1: optional binary aad_prefix - "aadPrefix">: - doc "AAD prefix" $ - optional binary, --- --- /** Unique file identifier part of AAD suffix **/ --- 2: optional binary aad_file_unique - "aadFileUnique">: - doc "Unique file identifier part of AAD suffix" $ - optional binary, --- --- /** In files encrypted with AAD prefix without storing it, --- * readers must supply the prefix **/ --- 3: optional bool supply_aad_prefix - "supplyAadPrefix">: - doc ("In files encrypted with AAD prefix without storing it, " ++ - "readers must supply the prefix") $ - optional boolean], --- } - --- union EncryptionAlgorithm { - def "EncryptionAlgorithm" $ - union [ --- 1: AesGcmV1 AES_GCM_V1 - "aesGcmV1">: parquet "AesGcmV1", --- 2: AesGcmCtrV1 AES_GCM_CTR_V1 - "aesGcmCtrV1">: parquet "AesGcmCtrV1"], --- } - --- /** --- * Description for file metadata --- */ --- struct FileMetaData { - def "FileMetaData" $ - doc "Description for file metadata" $ - record [ --- /** Version of this file **/ --- 1: required i32 version - "version">: - doc "Version of this file" - int32, --- --- /** Parquet schema for this file. This schema contains metadata for all the columns. --- * The schema is represented as a tree with a single root. The nodes of the tree --- * are flattened to a list by doing a depth-first traversal. --- * The column metadata contains the path in the schema for that column which can be --- * used to map columns to nodes in the schema. --- * The first element is the root **/ --- 2: required list schema; - "schema">: - doc ("Parquet schema for this file. This schema contains metadata for all the columns. " ++ - "The schema is represented as a tree with a single root. The nodes of the tree " ++ - "are flattened to a list by doing a depth-first traversal. " ++ - "The column metadata contains the path in the schema for that column which can be " ++ - "used to map columns to nodes in the schema. " ++ - "The first element is the root") $ - list $ parquet "SchemaElement", --- --- /** Number of rows in this file **/ --- 3: required i64 num_rows - "numRows">: - doc "Number of rows in this file" - int64, --- --- /** Row groups in this file **/ --- 4: required list row_groups - "rowGroups">: - doc "Row groups in this file" $ - list $ parquet "RowGroup", --- --- /** Optional key/value metadata **/ --- 5: optional list key_value_metadata - "keyValueMetadata">: - doc "Optional key/value metadata" $ - optional $ list $ parquet "KeyValue", --- --- /** String for application that wrote this file. This should be in the format --- * version (build ). --- * e.g. impala version 1.0 (build 6cf94d29b2b7115df4de2c06e2ab4326d721eb55) --- **/ --- 6: optional string created_by - "createdBy">: - doc ("String for application that wrote this file. This should be in the format " ++ - " version (build ). " ++ - "e.g. impala version 1.0 (build 6cf94d29b2b7115df4de2c06e2ab4326d721eb55)") $ - optional string, --- --- /** --- * Sort order used for the min_value and max_value fields in the Statistics --- * objects and the min_values and max_values fields in the ColumnIndex --- * objects of each column in this file. Sort orders are listed in the order --- * matching the columns in the schema. The indexes are not necessary the same --- * though, because only leaf nodes of the schema are represented in the list --- * of sort orders. --- * --- * Without column_orders, the meaning of the min_value and max_value fields --- * in the Statistics object and the ColumnIndex object is undefined. To ensure --- * well-defined behaviour, if these fields are written to a Parquet file, --- * column_orders must be written as well. --- * --- * The obsolete min and max fields in the Statistics object are always sorted --- * by signed comparison regardless of column_orders. --- */ --- 7: optional list column_orders; - "columnOrders">: - doc ("Sort order used for the min_value and max_value fields in the Statistics " ++ - "objects and the min_values and max_values fields in the ColumnIndex " ++ - "objects of each column in this file. Sort orders are listed in the order " ++ - "matching the columns in the schema. The indexes are not necessary the same " ++ - "though, because only leaf nodes of the schema are represented in the list " ++ - "of sort orders.\n" ++ - "Without column_orders, the meaning of the min_value and max_value fields " ++ - "in the Statistics object and the ColumnIndex object is undefined. To ensure " ++ - "well-defined behaviour, if these fields are written to a Parquet file, " ++ - "column_orders must be written as well.\n" ++ - "The obsolete min and max fields in the Statistics object are always sorted " ++ - "by signed comparison regardless of column_orders.") $ - optional $ list $ parquet "ColumnOrder", --- --- /** --- * Encryption algorithm. This field is set only in encrypted files --- * with plaintext footer. Files with encrypted footer store algorithm id --- * in FileCryptoMetaData structure. --- */ --- 8: optional EncryptionAlgorithm encryption_algorithm - "encryptionAlgorithm">: - doc ("Encryption algorithm. This field is set only in encrypted files " ++ - "with plaintext footer. Files with encrypted footer store algorithm id " ++ - "in FileCryptoMetaData structure.") $ - optional $ parquet "EncryptionAlgorithm", --- --- /** --- * Retrieval metadata of key used for signing the footer. --- * Used only in encrypted files with plaintext footer. --- */ --- 9: optional binary footer_signing_key_metadata - "footerSigningKeyMetadata">: - doc ("Retrieval metadata of key used for signing the footer. " ++ - "Used only in encrypted files with plaintext footer.") $ - optional binary], --- } - --- /** Crypto metadata for files with encrypted footer **/ --- struct FileCryptoMetaData { - def "FileCryptoMetaData" $ - doc "Crypto metadata for files with encrypted footer" $ - record [ --- /** --- * Encryption algorithm. This field is only used for files --- * with encrypted footer. Files with plaintext footer store algorithm id --- * inside footer (FileMetaData structure). --- */ --- 1: required EncryptionAlgorithm encryption_algorithm - "encryptionAlgorithm">: - doc ("Encryption algorithm. This field is only used for files " ++ - "with encrypted footer. Files with plaintext footer store algorithm id " ++ - "inside footer (FileMetaData structure).") $ - parquet "EncryptionAlgorithm", --- --- /** Retrieval metadata of key used for encryption of footer, --- * and (possibly) columns **/ --- 2: optional binary key_metadata - "keyMetadata">: - doc ("Retrieval metadata of key used for encryption of footer, " ++ - "and (possibly) columns") $ - optional binary]] --- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Pegasus/Pdl.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Pegasus/Pdl.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Pegasus/Pdl.hs +++ /dev/null @@ -1,128 +0,0 @@ -module Hydra.Sources.Tier4.Langs.Pegasus.Pdl where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -pegasusPdlModule :: Module -pegasusPdlModule = Module ns elements [jsonModelModule] tier0Modules $ - Just ("A model for PDL (Pegasus Data Language) schemas. Based on the specification at:\n" ++ - " https://linkedin.github.io/rest.li/pdl_schema") - where - ns = Namespace "hydra/langs/pegasus/pdl" - def = datatype ns - pdl = typeref ns - json = typeref $ moduleNamespace jsonModelModule - - elements = [ - - def "Annotations" $ - doc "Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas" $ - record [ - "doc">: optional string, - "deprecated">: boolean], - - def "EnumField" $ - record [ - "name">: pdl "EnumFieldName", - "annotations">: pdl "Annotations"], - - def "EnumFieldName" - string, - - def "EnumSchema" $ - record [ - "fields">: list $ pdl "EnumField"], - - def "FieldName" - string, - - def "NamedSchema" $ - record [ - "qualifiedName">: pdl "QualifiedName", - "type">: pdl "NamedSchema.Type", - "annotations">: pdl "Annotations"], - - def "NamedSchema.Type" $ - union [ - "record">: pdl "RecordSchema", - "enum">: pdl "EnumSchema", - "typeref">: pdl "Schema"], - - def "Name" - string, - - def "Namespace" - string, - - def "Package" - string, - - def "PrimitiveType" $ - enum [ - "boolean", - "bytes", - "double", - "float", - "int", - "long", - "string"], - - def "PropertyKey" - string, - - def "Property" $ - record [ - "key">: pdl "PropertyKey", - "value">: optional $ json "Value"], - - def "QualifiedName" $ - record [ - "name">: pdl "Name", - "namespace">: optional $ pdl "Namespace"], - - def "RecordField" $ - record [ - "name">: pdl "FieldName", - "value">: pdl "Schema", - "optional">: boolean, - -- Note: the default value for an enum-valued must be one of the enumerated string symbols - "default">: optional $ json "Value", - "annotations">: pdl "Annotations"], - - def "RecordSchema" $ - record [ - "fields">: list $ pdl "RecordField", - -- Note: all included schemas must be record schemas - "includes">: list $ pdl "NamedSchema"], - - def "Schema" $ - union [ - "array">: pdl "Schema", - "fixed">: int32, - "inline">: pdl "NamedSchema", - "map">: pdl "Schema", - "named">: pdl "QualifiedName", - "null">: unit, - "primitive">: pdl "PrimitiveType", - "union">: pdl "UnionSchema"], - - def "SchemaFile" $ - record [ - "namespace">: pdl "Namespace", - "package">: optional $ pdl "Package", - "imports">: list $ pdl "QualifiedName", - "schemas">: list $ pdl "NamedSchema"], - - def "UnionMember" $ - record [ - "alias">: optional $ pdl "FieldName", - "value">: pdl "Schema", - -- Note: annotations are only available for aliased members - "annotations">: pdl "Annotations"], - - -- Note: unions are not allowed as member types of other unions - def "UnionSchema" $ - list $ pdl "UnionMember"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Any.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Any.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Any.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Protobuf.Any where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -pbAnyNs = Namespace "hydra/langs/protobuf/any" -pbAny = typeref pbAnyNs - -protobufAnyModule :: Module -protobufAnyModule = Module pbAnyNs elements [hydraCoreModule] tier0Modules $ - Just "Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/any.proto" - where - def = datatype pbAnyNs - - elements = [ --- // `Any` contains an arbitrary serialized protocol buffer message along with a --- // URL that describes the type of the serialized message. --- // --- // Protobuf library provides support to pack/unpack Any values in the form --- // of utility functions or additional generated methods of the Any type. --- // --- // Example 1: Pack and unpack a message in C++. --- // --- // Foo foo = ...; --- // Any any; --- // any.PackFrom(foo); --- // ... --- // if (any.UnpackTo(&foo)) { --- // ... --- // } --- // --- // Example 2: Pack and unpack a message in Java. --- // --- // Foo foo = ...; --- // Any any = Any.pack(foo); --- // ... --- // if (any.is(Foo.class)) { --- // foo = any.unpack(Foo.class); --- // } --- // // or ... --- // if (any.isSameTypeAs(Foo.getDefaultInstance())) { --- // foo = any.unpack(Foo.getDefaultInstance()); --- // } --- // --- // Example 3: Pack and unpack a message in Python. --- // --- // foo = Foo(...) --- // any = Any() --- // any.Pack(foo) --- // ... --- // if any.Is(Foo.DESCRIPTOR): --- // any.Unpack(foo) --- // ... --- // --- // Example 4: Pack and unpack a message in Go --- // --- // foo := &pb.Foo{...} --- // any, err := anypb.New(foo) --- // if err != nil { --- // ... --- // } --- // ... --- // foo := &pb.Foo{} --- // if err := any.UnmarshalTo(foo); err != nil { --- // ... --- // } --- // --- // The pack methods provided by protobuf library will by default use --- // 'type.googleapis.com/full.type.name' as the type URL and the unpack --- // methods only use the fully qualified type name after the last '/' --- // in the type URL, for example "foo.bar.com/x/y.z" will yield type --- // name "y.z". --- // --- // JSON --- // --- // The JSON representation of an `Any` value uses the regular --- // representation of the deserialized, embedded message, with an --- // additional field `@type` which contains the type URL. Example: --- // --- // package google.profile; --- // message Person { --- // string first_name = 1; --- // string last_name = 2; --- // } --- // --- // { --- // "@type": "type.googleapis.com/google.profile.Person", --- // "firstName": , --- // "lastName": --- // } --- // --- // If the embedded message type is well-known and has a custom JSON --- // representation, that representation will be embedded adding a field --- // `value` which holds the custom JSON in addition to the `@type` --- // field. Example (for message [google.protobuf.Duration][]): --- // --- // { --- // "@type": "type.googleapis.com/google.protobuf.Duration", --- // "value": "1.212s" --- // } --- // --- message Any { - def "Any" $ - doc ("`Any` contains an arbitrary serialized protocol buffer message along with a " ++ - "URL that describes the type of the serialized message.") $ - record [ --- // A URL/resource name that uniquely identifies the type of the serialized --- // protocol buffer message. This string must contain at least --- // one "/" character. The last segment of the URL's path must represent --- // the fully qualified name of the type (as in --- // `path/google.protobuf.Duration`). The name should be in a canonical form --- // (e.g., leading "." is not accepted). --- // --- // In practice, teams usually precompile into the binary all types that they --- // expect it to use in the context of Any. However, for URLs which use the --- // scheme `http`, `https`, or no scheme, one can optionally set up a type --- // server that maps type URLs to message definitions as follows: --- // --- // * If no scheme is provided, `https` is assumed. --- // * An HTTP GET on the URL must yield a [google.protobuf.Type][] --- // value in binary format, or produce an error. --- // * Applications are allowed to cache lookup results based on the --- // URL, or have them precompiled into a binary to avoid any --- // lookup. Therefore, binary compatibility needs to be preserved --- // on changes to types. (Use versioned type names to manage --- // breaking changes.) --- // --- // Note: this functionality is not currently available in the official --- // protobuf release, and it is not used for type URLs beginning with --- // type.googleapis.com. --- // --- // Schemes other than `http`, `https` (or the empty scheme) might be --- // used with implementation specific semantics. --- // --- string type_url = 1; - "typeUrl">: - doc ("A URL/resource name that uniquely identifies the type of the serialized " ++ - "protocol buffer message.") - string, --- --- // Must be a valid serialized protocol buffer of the above specified type. --- bytes value = 2; - "value">: - doc "Must be a valid serialized protocol buffer of the above specified type." - binary]] --- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Language.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Language.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Language.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Protobuf.Language (protobufLanguageModule) where - --- Standard Tier-4 imports -import Prelude hiding ((++)) -import qualified Data.List as L -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Maybe as Y -import Hydra.Dsl.Base as Base -import qualified Hydra.Dsl.Core as Core -import qualified Hydra.Dsl.Graph as Graph -import qualified Hydra.Dsl.Lib.Equality as Equality -import qualified Hydra.Dsl.Lib.Flows as Flows -import qualified Hydra.Dsl.Lib.Io as Io -import qualified Hydra.Dsl.Lib.Lists as Lists -import qualified Hydra.Dsl.Lib.Literals as Literals -import qualified Hydra.Dsl.Lib.Logic as Logic -import qualified Hydra.Dsl.Lib.Maps as Maps -import qualified Hydra.Dsl.Lib.Math as Math -import qualified Hydra.Dsl.Lib.Optionals as Optionals -import qualified Hydra.Dsl.Lib.Sets as Sets -import Hydra.Dsl.Lib.Strings as Strings -import qualified Hydra.Dsl.Module as Module -import qualified Hydra.Dsl.Terms as Terms -import qualified Hydra.Dsl.Types as Types -import Hydra.Sources.Tier3.All - - -protobufLanguageDefinition :: String -> Datum a -> Definition a -protobufLanguageDefinition = definitionInModule protobufLanguageModule - -protobufLanguageModule :: Module -protobufLanguageModule = Module ns elements [hydraCodersModule, hydraBasicsModule, hydraStripModule] tier0Modules $ - Just "Language constraints for Protobuf v3" - where - ns = Namespace "hydra/langs/protobuf/language" - elements = [ - el protobufLanguageDef, - el protobufReservedWordsDef] - -protobufLanguageDef :: Definition (Language) -protobufLanguageDef = protobufLanguageDefinition "protobufLanguage" $ - doc "Language constraints for Protocol Buffers v3" $ - typed languageT $ - record _Language [ - _Language_name>>: wrap _LanguageName "hydra/langs/protobuf", - _Language_constraints>>: record _LanguageConstraints [ - _LanguageConstraints_eliminationVariants>>: Sets.empty, - _LanguageConstraints_literalVariants>>: Sets.fromList @@ list (unitVariant _LiteralVariant <$> [ - _LiteralVariant_binary, - _LiteralVariant_boolean, - _LiteralVariant_float, - _LiteralVariant_integer, - _LiteralVariant_string]), - _LanguageConstraints_floatTypes>>: Sets.fromList @@ list (unitVariant _FloatType <$> [ - _FloatType_float32, - _FloatType_float64]), - _LanguageConstraints_functionVariants>>: Sets.empty, - _LanguageConstraints_integerTypes>>: Sets.fromList @@ list (unitVariant _IntegerType <$> [ - _IntegerType_int32, - _IntegerType_int64, - _IntegerType_uint32, - _IntegerType_uint64]), - _LanguageConstraints_termVariants>>: Sets.fromList @@ list (unitVariant _TermVariant <$> [ - _TermVariant_list, - _TermVariant_literal, - _TermVariant_map, - _TermVariant_optional, - _TermVariant_record, - _TermVariant_union]), - _LanguageConstraints_typeVariants>>: Sets.fromList @@ list (unitVariant _TypeVariant <$> [ - _TypeVariant_annotated, - _TypeVariant_list, - _TypeVariant_literal, - _TypeVariant_map, - _TypeVariant_optional, - _TypeVariant_record, - _TypeVariant_union, - _TypeVariant_variable]), - _LanguageConstraints_types>>: match _Type (Just true) [ - _Type_map>>: lambda "mt" (match _Type (Just true) [ - _Type_optional>>: constant false] @@ (ref stripTypeDef @@ (Core.mapTypeValues @@ var "mt")))]]] - -protobufReservedWordsDef :: Definition (S.Set String) -protobufReservedWordsDef = protobufLanguageDefinition "protobufReservedWords" $ - doc "A set of reserved words in Protobuf" $ - typed (setT stringT) $ - (Sets.fromList @@ (Lists.concat @@ list [var "fieldNames"])) - `with` [ - "fieldNames">: - doc "See: http://google.github.io/proto-lens/reserved-names.html" $ - list [ - "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl", - "infixr", "instance", "let", "mdo", "module", "newtype", "of", "pattern", "proc", "rec", "then", "type", "where"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Proto3.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Proto3.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Proto3.hs +++ /dev/null @@ -1,164 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Protobuf.Proto3 where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -proto3Ns = Namespace "hydra/langs/protobuf/proto3" -proto3 = typeref proto3Ns - -proto3Module :: Module -proto3Module = Module proto3Ns elements [hydraCoreModule] tier0Modules $ - Just ("A model for Protocol Buffers v3 enum and message types, designed as a target for transformations." - ++ "This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto," - ++ " as well as the proto3 reference documentation") - where - def = datatype proto3Ns - elements = [ - - def "Definition" $ - union [ - "enum">: proto3 "EnumDefinition", - "message">: proto3 "MessageDefinition"], - - def "EnumDefinition" $ - doc "Enum type definition" $ - record [ - "name">: - doc "Enum type name" $ - proto3 "TypeName", - "values">: - doc "Enum value definitions" $ - list $ proto3 "EnumValue", - "options">: - doc "Protocol buffer options" $ - list $ proto3 "Option"], - - def "EnumValue" $ - doc "Enum value definition" $ - record [ - "name">: - doc "Enum value name" $ - proto3 "EnumValueName", - "number">: - doc "Enum value number" - int32, - "options">: - doc "Protocol buffer options" $ - list $ proto3 "Option"], - - def "EnumValueName" string, - - def "Field" $ - doc "A single field of a message type" $ - record [ - "name">: - doc "The field name" $ - proto3 "FieldName", - "jsonName">: - doc "The field JSON name" $ - optional string, - "type">: - doc "The datatype of the field" $ - proto3 "FieldType", - "number">: - doc "The field number" - int32, - "options">: - doc "The protocol buffer options" $ - list $ proto3 "Option"], - - def "FieldName" $ - doc "The name of a field" - string, - - def "FieldType" $ - union [ - "map">: proto3 "SimpleType", - "oneof">: list $ proto3 "Field", - "repeated">: proto3 "SimpleType", - "simple">: proto3 "SimpleType"], - - def "FileReference" string, - - def "MessageDefinition" $ - doc "A protocol buffer message type" $ - record [ - "name">: - doc "The fully qualified message name" $ - proto3 "TypeName", - "fields">: - doc "The list of fields" $ - list $ proto3 "Field", - "options">: - doc "The protocol buffer options" $ - list $ proto3 "Option"], - - def "Option" $ - doc ("A protocol buffer option, which can be attached to a message, field, " ++ - "enumeration, etc") $ - record [ - "name">: - doc ("The option's name. For protobuf built-in options (options defined in " ++ - "descriptor.proto), this is the short name. For example, `\"map_entry\"`. " ++ - "For custom options, it should be the fully-qualified name. For example, " ++ - "`\"google.api.http\"`.") - string, - "value">: - doc ("The option's value") $ - proto3 "Value"], - - def "PackageName" string, - - def "ProtoFile" $ - doc "A .proto file, usually containing one or more enum or message type definitions" $ - record [ - "package">: proto3 "PackageName", - "imports">: list $ proto3 "FileReference", - "types">: list $ proto3 "Definition", - "options">: list $ proto3 "Option"], - - def "ScalarType" $ - doc "One of several Proto3 scalar types" $ - enum [ - "bool", - "bytes", - "double", - "fixed32", - "fixed64", - "float", - "int32", - "int64", - "sfixed32", - "sfixed64", - "sint32", - "sint64", - "string", - "uint32", - "uint64"], - - def "SimpleType" $ - doc "A scalar type or a reference to an enum type or message type" $ - union [ - "reference">: proto3 "TypeName", - "scalar">: proto3 "ScalarType"], - - def "TypeName" $ - doc "The local name of an enum type or message type" - string, - - def "TypeReference" $ - doc "A reference to an enum type or message type" - string, - - def "Value" $ - doc "A scalar value" $ - union [ - "boolean">: boolean, - "string">: string - -- Add other scalar value types as needed - ]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/SourceContext.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/SourceContext.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/SourceContext.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Protobuf.SourceContext where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Types as Types -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap - - -pbSourceContextNs = Namespace "hydra/langs/protobuf/sourceContext" -pbSourceContext = typeref pbSourceContextNs - -protobufSourceContextModule :: Module -protobufSourceContextModule = Module pbSourceContextNs elements [hydraCoreModule] tier0Modules $ - Just "Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/source_context.proto" - where - def = datatype pbSourceContextNs - - elements = [ --- // `SourceContext` represents information about the source of a --- // protobuf element, like the file in which it is defined. --- message SourceContext { - def "SourceContext" $ - doc ("`SourceContext` represents information about the source of a " ++ - "protobuf element, like the file in which it is defined.") $ - record [ --- // The path-qualified name of the .proto file that contained the associated --- // protobuf element. For example: `"google/protobuf/source_context.proto"`. --- string file_name = 1; - "fileName">: - doc ("The path-qualified name of the .proto file that contained the associated " ++ - "protobuf element. For example: `\"google/protobuf/source_context.proto\"`.") - string]] --- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Python/Python3.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Python/Python3.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Python/Python3.hs +++ /dev/null @@ -1,1399 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Python.Python3 (python3Module) where - -import Hydra.Kernel -import Hydra.Dsl.Grammars -import Hydra.Tools.GrammarToModule -import qualified Hydra.Dsl.Annotations as Ann -import qualified Hydra.Grammar as G - -import qualified Data.List as L - - -python3Module :: Module -python3Module = grammarToModule ns python3Grammar $ - Just "A Python 3 syntax model, based on the BNF/PEG grammar at https://docs.python.org/3/reference/grammar.html as of 2023-04-03." - where - ns = Namespace "hydra/langs/python/python3" - -python3Grammar :: G.Grammar -python3Grammar = G.Grammar $ tokens ++ productions - -amp_ = terminal "&" -assign_ = terminal ":=" -star_ = terminal "*" -at_ = terminal "@" -close_curly_ = terminal "}" -close_paren_ = terminal ")" -close_square_ = terminal "]" -colon_ = terminal ":" -comma_ = terminal "," -dot_ = terminal "." -double_equal_ = terminal "==" -double_gt_ = terminal ">>" -double_lt_ = terminal "<<" -double_slash_ = terminal "//" -double_star_ = terminal "**" -ellipsis_ = terminal "..." -endmarker_ = terminal "" -equal_ = terminal "=" -gt_ = terminal ">" -gte_ = terminal ">=" -hat_ = terminal "^" -lt_ = terminal "<" -lte_ = terminal "<=" -minus_ = terminal "-" -newline_ = terminal "\n" -noteq_ = terminal "!=" -open_curly_ = terminal "{" -open_paren_ = terminal "(" -open_square_ = terminal "[" -percent_ = terminal "%" -pipe_ = terminal "|" -plus_ = terminal "+" -right_arrow_ = terminal "->" -semi_ = terminal ";" -slash_ = terminal "/" -tilde_ = terminal "~" -underscore_ = terminal "_" - -tokens :: [G.Production] -tokens = [ - define "Async" [terminal "async"], -- TODO: not specified in the BNF - define "Await" [terminal "await"], -- TODO: not specified in the BNF - define "Dedent" [terminal "\n"], -- TODO: not specified in the BNF - define "Indent" [terminal "\t"], -- TODO: not specified in the BNF - define "Name" [regex "[A-Za-z0-9][A-Za-z0-9_]*"], -- TODO: not specified in the BNF - define "Number" [regex "[0-9]+"], -- TODO: not specified in the BNF - define "String" [regex "\"[^\"]*\""], -- TODO: not specified in the BNF - define "TypeComment" [terminal ""]] -- TODO: not specified in the BNF - -productions :: [G.Production] -productions = [ --- # STARTING RULES --- # ============== - --- file: [statements] ENDMARKER - define "File" [ - star "Statement"], - --- interactive: statement_newline - define "Interactive" [ - "StatementNewline"], - --- eval: expressions NEWLINE* ENDMARKER - define "Eval" [ - list[sepp comma_ "Expression", star newline_]], - --- func_type: '(' [type_expressions] ')' '->' expression NEWLINE* ENDMARKER - define "FuncType" [open_paren_, opt "TypeExpressions", close_paren_, right_arrow_, star newline_, endmarker_], - --- fstring: star_expressions - define "Fstring" [ - sepp comma_ "StarExpression"], - --- # GENERAL STATEMENTS --- # ================== - --- statements: statement+ - --- statement: compound_stmt | simple_stmts - define "Statement" [ - "CompoundStmt", - "SimpleStmts"], - --- statement_newline: --- | compound_stmt NEWLINE --- | simple_stmts --- | NEWLINE --- | ENDMARKER - define "StatementNewline" [ - list["CompoundStmt", newline_], - "SimpleStmts", - newline_, - endmarker_], - --- simple_stmts: --- | simple_stmt !';' NEWLINE # Not needed, there for speedup --- | ';'.simple_stmt+ [';'] NEWLINE - define "SimpleStmts" [ - list ["SimpleStmt", star(list[semi_, dot_, "SimpleStmt"]), newline_]], - --- # NOTE: assignment MUST precede expression, else parsing a simple assignment --- # will throw a SyntaxError. --- simple_stmt: --- | assignment --- | star_expressions --- | return_stmt --- | import_stmt --- | raise_stmt --- | 'pass' --- | del_stmt --- | yield_stmt --- | assert_stmt --- | 'break' --- | 'continue' --- | global_stmt --- | nonlocal_stmt - define "SimpleStmt" [ - "Assignment", - sepp comma_ "StarExpression", - "ReturnStmt", - "ImportStmt", - "RaiseStmt", - terminal "pass", - "DelStmt", - "YieldStmt", - "AssertStmt", - terminal "break", - terminal "continue", - "GlobalStmt", - "NonlocalStmt"], - --- compound_stmt: --- | function_def --- | if_stmt --- | class_def --- | with_stmt --- | for_stmt --- | try_stmt --- | while_stmt --- | match_stmt - define "CompoundStmt" [ - "FunctionDef", - "IfStmt", - "ClassDef", - "WithStmt", - "ForStmt", - "TryStmt", - "WhileStmt", - "MatchStmt"], - --- # SIMPLE STATEMENTS --- # ================= - --- # NOTE: annotated_rhs may start with 'yield'; yield_expr must start with 'yield' --- assignment: --- | NAME ':' expression ['=' annotated_rhs ] --- | ('(' single_target ')' --- | single_subscript_attribute_target) ':' expression ['=' annotated_rhs ] --- | (star_targets '=' )+ (yield_expr | star_expressions) !'=' [TYPE_COMMENT] --- | single_target augassign ~ (yield_expr | star_expressions) - define "Assignment" [ - list["Name", colon_, "Expression", opt(list[equal_, "AnnotatedRhs"])], - list[alts[list[open_paren_, "SingleTarget", close_paren_], "SingleSubscriptAttributeTarget"], colon_, "Expression", opt(list[equal_, "AnnotatedRhs"])], - list[plus(list[sepp comma_ "StarTarget", equal_]), alts["YieldExpr", sepp comma_ "StarExpression"], opt("TypeComment")], - list["SingleTarget", "Augassign", tilde_, alts["YieldExpr", sepp comma_ "StarExpression"]]], - --- annotated_rhs: yield_expr | star_expressions - define "AnnotatedRhs" [ - "YieldExpr", - sepp comma_ "StarExpression"], - --- augassign: --- | '+=' --- | '-=' --- | '*=' --- | '@=' --- | '/=' --- | '%=' --- | '&=' --- | '|=' --- | '^=' --- | '<<=' --- | '>>=' --- | '**=' --- | '//=' - define "Augassign" [ - terminal "+=", - terminal "-=", - terminal "*=", - terminal "@=", - terminal "/=", - terminal "%=", - terminal "&=", - terminal "|=", - terminal "^=", - terminal "<<=", - terminal ">>=", - terminal "**=", - terminal "//="], - --- return_stmt: --- | 'return' [star_expressions] - define "ReturnStmt" [ - list [terminal "return", opt(sepp comma_ "StarExpression")]], - --- raise_stmt: --- | 'raise' expression ['from' expression ] --- | 'raise' - define "RaiseStmt" [ - list[terminal "raise", "Expression", opt(list[terminal "from", "Expression"])], - terminal "raise"], - --- global_stmt: 'global' ','.NAME+ - define "GlobalStmt" [ - list[terminal "global", comma_, dot_, plus(list[dot_, "Name"])]], -- Note: interpreting the above as (.NAME)+, not .(Name+) - --- nonlocal_stmt: 'nonlocal' ','.NAME+ - define "NonlocalStmt" [ - list[terminal "nonlocal", comma_, plus(list[dot_, "Name"])]], -- Note: interpreting the above as (.NAME)+, not .(Name+) - --- del_stmt: --- | 'del' del_targets &(';' | NEWLINE) - define "DelStmt" [ - list[terminal "del", "DelTargets"]], - --- yield_stmt: yield_expr - define "YieldStmt" [ - "YieldExpr"], - --- assert_stmt: 'assert' expression [',' expression ] - define "AssertStmt" [ - list[terminal "assert", "Expression", opt(list[comma_, "Expression"])]], - --- import_stmt: import_name | import_from - define "ImportStmt" [ - "ImportName", - "ImportFrom"], - --- # Import statements --- # ----------------- - --- import_name: 'import' dotted_as_names - define "ImportName" [ - list[terminal "import", sep comma_ "DottedAsName"]], - --- # note below: the ('.' | '...') is necessary because '...' is tokenized as ELLIPSIS --- import_from: --- | 'from' ('.' | '...')* dotted_name 'import' import_from_targets --- | 'from' ('.' | '...')+ 'import' import_from_targets - define "ImportFrom" [ - list[terminal "from", star(alts[dot_, ellipsis_]), "DottedName", terminal "import", "ImportFromTargets"], - list[terminal "from", plus(alts[dot_, ellipsis_]), terminal "import", "ImportFromTargets"]], - --- import_from_targets: --- | '(' import_from_as_names [','] ')' --- | import_from_as_names !',' --- | '*' - define "ImportFromTargets" [ - list[open_paren_, "ImportFromAsNames", opt(comma_), close_paren_], - "ImportFromAsNames"], - --- import_from_as_names: --- | ','.import_from_as_name+ - define "ImportFromAsNames" [ - list[comma_, plus(list[dot_, "ImportFromAsName"])]], -- Note: interpreting the above as (.import_from_as_name)+, not .(import_from_as_name+) - --- import_from_as_name: --- | NAME ['as' NAME ] - define "ImportFromAsName" [ - list["Name", opt(list[terminal "as", "Name"])]], - --- dotted_as_names: --- | ','.dotted_as_name+ --- dotted_as_name: --- | dotted_name ['as' NAME ] - define "DottedAsName" [ - list["DottedName", opt(list[terminal "as", "Name"])]], - --- dotted_name: --- | dotted_name '.' NAME --- | NAME - define "DottedName" [ - sep dot_ "Name"], - --- # COMPOUND STATEMENTS --- # =================== - --- # Common elements --- # --------------- - --- block: --- | NEWLINE INDENT statements DEDENT --- | simple_stmts - define "Block" [ - list[newline_, "Indent", star "Statement", "Dedent"], - "SimpleStmts"], - --- decorators: ('@' named_expression NEWLINE )+ - define "Decorators" [ - plus(list[at_, "NamedExpression", newline_])], - --- # Class definitions --- # ----------------- - --- class_def: --- | decorators class_def_raw --- | class_def_raw - define "ClassDef" [ - list["Decorators", "ClassDefRaw"], - "ClassDefRaw"], - --- class_def_raw: --- | 'class' NAME ['(' [arguments] ')' ] ':' block - define "ClassDefRaw" [ - list[terminal "class", "Name", opt(list[open_paren_, opt("Arguments"), close_paren_]), colon_, "Block"]], - --- # Function definitions --- # -------------------- - --- function_def: --- | decorators function_def_raw --- | function_def_raw - define "FunctionDef" [ - list["Decorators", "FunctionDefRaw"], - "FunctionDefRaw"], - --- function_def_raw: --- | 'def' NAME '(' [params] ')' ['->' expression ] ':' [func_type_comment] block --- | ASYNC 'def' NAME '(' [params] ')' ['->' expression ] ':' [func_type_comment] block - define "FunctionDefRaw" [ - list[ - opt(list["Async", terminal "def"]), "Name", - open_paren_, opt("Parameters"), close_paren_, - opt(list[right_arrow_, "Expression"]), - colon_, opt("FuncTypeComment"), "Block"]], - --- # Function parameters --- # ------------------- - --- params: --- | parameters - --- parameters: --- | slash_no_default param_no_default* param_with_default* [star_etc] --- | slash_with_default param_with_default* [star_etc] --- | param_no_default+ param_with_default* [star_etc] --- | param_with_default+ [star_etc] --- | star_etc - define "Parameters" [ - list["SlashNoDefault", star("ParamNoDefault"), star("ParamWithDefault"), opt("StarEtc")], - list["SlashWithDefault", star("ParamWithDefault"), opt("StarEtc")], - list[plus("ParamNoDefault"), star("ParamWithDefault"), opt("StarEtc")], - list[plus("ParamWithDefault"), opt("StarEtc")], - "StarEtc"], - --- # Some duplication here because we can't write (',' | &')'), --- # which is because we don't support empty alternatives (yet). - --- slash_no_default: --- | param_no_default+ '/' ',' --- | param_no_default+ '/' &')' - define "SlashNoDefault" [ - list[plus("ParamNoDefault"), slash_, opt(comma_)]], - --- slash_with_default: --- | param_no_default* param_with_default+ '/' ',' --- | param_no_default* param_with_default+ '/' &')' - define "SlashWithDefault" [ - list[star("ParamNoDefault"), plus("ParamWithDefault"), slash_, opt(comma_)]], - --- star_etc: --- | '*' param_no_default param_maybe_default* [kwds] --- | '*' param_no_default_star_annotation param_maybe_default* [kwds] --- | '*' ',' param_maybe_default+ [kwds] --- | kwds - define "StarEtc" [ - list[star_, "ParamNoDefault", star("ParamMaybeDefault"), opt("Kwds")], - list[star_, "ParamNoDefaultStarAnnotation", star("ParamMaybeDefault"), opt("Kwds")], - list[star_, comma_, plus("ParamMaybeDefault"), opt("Kwds")], - "Kwds"], - --- kwds: --- | '**' param_no_default - define "Kwds" [ - list[double_star_, "ParamNoDefault"]], - --- # One parameter. This *includes* a following comma and type comment. --- # --- # There are three styles: --- # - No default --- # - With default --- # - Maybe with default --- # --- # There are two alternative forms of each, to deal with type comments: --- # - Ends in a comma followed by an optional type comment --- # - No comma, optional type comment, must be followed by close paren --- # The latter form is for a final parameter without trailing comma. --- # --- --- param_no_default: --- | param ',' TYPE_COMMENT? --- | param TYPE_COMMENT? &')' - define "ParamNoDefault" [ - list["Param", opt(comma_), opt("TypeComment")]], - --- param_no_default_star_annotation::r --- | param_star_annotation ',' TYPE_COMMENT? --- | param_star_annotation TYPE_COMMENT? &')' - define "ParamNoDefaultStarAnnotation" [ - list["ParamStarAnnotation", opt(comma_), opt("TypeComment")]], - --- param_with_default: --- | param default ',' TYPE_COMMENT? --- | param default TYPE_COMMENT? &')' - define "ParamWithDefault" [ - list["Param", "Default", opt(comma_), opt("TypeComment")]], - --- param_maybe_default: --- | param default? ',' TYPE_COMMENT? --- | param default? TYPE_COMMENT? &')' - define "ParamMaybeDefault" [ - list["Param", opt("Default"), opt(comma_), opt("TypeComment")]], - --- param: NAME annotation? - define "Param" [ - list["Name", opt("Annotation")]], - --- param_star_annotation: NAME star_annotation - define "ParamStarAnnotation" [ - list["Name", "StarAnnotation"]], - --- annotation: ':' expression - define "Annotation" [ - list[colon_, "Expression"]], - --- star_annotation: ':' star_expression - define "StarAnnotation" [ - list[colon_, "StarExpression"]], - --- default: '=' expression | invalid_default - define "Default" [ - list[equal_, "Expression"]], - -- "InvalidDefault"], -- TODO: invalid_default is referenced but not defined in the source grammar - --- # If statement --- # ------------ - --- if_stmt: --- | 'if' named_expression ':' block elif_stmt --- | 'if' named_expression ':' block [else_block] - define "IfStmt" [ - list[terminal "if", "NamedExpression", colon_, "Block", alts["ElifStmt", "ElseBlock"]]], - --- elif_stmt: --- | 'elif' named_expression ':' block elif_stmt --- | 'elif' named_expression ':' block [else_block] - define "ElifStmt" [ - list[terminal "elif", "NamedExpression", colon_, "Block", alts["ElifStmt", "ElseBlock"]]], - --- else_block: --- | 'else' ':' block - define "ElseBlock" [ - list[terminal "else", colon_, "Block"]], - --- # While statement --- # --------------- - --- while_stmt: --- | 'while' named_expression ':' block [else_block] - define "WhileStmt" [ - list[terminal "while", "NamedExpression", colon_, "Block", opt("ElseBlock")]], - --- # For statement --- # ------------- - --- for_stmt: --- | 'for' star_targets 'in' ~ star_expressions ':' [TYPE_COMMENT] block [else_block] --- | ASYNC 'for' star_targets 'in' ~ star_expressions ':' [TYPE_COMMENT] block [else_block] - define "ForStmt" [ - list[opt("Async"), terminal "for", sepp comma_ "StarTarget", terminal "in", tilde_, sepp comma_ "StarExpression", colon_, opt("TypeComment"), "Block", opt("ElseBlock")]], - --- # With statement --- # -------------- - --- with_stmt: --- | 'with' '(' ','.with_item+ ','? ')' ':' block --- | 'with' ','.with_item+ ':' [TYPE_COMMENT] block --- | ASYNC 'with' '(' ','.with_item+ ','? ')' ':' block --- | ASYNC 'with' ','.with_item+ ':' [TYPE_COMMENT] block - define "WithStmt" [ - list[opt("Async"), terminal "with", alts[ - list[open_paren_, sepp comma_ "WithItem", close_paren_, colon_], - list[sepp comma_ "WithItem", colon_, opt("TypeComment")]], "Block"]], - --- with_item: --- | expression 'as' star_target &(',' | ')' | ':') --- | expression - define "WithItem" [ - list["Expression", opt(list[terminal "as", "StarTarget"])]], - --- # Try statement --- # ------------- - --- try_stmt: --- | 'try' ':' block finally_block --- | 'try' ':' block except_block+ [else_block] [finally_block] --- | 'try' ':' block except_star_block+ [else_block] [finally_block] - define "TryStmt" [ - list[terminal "try", colon_, "Block", alts[ - "FinallyBlock", - list[plus("ExceptBlock"), opt("ElseBlock"), opt("FinallyBlock")], - list[plus("ExceptStarBlock"), opt("ElseBlock"), opt("FinallyBlock")]]]], - --- # Except statement --- # ---------------- - --- except_block: --- | 'except' expression ['as' NAME ] ':' block --- | 'except' ':' block - define "ExceptBlock" [ - list[terminal "except", opt(list["Expression", opt(list[terminal "as", "Name"])]), colon_, "Block"]], - --- except_star_block: --- | 'except' '*' expression ['as' NAME ] ':' block - define "ExceptStarBlock" [ - list[terminal "except", star_, "Expression", opt(list[terminal "as", "Name"]), colon_, "Block"]], - --- finally_block: --- | 'finally' ':' block - define "FinallyBlock" [ - list[terminal "finally", colon_, "Block"]], - --- # Match statement --- # --------------- - --- match_stmt: --- | "match" subject_expr ':' NEWLINE INDENT case_block+ DEDENT - define "MatchStmt" [ - list[terminal "match", "SubjectExpr", colon_, newline_, "Indent", plus("CaseBlock"), "Dedent"]], - --- subject_expr: --- | star_named_expression ',' star_named_expressions? --- | named_expression - define "SubjectExpr" [ - list["StarNamedExpression", comma_, opt(sepp comma_ "StarNamedExpression")]], - --- case_block: --- | "case" patterns guard? ':' block - define "CaseBlock" [ - list[terminal "case", "Patterns", opt("Guard"), colon_, "Block"]], - --- guard: 'if' named_expression - define "Guard" [ - list[terminal "if", "NamedExpression"]], - --- patterns: --- | open_sequence_pattern --- | pattern - define "Patterns" [ - "OpenSequencePattern", - "Pattern"], - --- pattern: --- | as_pattern --- | or_pattern - define "Pattern" [ - "AsPattern", - "OrPattern"], - --- as_pattern: --- | or_pattern 'as' pattern_capture_target - define "AsPattern" [ - list["OrPattern", terminal "as", "PatternCaptureTarget"]], - --- or_pattern: --- | '|'.closed_pattern+ - define "OrPattern" [ - list[pipe_, sep dot_ "ClosedPattern"]], - --- closed_pattern: --- | literal_pattern --- | capture_pattern --- | wildcard_pattern --- | value_pattern --- | group_pattern --- | sequence_pattern --- | mapping_pattern --- | class_pattern - define "ClosedPattern" [ - "LiteralPattern", - "CapturePattern", - "WildcardPattern", - "ValuePattern", - "GroupPattern", - "SequencePattern", - "MappingPattern", - "ClassPattern"], - --- # Literal patterns are used for equality and identity constraints --- literal_pattern: --- | signed_number !('+' | '-') --- | complex_number --- | strings --- | 'None' --- | 'True' --- | 'False' - define "LiteralPattern" [ - "SignedNumber", - "ComplexNumber", - plus("String"), - terminal "None", - terminal "True", - terminal "False"], - --- # Literal expressions are used to restrict permitted mapping pattern keys --- literal_expr: --- | signed_number !('+' | '-') --- | complex_number --- | strings --- | 'None' --- | 'True' --- | 'False' - --- complex_number: --- | signed_real_number '+' imaginary_number --- | signed_real_number '-' imaginary_number - define "ComplexNumber" [ - list["SignedRealNumber", alts[plus_, minus_], "ImaginaryNumber"]], - --- signed_number: --- | NUMBER --- | '-' NUMBER - define "SignedNumber" [ - list[opt(minus_), "Number"]], - --- signed_real_number: --- | real_number --- | '-' real_number - define "SignedRealNumber" [ - list[opt(minus_), "RealNumber"]], - --- real_number: --- | NUMBER - define "RealNumber" [ - "Number"], - --- imaginary_number: --- | NUMBER - define "ImaginaryNumber" [ - "Number"], - --- capture_pattern: --- | pattern_capture_target - define "CapturePattern" [ - "PatternCaptureTarget"], - --- pattern_capture_target: --- | !"_" NAME !('.' | '(' | '=') - define "PatternCaptureTarget" [ - "Name"], - --- wildcard_pattern: --- | "_" - define "WildcardPattern" [ - underscore_], - --- value_pattern: --- | attr !('.' | '(' | '=') - define "ValuePattern" [ - "Attr"], - --- attr: --- | name_or_attr '.' NAME - define "Attr" [ - list["NameOrAttr", dot_, "Name"]], - --- name_or_attr: --- | attr --- | NAME - define "NameOrAttr" [ - "Attr", - "Name"], - --- group_pattern: --- | '(' pattern ')' - define "GroupPattern" [ - list[open_paren_, "Pattern", close_paren_]], - --- sequence_pattern: --- | '[' maybe_sequence_pattern? ']' --- | '(' open_sequence_pattern? ')' - define "SequencePattern" [ - list[open_square_, opt("MaybeSequencePattern"), close_square_], - list[open_paren_, opt("MaybeSequencePattern"), close_paren_]], - --- open_sequence_pattern: --- | maybe_star_pattern ',' maybe_sequence_pattern? - define "OpenSequencePattern" [ - list["MaybeStarPattern", comma_, opt("MaybeSequencePattern")]], - --- maybe_sequence_pattern: --- | ','.maybe_star_pattern+ ','? - define "MaybeSequencePattern" [ - seq comma_ "MaybeStarPattern"], - --- maybe_star_pattern: --- | star_pattern --- | pattern - define "MaybeStarPattern" [ - "StarPattern", - "Pattern"], - --- star_pattern: --- | '*' pattern_capture_target --- | '*' wildcard_pattern - define "StarPattern" [ - list[star_, alts["PatternCaptureTarget", "WildcardPattern"]]], - --- mapping_pattern: --- | '{' '}' --- | '{' double_star_pattern ','? '}' --- | '{' items_pattern ',' double_star_pattern ','? '}' --- | '{' items_pattern ','? '}' - define "MappingPattern" [ - "empty">: list[open_curly_, close_curly_], - list[open_curly_, "DoubleStarPattern", opt(comma_), close_curly_], - list[open_curly_, "ItemsPattern", comma_, "DoubleStarPattern", opt(comma_), close_curly_], - list[open_curly_, "ItemsPattern", opt(comma_), close_curly_]], - --- items_pattern: --- | ','.key_value_pattern+ - define "ItemsPattern" [ - sep comma_ "KeyValuePattern"], - --- key_value_pattern: --- | (literal_expr | attr) ':' pattern - define "KeyValuePattern" [ - list[alts["LiteralPattern", "Attr"], colon_, "Pattern"]], - --- double_star_pattern: --- | '**' pattern_capture_target - define "DoubleStarPattern" [ - list[double_star_, "PatternCaptureTarget"]], - --- class_pattern: --- | name_or_attr '(' ')' --- | name_or_attr '(' positional_patterns ','? ')' --- | name_or_attr '(' keyword_patterns ','? ')' --- | name_or_attr '(' positional_patterns ',' keyword_patterns ','? ')' - define "ClassPattern" [ - list["NameOrAttr", open_paren_, alts[ - nil, - list[seq comma_ "Pattern", opt(comma_)], - list[seq comma_ "KeywordPattern", opt(comma_)], - list[seq comma_ "Pattern", comma_, seq comma_ "KeywordPattern", opt(comma_)] - ], close_paren_]], - --- positional_patterns: --- | ','.pattern+ --- keyword_patterns: --- | ','.keyword_pattern+ --- keyword_pattern: --- | NAME '=' pattern - define "KeywordPattern" [ - list["Name", equal_, "Pattern"]], - --- # EXPRESSIONS --- # ----------- - --- expressions: --- | expression (',' expression )+ [','] --- | expression ',' --- | expression - --- expression: --- | disjunction 'if' disjunction 'else' expression --- | disjunction --- | lambdef - define "Expression" [ - list["Disjunction", terminal "if", "Disjunction", terminal "else", "Expression"], - "Disjunction", - "Lambdef"], - --- yield_expr: --- | 'yield' 'from' expression --- | 'yield' [star_expressions] - define "YieldExpr" [ - list[terminal "yield", alts[list[terminal "from", "Expression"], opt(sepp comma_ "StarExpression")]]], - --- star_expressions: --- | star_expression (',' star_expression )+ [','] --- | star_expression ',' --- | star_expression - --- star_expression: --- | '*' bitwise_or --- | expression - define "StarExpression" [ - list[star_, "BitwiseOr"], - "Expression"], - --- star_named_expressions: ','.star_named_expression+ [','] --- --- star_named_expression: --- | '*' bitwise_or --- | named_expression - define "StarNamedExpression" [ - list[star_, "BitwiseOr"], - "NamedExpression"], - --- assignment_expression: --- | NAME ':=' ~ expression - define "AssignmentExpression" [ - list["Name", assign_, tilde_, "Expression"]], - --- named_expression: --- | assignment_expression --- | expression !':=' - define "NamedExpression" [ - "AssignmentExpression", - "Expression"], - --- disjunction: --- | conjunction ('or' conjunction )+ --- | conjunction - define "Disjunction" [ - sep (terminal "or") "Conjunction"], - --- conjunction: --- | inversion ('and' inversion )+ --- | inversion - define "Conjunction" [ - sep (terminal "and") "Inversion"], - --- inversion: --- | 'not' inversion --- | comparison - define "Inversion" [ - list[terminal "not", "Inversion"], - "Comparison"], - --- # Comparison operators --- # -------------------- - --- comparison: --- | bitwise_or compare_op_bitwise_or_pair+ --- | bitwise_or - define "Comparison" [ - list["BitwiseOr", star("CompareOpBitwiseOrPair")]], - --- compare_op_bitwise_or_pair: --- | eq_bitwise_or --- | noteq_bitwise_or --- | lte_bitwise_or --- | lt_bitwise_or --- | gte_bitwise_or --- | gt_bitwise_or --- | notin_bitwise_or --- | in_bitwise_or --- | isnot_bitwise_or --- | is_bitwise_or - define "CompareOpBitwiseOrPair" [ - "EqBitwiseOr", - "NoteqBitwiseOr", - "LteBitwiseOr", - "LtBitwiseOr", - "GteBitwiseOr", - "GtBitwiseOr", - "NotinBitwiseOr", - "InBitwiseOr", - "IsnotBitwiseOr", - "IsBitwiseOr"], - --- eq_bitwise_or: '==' bitwise_or - define "EqBitwiseOr" [ - list[double_equal_, "BitwiseOr"]], - --- noteq_bitwise_or: --- | ('!=' ) bitwise_or - define "NoteqBitwiseOr" [ - list[noteq_, "BitwiseOr"]], - --- lte_bitwise_or: '<=' bitwise_or - define "LteBitwiseOr" [ - list[lte_, "BitwiseOr"]], - --- lt_bitwise_or: '<' bitwise_or - define "LtBitwiseOr" [ - list[lt_, "BitwiseOr"]], - --- gte_bitwise_or: '>=' bitwise_or - define "GteBitwiseOr" [ - list[gte_, "BitwiseOr"]], - --- gt_bitwise_or: '>' bitwise_or - define "GtBitwiseOr" [ - list[gt_, "BitwiseOr"]], - --- notin_bitwise_or: 'not' 'in' bitwise_or - define "NotinBitwiseOr" [ - list[terminal "not", terminal "in", "BitwiseOr"]], - --- in_bitwise_or: 'in' bitwise_or - define "InBitwiseOr" [ - list[terminal "in", "BitwiseOr"]], - --- isnot_bitwise_or: 'is' 'not' bitwise_or - define "IsnotBitwiseOr" [ - list[terminal "is", terminal "not", "BitwiseOr"]], - --- is_bitwise_or: 'is' bitwise_or - define "IsBitwiseOr" [ - list[terminal "is", "BitwiseOr"]], - --- # Bitwise operators --- # ----------------- - --- bitwise_or: --- | bitwise_or '|' bitwise_xor --- | bitwise_xor - define "BitwiseOr" [ - list[opt(list["BitwiseOr", pipe_]), "BitwiseXor"]], - --- bitwise_xor: --- | bitwise_xor '^' bitwise_and --- | bitwise_and - define "BitwiseXor" [ - list[opt(list["BitwiseXor", hat_]), "BitwiseAnd"]], - --- bitwise_and: --- | bitwise_and '&' shift_expr --- | shift_expr - define "BitwiseAnd" [ - list[opt(list["BitwiseAnd", amp_]), "ShiftExpr"]], - --- shift_expr: --- | shift_expr '<<' sum --- | shift_expr '>>' sum --- | sum - define "ShiftExpr" [ - list[ - opt(list["ShiftExpr", alts[double_lt_, double_gt_]]), - "Sum"]], - --- # Arithmetic operators --- # -------------------- - --- sum: --- | sum '+' term --- | sum '-' term --- | term - define "Sum" [ - list[opt(list["Sum", alts[plus_, minus_]]), "Term"]], - --- term: --- | term '*' factor --- | term '/' factor --- | term '//' factor --- | term '%' factor --- | term '@' factor --- | factor - define "Term" [ - list[opt(list["Term", alts[star_, slash_, double_slash_, percent_, at_]]), "Factor"]], - --- factor: --- | '+' factor --- | '-' factor --- | '~' factor --- | power - define "Factor" [ - list[alts[plus_, minus_, tilde_], "Factor"], - "Power"], - --- power: --- | await_primary '**' factor --- | await_primary - define "Power" [ - list["AwaitPrimary", opt(list[double_star_, "Factor"])]], - --- # Primary elements --- # ---------------- - --- # Primary elements are things like "obj.something.something", "obj[something]", "obj(something)", "obj" ... - --- await_primary: --- | AWAIT primary --- | primary - define "AwaitPrimary" [ - list[opt("Await"), "Primary"]], - --- primary: --- | primary '.' NAME --- | primary genexp --- | primary '(' [arguments] ')' --- | primary '[' slices ']' --- | atom - define "Primary" [ - list["Primary", alts[ - list[dot_, "Name"], - "Genexp", - list[open_paren_, opt("Arguments"), close_paren_], - list[open_square_, "Slices", close_square_]]], - "Atom"], - --- slices: --- | slice !',' --- | ','.(slice | starred_expression)+ [','] - define "Slices" [ - "Slice", - sepp comma_ (alts["Slice", "StarredExpression"])], - --- slice: --- | [expression] ':' [expression] [':' [expression] ] --- | named_expression - define "Slice" [ - list[opt("Expression"), colon_, opt("Expression"), opt(list[colon_, opt("Expression")])], - "NamedExpression"], - --- atom: --- | NAME --- | 'True' --- | 'False' --- | 'None' --- | strings --- | NUMBER --- | (tuple | group | genexp) --- | (list | listcomp) --- | (dict | set | dictcomp | setcomp) --- | '...' - define "Atom" [ - "Name", - terminal "True", - terminal "False", - terminal "None", - plus("String"), - "Number", - "Tuple", - "Group", - "Genexp", - "List", - "Listcomp", - "Dict", - "Set", - "Dictcomp", - "Setcomp", - ellipsis_], - --- group: --- | '(' (yield_expr | named_expression) ')' - define "Group" [ - list[open_paren_, alts["YieldExpr", "NamedExpression"], close_paren_]], - --- # Lambda functions --- # ---------------- - --- lambdef: --- | 'lambda' [lambda_params] ':' expression - define "Lambdef" [ - list[terminal "lambda", opt("LambdaParameters"), colon_, "Expression"]], - --- lambda_params: --- | lambda_parameters - --- # lambda_parameters etc. duplicates parameters but without annotations --- # or type comments, and if there's no comma after a parameter, we expect --- # a colon, not a close parenthesis. (For more, see parameters above.) --- # --- lambda_parameters: --- | lambda_slash_no_default lambda_param_no_default* lambda_param_with_default* [lambda_star_etc] --- | lambda_slash_with_default lambda_param_with_default* [lambda_star_etc] --- | lambda_param_no_default+ lambda_param_with_default* [lambda_star_etc] --- | lambda_param_with_default+ [lambda_star_etc] --- | lambda_star_etc - define "LambdaParameters" [ - list["LambdaSlashNoDefault", star("LambdaParamNoDefault"), star("LambdaParamWithDefault"), opt("LambdaStarEtc")], - list["LambdaSlashWithDefault", star("LambdaParamWithDefault"), opt("LambdaStarEtc")], - list[plus("LambdaParamNoDefault"), star("LambdaParamWithDefault"), opt("LambdaStarEtc")], - list[plus("LambdaParamWithDefault"), opt("LambdaStarEtc")], - "LambdaStarEtc"], - --- lambda_slash_no_default: --- | lambda_param_no_default+ '/' ',' --- | lambda_param_no_default+ '/' &':' - define "LambdaSlashNoDefault" [ - list[plus("LambdaParamNoDefault"), slash_, opt(comma_)]], - --- lambda_slash_with_default: --- | lambda_param_no_default* lambda_param_with_default+ '/' ',' --- | lambda_param_no_default* lambda_param_with_default+ '/' &':' - define "LambdaSlashWithDefault" [ - list[star("LambdaParamNoDefault"), plus("LambdaParamWithDefault"), slash_, opt(comma_)]], - --- lambda_star_etc: --- | '*' lambda_param_no_default lambda_param_maybe_default* [lambda_kwds] --- | '*' ',' lambda_param_maybe_default+ [lambda_kwds] --- | lambda_kwds - define "LambdaStarEtc" [ - list[star_, "LambdaParamNoDefault", star("LambdaParamMaybeDefault"), opt("LambdaKwds")], - list[star_, comma_, plus("LambdaParamMaybeDefault"), opt("LambdaKwds")], - "LambdaKwds"], - --- lambda_kwds: --- | '**' lambda_param_no_default - define "LambdaKwds" [ - list[double_star_, "LambdaParamNoDefault"]], - --- lambda_param_no_default: --- | lambda_param ',' --- | lambda_param &':' - define "LambdaParamNoDefault" [ - list["LambdaParam", opt(comma_)]], - --- lambda_param_with_default: --- | lambda_param default ',' --- | lambda_param default &':' - define "LambdaParamWithDefault" [ - list["LambdaParam", "Default", opt(comma_)]], - --- lambda_param_maybe_default: --- | lambda_param default? ',' --- | lambda_param default? &':' - define "LambdaParamMaybeDefault" [ - list["LambdaParam", opt("Default"), opt(comma_)]], - --- lambda_param: NAME - define "LambdaParam" [ - "Name"], - --- # LITERALS --- # ======== - --- strings: STRING+ - --- list: --- | '[' [star_named_expressions] ']' - define "List" [ - list[open_square_, sepp comma_ "StarNamedExpression", close_square_]], - --- tuple: --- | '(' [star_named_expression ',' [star_named_expressions] ] ')' - define "Tuple" [ - list[open_paren_, opt(sepp comma_ "StarNamedExpression"), close_paren_]], - --- set: '{' star_named_expressions '}' - define "Set" [ - list[open_curly_, sepp comma_ "StarNamedExpression", close_curly_]], - --- # Dicts --- # ----- - --- dict: --- | '{' [double_starred_kvpairs] '}' - define "Dict" [ - list[open_curly_, opt(sepp comma_ "DoubleStarredKvpair"), close_curly_]], - --- double_starred_kvpairs: ','.double_starred_kvpair+ [','] - --- double_starred_kvpair: --- | '**' bitwise_or --- | kvpair - define "DoubleStarredKvpair" [ - list[double_star_, "BitwiseOr"], - "Kvpair"], - --- kvpair: expression ':' expression - define "Kvpair" [ - list["Expression", colon_, "Expression"]], - --- # Comprehensions & Generators --- # --------------------------- - --- for_if_clauses: --- | for_if_clause+ - --- for_if_clause: --- | ASYNC 'for' star_targets 'in' ~ disjunction ('if' disjunction )* --- | 'for' star_targets 'in' ~ disjunction ('if' disjunction )* - define "ForIfClause" [ - list[opt("Async"), terminal "for", sepp comma_ "StarTarget", terminal "in", tilde_, "Disjunction", star(list[terminal "if", "Disjunction"])]], - --- listcomp: --- | '[' named_expression for_if_clauses ']' - define "Listcomp" [ - list[open_square_, "NamedExpression", plus("ForIfClause"), close_square_]], - --- setcomp: --- | '{' named_expression for_if_clauses '}' - define "Setcomp" [ - list[open_curly_, "NamedExpression", plus("ForIfClause"), close_curly_]], - --- genexp: --- | '(' ( assignment_expression | expression !':=') for_if_clauses ')' - define "Genexp" [ - list[open_paren_, alts["AssignmentExpression", "Expression"], plus("ForIfClause"), close_paren_]], - --- dictcomp: --- | '{' kvpair for_if_clauses '}' - define "Dictcomp" [ - list[open_curly_, "Kvpair", plus("ForIfClause"), close_curly_]], - --- # FUNCTION CALL ARGUMENTS --- # ======================= --- --- arguments: --- | args [','] &')' - define "Arguments" [ - list["Args", opt(comma_)]], - --- args: --- | ','.(starred_expression | ( assignment_expression | expression !':=') !'=')+ [',' kwargs ] --- | kwargs - define "Args" [ - list[sep comma_ (alts["StarredExpression", "AssignmentExpression", "Expression"]), opt(list[comma_, "Kwargs"])], - "Kwargs"], - --- kwargs: --- | ','.kwarg_or_starred+ ',' ','.kwarg_or_double_starred+ --- | ','.kwarg_or_starred+ --- | ','.kwarg_or_double_starred+ - define "Kwargs" [ - list[comma_, alts[ - list[plus(list[dot_, "KwargOrStarred"]), opt(list[comma_, comma_, plus(list[dot_, "KwargOrDoubleStarred"])])], - plus(list[dot_, "KwargOrDoubleStarred"])]]], - --- starred_expression: --- | '*' expression - define "StarredExpression" [ - list[star_, "Expression"]], - --- kwarg_or_starred: --- | NAME '=' expression --- | starred_expression - define "KwargOrStarred" [ - list["Name", equal_, "Expression"], - "StarredExpression"], - --- kwarg_or_double_starred: --- | NAME '=' expression --- | '**' expression - define "KwargOrDoubleStarred" [ - list["Name", equal_, "Expression"], - list[double_star_, "Expression"]], - --- # ASSIGNMENT TARGETS --- # ================== - --- # Generic targets --- # --------------- - --- # NOTE: star_targets may contain *bitwise_or, targets may not. --- star_targets: --- | star_target !',' --- | star_target (',' star_target )* [','] - --- star_targets_list_seq: ','.star_target+ [','] - define "StarTargetsListSeq" [ - sepp comma_ (plus(list[dot_, "StarTarget"]))], - --- star_targets_tuple_seq: --- | star_target (',' star_target )+ [','] --- | star_target ',' - define "StarTargetsTupleSeq" [ - sepp comma_ (plus("StarTarget"))], - --- star_target: --- | '*' (!'*' star_target) --- | target_with_star_atom - define "StarTarget" [ - list[star_, "StarTarget"], - "TargetWithStarAtom"], - --- target_with_star_atom: --- | t_primary '.' NAME !t_lookahead --- | t_primary '[' slices ']' !t_lookahead --- | star_atom - define "TargetWithStarAtom" [ - list["TPrimary", dot_, "Name"], - list["TPrimary", open_square_, "Slices", close_square_], - "StarAtom"], - --- star_atom: --- | NAME --- | '(' target_with_star_atom ')' --- | '(' [star_targets_tuple_seq] ')' --- | '[' [star_targets_list_seq] ']' - define "StarAtom" [ - "Name", - list[open_paren_, "TargetWithStarAtom", close_paren_], - list[open_paren_, "StarTargetsTupleSeq", close_paren_], - list[open_square_, "StarTargetsListSeq", close_square_]], - --- single_target: --- | single_subscript_attribute_target --- | NAME --- | '(' single_target ')' - define "SingleTarget" [ - "SingleSubscriptAttributeTarget", - "Name", - list[open_paren_, "SingleTarget", close_paren_]], - --- single_subscript_attribute_target: --- | t_primary '.' NAME !t_lookahead --- | t_primary '[' slices ']' !t_lookahead - define "SingleSubscriptAttributeTarget" [ - list["TPrimary", dot_, "Name"], - list["TPrimary", open_square_, "Slices", close_square_]], - --- t_primary: --- | t_primary '.' NAME &t_lookahead --- | t_primary '[' slices ']' &t_lookahead --- | t_primary genexp &t_lookahead --- | t_primary '(' [arguments] ')' &t_lookahead --- | atom &t_lookahead - define "TPrimary" [ - list["TPrimary", dot_, "Name"], - list["TPrimary", open_square_, "Slices", close_square_], - list["TPrimary", "Genexp"], - list["TPrimary", open_paren_, opt("Arguments"), close_paren_], - "Atom"], - --- t_lookahead: '(' | '[' | '.' - define "TLookahead" [ - open_paren_, open_square_, dot_], - --- # Targets for del statements --- # -------------------------- - --- del_targets: ','.del_target+ [','] - define "DelTargets" [ - list["TPrimary", dot_, "Name"], - list["TPrimary", open_square_, "Slices", close_square_], - "DelTAtom"], - --- del_target: --- | t_primary '.' NAME !t_lookahead --- | t_primary '[' slices ']' !t_lookahead --- | del_t_atom - define "DelTarget" [ - list["TPrimary", dot_, "Name"], - list["TPrimary", open_square_, "Slices", close_square_], - "DelTAtom"], - --- del_t_atom: --- | NAME --- | '(' del_target ')' --- | '(' [del_targets] ')' --- | '[' [del_targets] ']' - define "DelTAtom" [ - "Name", - list[open_paren_, "DelTarget", close_paren_], - list[open_paren_, opt("DelTargets"), close_paren_], - list[open_square_, opt("DelTargets"), close_square_]], - --- # TYPING ELEMENTS --- # --------------- - --- # type_expressions allow */** but ignore them --- type_expressions: --- | ','.expression+ ',' '*' expression ',' '**' expression --- | ','.expression+ ',' '*' expression --- | ','.expression+ ',' '**' expression --- | '*' expression ',' '**' expression --- | '*' expression --- | '**' expression --- | ','.expression+ - define "TypeExpressions" [ - list[sepp comma_ "Expression", star_, "Expression", opt(list[comma_, double_star_, "Expression"])], - list[sepp comma_ "Expression", star_, double_star_, "Expression"], - list[star_, "Expression", opt(list[comma_, double_star_, "Expression"])], - list[double_star_, "Expression"], - list[sepp comma_ "Expression"]], - --- func_type_comment: --- | NEWLINE TYPE_COMMENT &(NEWLINE INDENT) # Must be followed by indented block --- | TYPE_COMMENT - define "FuncTypeComment" [ - list[opt(newline_), "TypeComment"]]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Rdf/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Rdf/Syntax.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Rdf/Syntax.hs +++ /dev/null @@ -1,102 +0,0 @@ -module Hydra.Sources.Tier4.Langs.Rdf.Syntax where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Types as Types -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap - - -rdfSyntaxModule :: Module -rdfSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just "An RDF 1.1 syntax model" - where - ns = Namespace "hydra/langs/rdf/syntax" - def = datatype ns - rdf = typeref ns - - elements = [ - - def "BlankNode" string, - - def "RdfsClass" - $ doc "Stand-in for rdfs:Class" unit, - - def "Dataset" $ set $ rdf "Quad", - - def "Description" $ - doc "A graph of RDF statements together with a distinguished subject and/or object node" $ - record [ - "subject">: rdf "Node", - "graph">: rdf "Graph"], - - def "Graph" $ set $ rdf "Triple", - - def "Iri" $ - doc "An Internationalized Resource Identifier" - string, - - def "IriOrLiteral" $ - doc ("An IRI or a literal; " ++ - "this type is a convenience for downstream models like SHACL which may exclude blank nodes") $ - union [ - "iri">: rdf "Iri", - "literal">: rdf "Literal"], - - def "LangStrings" $ - doc "A convenience type which provides at most one string value per language, and optionally a value without a language" $ - Types.map (optional $ rdf "LanguageTag") string, - - def "LanguageTag" $ - doc "A BCP47 language tag" - string, - - def "Literal" $ - doc "A value such as a string, number, or date" $ - record [ - "lexicalForm">: - doc "a Unicode string, which should be in Normal Form C" - string, - "datatypeIri">: - doc "an IRI identifying a datatype that determines how the lexical form maps to a literal value" $ - rdf "Iri", - "languageTag">: - doc "An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString" $ - optional $ rdf "LanguageTag"], - - def "Node" $ - union [ - "iri">: rdf "Iri", - "bnode">: rdf "BlankNode", - "literal">: rdf "Literal"], - - def "Property" $ - doc "A type representing an RDF property, and encapsulating its domain, range, and subclass relationships" $ - record [ - "domain">: - doc "State that any resource that has a given property is an instance of one or more classes" $ - set $ rdf "RdfsClass", - "range">: - doc "States that the values of a property are instances of one or more classes" $ - set $ rdf "RdfsClass", - "subPropertyOf">: - set $ rdf "Property"], - - def "Quad" $ - doc "An RDF triple with an optional named graph component" $ - record [ - "subject">: rdf "Resource", - "predicate">: rdf "Iri", - "object">: rdf "Node", - "graph">: optional $ rdf "Iri"], - - def "Resource" $ - union [ - "iri">: rdf "Iri", - "bnode">: rdf "BlankNode"], - - def "Triple" $ - doc "An RDF triple defined by a subject, predicate, and object" $ - record [ - "subject">: rdf "Resource", - "predicate">: rdf "Iri", - "object">: rdf "Node"]] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/RelationalModel.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/RelationalModel.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/RelationalModel.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.RelationalModel where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -relationalModelModule :: Module -relationalModelModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just ("An interpretation of Codd's Relational Model, " ++ - "as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). " ++ - "Types ('domains') and values are parameterized so as to allow for application-specific implementations. " ++ - "No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.") - where - ns = Namespace "hydra/langs/relationalModel" - def = datatype ns - rm = typeref ns - - elements = [ - def "ColumnName" $ - doc "A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd" - string, - - def "ColumnSchema" $ - doc "An abstract specification of the domain represented by a column in a relation; a role" $ - lambda "t" $ record [ - "name">: - doc "A unique name for the column" $ - rm "ColumnName", - "domain">: - doc "The domain (type) of the column" $ - "t", - "isPrimaryKey">: - doc "Whether this column represents the primary key of its relation" - boolean], - - def "ForeignKey" $ - doc "A mapping from certain columns of a source relation to primary key columns of a target relation" $ - record [ - "foreignRelation">: - doc "The name of the target relation" $ - rm "RelationName", - "keys">: - Types.map (rm "ColumnName") (rm "ColumnName")], -- TODO: nonempty map - - def "PrimaryKey" $ - doc "A primary key of a relation, specified either as a single column, or as a list of columns" $ - list $ rm "ColumnName", -- TODO: non-empty list - - def "Relation" $ - doc "A set of distinct n-tuples; a table" $ - lambda "v" $ set $ list "v", - - def "RelationName" $ - doc "A unique relation (table) name" - string, - - def "RelationSchema" $ -- Note: this term is not in Codd - doc "An abstract relation; the name and columns of a relation without its actual data" $ - lambda "t" $ record [ - "name">: - doc "A unique name for the relation" $ - rm "RelationName", - "columns">: - doc "A list of column specifications" $ - list $ rm "ColumnSchema" @@ "t", - "primaryKeys">: - doc "Any number of primary keys for the relation, each of which must be valid for this relation" $ - list $ rm "PrimaryKey", - "foreignKeys">: - doc "Any number of foreign keys, each of which must be valid for both this relation and the target relation" $ - list $ rm "ForeignKey"], - - def "Relationship" $ - doc "A domain-unordered (string-indexed, rather than position-indexed) relation" $ - lambda "v" $ set $ Types.map (rm "ColumnName") "v", - - def "Row" $ - doc "An n-tuple which is an element of a given relation" $ - lambda "v" $ list "v"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Scala/Meta.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Scala/Meta.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Scala/Meta.hs +++ /dev/null @@ -1,1372 +0,0 @@ -module Hydra.Sources.Tier4.Langs.Scala.Meta where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Dsl.Types as Types - - -scalaMetaModule :: Module -scalaMetaModule = Module ns elements [hydraCoreModule] tier0Modules $ - Just "A Scala syntax model based on Scalameta (https://scalameta.org)" - where - ns = Namespace "hydra/langs/scala/meta" - def = datatype ns - meta = typeref ns - - elements = [ - - def "PredefString" -- See scala/Predef.scala - string, - - def "ScalaSymbol" $ -- See scala/Symbol.scala - record [ - "name">: string], - --- scala/meta/Trees.scala source below this line. Hydra type definitions inline - --- package scala.meta --- --- import org.scalameta.invariants._ --- import scala.meta.classifiers._ --- import scala.meta.inputs._ --- import scala.meta.tokens._ --- import scala.meta.prettyprinters._ --- import scala.meta.internal.trees._ --- import scala.meta.internal.trees.Metadata.binaryCompatField --- @root trait Tree extends InternalTree { - def "Tree" $ -- Note: ignoring fields of Tree and InternalTree for now - union [ - "ref">: meta "Ref", - "stat">: meta "Stat", - "type">: meta "Type", - "bounds">: meta "Type.Bounds", - "pat">: meta "Pat", - "member">: meta "Member", - "ctor">: meta "Ctor", - "template">: meta "Template", - "mod">: meta "Mod", - "enumerator">: meta "Enumerator", - "importer">: meta "Importer", - "importee">: meta "Importee", - "caseTree">: meta "CaseTree", - "source">: meta "Source", - "quasi">: meta "Quasi"], --- def parent: Option[Tree] --- def children: List[Tree] --- --- def pos: Position --- def tokens(implicit dialect: Dialect): Tokens --- --- final override def canEqual(that: Any): Boolean = this eq that.asInstanceOf[AnyRef] --- final override def equals(that: Any): Boolean = this eq that.asInstanceOf[AnyRef] --- final override def hashCode: Int = System.identityHashCode(this) --- final override def toString = scala.meta.internal.prettyprinters.TreeToString(this) --- } --- --- object Tree extends InternalTreeXtensions { --- implicit def classifiable[T <: Tree]: Classifiable[T] = null --- implicit def showStructure[T <: Tree]: Structure[T] = --- scala.meta.internal.prettyprinters.TreeStructure.apply[T] --- implicit def showSyntax[T <: Tree](implicit dialect: Dialect): Syntax[T] = --- scala.meta.internal.prettyprinters.TreeSyntax.apply[T](dialect) --- } --- --- @branch trait Ref extends Tree - def "Ref" $ - union [ - "name">: meta "Name", - "init">: meta "Init"], --- @branch trait Stat extends Tree - def "Stat" $ - union [ - "term">: meta "Data", - "decl">: meta "Decl", - "defn">: meta "Defn", - "importExport">: meta "ImportExportStat"], --- --- @branch trait Name extends Ref { def value: String } - def "Name" $ - union [ - "value">: string, - "anonymous">: unit, - "indeterminate">: meta "PredefString"], --- object Name { --- def apply(value: String): Name = if (value == "") Name.Anonymous() else Name.Indeterminate(value) --- def unapply(name: Name): Option[String] = Some(name.value) --- @ast class Anonymous() extends Name { --- def value = "" --- checkParent(ParentChecks.NameAnonymous) --- } --- @ast class Indeterminate(value: Predef.String @nonEmpty) extends Name --- } --- --- @branch trait Lit extends Data with Pat with Type { - def "Lit" $ - union [ --- def value: Any --- } --- object Lit { --- def unapply(arg: Lit): Option[Any] = Some(arg.value) --- @ast class Null() extends Lit { def value: Any = null } - "null">: unit, --- @ast class Int(value: scala.Int) extends Lit - "int">: int32, --- // NOTE: Lit.Double/Float are strings to work the same across JS/JVM. Example: --- // 1.4f.toString == "1.399999976158142" // in JS --- // 1.4f.toString == "1.4" // in JVM --- // See https://www.scala-js.org/doc/semantics.html-- tostring-of-float-double-and-unit --- @ast class Double(format: scala.Predef.String) extends Lit { val value = format.toDouble } - "double">: float64, --- object Double { def apply(double: scala.Double): Double = Lit.Double(double.toString) } --- @ast class Float(format: scala.Predef.String) extends Lit { val value = format.toFloat } - "float">: float32, --- object Float { def apply(float: scala.Float): Float = Lit.Float(float.toString) } --- @ast class Byte(value: scala.Byte) extends Lit - "byte">: int8, --- @ast class Short(value: scala.Short) extends Lit - "short">: int16, --- @ast class Char(value: scala.Char) extends Lit - "char">: uint16, --- @ast class Long(value: scala.Long) extends Lit - "long">: int64, --- @ast class Boolean(value: scala.Boolean) extends Lit - "boolean">: boolean, --- @ast class Unit() extends Lit { def value: Any = () } - "unit">: unit, --- @ast class String(value: scala.Predef.String) extends Lit - "string">: string, --- @ast class Symbol(value: scala.Symbol) extends Lit - "symbol">: meta "ScalaSymbol"], --- } --- --- @branch trait Data extends Stat - def "Data" $ - union [ - "lit">: meta "Lit", - "ref">: meta "Data.Ref", - "interpolate">: meta "Data.Interpolate", - "xml">: meta "Data.Xml", - "apply">: meta "Data.Apply", - "applyUsing">: meta "Data.ApplyUsing", - "applyType">: meta "Data.ApplyType", - "assign">: meta "Data.Assign", - "return">: meta "Data.Return", - "throw">: meta "Data.Throw", - "ascribe">: meta "Data.Ascribe", - "annotate">: meta "Data.Annotate", - "tuple">: meta "Data.Tuple", - "block">: meta "Data.Block", - "endMarker">: meta "Data.EndMarker", - "if">: meta "Data.If", - "quotedMacroExpr">: meta "Data.QuotedMacroExpr", - "quotedMacroType">: meta "Data.QuotedMacroType", - "splicedMacroExpr">: meta "Data.SplicedMacroExpr", - "match">: meta "Data.Match", - "try">: meta "Data.Try", - "tryWithHandler">: meta "Data.TryWithHandler", - "functionData">: meta "Data.FunctionData", - "polyFunction">: meta "Data.PolyFunction", - "partialFunction">: meta "Data.PartialFunction", - "while">: meta "Data.While", - "do">: meta "Data.Do", - "for">: meta "Data.For", - "forYield">: meta "Data.ForYield", - "new">: meta "Data.New", - "newAnonymous">: meta "Data.NewAnonymous", - "placeholder">: meta "Data.Placeholder", - "eta">: meta "Data.Eta", - "repeated">: meta "Data.Repeated", - "param">: meta "Data.Param"], --- object Data { --- @branch trait Ref extends Data with scala.meta.Ref - def "Data.Ref" $ - union [ - "this">: meta "Data.This", - "super">: meta "Data.Super", - "name">: meta "Data.Name", - "anonymous">: meta "Data.Anonymous", - "select">: meta "Data.Select", - "applyUnary">: meta "Data.ApplyUnary"], --- @ast class This(qual: scala.meta.Name) extends Data.Ref - def "Data.This" - unit, --- @ast class Super(thisp: scala.meta.Name, superp: scala.meta.Name) extends Data.Ref - def "Data.Super" $ - record [ - "thisp">: meta "Name", - "superp">: meta "Name"], --- @ast class Name(value: Predef.String @nonEmpty) extends scala.meta.Name with Data.Ref with Pat - def "Data.Name" $ - record [ - "value">: meta "PredefString"], --- @ast class Anonymous() extends scala.meta.Name with Data.Ref { - def "Data.Anonymous" - unit, --- def value = "" --- checkParent(ParentChecks.AnonymousImport) --- } --- @ast class Select(qual: Data, name: Data.Name) extends Data.Ref with Pat - def "Data.Select" $ - record [ - "qual">: meta "Data", - "name">: meta "Data.Name"], --- @ast class Interpolate(prefix: Name, parts: List[Lit] @nonEmpty, args: List[Data]) extends Data { - def "Data.Interpolate" $ - record [ - "prefix">: meta "Data.Name", - "parts">: list $ meta "Lit", - "args">: list $ meta "Data"], --- checkFields(parts.length == args.length + 1) --- } --- @ast class Xml(parts: List[Lit] @nonEmpty, args: List[Data]) extends Data { - def "Data.Xml" $ - record [ - "parts">: list $ meta "Lit", - "args">: list $ meta "Data"], --- checkFields(parts.length == args.length + 1) --- } --- @ast class Apply(fun: Data, args: List[Data]) extends Data - def "Data.Apply" $ - record [ - "fun">: meta "Data", - "args">: list $ meta "Data"], --- @ast class ApplyUsing(fun: Data, args: List[Data]) extends Data - def "Data.ApplyUsing" $ - record [ - "fun">: meta "Data", - "targs">: list $ meta "Data"], --- @ast class ApplyType(fun: Data, targs: List[Type] @nonEmpty) extends Data - def "Data.ApplyType" $ - record [ - "lhs">: meta "Data", - "op">: meta "Data.Name", - "targs">: list $ meta "Type", - "args">: list $ meta "Data"], --- @ast class ApplyInfix(lhs: Data, op: Name, targs: List[Type], args: List[Data]) extends Data - def "Data.ApplyInfix" $ - record [ - "lhs">: meta "Data", - "op">: meta "Data.Name", - "targs">: list $ meta "Type", - "args">: list $ meta "Data"], --- @ast class ApplyUnary(op: Name, arg: Data) extends Data.Ref { - def "Data.ApplyUnary" $ - record [ - "op">: meta "Data.Name", - "arg">: meta "Data"], --- checkFields(op.isUnaryOp) --- } --- @ast class Assign(lhs: Data, rhs: Data) extends Data { - def "Data.Assign" $ - record [ - "lhs">: meta "Data", - "rhs">: meta "Data"], --- checkFields(lhs.is[Data.Quasi] || lhs.is[Data.Ref] || lhs.is[Data.Apply]) --- checkParent(ParentChecks.DataAssign) --- } --- @ast class Return(expr: Data) extends Data - def "Data.Return" $ - record [ - "expr">: meta "Data"], --- @ast class Throw(expr: Data) extends Data - def "Data.Throw" $ - record [ - "expr">: meta "Data"], --- @ast class Ascribe(expr: Data, tpe: Type) extends Data - def "Data.Ascribe" $ - record [ - "expr">: meta "Data", - "tpe">: meta "Type"], --- @ast class Annotate(expr: Data, annots: List[Mod.Annot] @nonEmpty) extends Data - def "Data.Annotate" $ - record [ - "expr">: meta "Data", - "annots">: list $ meta "Mod.Annot"], --- @ast class Tuple(args: List[Data] @nonEmpty) extends Data { - def "Data.Tuple" $ - record [ - "args">: list $ meta "Data"], --- // tuple must have more than one element --- // however, this element may be Quasi with "hidden" list of elements inside --- checkFields(args.length > 1 || (args.length == 1 && args.head.is[Data.Quasi])) --- } --- @ast class Block(stats: List[Stat]) extends Data { - def "Data.Block" $ - record [ - "stats">: list $ meta "Stat"], --- // extension group block can have declarations without body too --- checkFields(stats.forall(st => st.isBlockStat || st.is[Decl])) --- } --- @ast class EndMarker(name: Data.Name) extends Data - def "Data.EndMarker" $ - record [ - "name">: meta "Data.Name"], --- @ast class If(cond: Data, thenp: Data, elsep: Data) extends Data { - def "Data.If" $ - record [ - "cond">: meta "Data", - "thenp">: meta "Data", - "elsep">: meta "Data"], --- @binaryCompatField(since = "4.4.0") --- private var _mods: List[Mod] = Nil --- } --- @ast class QuotedMacroExpr(body: Data) extends Data - def "Data.QuotedMacroExpr" $ - record [ - "body">: meta "Data"], --- @ast class QuotedMacroType(tpe: Type) extends Data - def "Data.QuotedMacroType" $ - record [ - "tpe">: meta "Type"], --- @ast class SplicedMacroExpr(body: Data) extends Data - def "Data.SplicedMacroExpr" $ - record [ - "body">: meta "Data"], --- @ast class Match(expr: Data, cases: List[Case] @nonEmpty) extends Data { - def "Data.Match" $ - record [ - "expr">: meta "Data", - "cases">: list $ meta "Case"], --- @binaryCompatField(since = "4.4.5") --- private var _mods: List[Mod] = Nil --- } --- @ast class Try(expr: Data, catchp: List[Case], finallyp: Option[Data]) extends Data - def "Data.Try" $ - record [ - "expr">: meta "Data", - "catchp">: list $ meta "Case", - "finallyp">: optional $ meta "Data"], --- @ast class TryWithHandler(expr: Data, catchp: Data, finallyp: Option[Data]) extends Data - def "Data.TryWithHandler" $ - record [ - "expr">: meta "Data", - "catchp">: meta "Data", - "finallyp">: optional $ meta "Data"], --- --- @branch trait FunctionData extends Data { - def "Data.FunctionData" $ - union [ - "contextFunction">: meta "Data.ContextFunction", - "function">: meta "Data.Function"], --- def params: List[Data.Param] --- def body: Data --- } --- @ast class ContextFunction(params: List[Data.Param], body: Data) extends FunctionData { - def "Data.ContextFunction" $ - record [ - "params">: list $ meta "Data.Param", - "body">: meta "Data"], --- checkFields( --- params.forall(param => --- param.is[Data.Param.Quasi] || --- (param.name.is[scala.meta.Name.Anonymous] ==> param.default.isEmpty) --- ) --- ) --- } --- @ast class Function(params: List[Data.Param], body: Data) extends FunctionData { - def "Data.Function" $ - record [ - "params">: list $ meta "Data.Param", - "body">: meta "Data"], --- checkFields( --- params.forall(param => --- param.is[Data.Param.Quasi] || --- (param.name.is[scala.meta.Name.Anonymous] ==> param.default.isEmpty) --- ) --- ) --- checkFields( --- params.exists(_.is[Data.Param.Quasi]) || --- params.exists(_.mods.exists(_.is[Mod.Implicit])) ==> (params.length == 1) --- ) --- } --- @ast class PolyFunction(tparams: List[Type.Param], body: Data) extends Data - def "Data.PolyFunction" $ - record [ - "tparams">: list $ meta "Type.Param", - "body">: meta "Data"], --- @ast class PartialFunction(cases: List[Case] @nonEmpty) extends Data - def "Data.PartialFunction" $ - record [ - "cases">: list $ meta "Case"], --- @ast class While(expr: Data, body: Data) extends Data - def "Data.While" $ - record [ - "expr">: meta "Data", - "body">: meta "Data"], --- @ast class Do(body: Data, expr: Data) extends Data - def "Data.Do" $ - record [ - "body">: meta "Data", - "expr">: meta "Data"], --- @ast class For(enums: List[Enumerator] @nonEmpty, body: Data) extends Data { - def "Data.For" $ - record [ - "enums">: list $ meta "Enumerator"], --- checkFields( --- enums.head.is[Enumerator.Generator] || enums.head.is[Enumerator.CaseGenerator] || enums.head --- .is[Enumerator.Quasi] --- ) --- } --- @ast class ForYield(enums: List[Enumerator] @nonEmpty, body: Data) extends Data - def "Data.ForYield" $ - record [ - "enums">: list $ meta "Enumerator"], --- @ast class New(init: Init) extends Data - def "Data.New" $ - record [ - "init">: meta "Init"], --- @ast class NewAnonymous(templ: Template) extends Data - def "Data.NewAnonymous" $ - record [ - "templ">: meta "Template"], --- @ast class Placeholder() extends Data - def "Data.Placeholder" - unit, --- @ast class Eta(expr: Data) extends Data - def "Data.Eta" $ - record [ - "expr">: meta "Data"], --- @ast class Repeated(expr: Data) extends Data { - def "Data.Repeated" $ - record [ - "expr">: meta "Data"], --- checkParent(ParentChecks.DataRepeated) --- } --- @ast class Param(mods: List[Mod], name: meta.Name, decltpe: Option[Type], default: Option[Data]) --- extends Member - def "Data.Param" $ - record [ - "mods">: list $ meta "Mod", - "name">: meta "Name", - "decltpe">: optional $ meta "Type", - "default">: optional $ meta "Data"], --- def fresh(): Data.Name = fresh("fresh") --- def fresh(prefix: String): Data.Name = Data.Name(prefix + Fresh.nextId()) --- } --- --- @branch trait Type extends Tree - def "Type" $ - union [ - "ref">: meta "Type.Ref", - "anonymousName">: meta "Type.AnonymousName", - "apply">: meta "Type.Apply", - "applyInfix">: meta "Type.ApplyInfix", - "functionType">: meta "Type.FunctionType", - "polyFunction">: meta "Type.PolyFunction", - "implicitFunction">: meta "Type.ImplicitFunction", - "tuple">: meta "Type.Tuple", - "with">: meta "Type.With", - "and">: meta "Type.And", - "or">: meta "Type.Or", - "refine">: meta "Type.Refine", - "existential">: meta "Type.Existential", - "annotate">: meta "Type.Annotate", - "lambda">: meta "Type.Lambda", - "macro">: meta "Type.Macro", - "method">: meta "Type.Method", - "placeholder">: meta "Type.Placeholder", - "byName">: meta "Type.ByName", - "repeated">: meta "Type.Repeated", - "var">: meta "Type.Var", - "typedParam">: meta "Type.TypedParam", - "match">: meta "Type.Match"], --- object Type { --- @branch trait Ref extends Type with scala.meta.Ref - def "Type.Ref" $ - union [ - "name">: meta "Type.Name", - "select">: meta "Type.Select", - "project">: meta "Type.Project", - "singleton">: meta "Type.Singleton"], --- @ast class Name(value: String @nonEmpty) extends scala.meta.Name with Type.Ref - def "Type.Name" $ - record [ - "value">: string], --- @ast class AnonymousName() extends Type - def "Type.AnonymousName" - unit, --- @ast class Select(qual: Data.Ref, name: Type.Name) extends Type.Ref { - def "Type.Select" $ - record [ - "qual">: meta "Data.Ref", - "name">: meta "Type.Name"], --- checkFields(qual.isPath || qual.is[Data.Super] || qual.is[Data.Ref.Quasi]) --- } --- @ast class Project(qual: Type, name: Type.Name) extends Type.Ref - def "Type.Project" $ - record [ - "qual">: meta "Type", - "name">: meta "Type.Name"], --- @ast class Singleton(ref: Data.Ref) extends Type.Ref { - def "Type.Singleton" $ - record [ - "ref">: meta "Data.Ref"], --- checkFields(ref.isPath || ref.is[Data.Super]) --- } --- @ast class Apply(tpe: Type, args: List[Type] @nonEmpty) extends Type - def "Type.Apply" $ - record [ - "tpe">: meta "Type", - "args">: list $ meta "Type"], --- @ast class ApplyInfix(lhs: Type, op: Name, rhs: Type) extends Type - def "Type.ApplyInfix" $ - record [ - "lhs">: meta "Type", - "op">: meta "Type.Name", - "rhs">: meta "Type"], --- @branch trait FunctionType extends Type { - def "Type.FunctionType" $ - union [ - "function">: meta "Type.Function", - "contextFunction">: meta "Type.ContextFunction"], --- def params: List[Type] --- def res: Type --- } --- @ast class Function(params: List[Type], res: Type) extends FunctionType - def "Type.Function" $ - record [ - "params">: list $ meta "Type", - "res">: meta "Type"], --- @ast class PolyFunction(tparams: List[Type.Param], tpe: Type) extends Type - def "Type.PolyFunction" $ - record [ - "tparams">: list $ meta "Type.Param", - "tpe">: meta "Type"], --- @ast class ContextFunction(params: List[Type], res: Type) extends FunctionType - def "Type.ContextFunction" $ - record [ - "params">: list $ meta "Type", - "res">: meta "Type"], --- @ast @deprecated("Implicit functions are not supported in any dialect") --- class ImplicitFunction( - def "Type.ImplicitFunction" $ - record [ --- params: List[Type], - "params">: list $ meta "Type", --- res: Type - "res">: meta "Type"], --- ) extends Type --- @ast class Tuple(args: List[Type] @nonEmpty) extends Type { - def "Type.Tuple" $ - record [ - "args">: list $ meta "Type"], --- checkFields(args.length > 1 || (args.length == 1 && args.head.is[Type.Quasi])) --- } --- @ast class With(lhs: Type, rhs: Type) extends Type - def "Type.With" $ - record [ - "lhs">: meta "Type", - "rhs">: meta "Type"], --- @ast class And(lhs: Type, rhs: Type) extends Type - def "Type.And" $ - record [ - "lhs">: meta "Type", - "rhs">: meta "Type"], --- @ast class Or(lhs: Type, rhs: Type) extends Type - def "Type.Or" $ - record [ - "lhs">: meta "Type", - "rhs">: meta "Type"], --- @ast class Refine(tpe: Option[Type], stats: List[Stat]) extends Type { - def "Type.Refine" $ - record [ - "tpe">: optional $ meta "Type", - "stats">: list $ meta "Stat"], --- checkFields(stats.forall(_.isRefineStat)) --- } --- @ast class Existential(tpe: Type, stats: List[Stat] @nonEmpty) extends Type { - def "Type.Existential" $ - record [ - "tpe">: meta "Type", - "stats">: list $ meta "Stat"], --- checkFields(stats.forall(_.isExistentialStat)) --- } --- @ast class Annotate(tpe: Type, annots: List[Mod.Annot] @nonEmpty) extends Type - def "Type.Annotate" $ - record [ - "tpe">: meta "Type", - "annots">: list $ meta "Mod.Annot"], --- @ast class Lambda(tparams: List[Type.Param], tpe: Type) extends Type { - def "Type.Lambda" $ - record [ - "tparams">: list $ meta "Type.Param", - "tpe">: meta "Type"], --- checkParent(ParentChecks.LambdaType) --- } --- @ast class Macro(body: Data) extends Type - def "Type.Macro" $ - record [ - "body">: meta "Data"], --- @deprecated("Method type syntax is no longer supported in any dialect", "4.4.3") --- @ast class Method(paramss: List[List[Data.Param]], tpe: Type) extends Type { - def "Type.Method" $ - record [ - "paramss">: list $ list $ meta "Data.Param", - "tpe">: meta "Type"], --- checkParent(ParentChecks.TypeMethod) --- } --- @ast class Placeholder(bounds: Bounds) extends Type - def "Type.Placeholder" $ - record [ - "bounds">: meta "Type.Bounds"], --- @ast class Bounds(lo: Option[Type], hi: Option[Type]) extends Tree - def "Type.Bounds" $ - record [ - "lo">: optional $ meta "Type", - "hi">: optional $ meta "Type"], --- @ast class ByName(tpe: Type) extends Type { - def "Type.ByName" $ - record [ - "tpe">: meta "Type"], --- checkParent(ParentChecks.TypeByName) --- } --- @ast class Repeated(tpe: Type) extends Type { - def "Type.Repeated" $ - record [ - "tpe">: meta "Type"], --- checkParent(ParentChecks.TypeRepeated) --- } --- @ast class Var(name: Name) extends Type with Member.Type { - def "Type.Var" $ - record [ - "name">: meta "Type.Name"], --- checkFields(name.value(0).isLower) --- checkParent(ParentChecks.TypeVar) --- } --- --- @ast class TypedParam(name: Name, typ: Type) extends Type with Member.Type - def "Type.TypedParam" $ - record [ - "name">: meta "Name", - "typ">: meta "Type"], --- @ast class Param( - def "Type.Param" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: meta.Name, - "name">: meta "Name", --- tparams: List[Type.Param], - "tparams">: list $ meta "Type.Param", --- tbounds: Type.Bounds, - "tbounds">: list $ meta "Type.Bounds", --- vbounds: List[Type], - "vbounds">: list $ meta "Type", --- cbounds: List[Type] - "cbounds">: list $ meta "Type"], --- ) extends Member --- --- @ast class Match(tpe: Type, cases: List[TypeCase] @nonEmpty) extends Type - def "Type.Match" $ - record [ - "tpe">: meta "Type", - "cases">: list $ meta "TypeCase"], --- def fresh(): Type.Name = fresh("fresh") --- def fresh(prefix: String): Type.Name = Type.Name(prefix + Fresh.nextId()) --- } --- --- @branch trait Pat extends Tree - def "Pat" $ - union [ - "var">: meta "Pat.Var", - "wildcard">: unit, - "seqWildcard">: unit, - "bind">: meta "Pat.Bind", - "alternative">: meta "Pat.Alternative", - "tuple">: meta "Pat.Tuple", - "repeated">: meta "Pat.Repeated", - "extract">: meta "Pat.Extract", - "extractInfix">: meta "Pat.ExtractInfix", - "interpolate">: meta "Pat.Interpolate", - "xml">: meta "Pat.Xml", - "typed">: meta "Pat.Typed", - "macro">: meta "Pat.Macro", - "given">: meta "Pat.Given"], --- object Pat { --- @ast class Var(name: scala.meta.Data.Name) extends Pat with Member.Data { @ - def "Pat.Var" $ - record [ - "name">: meta "Data.Name"], --- // NOTE: can't do this check here because of things like `val X = 2` --- // checkFields(name.value(0).isLower) --- checkParent(ParentChecks.PatVar) --- } --- @ast class Wildcard() extends Pat --- @ast class SeqWildcard() extends Pat { --- checkParent(ParentChecks.PatSeqWildcard) --- } --- @ast class Bind(lhs: Pat, rhs: Pat) extends Pat { - def "Pat.Bind" $ - record [ - "lhs">: meta "Pat", - "rhs">: meta "Pat"], --- checkFields(lhs.is[Pat.Var] || lhs.is[Pat.Quasi]) --- } --- @ast class Alternative(lhs: Pat, rhs: Pat) extends Pat - def "Pat.Alternative" $ - record [ - "lhs">: meta "Pat", - "rhs">: meta "Pat"], --- @ast class Tuple(args: List[Pat] @nonEmpty) extends Pat { - def "Pat.Tuple" $ - record [ - "args">: list $ meta "Pat"], --- checkFields(args.length > 1 || (args.length == 1 && args.head.is[Pat.Quasi])) --- } --- @ast class Repeated(name: scala.meta.Data.Name) extends Pat - def "Pat.Repeated" $ - record [ - "name">: meta "Data.Name"], --- @ast class Extract(fun: Data, args: List[Pat]) extends Pat { - def "Pat.Extract" $ - record [ - "fun">: meta "Data", - "args">: list $ meta "Pat"], --- checkFields(fun.isExtractor) --- } --- @ast class ExtractInfix(lhs: Pat, op: Data.Name, rhs: List[Pat]) extends Pat - def "Pat.ExtractInfix" $ - record [ - "lhs">: meta "Pat", - "op">: meta "Data.Name", - "rhs">: list $ meta "Pat"], --- @ast class Interpolate(prefix: Data.Name, parts: List[Lit] @nonEmpty, args: List[Pat]) - def "Pat.Interpolate" $ - record [ - "prefix">: meta "Data.Name", - "parts">: list $ meta "Lit"], --- extends Pat { --- checkFields(parts.length == args.length + 1) --- } --- @ast class Xml(parts: List[Lit] @nonEmpty, args: List[Pat]) extends Pat { - def "Pat.Xml" $ - record [ - "parts">: list $ meta "Lit", - "args">: list $ meta "Pat"], --- checkFields(parts.length == args.length + 1) --- } --- @ast class Typed(lhs: Pat, rhs: Type) extends Pat { - def "Pat.Typed" $ - record [ - "lhs">: meta "Pat", - "rhs">: meta "Type"], --- checkFields(!rhs.is[Type.Var] && !rhs.is[Type.Placeholder]) --- } --- @ast class Macro(body: Data) extends Pat { - def "Pat.Macro" $ - record [ - "body">: meta "Data"], --- checkFields(body.is[Data.QuotedMacroExpr] || body.is[Data.QuotedMacroType]) --- } --- @ast class Given(tpe: Type) extends Pat - def "Pat.Given" $ - record [ - "tpe">: meta "Type"], --- def fresh(): Pat.Var = Pat.Var(Data.fresh()) --- def fresh(prefix: String): Pat.Var = Pat.Var(Data.fresh(prefix)) --- } --- --- @branch trait Member extends Tree { - def "Member" $ - union [ - "term">: meta "Member.Data", - "type">: meta "Member.Type", - "termParam">: meta "Data.Param", - "typeParam">: meta "Type.Param", - "self">: meta "Self"], --- def name: Name --- } --- object Member { --- @branch trait Data extends Member { - def "Member.Data" $ - union [ - "pkg">: meta "Pkg", - "object">: meta "Pkg.Object"], --- def name: scala.meta.Data.Name --- } --- @branch trait Type extends Member { - def "Member.Type" $ - record [ --- def name: scala.meta.Type.Name - "name">: meta "Type.Name"], --- } --- } --- --- @branch trait Decl extends Stat - def "Decl" $ - union [ - "val">: meta "Decl.Val", - "var">: meta "Decl.Var", - "def">: meta "Decl.Def", - "type">: meta "Decl.Type", - "given">: meta "Decl.Given"], --- object Decl { --- @ast class Val(mods: List[Mod], pats: List[Pat] @nonEmpty, decltpe: scala.meta.Type) extends Decl - def "Decl.Val" $ - record [ - "mods">: list $ meta "Mod", - "pats">: list $ meta "Pat", - "decltpe">: meta "Type"], --- @ast class Var(mods: List[Mod], pats: List[Pat] @nonEmpty, decltpe: scala.meta.Type) extends Decl - def "Decl.Var" $ - record [ - "mods">: list $ meta "Mod", - "pats">: list $ meta "Pat", - "decltpe">: meta "Type"], --- @ast class Def( - def "Decl.Def" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: Data.Name, - "name">: meta "Data.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- paramss: List[List[Data.Param]], - "paramss">: list $ list $ meta "Data.Param", --- decltpe: scala.meta.Type - "decltpe">: meta "Type"], --- ) extends Decl with Member.Data @ - -- @ast class Type( - def "Decl.Type" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Type.Name, - "name">: meta "Type.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- bounds: scala.meta.Type.Bounds - "bounds">: meta "Type.Bounds"], --- ) extends Decl with Member.Type --- @ast class Given( - def "Decl.Given" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: Data.Name, - "name">: meta "Data.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- sparams: List[List[Data.Param]], - "sparams">: list $ list $ meta "Data.Param", --- decltpe: scala.meta.Type - "decltpe">: meta "Type"], --- ) extends Decl with Member.Data @ --- } --- --- @branch trait Defn extends Stat - def "Defn" $ - union [ - "val">: meta "Defn.Val", - "var">: meta "Defn.Var", - "given">: meta "Defn.Given", - "enum">: meta "Defn.Enum", - "enumCase">: meta "Defn.EnumCase", - "repeatedEnumCase">: meta "Defn.RepeatedEnumCase", - "givenAlias">: meta "Defn.GivenAlias", - "extensionGroup">: meta "Defn.ExtensionGroup", - "def">: meta "Defn.Def", - "macro">: meta "Defn.Macro", - "type">: meta "Defn.Type", - "class">: meta "Defn.Class", - "trait">: meta "Defn.Trait", - "object">: meta "Defn.Object"], --- object Defn { --- @ast class Val( - def "Defn.Val" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- pats: List[Pat] @nonEmpty, - "pats">: list $ meta "Pat", --- decltpe: Option[scala.meta.Type], - "decltpe">: optional $ meta "Type", --- rhs: Data - "rhs">: meta "Data"], --- ) extends Defn { --- checkFields(pats.forall(!_.is[Data.Name])) --- } --- @ast class Var( - def "Defn.Var" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- pats: List[Pat] @nonEmpty, - "pats">: list $ meta "Pat", --- decltpe: Option[scala.meta.Type], - "decltpe">: meta "Type", --- rhs: Option[Data] - "rhs">: optional $ meta "Data"], --- ) extends Defn { --- checkFields(pats.forall(!_.is[Data.Name])) --- checkFields(decltpe.nonEmpty || rhs.nonEmpty) --- checkFields(rhs.isEmpty ==> pats.forall(_.is[Pat.Var])) --- } --- @ast class Given( - def "Defn.Given" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Name, - "name">: meta "Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ list $ meta "Type.Param", --- sparams: List[List[Data.Param]], - "sparams">: list $ list $ meta "Data.Param", --- templ: Template - "templ">: meta "Template"], --- ) extends Defn --- @ast class Enum( - def "Defn.Enum" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Type.Name, - "name">: meta "Type.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- ctor: Ctor.Primary, - "ctor">: meta "Ctor.Primary", --- templ: Template - "template">: meta "Template"], --- ) extends Defn with Member.Type --- @ast class EnumCase( - def "Defn.EnumCase" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: Data.Name, - "name">: meta "Data.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- ctor: Ctor.Primary, - "ctor">: meta "Ctor.Primary", --- inits: List[Init] - "inits">: list $ meta "Init"], --- ) extends Defn with Member.Data { @ --- checkParent(ParentChecks.EnumCase) --- } --- @ast class RepeatedEnumCase( - def "Defn.RepeatedEnumCase" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- cases: List[Data.Name] - "cases">: list $ meta "Data.Name"], --- ) extends Defn { --- checkParent(ParentChecks.EnumCase) --- } --- @ast class GivenAlias( - def "Defn.GivenAlias" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Name, - "name">: meta "Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ list $ meta "Type.Param", --- sparams: List[List[Data.Param]], - "sparams">: list $ list $ meta "Data.Param", --- decltpe: scala.meta.Type, - "decltpe">: meta "Type", --- body: Data - "body">: meta "Data"], --- ) extends Defn --- @ast class ExtensionGroup( - def "Defn.ExtensionGroup" $ - record [ --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- paramss: List[List[Data.Param]], - "parmss">: list $ list $ meta "Data.Param", --- body: Stat - "body">: meta "Stat"], --- ) extends Defn --- @ast class Def( - def "Defn.Def" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: Data.Name, - "name">: meta "Data.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- paramss: List[List[Data.Param]], - "paramss">: list $ list $ meta "Data.Param", --- decltpe: Option[scala.meta.Type], - "decltpe">: optional $ meta "Type", --- body: Data - "body">: meta "Data"], --- ) extends Defn with Member.Data { @ --- checkFields(paramss.forall(onlyLastParamCanBeRepeated)) --- } --- @ast class Macro( - def "Defn.Macro" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: Data.Name, - "name">: meta "Data.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- paramss: List[List[Data.Param]], - "paramss">: list $ list $ meta "Data.Param", --- decltpe: Option[scala.meta.Type], - "decltpe">: optional $ meta "Type", --- body: Data - "body">: meta "Data"], --- ) extends Defn with Member.Data @ --- @ast class Type( - def "Defn.Type" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Type.Name, - "name">: meta "Type.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- body: scala.meta.Type - "body">: meta "Type"], --- ) extends Defn with Member.Type { --- @binaryCompatField("4.4.0") --- private var _bounds: scala.meta.Type.Bounds = scala.meta.Type.Bounds(None, None) --- } --- @ast class Class( - def "Defn.Class" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Type.Name, - "name">: meta "Type.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- ctor: Ctor.Primary, - "ctor">: meta "Ctor.Primary", --- templ: Template - "template">: meta "Template"], --- ) extends Defn with Member.Type --- @ast class Trait( - def "Defn.Trait" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: scala.meta.Type.Name, - "name">: meta "Type.Name", --- tparams: List[scala.meta.Type.Param], - "tparams">: list $ meta "Type.Param", --- ctor: Ctor.Primary, - "ctor">: meta "Ctor.Primary", --- templ: Template - "template">: meta "Template"], --- ) extends Defn with Member.Type { --- checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor])) --- } --- @ast class Object(mods: List[Mod], name: Data.Name, templ: Template) - def "Defn.Object" $ - record [ - "name">: meta "Data.Name"], -- from Member.Data --- extends Defn with Member.Data { @ --- checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor])) --- } --- } --- --- @ast class Pkg(ref: Data.Ref, stats: List[Stat]) extends Member.Data with Stat { @ - def "Pkg" $ - record [ - "name">: meta "Data.Name", -- from Member.Data - "ref">: meta "Data.Ref", - "stats">: list $ meta "Stat"], --- checkFields(ref.isQualId) --- def name: Data.Name = ref match { --- case name: Data.Name => name --- case Data.Select(_, name: Data.Name) => name --- } --- } --- object Pkg { --- @ast class Object(mods: List[Mod], name: Data.Name, templ: Template) --- extends Member.Data with Stat { @ - def "Pkg.Object" $ - record [ - "mods">: list $ meta "Mod", - "name">: meta "Data.Name", - "template">: meta "Template"], --- checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor])) --- } --- } --- --- // NOTE: The names of Ctor.Primary and Ctor.Secondary here is always Name.Anonymous. --- // While seemingly useless, this name is crucial to one of the key principles behind the semantic API: --- // "every definition and every reference should carry a name". --- @branch trait Ctor extends Tree with Member - def "Ctor" $ - union [ - "primary">: meta "Ctor.Primary", - "secondary">: meta "Ctor.Secondary"], --- object Ctor { --- @ast class Primary(mods: List[Mod], name: Name, paramss: List[List[Data.Param]]) extends Ctor - def "Ctor.Primary" $ - record [ - "mods">: list $ meta "Mod", - "name">: meta "Name", - "paramss">: list $ list $ meta "Data.Param"], --- @ast class Secondary( - def "Ctor.Secondary" $ - record [ --- mods: List[Mod], - "mods">: list $ meta "Mod", --- name: Name, - "name">: meta "Name", --- paramss: List[List[Data.Param]] @nonEmpty, - "paramss">: list $ list $ meta "Data.Param", --- init: Init, - "init">: meta "Init", --- stats: List[Stat] - "stats">: list $ meta "Stat"], --- ) extends Ctor with Stat { --- checkFields(stats.forall(_.isBlockStat)) --- } --- } --- --- // NOTE: The name here is always Name.Anonymous. --- // See comments to Ctor.Primary and Ctor.Secondary for justification. --- @ast class Init(tpe: Type, name: Name, argss: List[List[Data]]) extends Ref { - def "Init" $ - record [ - "tpe">: meta "Type", - "name">: meta "Name", - "argss">: list $ list $ meta "Data"], --- checkFields(tpe.isConstructable) --- checkParent(ParentChecks.Init) --- } --- --- @ast class Self(name: Name, decltpe: Option[Type]) extends Member - def "Self" - unit, --- --- @ast class Template( - def "Template" $ - record [ --- early: List[Stat], - "early">: list $ meta "Stat", --- inits: List[Init], - "inits">: list $ meta "Init", --- self: Self, - "self">: meta "Self", --- stats: List[Stat] - "stats">: list $ meta "Stat"], --- ) extends Tree { --- @binaryCompatField("4.4.0") --- private var _derives: List[Type] = Nil --- checkFields(early.forall(_.isEarlyStat && inits.nonEmpty)) --- checkFields(stats.forall(_.isTemplateStat)) --- } --- --- @branch trait Mod extends Tree - def "Mod" $ - union [ - "annot">: meta "Mod.Annot", - "private">: meta "Mod.Private", - "protected">: meta "Mod.Protected", - "implicit">: unit, - "final">: unit, - "sealed">: unit, - "open">: unit, - "super">: unit, - "override">: unit, - "case">: unit, - "abstract">: unit, - "covariant">: unit, - "contravariant">: unit, - "lazy">: unit, - "valParam">: unit, - "varParam">: unit, - "infix">: unit, - "inline">: unit, - "using">: unit, - "opaque">: unit, - "transparent">: unit], --- object Mod { --- @ast class Annot(init: Init) extends Mod { - def "Mod.Annot" $ - record [ - "init">: meta "Init"], --- @deprecated("Use init instead", "1.9.0") --- def body = init --- } --- @ast class Private(within: Ref) extends Mod { - def "Mod.Private" $ - record [ - "within">: meta "Ref"], --- checkFields(within.isWithin) --- } --- @ast class Protected(within: Ref) extends Mod { - def "Mod.Protected" $ - record [ - "within">: meta "Ref"], --- checkFields(within.isWithin) --- } --- @ast class Implicit() extends Mod --- @ast class Final() extends Mod --- @ast class Sealed() extends Mod --- @ast class Open() extends Mod --- @deprecated("Super traits introduced in dotty, but later removed.") --- @ast class Super() extends Mod --- @ast class Override() extends Mod --- @ast class Case() extends Mod --- @ast class Abstract() extends Mod --- @ast class Covariant() extends Mod --- @ast class Contravariant() extends Mod --- @ast class Lazy() extends Mod --- @ast class ValParam() extends Mod --- @ast class VarParam() extends Mod --- @ast class Infix() extends Mod --- @ast class Inline() extends Mod --- @ast class Using() extends Mod --- @ast class Opaque() extends Mod --- @ast class Transparent() extends Mod --- } --- --- @branch trait Enumerator extends Tree - def "Enumerator" $ - union [ - "generator">: meta "Enumerator.Generator", - "caseGenerator">: meta "Enumerator.CaseGenerator", - "val">: meta "Enumerator.Val", - "guard">: meta "Enumerator.Guard"], --- object Enumerator { --- @ast class Generator(pat: Pat, rhs: Data) extends Enumerator - def "Enumerator.Generator" $ - record [ - "pat">: meta "Pat", - "rhs">: meta "Data"], --- @ast class CaseGenerator(pat: Pat, rhs: Data) extends Enumerator - def "Enumerator.CaseGenerator" $ - record [ - "pat">: meta "Pat", - "rhs">: meta "Data"], --- @ast class Val(pat: Pat, rhs: Data) extends Enumerator - def "Enumerator.Val" $ - record [ - "pat">: meta "Pat", - "rhs">: meta "Data"], --- @ast class Guard(cond: Data) extends Enumerator - def "Enumerator.Guard" $ - record [ - "cond">: meta "Data"], --- } --- --- @branch trait ImportExportStat extends Stat { - def "ImportExportStat" $ - union [ - "import">: meta "Import", - "export">: meta "Export"], --- def importers: List[Importer] --- } --- @ast class Import(importers: List[Importer] @nonEmpty) extends ImportExportStat - def "Import" $ - record [ - "importers">: list $ meta "Importer"], --- @ast class Export(importers: List[Importer] @nonEmpty) extends ImportExportStat - def "Export" $ - record [ - "importers">: list $ meta "Importer"], --- --- @ast class Importer(ref: Data.Ref, importees: List[Importee] @nonEmpty) extends Tree { - def "Importer" $ - record [ - "ref">: meta "Data.Ref", - "importees">: list $ meta "Importee"], --- checkFields(ref.isStableId) --- } --- --- @branch trait Importee extends Tree with Ref - def "Importee" $ - union [ - "wildcard">: unit, - "given">: meta "Importee.Given", - "givenAll">: unit, - "name">: meta "Importee.Name", - "rename">: meta "Importee.Rename", - "unimport">: meta "Importee.Unimport"], --- object Importee { --- @ast class Wildcard() extends Importee --- @ast class Given(tpe: Type) extends Importee - def "Importee.Given" $ - record [ - "tpe">: meta "Type"], --- @ast class GivenAll() extends Importee --- @ast class Name(name: scala.meta.Name) extends Importee { - def "Importee.Name" $ - record [ - "name">: meta "Name"], --- checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate]) --- } --- @ast class Rename(name: scala.meta.Name, rename: scala.meta.Name) extends Importee { - def "Importee.Rename" $ - record [ - "name">: meta "Name", - "rename">: meta "Name"], --- checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate]) --- checkFields(rename.is[scala.meta.Name.Quasi] || rename.is[scala.meta.Name.Indeterminate]) --- } --- @ast class Unimport(name: scala.meta.Name) extends Importee { - def "Importee.Unimport" $ - record [ - "name">: meta "Name"], --- checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate]) --- } --- } --- --- @branch trait CaseTree extends Tree { - def "CaseTree" $ - union [ - "case">: meta "Case", - "typeCase">: meta "TypeCase"], --- def pat: Tree --- def body: Tree --- } --- @ast class Case(pat: Pat, cond: Option[Data], body: Data) extends CaseTree - def "Case" $ - record [ - "pat">: meta "Pat", - "cond">: optional $ meta "Data", - "body">: meta "Data"], --- @ast class TypeCase(pat: Type, body: Type) extends CaseTree - def "TypeCase" $ - record [ - "pat">: meta "Type", - "body">: meta "Type"], --- --- @ast class Source(stats: List[Stat]) extends Tree { - def "Source" $ - record [ - "stats">: list $ meta "Stat"], --- // NOTE: This validation has been removed to allow dialects with top-level terms. --- // Ideally, we should push the validation into a dialect-specific prettyprinter when -- 220 is fixed. --- // checkFields(stats.forall(_.isTopLevelStat)) --- } --- --- package internal.trees { --- // NOTE: Quasi is a base trait for a whole bunch of classes. --- // Every root, branch and ast trait/class among scala.meta trees (except for quasis themselves) --- // has a corresponding quasi, e.g. Data.Quasi or Type.Quasi. --- // --- // Here's how quasis represent unquotes --- // (XXX below depends on the position where the unquote occurs, e.g. q"$x" will result in Data.Quasi): --- // * $x => XXX.Quasi(0, XXX.Name("x")) --- // * ..$xs => XXX.Quasi(1, XXX.Quasi(0, XXX.Name("xs")) --- // * ...$xss => XXX.Quasi(2, XXX.Quasi(0, XXX.Name("xss")) --- // * ..{$fs($args)} => Complex ellipses aren't supported yet --- @branch trait Quasi extends Tree { - def "Quasi" -- TODO - unit] --- def rank: Int --- def tree: Tree --- def pt: Class[_] --- def become[T <: Quasi: AstInfo]: T --- } --- --- @registry object All --- } diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Shacl/Model.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Shacl/Model.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Shacl/Model.hs +++ /dev/null @@ -1,273 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Shacl.Model where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Annotations -import Hydra.Dsl.Bootstrap -import Hydra.Sources.Tier4.Langs.Rdf.Syntax -import Hydra.Dsl.Types as Types - - -shaclModelModule :: Module -shaclModelModule = Module ns elements [rdfSyntaxModule] tier0Modules $ - Just "A SHACL syntax model. See https://www.w3.org/TR/shacl" - where - ns = Namespace "hydra/langs/shacl/model" - def = datatype ns - shacl = typeref ns - rdf = typeref $ moduleNamespace rdfSyntaxModule - - elements = [ - - def "Closed" $ - see "https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent" $ - record [ - "isClosed">: boolean, - "ignoredProperties">: optional $ set $ rdf "Property"], - - def "CommonConstraint" $ - doc "Any of a number of constraint parameters which can be applied either to node or property shapes" $ - union [ - "and">: - see "https://www.w3.org/TR/shacl/#AndConstraintComponent" $ - set $ shacl "Reference" @@ shacl "Shape", - - "closed">: - see "https://www.w3.org/TR/shacl/#ClosedConstraintComponent" $ - shacl "Closed", - - "class">: - see "https://www.w3.org/TR/shacl/#ClassConstraintComponent" $ - set $ rdf "RdfsClass", - - "datatype">: - see "https://www.w3.org/TR/shacl/#DatatypeConstraintComponent" $ - rdf "Iri", - - "disjoint">: - see "https://www.w3.org/TR/shacl/#DisjointConstraintComponent" $ - set $ rdf "Property", - - "equals">: - see "https://www.w3.org/TR/shacl/#EqualsConstraintComponent" $ - set $ rdf "Property", - - "hasValue">: - doc ("Specifies the condition that at least one value node is equal to the given RDF term. " ++ - "See https://www.w3.org/TR/shacl/#HasValueConstraintComponent") $ - set $ rdf "Node", - - "in">: - doc ("Specifies the condition that each value node is a member of a provided SHACL list. " ++ - "See https://www.w3.org/TR/shacl/#InConstraintComponent") $ - list $ rdf "Node", - - "languageIn">: - see "https://www.w3.org/TR/shacl/#LanguageInConstraintComponent" $ - set $ rdf "LanguageTag", - - "nodeKind">: - see "https://www.w3.org/TR/shacl/#NodeKindConstraintComponent" $ - shacl "NodeKind", - - "node">: - see "https://www.w3.org/TR/shacl/#NodeConstraintComponent" $ - set $ shacl "Reference" @@ shacl "NodeShape", - - "not">: - see "https://www.w3.org/TR/shacl/#NotConstraintComponent" $ - set $ shacl "Reference" @@ shacl "Shape", - - "maxExclusive">: - see "https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent" $ - rdf "Literal", - - "maxInclusive">: - see "https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent" $ - rdf "Literal", - - "maxLength">: - see "https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent" $ - bigint, - - "minExclusive">: - see "https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent" $ - rdf "Literal", - - "minInclusive">: - see "https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent" $ - rdf "Literal", - - "minLength">: - see "https://www.w3.org/TR/shacl/#MinLengthConstraintComponent" $ - bigint, - - "pattern">: - see "https://www.w3.org/TR/shacl/#PatternConstraintComponent" $ - shacl "Pattern", - - "property">: - see "https://www.w3.org/TR/shacl/#PropertyConstraintComponent" $ - set $ shacl "Reference" @@ shacl "PropertyShape", - - "or">: - see "https://www.w3.org/TR/shacl/#OrConstraintComponent" $ - set $ shacl "Reference" @@ shacl "Shape", - - "xone">: - see "https://www.w3.org/TR/shacl/#XoneConstraintComponent" $ - set $ shacl "Reference" @@ shacl "Shape"], - - def "CommonProperties" $ - doc "Common constraint parameters and other properties for SHACL shapes" $ - record [ - "constraints">: - doc "Common constraint parameters attached to this shape" - $ set $ shacl "CommonConstraint", - - "deactivated">: - see "https://www.w3.org/TR/shacl/#deactivated" $ - optional boolean, - - "message">: - see "https://www.w3.org/TR/shacl/#message" $ - rdf "LangStrings", - - "severity">: - see "https://www.w3.org/TR/shacl/#severity" $ - shacl "Severity", - - "targetClass">: - see "https://www.w3.org/TR/shacl/#targetClass" $ - set $ rdf "RdfsClass", - - "targetNode">: - see "https://www.w3.org/TR/shacl/#targetNode" $ - set $ rdf "IriOrLiteral", - - "targetObjectsOf">: - see "https://www.w3.org/TR/shacl/#targetObjectsOf" $ - set $ rdf "Property", - - "targetSubjectsOf">: - see "https://www.w3.org/TR/shacl/#targetSubjectsOf" $ - set $ rdf "Property"], - - def "Definition" $ - doc "An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance" $ - lambda "a" $ record [ - "iri">: rdf "Iri", - "target">: "a"], - - def "NodeKind" $ union [ - "blankNode">: doc "A blank node" unit, - "iri">: doc "An IRI" unit, - "literal">: doc "A literal" unit, - "blankNodeOrIri">: doc "A blank node or an IRI" unit, - "blankNodeOrLiteral">: doc "A blank node or a literal" unit, - "iriOrLiteral">: doc "An IRI or a literal" unit], - - def "NodeShape" $ - doc "A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes" $ - record [ - "common">: shacl "CommonProperties"], - - def "Pattern" $ - doc "A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent" $ - record [ - "regex">: string, - "flags">: optional string], - - def "PropertyShape" $ - doc "A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes" $ - record [ - "common">: shacl "CommonProperties", - - "constraints">: - doc "Any property shape -specific constraint parameters" $ - set $ shacl "PropertyShapeConstraint", - - "defaultValue">: - see "https://www.w3.org/TR/shacl/#defaultValue" $ - optional $ rdf "Node", - - "description">: - see "https://www.w3.org/TR/shacl/#name" $ - rdf "LangStrings", - - "name">: - see "https://www.w3.org/TR/shacl/#name" $ - rdf "LangStrings", - - "order">: - see "https://www.w3.org/TR/shacl/#order" $ - optional bigint, - - "path">: rdf "Iri"], -- TODO - -- Note: sh:group is omitted for now, for lack of a clear definition of PropertyGroup - - def "PropertyShapeConstraint" $ - doc "A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes" $ - union [ - - "lessThan">: - see "https://www.w3.org/TR/shacl/#LessThanConstraintComponent" $ - set $ rdf "Property", - - "lessThanOrEquals">: - see "https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent" $ - set $ rdf "Property", - - "maxCount">: - doc ("The maximum cardinality. Node shapes cannot have any value for sh:maxCount. " ++ - "See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent") $ - bigint, - - "minCount">: - doc ("The minimum cardinality. Node shapes cannot have any value for sh:minCount. " ++ - "See https://www.w3.org/TR/shacl/#MinCountConstraintComponent") $ - bigint, - - "uniqueLang">: - see "https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent" $ - boolean, - - "qualifiedValueShape">: - see "https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" $ - shacl "QualifiedValueShape"], - - def "QualifiedValueShape" $ - see "https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" $ - record [ - "qualifiedValueShape">: shacl "Reference" @@ shacl "Shape", - "qualifiedMaxCount">: bigint, - "qualifiedMinCount">: bigint, - "qualifiedValueShapesDisjoint">: optional boolean], - - def "Reference" $ - doc "Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type" $ - lambda "a" $ union [ - "named">: rdf "Iri", - "anonymous">: - doc "An anonymous instance" - "a", - "definition">: - doc "An inline definition" $ - shacl "Definition" @@ "a"], - - def "Severity" $ union [ - "info">: doc "A non-critical constraint violation indicating an informative message" unit, - "warning">: doc "A non-critical constraint violation indicating a warning" unit, - "violation">: doc "A constraint violation" unit], - - def "Shape" $ - doc "A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes" $ - union [ - "node">: shacl "NodeShape", - "property">: shacl "PropertyShape"], - - def "ShapesGraph" $ - doc ("An RDF graph containing zero or more shapes that is passed into a SHACL validation process " ++ - "so that a data graph can be validated against the shapes") $ - set $ shacl "Definition" @@ shacl "Shape"] diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Shex/Syntax.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Shex/Syntax.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Shex/Syntax.hs +++ /dev/null @@ -1,524 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Shex.Syntax where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Grammars -import Hydra.Tools.GrammarToModule -import qualified Hydra.Dsl.Annotations as Ann -import qualified Hydra.Grammar as G - - -base_ = terminal "BASE" -prefix_ = terminal "PREFIX" -start_ = terminal "start" -equal_ = terminal "=" -or_ = terminal "OR" -and_ = terminal "AND" -not_ = terminal "NOT" -true_ = terminal "true" -false_ = terminal "false" -iri_ = terminal "IRI" -bnode_ = terminal "BNODE" -literal_ = terminal "LITERAL" -nonLiteral_ = terminal "NONLITERAL" -length_ = terminal "LENGTH" -minLength_ = terminal "MINLENGTH" -maxLength_ = terminal "MAXLENGTH" -external_ = terminal "EXTERNAL" -percent_ = terminal "%" -at_ = terminal "@" -dollar_ = terminal "$" -ampersand_ = terminal "&" -colon_ = terminal ":" -period_ = terminal "." -coma_ = terminal "," -semicolon_ = terminal ";" -underscore_ = terminal "_" -dash_ = terminal "-" -parenOpen_ = terminal "(" -parenClose_ = terminal ")" -braceOpen_ = terminal "{" -braceClose_ = terminal "}" -pipe_ = terminal "|" -star_ = terminal "*" -plus_ = terminal "+" -question_ = terminal "?" -tilde_ = terminal "~" -doubleFrwSlash_ = terminal "\\" -singleQuote_ = terminal "'" -doubleQuote_ = terminal "\"" - -minInclusive_ = terminal "MININCLUSIVE" -minExclusive_ = terminal "MINEXCLUSIVE" -maxInclusive_ = terminal "MAXINCLUSIVE" -maxExclusive_ = terminal "MAXEXCLUSIVE" -totalDigits_ = terminal "TOTALDIGITS" -fractionDigits_ = terminal "FRACTIONDIGITS" -extra_ = terminal "EXTRA" -closed_ = terminal "CLOSED" - - -shexSyntaxModule :: Module -shexSyntaxModule = grammarToModule ns shexGrammar $ - Just ("A Shex model. Based on the BNF at:\n" ++ - " https://github.com/shexSpec/grammar/blob/master/bnf") - where - ns = Namespace "hydra/langs/shex/syntax" - -shexGrammar :: G.Grammar -shexGrammar = G.Grammar [ - --- [1] ShexDoc ::= Directive* ((NotStartAction | StartActions) Statement*)? - define "ShexDoc" [ - list[star"Directive", opt(list[ alts["NotStartAction", "StartActions"], star "Statement" ]), "PrefixDecl"]], - --- [2] Directive ::= BaseDecl | PrefixDecl - define "Directive" [ - "BaseDecl", "PrefixDecl"], - --- [3] BaseDecl ::= "BASE" IriRef - define "BaseDecl" [ - list[base_, "IriRef"]], - --- [4] PrefixDecl ::= "PREFIX" PnameNs IriRef - define "PrefixDecl" [ - list[prefix_, "PnameNs", "IriRef"]], - --- [5] NotStartAction ::= start | shapeExprDecl --- [6] start ::= "start" '=' ShapeExpression --- [9] shapeExprDecl ::= ShapeExprLabel (ShapeExpression|"EXTERNAL") - define "NotStartAction" [ - "start">: list[start_, equal_, "ShapeExpression"], - "shapeExprDecl">: list["ShapeExprLabel", alts["ShapeExpression", external_]]], - --- [7] StartActions ::= CodeDecl+ - define "StartActions" [ - plus("CodeDecl")], - --- [8] Statement ::= Directive | NotStartAction - define "Statement" [ - alts[ "Directive", "NotStartAction"]], - --- [10] ShapeExpression ::= ShapeOr - define "ShapeExpression" [ - "ShapeOr"], - --- [11] InlineShapeExpression ::= InlineShapeOr - define "InlineShapeExpression" [ - "InlineShapeOr"], - --- [12] ShapeOr ::= ShapeAnd ("OR" ShapeAnd)* - define "ShapeOr" [ - list["ShapeAnd", star(list[or_, "ShapeAnd"])]], - --- [13] InlineShapeOr ::= InlineShapeAnd ("OR" InlineShapeAnd)* - define "InlineShapeOr" [ - list["ShapeAnd", star(list[or_, "InlineShapeAnd"])]], - --- [14] ShapeAnd ::= ShapeNot ("AND" ShapeNot)* - define "ShapeAnd" [ - list["ShapeNot", star(list[and_, "ShapeNot"])]], - --- [15] InlineShapeAnd ::= InlineShapeNot ("AND" InlineShapeNot)* - define "InlineShapeAnd" [ - list["InlineShapeNot", star(list[and_, "InlineShapeNot"])]], - --- [16] ShapeNot ::= "NOT"? ShapeAtom - define "ShapeNot" [ - list[opt (not_), "ShapeAtom"]], - --- [17] InlineShapeNot ::= "NOT"? InlineShapeAtom - define "InlineShapeNot" [ - list[opt(not_), "InlineShapeAtom"]], - --- [18] ShapeAtom ::= NodeConstraint ShapeOrRef? --- | ShapeOrRef --- | "(" ShapeExpression ")" --- | '.' # no constraint - define "ShapeAtom" [ - list["NodeConstraint", opt("ShapeOrRef")], - "ShapeOrRef", - list[parenOpen_, "ShapeExpression", parenClose_], - period_], - --- [19] InlineShapeAtom ::= NodeConstraint InlineShapeOrRef? --- | InlineShapeOrRef NodeConstraint? --- | "(" ShapeExpression ")" --- | '.' # no constraint - define "InlineShapeAtom" [ - list["NodeConstraint", opt("InlineShapeOrRef")], - list["InlineShapeOrRef", opt("NodeConstraint")], - list[parenOpen_, "ShapeExpression", parenClose_], - period_], - --- [20] ShapeOrRef ::= ShapeDefinition --- | AtpNameLn | AtpNameNs | '@' ShapeExprLabel - define "ShapeOrRef" [ - "ShapeDefinition", - "AtpNameLn", - "AtpNameNs", - list[at_,"ShapeExprLabel"]], - --- [21] InlineShapeOrRef ::= InlineShapeDefinition --- | AtpNameLn | AtpNameNs | '@' ShapeExprLabel - define "InlineShapeOrRef" [ - "InlineShapeDefinition", - "AtpNameLn", - "AtpNameNs", - list[at_,"ShapeExprLabel"]], - --- [22] NodeConstraint ::= "LITERAL" XsFacet* --- | NonLiteralKind StringFacet* --- | Datatype XsFacet* --- | ValueSet XsFacet* --- | XsFacet+ - define "NodeConstraint" [ - list[literal_, star("XsFacet")], - list["NonLiteralKind", star("StringFacet")], - list["Datatype", star("XsFacet")], - list["ValueSet", star("XsFacet")], - list["ValueSet", star("XsFacet")], - plus("XsFacet")], - --- [23] NonLiteralKind ::= "IRI" | "BNODE" | "NONLITERAL" - define "NonLiteralKind" [iri_, bnode_, nonLiteral_], - --- [24] XsFacet ::= StringFacet | NumericFacet - define "XsFacet" ["StringFacet", "NumericFacet"], - --- [25] StringFacet ::= StringLength Integer | Regexp - define "StringFacet" [ - list ["StringLength", "Integer"], - "Regexp" ], - --- [26] StringLength ::= "LENGTH" | "MINLENGTH" | "MAXLENGTH" - define "StringLength" [ - length_, minLength_, maxLength_], - --- [27] NumericFacet ::= NumericRange NumericLiteral --- | NumericLength Integer - define "NumericFacet" [ - list ["NumericRange", "NumericLiteral"], - list ["NumericLength", "Integer"]], - --- [28] NumericRange ::= "MININCLUSIVE" | "MINEXCLUSIVE" | "MAXINCLUSIVE" | "MAXEXCLUSIVE" - define "NumericRange" [ - minInclusive_, minExclusive_, maxInclusive_, maxExclusive_], - --- [29] NumericLength ::= "TOTALDIGITS" | "FRACTIONDIGITS" - define "NumericLength" [ - totalDigits_, fractionDigits_], - --- [30] ShapeDefinition ::= (IncludeSet | ExtraPropertySet | "CLOSED")* '{' TripleExpression? '}' Annotation* SemanticActions - define "ShapeDefinition" [ - list[star(alts["IncludeSet", "ExtraPropertySet", closed_]), - braceOpen_, opt("TripleExpression"), braceClose_, - star("Annotation"), "SemanticActions"]], - --- [31] InlineShapeDefinition ::= (IncludeSet | ExtraPropertySet | "CLOSED")* '{' TripleExpression? '}' - define "InlineShapeDefinition" [ - list[star(alts["IncludeSet", "ExtraPropertySet", closed_]), braceOpen_, opt("TripleExpression"), braceClose_]], - --- [32] ExtraPropertySet ::= "EXTRA" Predicate+ - define "ExtraPropertySet" [ - list[extra_, plus"Predicate"]], - --- [33] TripleExpression ::= OneOfTripleExpr - define "TripleExpression" [ - "OneOfTripleExpr"], - --- [34] OneOfTripleExpr ::= GroupTripleExpr | MultiElementOneOf - define "OneOfTripleExpr" [ - "GroupTripleExpr", - "MultiElementOneOf"], - --- [35] MultiElementOneOf ::= GroupTripleExpr ('|' GroupTripleExpr)+ - define "MultiElementOneOf" [ - list["GroupTripleExpr", plus(list[pipe_, "GroupTripleExpr"])]], - --- [36] InnerTripleExpr ::= MultiElementGroup | MultiElementOneOf - define "InnerTripleExpr" [ - "MultiElementGroup", - "MultiElementOneOf"], - --- [37] GroupTripleExpr ::= SingleElementGroup | MultiElementGroup - define "GroupTripleExpr" [ - "SingleElementGroup", - "MultiElementGroup"], - --- [38] SingleElementGroup ::= UnaryTripleExpr ';'? - define "SingleElementGroup" [ - list["UnaryTripleExpr", opt(semicolon_)]], - --- [39] MultiElementGroup ::= UnaryTripleExpr (';' UnaryTripleExpr)+ ';'? - define "MultiElementGroup" [ - list["UnaryTripleExpr", plus(list[semicolon_, "UnaryTripleExpr"]), opt(semicolon_)]], - --- [40] UnaryTripleExpr ::= ('$' TripleExprLabel)? (TripleConstraint | BracketedTripleExpr) | Include - define "UnaryTripleExpr" [ - list[opt(list[dollar_, "TripleExprLabel"]), alts["TripleConstraint", "BracketedTripleExpr"]], - "Include"], - --- [41] BracketedTripleExpr ::= '(' InnerTripleExpr ')' Cardinality? Annotation* SemanticActions - define "BracketedTripleExpr" [ - list[parenOpen_, "InnerTripleExpr", parenClose_, opt"Cardinality", star"Annotation", "SemanticActions"]], - --- [43] TripleConstraint ::= SenseFlags? Predicate InlineShapeExpression Cardinality? Annotation* SemanticActions - define "TripleConstraint" [ - list[opt"SenseFlags", "Predicate", "InlineShapeExpression", opt"Cardinality", star"Annotation", "SemanticActions"]], - --- [44] Cardinality ::= '*' | '+' | '?' | RepeatRange - define "Cardinality" [ - star_, plus_, question_, "RepeatRange"], - - --- [45] SenseFlags ::= '^' - define "SenseFlags" [ - terminal "^"], - --- [46] ValueSet ::= '[' ValueSetValue* ']' - define "ValueSet" [ - list[terminal "[", star"ValueSetValue", terminal "]"]], - --- [47] ValueSetValue ::= IriRange | Literal - define "ValueSetValue" [ - "IriRange", - "Literal"], - --- [48] IriRange ::= Iri ('~' Exclusion*)? | '.' Exclusion+ - define "IriRange" [ - list["Iri", opt(list[tilde_, star"Exclusion"])], - list[period_, plus"Exclusion"]], - --- [49] Exclusion ::= '-' Iri '~'? - define "Exclusion" [ - list[dash_, "Iri", tilde_]], - --- [50] Include ::= '&' TripleExprLabel - define "Include" [ - list[ampersand_, "TripleExprLabel"]], - --- [51] Annotation ::= '//' Predicate (Iri | Literal) - define "Annotation" [ - list[terminal "//", "Predicate", alts["Iri", "Literal"]]], - --- [52] SemanticActions ::= CodeDecl* - define "SemanticActions" [ - star"CodeDecl"], - --- [53] CodeDecl ::= '%' Iri (Code | "%") - define "CodeDecl" [ - list[percent_, "Iri", alts["Code", percent_]]], - --- [13t] Literal ::= RdfLiteral | NumericLiteral | BooleanLiteral - define "Literal" [ - "RdfLiteral", - "NumericLiteral", - "BooleanLiteral"], - --- [54] Predicate ::= Iri | RdfType - define "Predicate" [ - "Iri", - "RdfType"], - --- [55] Datatype ::= Iri - define "Datatype" [ - "Iri"], - --- [56] ShapeExprLabel ::= Iri | BlankNode - define "ShapeExprLabel" [ - "Iri", - "BlankNode"], - --- [42] TripleExprLabel ::= '$' (Iri | BlankNode) - define "TripleExprLabel" [ - list[dollar_, alts["Iri", "BlankNode"]]], - --- [16t] NumericLiteral ::= Integer | Decimal | Double - define "NumericLiteral" [ - "Integer", "Decimal", "Double"], - --- [129s] RdfLiteral ::= String (LangTag | '^^' Datatype)? - define "RdfLiteral" [ - list["String", opt(alts["LangTag", list[terminal "^^", "Datatype"]])]], - --- [134s] BooleanLiteral ::= 'true' | 'false' - define "BooleanLiteral" [ - true_, false_], - --- [135s] String ::= StringLiteral1 | StringLiteralLong1 --- | StringLiteral2 | StringLiteralLong2 - define "String" [ - "StringLiteral1", - "StringLiteralLong1", - "StringLiteral2", - "StringLiteralLong2"], - --- [136s] Iri ::= IriRef | PrefixedName - define "Iri" [ - "IriRef", - "PrefixedName"], - --- [137s] PrefixedName ::= PnameLn | PnameNs - define "PrefixedName" [ - "PnameLn", - "PnameNs"], - --- [138s] BlankNode ::= BlankNodeLabel - define "BlankNode" [ - "BlankNodeLabel"], - --- # Reserved for future use --- [57] IncludeSet ::= '&' ShapeExprLabel+ - define "IncludeSet" [ - list[ampersand_, plus"ShapeExprLabel"]], - --- [58] Code ::= '{' ([^%\\] | '\\' [%\\] | Uchar)* '%' '}' - define "Code" [ - list[braceOpen_, star(alts[ regex "[^%\\]", list[doubleFrwSlash_, regex "[%\\]"], "Uchar" ]), percent_, braceClose_]], - --- [59] RepeatRange ::= '{' Integer (',' (Integer | '*')?)? '}' - define "RepeatRange" [ - list[braceOpen_, "Integer", opt(list[coma_, opt(opt(alts["Integer", star_]))]), braceClose_]], - --- [60] RdfType ::= 'a' - define "RdfType" [ - terminal "a"], - --- [18t] IriRef ::= '<' ([^#x00-#x20<>\"{}|^`\\] | Uchar)* '>' /* #x00=NULL #01-#x1F=control codes #x20=space */ - define "IriRef" [ - list[terminal "<", star(alts[ regex "[^#x00-#x20<>\"{}|^`\\]", "Uchar"]), terminal ">"]], - --- [140s] PnameNs ::= PnPrefix? ':' - define "PnameNs" [ - list[opt"PnPrefix", semicolon_]], - --- [141s] PnameLn ::= PnameNs PnLocal - define "PnameLn" [ - list["PnameNs", "PnLocal"]], - --- [61] AtpNameNs ::= '@' PnPrefix? ':' - define "AtpNameNs" [ - list[at_, opt"PnPrefix", colon_]], - --- [62] AtpNameLn ::= '@' PnameNs PnLocal - define "AtpNameLn" [ - list[at_, "PnameNs", "PnLocal"]], - --- [63] Regexp ::= '~/' ([^#x2f#x5C#xA#xD] | '\\' [tbnrf\\/] | Uchar)* '/' [smix]* - define "Regexp" [ - list[terminal "~/", star(alts[ - regex "[^#x2f#x5C#xA#xD]", - list[terminal "\\", regex "[tbnrf\\/]"], "Uchar"]), - terminal "/", star( regex "[smix]") - ]], - --- [142s] BlankNodeLabel ::= '_:' (PnCharsU | [0-9]) ((PnChars | '.')* PnChars)? - define "BlankNodeLabel" [ - list[terminal "_:", alts["PnCharsU", regex "[0-9]"], opt(star(alts["PnChars", period_])),"PnChars"]], - --- [145s] LangTag ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)* - define "LangTag" [ - regex "@[a-zA-Z]+('-'[a-zA-Z0-9]+)*"], - --- [19t] Integer ::= [+-]? [0-9]+ - define "Integer" [ - regex "[+-]? [0-9]+"], - --- [20t] Decimal ::= [+-]? [0-9]* '.' [0-9]+ - define "Decimal" [ - regex "[+-]? [0-9]*\\.[0-9]+"], - --- [21t] Double ::= [+-]? ([0-9]+ '.' [0-9]* EXPONENT | '.'? [0-9]+ EXPONENT) --- [155s] EXPONENT ::= [eE] [+-]? [0-9]+ - define "Double" [ - regex "([+-]?([0-9]+)?\\.[0-9]*[eE][+-]?[0-9]+"], - --- [156s] StringLiteral1 ::= "'" ([^#x27#x5C#xA#xD] | Echar | Uchar)* "'" /* #x27=' #x5C=\ #xA=new line #xD=carriage return */ - define "StringLiteral1" [ - list[singleQuote_, star(alts[regex "[^#x27#x5C#xA#xD]", "Echar", "Uchar"]), singleQuote_]], - --- [157s] StringLiteral2 ::= '"' ([^#x22#x5C#xA#xD] | Echar | Uchar)* '"' /* #x22=" #x5C=\ #xA=new line #xD=carriage return */ - define "StringLiteral2" [ - list[doubleQuote_, star(alts[regex "[^#x22#x5C#xA#xD]", "Echar", "Uchar"]), doubleQuote_]], - --- [158s] StringLiteralLong1 ::= "'''" (("'" | "''")? ([^\'\\] | Echar | Uchar))* "'''" - define "StringLiteralLong1" [ - list[singleQuote_, singleQuote_, singleQuote_, - star(alts[list[ opt(alts[singleQuote_, list[singleQuote_,singleQuote_]]), regex "[^\'\\]"], "Echar", "Uchar"]), - singleQuote_, singleQuote_, singleQuote_]], - --- [159s] StringLiteralLong2 ::= '"""' (('"' | '""')? ([^\"\\] | Echar | Uchar))* '"""' - define "StringLiteralLong2" [ - list[doubleQuote_, doubleQuote_, doubleQuote_, - star(alts[list[ opt(alts[doubleQuote_, list[doubleQuote_,doubleQuote_]]), regex "[^\"\\]"], "Echar", "Uchar"]), - doubleQuote_, doubleQuote_, doubleQuote_]], - --- [26t] Uchar ::= '\\u' Hex Hex Hex Hex --- | '\\U' Hex Hex Hex Hex Hex Hex Hex Hex - define "Uchar" [ - list[terminal "\\u", "Hex", "Hex", "Hex", "Hex"], - list[terminal "\\U", "Hex", "Hex", "Hex", "Hex", "Hex", "Hex", "Hex", "Hex"]], - --- [160s] Echar ::= '\\' [tbnrf\\\"\'] - define "Echar" [ - list[doubleFrwSlash_, regex "[tbnrf\\\"\']"]], - --- [164s] PnCharsBase ::= [A-Z] | [a-z] --- | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x02FF] --- | [#x0370-#x037D] | [#x037F-#x1FFF] --- | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] --- | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] --- | [#x10000-#xEFFFF] - define "PnCharsBase" [ - regex "[A-Z]", - regex "[a-z]"], -- TODO other chars - - --- [165s] PnCharsU ::= PnCharsBase | '_' - define "PnCharsU" [ - "PnCharsBase", - underscore_], - --- [167s] PnChars ::= PnCharsU | '-' | [0-9] --- | [#x00B7] | [#x0300-#x036F] | [#x203F-#x2040] - define "PnChars" [ - "PnCharsU", - dash_, - regex "0-9"], -- TODO other chars - --- [168s] PnPrefix ::= PnCharsBase ((PnChars | '.')* PnChars)? - define "PnPrefix" [ - list["PnCharsBase", - opt(list[alts["PnChars", period_],"PnChars"])]], - --- [169s] PnLocal ::= (PnCharsU | ':' | [0-9] | Plx) ((PnChars | '.' | ':' | Plx)* (PnChars | ':' | Plx))? - define "PnLocal" [ - list[ - alts["PnCharsU", colon_, regex "0-9", "Plx"], - opt(list[ - star(alts["PnChars", period_, colon_, "Plx"]), - alts["PnChars", colon_, "Plx"]] - )]], - --- [170s] Plx ::= Percent | PnLocalEsc - define "Plx" [ - "Percent", - "PnLocalEsc"], - --- [171s] Percent ::= '%' Hex Hex - define "Percent" [ - list[percent_, "Hex", "Hex"]], - --- [172s] Hex ::= [0-9] | [A-F] | [a-f] - define "Hex" [regex "[0-9][A-F][a-f]"], - - --- [173s] PnLocalEsc ::= '\\' ('_' | '~' | '.' | '-' | '!' | '$' | '&' | "'" | '(' | ')' | '*' | '+' | ',' | ';' | '=' | '/' | '?' | '#' | '@' | '%') - define "PnLocalEsc" [ - list[doubleFrwSlash_, regex "[_~\\.-!$&'\\(\\)\\*+,;=/\\?#@%]"]]] - --- @pass ::= [ \t\r\n]+ -- TODO --- | "#" [^\r\n]* - diff --git a/src/main/haskell/Hydra/Sources/Tier4/Langs/Sql/Ansi.hs b/src/main/haskell/Hydra/Sources/Tier4/Langs/Sql/Ansi.hs deleted file mode 100644 --- a/src/main/haskell/Hydra/Sources/Tier4/Langs/Sql/Ansi.hs +++ /dev/null @@ -1,1016 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Hydra.Sources.Tier4.Langs.Sql.Ansi where - -import Hydra.Sources.Tier3.All -import Hydra.Dsl.Grammars -import Hydra.Tools.GrammarToModule -import qualified Hydra.Dsl.Annotations as Ann -import qualified Hydra.Grammar as G - -import qualified Data.List as L - - -sqlModule :: Module -sqlModule = grammarToModule ns sqlGrammar $ - Just ("A subset of ANSI SQL:2003, capturing selected productions of the BNF grammar provided at " - ++ "https://ronsavage.github.io/SQL/sql-2003-2.bnf.html, which is based on " - ++ "the Final Committee Draft (FCD) of ISO/IEC 9075-2:2003") - where - ns = Namespace "hydra/langs/sql/ansi" - -sqlGrammar :: G.Grammar -sqlGrammar = G.Grammar $ tokens ++ productions - -tokens :: [G.Production] -tokens = [ - -- ::= E - define "ApproximateNumericLiteral" [regex $ mantissa ++ "E" ++ exponent], - - -- ::= - -- X [ { }... ] - -- [ { [ { }... ] }... ] - -- [ ESCAPE ] - define "BinaryStringLiteral" unsupported, - - -- ::= - -- [ ] - -- [ ... ] - -- [ { [ ... ] }... ] - define "CharacterStringLiteral" [regex $ - opt(introducer ++ characterSetSpecification) - ++ quote ++ star(characterRepresentation) ++ quote - ++ star(separator ++ quote ++ star(characterRepresentation) ++ quote)], - - -- ::= - define "ColumnName" [regex identifier], - - -- ::= - define "DateString" unsupported, - - -- ::= - define "DomainName" [regex schemaQualifiedName], - - -- ::= - -- [ [ ] ] - -- | - define "ExactNumericLiteral" [regex $ or [ - unsignedInteger ++ opt (period ++ unsignedInteger), - period ++ unsignedInteger]], - - -- ::= | - define "LeftBracketOrTrigraph" [regex $ or [leftBracket, leftBracketTrigraph]], - - -- ::= | - define "RightBracketOrTrigraph" [regex $ or [rightBracket, rightBracketTrigraph]], - - -- ::= - -- N [ ... ] - -- [ { [ ... ] }... ] - define "NationalCharacterStringLiteral" unsupported, - - -- ::= - define "PathResolvedUserDefinedTypeName" [regex userDefinedTypeName], - - -- ::= - define "TableName" [regex localOrSchemaQualifiedName], - - --
- define "InsertionTarget" [ - "TableName"], - - -- ::= INTERVAL [ ] - define "IntervalLiteral" unsupported, - - -- ::= INTERVAL - define "IntervalType" unsupported, - - -- ::= - -- - -- | - -- | - -- | - define "IntervalValueExpression" unsupported, - - -- ::= - -- [ ] [ ] - -- | [ ] - define "LargeObjectLength" unsupported, - - -- ::= - define "Length" [ - "UnsignedInteger"], - - -- ::= LIKE
[ ] - define "LikeClause" unsupported, - - -- ::= | - define "MethodInvocation" unsupported, - - -- ::= - -- ELEMENT - define "MultisetElementReference" unsupported, - - -- ::= MULTISET - define "MultisetType" [ - list["DataType", multiset_]], - - -- ::= - -- - -- | - -- |
- define "MultisetValueConstructor" unsupported, - - -- ::= - -- - -- | MULTISET UNION [ ALL | DISTINCT ] - -- | MULTISET EXCEPT [ ALL | DISTINCT ] - define "MultisetValueExpression" unsupported, - - -- ::= - -- NATIONAL CHARACTER [ ] - -- | NATIONAL CHAR [ ] - -- | NCHAR [ ] - -- | NATIONAL CHARACTER VARYING - -- | NATIONAL CHAR VARYING - -- | NCHAR VARYING - -- | NATIONAL CHARACTER LARGE OBJECT [ ] - -- | NCHAR LARGE OBJECT [ ] - -- | NCLOB [ ] - define "NationalCharacterStringType" unsupported, - - -- ::= NEW - define "NewSpecification" unsupported, - - -- ::= NEXT VALUE FOR - define "NextValueExpression" unsupported, - - -- ::= | - define "NumericType" [ - "exact">: "ExactNumericType", - "approximate">: "ApproximateNumericType"], - - -- ::= - -- - -- | - -- | - define "NumericValueExpression" unsupported, - - -- ::= OVERRIDING USER VALUE | OVERRIDING SYSTEM VALUE - define "OverrideClause" [ - overriding_user_value_, - overriding_system_value], - - -- ::= - define "ParenthesizedValueExpression" [ - parens["ValueExpression"]], - - -- ::= - define "Precision" [ - "UnsignedInteger"], - - -- ::= - -- [ CHARACTER SET ] [ ] - -- | [ ] - -- | - -- | - -- | - -- | - -- | - define "PredefinedType" [ - "string">: list[ - "type">: "CharacterStringType", - "characters">: opt(list[character_set_, "CharacterSetSpecification"]), - "collate">: opt"CollateClause"], - "nationalString">: list[ - "type">: "NationalCharacterStringType", - "collate">: opt"CollateClause"], - "blob">: "BinaryLargeObjectStringType", - "numeric">: "NumericType", - "boolean">: "BooleanType", - "datetime">: "DatetimeType", - "interval">: "IntervalType"], - - -- ::= - -- - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - define "Predicate" unsupported, - - -- ::= [ ] - define "QueryExpression" unsupported, - - -- ::= REFERENCES ARE [ NOT ] CHECKED [ ON DELETE ] - define "ReferenceScopeCheck" unsupported, - - -- ::= REF [ ] - define "ReferenceType" unsupported, - - -- ::= ROW - define "RowType" unsupported, - - -- ::= - define "RowValueSpecialCase" [ - "NonparenthesizedValueExpressionPrimary"], - - -- ::= - -- - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - -- | - define "NonparenthesizedValueExpressionPrimary" [ - "unsigned">: "UnsignedValueSpecification", - "column">: "ColumnReference", - "setFunction">: "SetFunctionSpecification", - "windowFunction">: "WindowFunction", - "scalarSubquery">: "ScalarSubquery", - "cases">: "CaseExpression", - "cast">: "CastSpecification", - "field">: "FieldReference", - "subtype">: "SubtypeTreatment", - "method">: "MethodInvocation", - "staticMethod">: "StaticMethodInvocation", - "new">: "NewSpecification", - "attributeOrMethod">: "AttributeOrMethodReference", - "reference">: "ReferenceResolution", - "collection">: "CollectionValueConstructor", - "arrayElement">: "ArrayElementReference", - "multisetElement">: "MultisetElementReference", - "routine">: "RoutineInvocation", - "next">: "NextValueExpression"], - - -- ::= DEREF - define "ReferenceResolution" unsupported, - - -- ::= - define "ReferenceValueExpression" [ - "ValueExpressionPrimary"], - - -- ::= - -- - -- | - define "RowValueExpression" unsupported, - - -- ::= - define "RoutineInvocation" unsupported, - - -- ::= - define "ScalarSubquery" [ - "Subquery"], - - -- ::= - define "Scale" [ - "UnsignedInteger"], - - -- ::= REF IS - define "SelfReferencingColumnSpecification" unsupported, - - -- ::= | - define "SetFunctionSpecification" unsupported, - - -- ::= - -- [ ] - define "StaticMethodInvocation" unsupported, - - -- ::= | - define "StringValueExpression" unsupported, - - -- ::= - define "Subquery" [ - parens["QueryExpression"]], - - -- ::= UNDER - define "SubtableClause" unsupported, - - -- ::= - -- TREAT AS - define "SubtypeTreatment" unsupported, - - --
::= PRESERVE | DELETE - define "TableCommitAction" [ - "preserve">: preserve_, - "delete">: delete_], - - --
::= [ ]
[ ] - define "TableConstraintDefinition" unsupported, - - --
::= - --
- -- | OF [ ] [
] - -- | - define "TableContentsSource" [ - "list">: "TableElementList", - "subtable">: list [ - of_, - "type">: "PathResolvedUserDefinedTypeName", - "subtable">: opt"SubtableClause", - "elements">: opt"TableElementList"], - "subquery">: "AsSubqueryClause"], - - --
::= - -- CREATE [
] TABLE
- -- [ ON COMMIT
ROWS ] - define "TableDefinition" [ - list[ - create_, - "scope">: opt"TableScope", - table_, - "name">: "TableName", - "source">: "TableContentsSource", - "commitActions">: opt(list[on_commit_, "TableCommitAction", rows_])]], - - --
::= - -- - -- |
- -- | - -- | - -- | - define "TableElement" [ - "column">: "ColumnDefinition", - "tableConstraint">: "TableConstraintDefinition", - "like">: "LikeClause", - "selfReferencingColumn">: "SelfReferencingColumnSpecification", - "columOptions">: "ColumnOptions"], - - --
::=
[ {
}... ] - define "TableElementList" [ - parens[commaList "TableElement"]], - - --
::= TEMPORARY - define "TableScope" [ - list["GlobalOrLocal", temporary_]], - - --