hydra 0.1.1 → 0.5.0
raw patch · 378 files changed
+62337/−33913 lines, 378 files
Files
- README.md +106/−28
- hydra.cabal +224/−128
- src/gen-main/haskell/Hydra/Adapters/Utils.hs +0/−88
- src/gen-main/haskell/Hydra/Ast.hs +200/−0
- src/gen-main/haskell/Hydra/Basics.hs +135/−45
- src/gen-main/haskell/Hydra/Coders.hs +111/−0
- src/gen-main/haskell/Hydra/Compute.hs +30/−224
- src/gen-main/haskell/Hydra/Constants.hs +19/−0
- src/gen-main/haskell/Hydra/Constraints.hs +36/−0
- src/gen-main/haskell/Hydra/Core.hs +315/−285
- src/gen-main/haskell/Hydra/CoreEncoding.hs +691/−0
- src/gen-main/haskell/Hydra/CoreLanguage.hs +25/−0
- src/gen-main/haskell/Hydra/Ext/Avro/Schema.hs +0/−221
- src/gen-main/haskell/Hydra/Ext/Graphql/Syntax.hs +0/−1413
- src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs +0/−892
- src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs +0/−3280
- src/gen-main/haskell/Hydra/Ext/Json/Model.hs +0/−32
- src/gen-main/haskell/Hydra/Ext/Owl/Syntax.hs +0/−1211
- src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs +0/−267
- src/gen-main/haskell/Hydra/Ext/Rdf/Syntax.hs +0/−185
- src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs +0/−2264
- src/gen-main/haskell/Hydra/Ext/Shacl/Model.hs +0/−357
- src/gen-main/haskell/Hydra/Ext/Shex/Syntax.hs +0/−1818
- src/gen-main/haskell/Hydra/Ext/Tinkerpop/Features.hs +0/−321
- src/gen-main/haskell/Hydra/Ext/Tinkerpop/Typed.hs +0/−220
- src/gen-main/haskell/Hydra/Ext/Tinkerpop/V3.hs +0/−111
- src/gen-main/haskell/Hydra/Ext/Xml/Schema.hs +0/−464
- src/gen-main/haskell/Hydra/Ext/Yaml/Model.hs +0/−53
- src/gen-main/haskell/Hydra/Extras.hs +62/−0
- src/gen-main/haskell/Hydra/Grammar.hs +19/−23
- src/gen-main/haskell/Hydra/Graph.hs +110/−0
- src/gen-main/haskell/Hydra/Json.hs +33/−0
- src/gen-main/haskell/Hydra/Langs/Avro/Schema.hs +222/−0
- src/gen-main/haskell/Hydra/Langs/Cypher/Features.hs +935/−0
- src/gen-main/haskell/Hydra/Langs/Cypher/OpenCypher.hs +1306/−0
- src/gen-main/haskell/Hydra/Langs/Graphql/Syntax.hs +1299/−0
- src/gen-main/haskell/Hydra/Langs/Haskell/Ast.hs +917/−0
- src/gen-main/haskell/Hydra/Langs/Java/Language.hs +237/−0
- src/gen-main/haskell/Hydra/Langs/Java/Syntax.hs +3276/−0
- src/gen-main/haskell/Hydra/Langs/Json/Decoding.hs +50/−0
- src/gen-main/haskell/Hydra/Langs/Kusto/Kql.hs +695/−0
- src/gen-main/haskell/Hydra/Langs/Owl/Syntax.hs +1208/−0
- src/gen-main/haskell/Hydra/Langs/Parquet/Delta.hs +122/−0
- src/gen-main/haskell/Hydra/Langs/Parquet/Format.hs +977/−0
- src/gen-main/haskell/Hydra/Langs/Pegasus/Pdl.hs +268/−0
- src/gen-main/haskell/Hydra/Langs/Protobuf/Any.hs +24/−0
- src/gen-main/haskell/Hydra/Langs/Protobuf/Language.hs +90/−0
- src/gen-main/haskell/Hydra/Langs/Protobuf/Proto3.hs +275/−0
- src/gen-main/haskell/Hydra/Langs/Protobuf/SourceContext.hs +20/−0
- src/gen-main/haskell/Hydra/Langs/Rdf/Syntax.hs +183/−0
- src/gen-main/haskell/Hydra/Langs/RelationalModel.hs +113/−0
- src/gen-main/haskell/Hydra/Langs/Scala/Meta.hs +2265/−0
- src/gen-main/haskell/Hydra/Langs/Shacl/Model.hs +357/−0
- src/gen-main/haskell/Hydra/Langs/Shex/Syntax.hs +1607/−0
- src/gen-main/haskell/Hydra/Langs/Sql/Ansi.hs +1373/−0
- src/gen-main/haskell/Hydra/Langs/Tabular.hs +40/−0
- src/gen-main/haskell/Hydra/Langs/Tinkerpop/Features.hs +322/−0
- src/gen-main/haskell/Hydra/Langs/Tinkerpop/Gremlin.hs +2409/−0
- src/gen-main/haskell/Hydra/Langs/Tinkerpop/Mappings.hs +183/−0
- src/gen-main/haskell/Hydra/Langs/Tinkerpop/PropertyGraph.hs +279/−0
- src/gen-main/haskell/Hydra/Langs/Tinkerpop/Queries.hs +329/−0
- src/gen-main/haskell/Hydra/Langs/Tinkerpop/Validate.hs +143/−0
- src/gen-main/haskell/Hydra/Langs/Xml/Schema.hs +465/−0
- src/gen-main/haskell/Hydra/Langs/Yaml/Model.hs +54/−0
- src/gen-main/haskell/Hydra/Mantle.hs +66/−137
- src/gen-main/haskell/Hydra/Messages.hs +11/−0
- src/gen-main/haskell/Hydra/Module.hs +30/−13
- src/gen-main/haskell/Hydra/Phantoms.hs +9/−9
- src/gen-main/haskell/Hydra/Printing.hs +83/−0
- src/gen-main/haskell/Hydra/Query.hs +246/−0
- src/gen-main/haskell/Hydra/Strip.hs +34/−0
- src/gen-main/haskell/Hydra/Testing.hs +59/−0
- src/gen-main/haskell/Hydra/Tier1.hs +269/−0
- src/gen-main/haskell/Hydra/Tier2.hs +71/−0
- src/gen-main/haskell/Hydra/Tier3.hs +28/−0
- src/gen-main/haskell/Hydra/Util/Codetree/Ast.hs +0/−173
- src/gen-main/haskell/Hydra/Workflow.hs +86/−0
- src/gen-test/haskell/Hydra/Test/TestSuite.hs +468/−0
- src/main/haskell/Hydra/AdapterUtils.hs +131/−0
- src/main/haskell/Hydra/Adapters.hs +90/−0
- src/main/haskell/Hydra/Adapters/Coders.hs +0/−49
- src/main/haskell/Hydra/Adapters/Literal.hs +0/−144
- src/main/haskell/Hydra/Adapters/Term.hs +0/−366
- src/main/haskell/Hydra/Adapters/UtilsEtc.hs +0/−127
- src/main/haskell/Hydra/Annotations.hs +216/−0
- src/main/haskell/Hydra/Codegen.hs +107/−0
- src/main/haskell/Hydra/Common.hs +0/−130
- src/main/haskell/Hydra/CoreDecoding.hs +189/−123
- src/main/haskell/Hydra/CoreEncoding.hs +0/−195
- src/main/haskell/Hydra/CoreLanguage.hs +0/−20
- src/main/haskell/Hydra/Dsl/Annotations.hs +79/−0
- src/main/haskell/Hydra/Dsl/Base.hs +224/−0
- src/main/haskell/Hydra/Dsl/Bootstrap.hs +65/−0
- src/main/haskell/Hydra/Dsl/Core.hs +274/−0
- src/main/haskell/Hydra/Dsl/Expect.hs +321/−0
- src/main/haskell/Hydra/Dsl/Grammars.hs +59/−0
- src/main/haskell/Hydra/Dsl/Graph.hs +40/−0
- src/main/haskell/Hydra/Dsl/Lib/Equality.hs +75/−0
- src/main/haskell/Hydra/Dsl/Lib/Flows.hs +67/−0
- src/main/haskell/Hydra/Dsl/Lib/Io.hs +13/−0
- src/main/haskell/Hydra/Dsl/Lib/Lists.hs +54/−0
- src/main/haskell/Hydra/Dsl/Lib/Literals.hs +80/−0
- src/main/haskell/Hydra/Dsl/Lib/Logic.hs +19/−0
- src/main/haskell/Hydra/Dsl/Lib/Maps.hs +47/−0
- src/main/haskell/Hydra/Dsl/Lib/Math.hs +27/−0
- src/main/haskell/Hydra/Dsl/Lib/Optionals.hs +33/−0
- src/main/haskell/Hydra/Dsl/Lib/Sets.hs +47/−0
- src/main/haskell/Hydra/Dsl/Lib/Strings.hs +45/−0
- src/main/haskell/Hydra/Dsl/Literals.hs +59/−0
- src/main/haskell/Hydra/Dsl/Module.hs +16/−0
- src/main/haskell/Hydra/Dsl/PhantomLiterals.hs +78/−0
- src/main/haskell/Hydra/Dsl/Prims.hs +230/−0
- src/main/haskell/Hydra/Dsl/ShorthandTypes.hs +86/−0
- src/main/haskell/Hydra/Dsl/Terms.hs +211/−0
- src/main/haskell/Hydra/Dsl/Tests.hs +34/−0
- src/main/haskell/Hydra/Dsl/Types.hs +150/−0
- src/main/haskell/Hydra/Ext/Avro/Coder.hs +0/−352
- src/main/haskell/Hydra/Ext/Avro/Language.hs +0/−32
- src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs +0/−165
- src/main/haskell/Hydra/Ext/Graphql/Coder.hs +0/−176
- src/main/haskell/Hydra/Ext/Graphql/Language.hs +0/−38
- src/main/haskell/Hydra/Ext/Graphql/Serde.hs +0/−13
- src/main/haskell/Hydra/Ext/Haskell/Coder.hs +0/−327
- src/main/haskell/Hydra/Ext/Haskell/Language.hs +0/−70
- src/main/haskell/Hydra/Ext/Haskell/Operators.hs +0/−110
- src/main/haskell/Hydra/Ext/Haskell/Serde.hs +0/−213
- src/main/haskell/Hydra/Ext/Haskell/Settings.hs +0/−7
- src/main/haskell/Hydra/Ext/Haskell/Utils.hs +0/−96
- src/main/haskell/Hydra/Ext/Java/Coder.hs +0/−710
- src/main/haskell/Hydra/Ext/Java/Language.hs +0/−96
- src/main/haskell/Hydra/Ext/Java/Serde.hs +0/−918
- src/main/haskell/Hydra/Ext/Java/Settings.hs +0/−4
- src/main/haskell/Hydra/Ext/Java/Utils.hs +0/−495
- src/main/haskell/Hydra/Ext/Json/Coder.hs +0/−113
- src/main/haskell/Hydra/Ext/Json/Eliminate.hs +0/−54
- src/main/haskell/Hydra/Ext/Json/Language.hs +0/−30
- src/main/haskell/Hydra/Ext/Pegasus/Coder.hs +0/−182
- src/main/haskell/Hydra/Ext/Pegasus/Language.hs +0/−42
- src/main/haskell/Hydra/Ext/Pegasus/Serde.hs +0/−81
- src/main/haskell/Hydra/Ext/Rdf/Serde.hs +0/−81
- src/main/haskell/Hydra/Ext/Scala/Coder.hs +0/−232
- src/main/haskell/Hydra/Ext/Scala/Language.hs +0/−73
- src/main/haskell/Hydra/Ext/Scala/Prepare.hs +0/−65
- src/main/haskell/Hydra/Ext/Scala/Serde.hs +0/−140
- src/main/haskell/Hydra/Ext/Scala/Utils.hs +0/−68
- src/main/haskell/Hydra/Ext/Shacl/Coder.hs +0/−273
- src/main/haskell/Hydra/Ext/Shacl/Language.hs +0/−36
- src/main/haskell/Hydra/Ext/Tinkerpop/Language.hs +0/−100
- src/main/haskell/Hydra/Ext/Yaml/Coder.hs +0/−117
- src/main/haskell/Hydra/Ext/Yaml/Language.hs +0/−26
- src/main/haskell/Hydra/Ext/Yaml/Modules.hs +0/−40
- src/main/haskell/Hydra/Flows.hs +16/−0
- src/main/haskell/Hydra/Impl/Haskell/Codegen.hs +0/−173
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Base.hs +0/−170
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Bootstrap.hs +0/−56
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Grammars.hs +0/−50
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Lists.hs +0/−27
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Literals.hs +0/−12
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Math.hs +0/−27
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Sets.hs +0/−20
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Strings.hs +0/−21
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Literals.hs +0/−94
- src/main/haskell/Hydra/Impl/Haskell/Dsl/PhantomLiterals.hs +0/−77
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Prims.hs +0/−103
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Standard.hs +0/−80
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Terms.hs +0/−266
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Types.hs +0/−142
- src/main/haskell/Hydra/Impl/Haskell/Ext/Bytestrings.hs +0/−12
- src/main/haskell/Hydra/Impl/Haskell/Ext/Json/Serde.hs +0/−77
- src/main/haskell/Hydra/Impl/Haskell/Ext/Yaml/Serde.hs +0/−80
- src/main/haskell/Hydra/Impl/Haskell/Sources/Adapters/Utils.hs +0/−95
- src/main/haskell/Hydra/Impl/Haskell/Sources/Basics.hs +0/−318
- src/main/haskell/Hydra/Impl/Haskell/Sources/Compute.hs +0/−160
- src/main/haskell/Hydra/Impl/Haskell/Sources/Core.hs +0/−378
- src/main/haskell/Hydra/Impl/Haskell/Sources/CoreLang.hs +0/−51
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Avro/Schema.hs +0/−140
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Graphql/Syntax.hs +0/−340
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Haskell/Ast.hs +0/−422
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Java/Syntax.hs +0/−1743
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Json/Model.hs +0/−28
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Owl/Syntax.hs +0/−601
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Pegasus/Pdl.hs +0/−130
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Rdf/Syntax.hs +0/−103
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Scala/Meta.hs +0/−1373
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Shacl/Model.hs +0/−274
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Shex/Syntax.hs +0/−526
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/Features.hs +0/−160
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/Typed.hs +0/−114
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/V3.hs +0/−72
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Xml/Schema.hs +0/−118
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Yaml/Model.hs +0/−77
- src/main/haskell/Hydra/Impl/Haskell/Sources/Grammar.hs +0/−66
- src/main/haskell/Hydra/Impl/Haskell/Sources/Libraries.hs +0/−264
- src/main/haskell/Hydra/Impl/Haskell/Sources/Mantle.hs +0/−131
- src/main/haskell/Hydra/Impl/Haskell/Sources/Module.hs +0/−42
- src/main/haskell/Hydra/Impl/Haskell/Sources/Phantoms.hs +0/−43
- src/main/haskell/Hydra/Impl/Haskell/Sources/Util/Codetree/Ast.hs +0/−81
- src/main/haskell/Hydra/Inference.hs +140/−0
- src/main/haskell/Hydra/Kernel.hs +56/−28
- src/main/haskell/Hydra/Langs/Avro/Coder.hs +389/−0
- src/main/haskell/Hydra/Langs/Avro/Language.hs +32/−0
- src/main/haskell/Hydra/Langs/Avro/SchemaJson.hs +166/−0
- src/main/haskell/Hydra/Langs/Graphql/Coder.hs +164/−0
- src/main/haskell/Hydra/Langs/Graphql/Language.hs +51/−0
- src/main/haskell/Hydra/Langs/Graphql/Serde.hs +106/−0
- src/main/haskell/Hydra/Langs/Haskell/Coder.hs +373/−0
- src/main/haskell/Hydra/Langs/Haskell/Language.hs +77/−0
- src/main/haskell/Hydra/Langs/Haskell/Operators.hs +42/−0
- src/main/haskell/Hydra/Langs/Haskell/Serde.hs +241/−0
- src/main/haskell/Hydra/Langs/Haskell/Settings.hs +7/−0
- src/main/haskell/Hydra/Langs/Haskell/Utils.hs +109/−0
- src/main/haskell/Hydra/Langs/Java/Coder.hs +974/−0
- src/main/haskell/Hydra/Langs/Java/Names.hs +39/−0
- src/main/haskell/Hydra/Langs/Java/Serde.hs +926/−0
- src/main/haskell/Hydra/Langs/Java/Settings.hs +4/−0
- src/main/haskell/Hydra/Langs/Java/Utils.hs +556/−0
- src/main/haskell/Hydra/Langs/Json/Coder.hs +194/−0
- src/main/haskell/Hydra/Langs/Json/Eliminate.hs +54/−0
- src/main/haskell/Hydra/Langs/Json/Language.hs +33/−0
- src/main/haskell/Hydra/Langs/Json/Serde.hs +80/−0
- src/main/haskell/Hydra/Langs/Pegasus/Coder.hs +188/−0
- src/main/haskell/Hydra/Langs/Pegasus/Language.hs +41/−0
- src/main/haskell/Hydra/Langs/Pegasus/Serde.hs +81/−0
- src/main/haskell/Hydra/Langs/Protobuf/Coder.hs +297/−0
- src/main/haskell/Hydra/Langs/Protobuf/Serde.hs +147/−0
- src/main/haskell/Hydra/Langs/Rdf/Serde.hs +81/−0
- src/main/haskell/Hydra/Langs/Rdf/Utils.hs +87/−0
- src/main/haskell/Hydra/Langs/Scala/Coder.hs +227/−0
- src/main/haskell/Hydra/Langs/Scala/Language.hs +71/−0
- src/main/haskell/Hydra/Langs/Scala/Prepare.hs +64/−0
- src/main/haskell/Hydra/Langs/Scala/Serde.hs +139/−0
- src/main/haskell/Hydra/Langs/Scala/Utils.hs +68/−0
- src/main/haskell/Hydra/Langs/Shacl/Coder.hs +197/−0
- src/main/haskell/Hydra/Langs/Shacl/Language.hs +34/−0
- src/main/haskell/Hydra/Langs/Tinkerpop/Coder.hs +353/−0
- src/main/haskell/Hydra/Langs/Tinkerpop/Language.hs +96/−0
- src/main/haskell/Hydra/Langs/Tinkerpop/TermsToElements.hs +251/−0
- src/main/haskell/Hydra/Langs/Yaml/Coder.hs +116/−0
- src/main/haskell/Hydra/Langs/Yaml/Language.hs +26/−0
- src/main/haskell/Hydra/Langs/Yaml/Modules.hs +39/−0
- src/main/haskell/Hydra/Langs/Yaml/Serde.hs +80/−0
- src/main/haskell/Hydra/Lexical.hs +40/−48
- src/main/haskell/Hydra/Lib/Equality.hs +74/−0
- src/main/haskell/Hydra/Lib/Flows.hs +36/−5
- src/main/haskell/Hydra/Lib/Io.hs +57/−28
- src/main/haskell/Hydra/Lib/Lists.hs +31/−1
- src/main/haskell/Hydra/Lib/Literals.hs +62/−2
- src/main/haskell/Hydra/Lib/Logic.hs +20/−0
- src/main/haskell/Hydra/Lib/Maps.hs +33/−0
- src/main/haskell/Hydra/Lib/Optionals.hs +15/−0
- src/main/haskell/Hydra/Lib/Sets.hs +21/−9
- src/main/haskell/Hydra/Lib/Strings.hs +15/−0
- src/main/haskell/Hydra/LiteralAdapters.hs +189/−0
- src/main/haskell/Hydra/Meta.hs +0/−140
- src/main/haskell/Hydra/Monads.hs +0/−118
- src/main/haskell/Hydra/Reduction.hs +119/−143
- src/main/haskell/Hydra/Rewriting.hs +272/−152
- src/main/haskell/Hydra/Rules.hs +348/−0
- src/main/haskell/Hydra/Scratchpad.hs +4/−0
- src/main/haskell/Hydra/Sources/Core.hs +398/−0
- src/main/haskell/Hydra/Sources/Libraries.hs +416/−0
- src/main/haskell/Hydra/Sources/Tier0/All.hs +50/−0
- src/main/haskell/Hydra/Sources/Tier0/Ast.hs +105/−0
- src/main/haskell/Hydra/Sources/Tier0/Coders.hs +93/−0
- src/main/haskell/Hydra/Sources/Tier0/Compute.hs +68/−0
- src/main/haskell/Hydra/Sources/Tier0/Constraints.hs +41/−0
- src/main/haskell/Hydra/Sources/Tier0/Grammar.hs +72/−0
- src/main/haskell/Hydra/Sources/Tier0/Graph.hs +92/−0
- src/main/haskell/Hydra/Sources/Tier0/Json.hs +35/−0
- src/main/haskell/Hydra/Sources/Tier0/Mantle.hs +103/−0
- src/main/haskell/Hydra/Sources/Tier0/Module.hs +59/−0
- src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs +49/−0
- src/main/haskell/Hydra/Sources/Tier0/Query.hs +153/−0
- src/main/haskell/Hydra/Sources/Tier0/Testing.hs +46/−0
- src/main/haskell/Hydra/Sources/Tier0/Workflow.hs +86/−0
- src/main/haskell/Hydra/Sources/Tier1/All.hs +24/−0
- src/main/haskell/Hydra/Sources/Tier1/Constants.hs +51/−0
- src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs +424/−0
- src/main/haskell/Hydra/Sources/Tier1/Messages.hs +43/−0
- src/main/haskell/Hydra/Sources/Tier1/Strip.hs +73/−0
- src/main/haskell/Hydra/Sources/Tier1/Tier1.hs +364/−0
- src/main/haskell/Hydra/Sources/Tier2/All.hs +25/−0
- src/main/haskell/Hydra/Sources/Tier2/Basics.hs +481/−0
- src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs +56/−0
- src/main/haskell/Hydra/Sources/Tier2/Extras.hs +128/−0
- src/main/haskell/Hydra/Sources/Tier2/Printing.hs +109/−0
- src/main/haskell/Hydra/Sources/Tier2/Tier2.hs +108/−0
- src/main/haskell/Hydra/Sources/Tier3/All.hs +15/−0
- src/main/haskell/Hydra/Sources/Tier3/Tier3.hs +58/−0
- src/main/haskell/Hydra/Sources/Tier4/All.hs +88/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Avro/Schema.hs +138/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/Features.hs +328/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/OpenCypher.hs +1049/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Graphql/Syntax.hs +338/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Haskell/Ast.hs +432/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Language.hs +143/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Syntax.hs +1742/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Json/Decoding.hs +96/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Kusto/Kql.hs +274/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Owl/Syntax.hs +599/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Delta.hs +62/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Format.hs +1758/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Pegasus/Pdl.hs +128/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Any.hs +151/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Language.hs +96/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Proto3.hs +164/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/SourceContext.hs +35/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Python/Python3.hs +1399/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Rdf/Syntax.hs +102/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/RelationalModel.hs +83/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Scala/Meta.hs +1372/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Shacl/Model.hs +273/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Shex/Syntax.hs +524/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Sql/Ansi.hs +1016/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tabular.hs +37/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Features.hs +159/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Gremlin.hs +3547/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Mappings.hs +118/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/PropertyGraph.hs +176/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Queries.hs +144/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Validate.hs +331/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Xml/Schema.hs +117/−0
- src/main/haskell/Hydra/Sources/Tier4/Langs/Yaml/Model.hs +76/−0
- src/main/haskell/Hydra/Sources/Tier4/Test/Lib/Lists.hs +80/−0
- src/main/haskell/Hydra/Sources/Tier4/Test/Lib/Strings.hs +58/−0
- src/main/haskell/Hydra/Sources/Tier4/Test/TestSuite.hs +44/−0
- src/main/haskell/Hydra/Substitution.hs +80/−0
- src/main/haskell/Hydra/TermAdapters.hs +405/−0
- src/main/haskell/Hydra/Tools/Bytestrings.hs +12/−0
- src/main/haskell/Hydra/Tools/Debug.hs +14/−0
- src/main/haskell/Hydra/Tools/Formatting.hs +122/−0
- src/main/haskell/Hydra/Tools/GrammarToModule.hs +115/−0
- src/main/haskell/Hydra/Tools/Serialization.hs +229/−0
- src/main/haskell/Hydra/Tools/Sorting.hs +44/−0
- src/main/haskell/Hydra/Tools/Templating.hs +111/−0
- src/main/haskell/Hydra/Types/Inference.hs +0/−353
- src/main/haskell/Hydra/Types/Substitution.hs +0/−78
- src/main/haskell/Hydra/Types/Unification.hs +0/−81
- src/main/haskell/Hydra/Unification.hs +115/−0
- src/main/haskell/Hydra/Util/Codetree/Script.hs +0/−206
- src/main/haskell/Hydra/Util/Debug.hs +0/−12
- src/main/haskell/Hydra/Util/Formatting.hs +0/−114
- src/main/haskell/Hydra/Util/GrammarToModule.hs +0/−100
- src/main/haskell/Hydra/Util/Sorting.hs +0/−20
- src/test/haskell/Hydra/Adapters/LiteralSpec.hs +0/−126
- src/test/haskell/Hydra/Adapters/TermSpec.hs +0/−377
- src/test/haskell/Hydra/AnnotationsSpec.hs +126/−0
- src/test/haskell/Hydra/ArbitraryCore.hs +25/−28
- src/test/haskell/Hydra/CommonSpec.hs +0/−42
- src/test/haskell/Hydra/CoreCodersSpec.hs +25/−28
- src/test/haskell/Hydra/Dsl/TypesSpec.hs +51/−0
- src/test/haskell/Hydra/Ext/Json/CoderSpec.hs +0/−134
- src/test/haskell/Hydra/Ext/Yaml/CoderSpec.hs +0/−123
- src/test/haskell/Hydra/FlowsSpec.hs +53/−0
- src/test/haskell/Hydra/Impl/Haskell/Dsl/TypesSpec.hs +0/−51
- src/test/haskell/Hydra/Impl/Haskell/Ext/Json/SerdeSpec.hs +0/−105
- src/test/haskell/Hydra/Impl/Haskell/Ext/Yaml/SerdeSpec.hs +0/−110
- src/test/haskell/Hydra/InferenceSpec.hs +498/−0
- src/test/haskell/Hydra/Langs/Json/CoderSpec.hs +130/−0
- src/test/haskell/Hydra/Langs/Json/SerdeSpec.hs +105/−0
- src/test/haskell/Hydra/Langs/Yaml/CoderSpec.hs +120/−0
- src/test/haskell/Hydra/Langs/Yaml/SerdeSpec.hs +110/−0
- src/test/haskell/Hydra/LiteralAdaptersSpec.hs +126/−0
- src/test/haskell/Hydra/MetaSpec.hs +0/−97
- src/test/haskell/Hydra/ReductionSpec.hs +44/−28
- src/test/haskell/Hydra/RewritingSpec.hs +149/−84
- src/test/haskell/Hydra/StripSpec.hs +43/−0
- src/test/haskell/Hydra/TermAdaptersSpec.hs +294/−0
- src/test/haskell/Hydra/TestData.hs +21/−33
- src/test/haskell/Hydra/TestGraph.hs +53/−43
- src/test/haskell/Hydra/TestSuiteSpec.hs +44/−0
- src/test/haskell/Hydra/TestUtils.hs +44/−36
- src/test/haskell/Hydra/Tools/SerializationSpec.hs +113/−0
- src/test/haskell/Hydra/Tools/SortingSpec.hs +145/−0
- src/test/haskell/Hydra/Types/InferenceSpec.hs +0/−353
- src/test/haskell/Hydra/Types/UnificationSpec.hs +0/−36
- src/test/haskell/Hydra/UnificationSpec.hs +36/−0
- src/test/haskell/Hydra/Util/Codetree/PrintSpec.hs +0/−113
README.md view
@@ -4,22 +4,29 @@ It has its roots in graph databases and type theory, and provides APIs in Haskell and Java. See the main Hydra [README](https://github.com/CategoricalData/hydra) for more details. This Haskell package contains Hydra's Haskell API and Haskell sources specifically.+Releases are available [on Hackage](https://hackage.haskell.org/package/hydra). ## Build Haskell is the current source-of-truth language for Hydra, which means that most of the Hydra implementation is written either in "raw" Haskell or in a Haskell-based DSL. You can find the DSL-based sources [here](https://github.com/CategoricalData/hydra/tree/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Sources);-anything written in the DSL is also mapped into the generated Scala and Java sources.+anything written in the DSL is also mapped into the generated Java and Scala sources. You can find the generated Haskell sources [here](https://github.com/CategoricalData/hydra/tree/main/hydra-haskell/src/gen-main/haskell).-To build Hydra and enter the GHCi REPL, use:+To build Hydra-Haskell and enter the GHCi REPL, use: ```bash stack ghci ``` -To run tests, use:+Or to enter the test environment: ```bash+stack ghci hydra:hydra-test+```++To run all tests at the command line, use:++```bash stack test ``` @@ -27,42 +34,113 @@ It is a long-term goal for Hydra to generate its own source code into various languages, producing nearly-complete Hydra implementations in those languages.-Both Haskell are fully supported as target languages,-which means that all of Hydra's type and programs currently specified in the Haskell DSL are mapped correctly to both Haskell and Java.+Both Haskell and Java are fully supported as target languages,+which means that all of Hydra's types and programs currently specified in the Haskell DSL are mapped correctly to both Haskell and Java. Scala support, on the other hand, is partial and experimental at this time. You can generate Hydra's Haskell sources by first entering the GHCi REPL as above, then: -```bash-writeHaskell allModules "/path/to/CategoricalData/hydra/hydra-haskell/src/gen-main/haskell"+```haskell+import Hydra.Codegen++writeHaskell "src/gen-main/haskell" mainModules ``` -The first argument to `writeHaskell` is the list of modules you want to generate (in this case, a special list containing all built-in modules),-and the second is the base directory to which the generated files are to be written.+The first argument to `writeHaskell` is the base directory to which the generated files are to be written,+and the second is the list of modules you want to generate (in this case, a special list containing all built-in modules). For individual modules, use list syntax, e.g. -```bash-writeHaskell [rdfSyntaxModule, shaclModelModule] "/path/to/CategoricalData/hydra/hydra-haskell/src/gen-main/haskell"+```haskell+writeHaskell "src/gen-main/haskell" [rdfSyntaxModule, shaclModelModule] ``` +To generate test modules, use:++```haskell+writeHaskell "src/gen-test/haskell" testModules+```+ Java generation is similar, e.g. -```bash-writeJava allModules "/path/to/CategoricalData/hydra/hydra-java/src/gen-main/java"+```haskell+writeJava "../hydra-java/src/gen-main/java" mainModules ``` +For Java tests, use:++```haskell+writeJava "../hydra-java/src/gen-test/java" testModules+```+ Scala generation has known bugs, but you can try it out with: -```bash-writeScala coreModules "/path/to/CategoricalData/hydra/hydra-scala/src/gen-main/scala"+```haskell+writeScala "../hydra-scala/src/gen-main/scala" kernelModules ``` -There is also schema-only support for PDL:+There is schema-only support for GraphQL: -```bash-writePdl coreModules "/tmp/pdl"+```haskell+import Hydra.Sources.Langs.Graphql.Syntax+import Hydra.Sources.Langs.Json.Model+writeGraphql "/tmp/graphql" [graphqlSyntaxModule, jsonModelModule] ``` +Because GraphQL does not support imports, the GraphQL coder will gather all of the dependencies of a given module together,+and map them to a single `.graphql` file.+Hydra has a similar level of schema-only support for [Protobuf](https://protobuf.dev/):++```haskell+writeProtobuf "/tmp/proto" [jsonModelModule]+```++...and similarly for [PDL](https://linkedin.github.io/rest.li/pdl_schema):++```haskell+writePdl "/tmp/pdl" [jsonModelModule]+```++Note that neither the Protobuf nor PDL coder currently supports polymorphic models.++### JSON and YAML generation++JSON and YAML are slightly different than the languages above, in that they are pure data languages, without accompanying syntax for schemas (types).+Hydra terms can be serialized to either JSON or YAML by first providing a type, then any number of terms corresponding to that type.+For example:++```haskell+:module Hydra.Kernel+import Hydra.Codegen+import Hydra.Langs.Json.Serde+import Hydra.Dsl.Terms as Terms++-- Choose a graph in which to execute flows; we will use the Hydra kernel graph.+g = hydraKernel+flow = fromFlowIo g++-- Choose a type for terms to encode. In this case, we will be encoding numeric precision values.+typ = TypeVariable _Precision++-- Construct an instance of the chosen type. In this case, we construct a precision value, then encode it as a term.+term = Terms.inject _Precision (Field _Precision_bits $ Terms.int32 64)++-- Create the adapting coder+coder <- flow $ jsonStringCoder typ++-- Apply the encoding, which turns the term into a JSON string.+flow (coderEncode coder term) >>= putStrLn+```++For a more sophisticated example involving recursive types, use:++```haskell+typ = TypeVariable _Type+term = Terms.inject _Type (Field _Type_literal $ Terms.inject _LiteralType (Field _LiteralType_boolean $ Terms.record _UnitType []))+```++in place of the `Precision` type and term above.+This defines a type (in this case, the type of all types), and also a term which is an instance of that type (so in this case, an encoded type).+ ## Haskell API ### Structures@@ -73,20 +151,20 @@ An `Element` is a named term together with its type, and a `Graph` is a collection of elements. A `Module` is a collection of elements in the same logical namespace, sometimes called a "model" if most of the elements represent type definitions. The main purpose of Hydra is to define and carry out transformations between graphs,-where those graphs may be almost anything which fits into Hydra's type system -- data, schemas, source code, transformations themselves, etc.+where those graphs may be almost anything which fits into Hydra's type system -- data, schemas, source code, other transformations, etc. "Graphs" in the traditional sense are partially supported at this time, including property graphs and RDF graphs. -Types, terms, graphs, elements, and many other things are parameterized by an annotation type, so you will usually see `Type m`, `Term m`, `Context m`, etc.+Types, terms, graphs, elements, and many other entities are parameterized by an annotation type, so you will usually see `Type m`, `Term m`, `Context m`, etc. in the code. The most common annotation type is called `Meta` (which is just a map of string-valued keys to terms), so you will also encounter `Type Meta`, etc. ### Transformations Transformations in Hydra take the form of simple functions or, more commonly, expressions involving the `Flow` monad (a special case of the [State](https://wiki.haskell.org/State_Monad) monad, which has been implemented in many programming languages)-as well as a bidirectional flow, called `Coder` and a two-level transformation (types and terms) called `Adapter`.-All of these constructs are provided in the generated [Hydra.Evaluation](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/gen-main/haskell/Hydra/Evaluation.hs) module in Haskell,+as well as a bidirectional flow called `Coder` and a two-level transformation (types and terms) called `Adapter`.+All of these constructs are provided in the generated [Hydra.Compute](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/gen-main/haskell/Hydra/Compute.hs) module in Haskell, along with the `Context` type which you will see almost everywhere in Hydra;-a `Context` provides a set of graphs and their elements, a set of primitive functions, an evaluation strategy, and other constructs which are needed for computation.+a `Context` provides a graph, the schema of that graph (which is itself a graph), a set of primitive functions, an evaluation strategy, and other constructs which are needed for computation. A context is part of the state which flows through a graph transformation as it is being applied. In Haskell, you will often see `Flow` and `Context` combined as the `GraphFlow` alias:@@ -95,7 +173,7 @@ type GraphFlow m = Flow (Context m) ``` -There are two helper types, `FlowWrapper` and `Trace`, which are used together with `Flow`; a `FlowWrapper` is the result of evaluating a `Flow`,+There are two helper types, `FlowState` and `Trace`, which are used together with `Flow`; a `FlowState` is the result of evaluating a `Flow`, while `Trace` encapsulates a stack trace and error or logger messages. Since `Flow` is a monad, you can create a `GraphFlow` with `f = pure x`, where `x` is anything you would like to enter into a transformation pipeline. The transformation is actually applied when you call `unFlow` and pass in a graph context and a trace, i.e.@@ -104,8 +182,8 @@ unFlow f cx emptyTrace ``` -This gives you a flow wrapper, which you can think of as the exit point of a transformation.-Inside the wrapper is either a concrete value (if the transformation succeeded) or `Nothing` (if the transformation failed), a stack trace, and a list of messages.+This gives you a flow state, which you can think of as the exit point of a transformation.+Inside the state object is either a concrete value (if the transformation succeeded) or `Nothing` (if the transformation failed), a stack trace, and a list of messages. You will always find at least one message if the transformation failed; this is analogous to an exception in mainstream programming languages. A `Coder`, as mentioned above, is a construct which has a `Flow` in either direction between two types.@@ -133,8 +211,8 @@ Since all of the work of defining transformations in Hydra consists of specifying types and terms, we make the task (much) easier using domain-specific languages (DSLs). These DSLs are specific to the host language, so we have Haskell DSLs in hydra-haskell, and (similar, but distinct) Java DSLs in hydra-java. For example, the type of a list of strings is just `list string` if you include the [Types](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Dsl/Types.hs) DSL,-and the specific list of strings we mentioned is just `list [string "foo", string "bar"]`, or (better yet) `list ["foo", "bar"]`.-There is additional syntactic sugar in Haskell which aim to make defining models and transformations as easy as possible;+and the specific list of strings we mentioned is just `list [string "foo", string "bar"]`, or (better yet) `list ["foo", "bar"]` if you include the [Terms](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Dsl/Terms.hs) DSL.+There is additional syntactic sugar in Hydra-Haskell which aims to make defining models and transformations as easy as possible; see the [Sources](https://github.com/CategoricalData/hydra/tree/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Sources) directory for many examples. ### Phantom types
hydra.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra-version: 0.1.1+version: 0.5.0 synopsis: Type-aware transformations for data and programs description: Hydra is a transformation toolkit along the lines of Dragon (Uber), but open source, and with a more advanced type system and other new features. Hydra maps data and schemas between languages in a way which maintains type conformance. It will even map functional programs between selected languages, including parts of its own source code. category: Data@@ -28,142 +28,233 @@ library exposed-modules:- Hydra.Adapters.Coders- Hydra.Adapters.Literal- Hydra.Adapters.Term- Hydra.Adapters.UtilsEtc- Hydra.Common+ Hydra.Adapters+ Hydra.AdapterUtils+ Hydra.Annotations+ Hydra.Codegen Hydra.CoreDecoding- Hydra.CoreEncoding- Hydra.CoreLanguage- 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.Language- 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.Pegasus.Coder- Hydra.Ext.Pegasus.Language- Hydra.Ext.Pegasus.Serde- Hydra.Ext.Rdf.Serde- 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.Tinkerpop.Language- Hydra.Ext.Yaml.Coder- Hydra.Ext.Yaml.Language- Hydra.Ext.Yaml.Modules- Hydra.Impl.Haskell.Codegen- Hydra.Impl.Haskell.Dsl.Base- Hydra.Impl.Haskell.Dsl.Bootstrap- Hydra.Impl.Haskell.Dsl.Grammars- Hydra.Impl.Haskell.Dsl.Lib.Lists- Hydra.Impl.Haskell.Dsl.Lib.Literals- Hydra.Impl.Haskell.Dsl.Lib.Math- Hydra.Impl.Haskell.Dsl.Lib.Sets- Hydra.Impl.Haskell.Dsl.Lib.Strings- Hydra.Impl.Haskell.Dsl.Literals- Hydra.Impl.Haskell.Dsl.PhantomLiterals- Hydra.Impl.Haskell.Dsl.Prims- Hydra.Impl.Haskell.Dsl.Standard- Hydra.Impl.Haskell.Dsl.Terms- Hydra.Impl.Haskell.Dsl.Types- Hydra.Impl.Haskell.Ext.Bytestrings- Hydra.Impl.Haskell.Ext.Json.Serde- Hydra.Impl.Haskell.Ext.Yaml.Serde- Hydra.Impl.Haskell.Sources.Adapters.Utils- Hydra.Impl.Haskell.Sources.Basics- Hydra.Impl.Haskell.Sources.Compute- Hydra.Impl.Haskell.Sources.Core- Hydra.Impl.Haskell.Sources.CoreLang- Hydra.Impl.Haskell.Sources.Ext.Avro.Schema- Hydra.Impl.Haskell.Sources.Ext.Graphql.Syntax- Hydra.Impl.Haskell.Sources.Ext.Haskell.Ast- Hydra.Impl.Haskell.Sources.Ext.Java.Syntax- Hydra.Impl.Haskell.Sources.Ext.Json.Model- Hydra.Impl.Haskell.Sources.Ext.Owl.Syntax- Hydra.Impl.Haskell.Sources.Ext.Pegasus.Pdl- Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax- Hydra.Impl.Haskell.Sources.Ext.Scala.Meta- Hydra.Impl.Haskell.Sources.Ext.Shacl.Model- Hydra.Impl.Haskell.Sources.Ext.Shex.Syntax- Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Features- Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Typed- Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.V3- Hydra.Impl.Haskell.Sources.Ext.Xml.Schema- Hydra.Impl.Haskell.Sources.Ext.Yaml.Model- Hydra.Impl.Haskell.Sources.Grammar- Hydra.Impl.Haskell.Sources.Libraries- Hydra.Impl.Haskell.Sources.Mantle- Hydra.Impl.Haskell.Sources.Module- Hydra.Impl.Haskell.Sources.Phantoms- Hydra.Impl.Haskell.Sources.Util.Codetree.Ast+ Hydra.Dsl.Annotations+ Hydra.Dsl.Base+ Hydra.Dsl.Bootstrap+ Hydra.Dsl.Core+ Hydra.Dsl.Expect+ Hydra.Dsl.Grammars+ Hydra.Dsl.Graph+ Hydra.Dsl.Lib.Equality+ Hydra.Dsl.Lib.Flows+ Hydra.Dsl.Lib.Io+ Hydra.Dsl.Lib.Lists+ Hydra.Dsl.Lib.Literals+ Hydra.Dsl.Lib.Logic+ Hydra.Dsl.Lib.Maps+ Hydra.Dsl.Lib.Math+ Hydra.Dsl.Lib.Optionals+ Hydra.Dsl.Lib.Sets+ Hydra.Dsl.Lib.Strings+ Hydra.Dsl.Literals+ Hydra.Dsl.Module+ Hydra.Dsl.PhantomLiterals+ Hydra.Dsl.Prims+ Hydra.Dsl.ShorthandTypes+ Hydra.Dsl.Terms+ Hydra.Dsl.Tests+ Hydra.Dsl.Types+ Hydra.Flows+ Hydra.Inference 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 Hydra.Lib.Io Hydra.Lib.Lists Hydra.Lib.Literals+ Hydra.Lib.Logic Hydra.Lib.Maps Hydra.Lib.Math Hydra.Lib.Optionals Hydra.Lib.Sets Hydra.Lib.Strings- Hydra.Meta- Hydra.Monads+ Hydra.LiteralAdapters Hydra.Reduction Hydra.Rewriting- Hydra.Types.Inference- Hydra.Types.Substitution- Hydra.Types.Unification- Hydra.Util.Codetree.Script- Hydra.Util.Debug- Hydra.Util.Formatting- Hydra.Util.GrammarToModule- Hydra.Util.Sorting- Hydra.Adapters.Utils+ Hydra.Rules+ Hydra.Scratchpad+ Hydra.Sources.Core+ Hydra.Sources.Libraries+ Hydra.Sources.Tier0.All+ Hydra.Sources.Tier0.Ast+ Hydra.Sources.Tier0.Coders+ Hydra.Sources.Tier0.Compute+ Hydra.Sources.Tier0.Constraints+ Hydra.Sources.Tier0.Grammar+ Hydra.Sources.Tier0.Graph+ Hydra.Sources.Tier0.Json+ Hydra.Sources.Tier0.Mantle+ Hydra.Sources.Tier0.Module+ Hydra.Sources.Tier0.Phantoms+ Hydra.Sources.Tier0.Query+ Hydra.Sources.Tier0.Testing+ Hydra.Sources.Tier0.Workflow+ Hydra.Sources.Tier1.All+ Hydra.Sources.Tier1.Constants+ Hydra.Sources.Tier1.CoreEncoding+ Hydra.Sources.Tier1.Messages+ Hydra.Sources.Tier1.Strip+ Hydra.Sources.Tier1.Tier1+ Hydra.Sources.Tier2.All+ Hydra.Sources.Tier2.Basics+ Hydra.Sources.Tier2.CoreLanguage+ Hydra.Sources.Tier2.Extras+ Hydra.Sources.Tier2.Printing+ Hydra.Sources.Tier2.Tier2+ 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.Test.Lib.Lists+ Hydra.Sources.Tier4.Test.Lib.Strings+ Hydra.Sources.Tier4.Test.TestSuite+ Hydra.Substitution+ Hydra.TermAdapters+ Hydra.Tools.Bytestrings+ Hydra.Tools.Debug+ Hydra.Tools.Formatting+ Hydra.Tools.GrammarToModule+ Hydra.Tools.Serialization+ Hydra.Tools.Sorting+ Hydra.Tools.Templating+ Hydra.Unification+ Hydra.Ast Hydra.Basics+ Hydra.Coders Hydra.Compute+ Hydra.Constants+ Hydra.Constraints Hydra.Core- Hydra.Ext.Avro.Schema- Hydra.Ext.Graphql.Syntax- Hydra.Ext.Haskell.Ast- Hydra.Ext.Java.Syntax- Hydra.Ext.Json.Model- Hydra.Ext.Owl.Syntax- Hydra.Ext.Pegasus.Pdl- Hydra.Ext.Rdf.Syntax- Hydra.Ext.Scala.Meta- Hydra.Ext.Shacl.Model- Hydra.Ext.Shex.Syntax- Hydra.Ext.Tinkerpop.Features- Hydra.Ext.Tinkerpop.Typed- Hydra.Ext.Tinkerpop.V3- Hydra.Ext.Xml.Schema- Hydra.Ext.Yaml.Model+ Hydra.CoreEncoding+ Hydra.CoreLanguage+ 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.Phantoms- Hydra.Util.Codetree.Ast+ Hydra.Printing+ Hydra.Query+ Hydra.Strip+ Hydra.Testing+ Hydra.Tier1+ Hydra.Tier2+ Hydra.Tier3+ Hydra.Workflow other-modules: Paths_hydra hs-source-dirs:@@ -189,28 +280,33 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:- Hydra.Adapters.LiteralSpec- Hydra.Adapters.TermSpec+ Hydra.AnnotationsSpec Hydra.ArbitraryCore- Hydra.CommonSpec Hydra.CoreCodersSpec- Hydra.Ext.Json.CoderSpec- Hydra.Ext.Yaml.CoderSpec- Hydra.Impl.Haskell.Dsl.TypesSpec- Hydra.Impl.Haskell.Ext.Json.SerdeSpec- Hydra.Impl.Haskell.Ext.Yaml.SerdeSpec- Hydra.MetaSpec+ Hydra.Dsl.TypesSpec+ Hydra.FlowsSpec+ Hydra.InferenceSpec+ Hydra.Langs.Json.CoderSpec+ Hydra.Langs.Json.SerdeSpec+ Hydra.Langs.Yaml.CoderSpec+ Hydra.Langs.Yaml.SerdeSpec+ Hydra.LiteralAdaptersSpec Hydra.ReductionSpec Hydra.RewritingSpec+ Hydra.StripSpec+ Hydra.TermAdaptersSpec Hydra.TestData Hydra.TestGraph+ Hydra.TestSuiteSpec Hydra.TestUtils- Hydra.Types.InferenceSpec- Hydra.Types.UnificationSpec- Hydra.Util.Codetree.PrintSpec+ Hydra.Tools.SerializationSpec+ Hydra.Tools.SortingSpec+ Hydra.UnificationSpec+ Hydra.Test.TestSuite Paths_hydra hs-source-dirs: src/test/haskell+ src/gen-test/haskell build-depends: HUnit , HsYAML >=0.2.1 && <0.3
− src/gen-main/haskell/Hydra/Adapters/Utils.hs
@@ -1,88 +0,0 @@--- | Utilities for use in transformations--module Hydra.Adapters.Utils where--import qualified Hydra.Basics as Basics-import qualified Hydra.Core as Core-import qualified Hydra.Lib.Literals as Literals-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Mantle as Mantle-import Data.List-import Data.Map-import Data.Set---- | Display a floating-point type as a string-describeFloatType :: (Core.FloatType -> String)-describeFloatType t = (Strings.cat [- (\x1 -> describePrecision (Basics.floatTypePrecision x1)) t,- " floating-point numbers"])---- | Display an integer type as a string-describeIntegerType :: (Core.IntegerType -> String)-describeIntegerType t = (Strings.cat [- (\x1 -> describePrecision (Basics.integerTypePrecision x1)) t,- " integers"])---- | Display a literal type as a string-describeLiteralType :: (Core.LiteralType -> String)-describeLiteralType x = case x of- Core.LiteralTypeBinary -> "binary strings"- Core.LiteralTypeBoolean -> "boolean values"- Core.LiteralTypeFloat v -> (describeFloatType v)- Core.LiteralTypeInteger v -> (describeIntegerType v)- 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 v -> (Strings.cat [- Literals.showInt32 v,- "-bit"])---- | Display a type as a string-describeType :: (Core.Type m -> String)-describeType typ = ((\x -> case x of- Core.TypeAnnotated v -> (Strings.cat [- "annotated ",- (describeType (Core.annotatedSubject v))])- Core.TypeApplication _ -> "instances of an application type"- Core.TypeLiteral v -> (describeLiteralType v)- Core.TypeElement v -> (Strings.cat [- "elements containing ",- (describeType v)])- Core.TypeFunction v -> (Strings.cat [- Strings.cat [- Strings.cat [- "functions from ",- (describeType (Core.functionTypeDomain v))],- " to "],- (describeType (Core.functionTypeCodomain v))])- Core.TypeLambda _ -> "polymorphic terms"- Core.TypeList v -> (Strings.cat [- "lists of ",- (describeType v)])- Core.TypeMap v -> (Strings.cat [- Strings.cat [- Strings.cat [- "maps from ",- (describeType (Core.mapTypeKeys v))],- " to "],- (describeType (Core.mapTypeValues v))])- Core.TypeNominal v -> (Strings.cat [- "alias for ",- (Core.unName v)])- Core.TypeOptional v -> (Strings.cat [- "optional ",- (describeType v)])- Core.TypeProduct _ -> "tuples"- Core.TypeRecord _ -> "records"- Core.TypeSet v -> (Strings.cat [- "sets of ",- (describeType v)])- Core.TypeStream v -> (Strings.cat [- "streams of ",- (describeType v)])- Core.TypeSum _ -> "variant tuples"- Core.TypeUnion _ -> "unions"- Core.TypeVariable _ -> "unspecified/parametric terms") typ)
+ src/gen-main/haskell/Hydra/Ast.hs view
@@ -0,0 +1,200 @@+-- | A model which provides a common syntax tree for Hydra serializers++module Hydra.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++-- | Operator associativity+data Associativity = + AssociativityNone |+ AssociativityLeft |+ AssociativityRight |+ AssociativityBoth + deriving (Eq, Ord, Read, Show)++_Associativity = (Core.Name "hydra/ast.Associativity")++_Associativity_none = (Core.Name "none")++_Associativity_left = (Core.Name "left")++_Associativity_right = (Core.Name "right")++_Associativity_both = (Core.Name "both")++-- | Formatting option for code blocks+data BlockStyle = + BlockStyle {+ blockStyleIndent :: (Maybe String),+ blockStyleNewlineBeforeContent :: Bool,+ blockStyleNewlineAfterContent :: Bool}+ deriving (Eq, Ord, Read, Show)++_BlockStyle = (Core.Name "hydra/ast.BlockStyle")++_BlockStyle_indent = (Core.Name "indent")++_BlockStyle_newlineBeforeContent = (Core.Name "newlineBeforeContent")++_BlockStyle_newlineAfterContent = (Core.Name "newlineAfterContent")++-- | An expression enclosed by brackets+data BracketExpr = + BracketExpr {+ bracketExprBrackets :: Brackets,+ bracketExprEnclosed :: Expr,+ bracketExprStyle :: BlockStyle}+ deriving (Eq, Ord, Read, Show)++_BracketExpr = (Core.Name "hydra/ast.BracketExpr")++_BracketExpr_brackets = (Core.Name "brackets")++_BracketExpr_enclosed = (Core.Name "enclosed")++_BracketExpr_style = (Core.Name "style")++-- | Matching open and close bracket symbols+data Brackets = + Brackets {+ bracketsOpen :: Symbol,+ bracketsClose :: Symbol}+ deriving (Eq, Ord, Read, Show)++_Brackets = (Core.Name "hydra/ast.Brackets")++_Brackets_open = (Core.Name "open")++_Brackets_close = (Core.Name "close")++-- | An abstract expression+data Expr = + ExprConst Symbol |+ ExprIndent IndentedExpression |+ ExprOp OpExpr |+ ExprBrackets BracketExpr+ deriving (Eq, Ord, Read, Show)++_Expr = (Core.Name "hydra/ast.Expr")++_Expr_const = (Core.Name "const")++_Expr_indent = (Core.Name "indent")++_Expr_op = (Core.Name "op")++_Expr_brackets = (Core.Name "brackets")++-- | An expression indented in a certain style+data IndentedExpression = + IndentedExpression {+ indentedExpressionStyle :: IndentStyle,+ indentedExpressionExpr :: Expr}+ deriving (Eq, Ord, Read, Show)++_IndentedExpression = (Core.Name "hydra/ast.IndentedExpression")++_IndentedExpression_style = (Core.Name "style")++_IndentedExpression_expr = (Core.Name "expr")++-- | Any of several indentation styles+data IndentStyle = + IndentStyleAllLines String |+ IndentStyleSubsequentLines String+ deriving (Eq, Ord, Read, Show)++_IndentStyle = (Core.Name "hydra/ast.IndentStyle")++_IndentStyle_allLines = (Core.Name "allLines")++_IndentStyle_subsequentLines = (Core.Name "subsequentLines")++-- | An operator symbol+data Op = + Op {+ opSymbol :: Symbol,+ opPadding :: Padding,+ opPrecedence :: Precedence,+ opAssociativity :: Associativity}+ deriving (Eq, Ord, Read, Show)++_Op = (Core.Name "hydra/ast.Op")++_Op_symbol = (Core.Name "symbol")++_Op_padding = (Core.Name "padding")++_Op_precedence = (Core.Name "precedence")++_Op_associativity = (Core.Name "associativity")++-- | An operator expression+data OpExpr = + OpExpr {+ opExprOp :: Op,+ opExprLhs :: Expr,+ opExprRhs :: Expr}+ deriving (Eq, Ord, Read, Show)++_OpExpr = (Core.Name "hydra/ast.OpExpr")++_OpExpr_op = (Core.Name "op")++_OpExpr_lhs = (Core.Name "lhs")++_OpExpr_rhs = (Core.Name "rhs")++-- | Left and right padding for an operator+data Padding = + Padding {+ paddingLeft :: Ws,+ paddingRight :: Ws}+ deriving (Eq, Ord, Read, Show)++_Padding = (Core.Name "hydra/ast.Padding")++_Padding_left = (Core.Name "left")++_Padding_right = (Core.Name "right")++-- | Operator precedence+newtype Precedence = + Precedence {+ unPrecedence :: Int}+ deriving (Eq, Ord, Read, Show)++_Precedence = (Core.Name "hydra/ast.Precedence")++-- | Any symbol+newtype Symbol = + Symbol {+ unSymbol :: String}+ deriving (Eq, Ord, Read, Show)++_Symbol = (Core.Name "hydra/ast.Symbol")++-- | One of several classes of whitespace+data Ws = + WsNone |+ WsSpace |+ WsBreak |+ WsBreakAndIndent String |+ WsDoubleBreak + deriving (Eq, Ord, Read, Show)++_Ws = (Core.Name "hydra/ast.Ws")++_Ws_none = (Core.Name "none")++_Ws_space = (Core.Name "space")++_Ws_break = (Core.Name "break")++_Ws_breakAndIndent = (Core.Name "breakAndIndent")++_Ws_doubleBreak = (Core.Name "doubleBreak")
src/gen-main/haskell/Hydra/Basics.hs view
@@ -1,33 +1,39 @@--- | Basic functions for working with types and terms+-- | A tier-2 module of basic functions for working with types and terms. module Hydra.Basics where import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+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.Strings as Strings import qualified Hydra.Mantle as Mantle import qualified Hydra.Module as Module-import Data.List-import Data.Map-import Data.Set+import qualified Hydra.Strip as Strip+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S -- | Find the elimination variant (constructor) for a given elimination term-eliminationVariant :: (Core.Elimination m -> Mantle.EliminationVariant)+eliminationVariant :: (Core.Elimination -> Mantle.EliminationVariant) eliminationVariant x = case x of- Core.EliminationElement -> Mantle.EliminationVariantElement Core.EliminationList _ -> Mantle.EliminationVariantList- Core.EliminationNominal _ -> Mantle.EliminationVariantNominal Core.EliminationOptional _ -> Mantle.EliminationVariantOptional+ Core.EliminationProduct _ -> Mantle.EliminationVariantProduct Core.EliminationRecord _ -> Mantle.EliminationVariantRecord Core.EliminationUnion _ -> Mantle.EliminationVariantUnion+ Core.EliminationWrap _ -> Mantle.EliminationVariantWrap -- | All elimination variants (constructors), in a canonical order eliminationVariants :: [Mantle.EliminationVariant] eliminationVariants = [- Mantle.EliminationVariantElement, Mantle.EliminationVariantList,- Mantle.EliminationVariantNominal,+ Mantle.EliminationVariantWrap, Mantle.EliminationVariantOptional,+ Mantle.EliminationVariantProduct, Mantle.EliminationVariantRecord, Mantle.EliminationVariantUnion] @@ -53,9 +59,8 @@ Core.FloatValueFloat64 _ -> Core.FloatTypeFloat64 -- | Find the function variant (constructor) for a given function-functionVariant :: (Core.Function m -> Mantle.FunctionVariant)+functionVariant :: (Core.Function -> Mantle.FunctionVariant) functionVariant x = case x of- Core.FunctionCompareTo _ -> Mantle.FunctionVariantCompareTo Core.FunctionElimination _ -> Mantle.FunctionVariantElimination Core.FunctionLambda _ -> Mantle.FunctionVariantLambda Core.FunctionPrimitive _ -> Mantle.FunctionVariantPrimitive@@ -63,11 +68,14 @@ -- | All function variants (constructors), in a canonical order functionVariants :: [Mantle.FunctionVariant] functionVariants = [- Mantle.FunctionVariantCompareTo, Mantle.FunctionVariantElimination, Mantle.FunctionVariantLambda, Mantle.FunctionVariantPrimitive] +-- | The identity function+id_ :: (a -> a)+id_ x = x+ -- | Find whether a given integer type is signed (true) or unsigned (false) integerTypeIsSigned :: (Core.IntegerType -> Bool) integerTypeIsSigned x = case x of@@ -125,8 +133,8 @@ literalType x = case x of Core.LiteralBinary _ -> Core.LiteralTypeBinary Core.LiteralBoolean _ -> Core.LiteralTypeBoolean- Core.LiteralFloat v -> ((\x2 -> Core.LiteralTypeFloat x2) (floatValueType v))- Core.LiteralInteger v -> ((\x2 -> Core.LiteralTypeInteger x2) (integerValueType v))+ Core.LiteralFloat v187 -> ((\x2 -> Core.LiteralTypeFloat x2) (floatValueType v187))+ Core.LiteralInteger v188 -> ((\x2 -> Core.LiteralTypeInteger x2) (integerValueType v188)) Core.LiteralString _ -> Core.LiteralTypeString -- | Find the literal type variant (constructor) for a given literal value@@ -140,7 +148,7 @@ -- | Find the literal variant (constructor) for a given literal value literalVariant :: (Core.Literal -> Mantle.LiteralVariant)-literalVariant x1 = (literalTypeVariant (literalType x1))+literalVariant x = (literalTypeVariant (literalType x)) -- | All literal variants, in a canonical order literalVariants :: [Mantle.LiteralVariant]@@ -151,33 +159,25 @@ Mantle.LiteralVariantInteger, Mantle.LiteralVariantString] --- | Construct a qualified (dot-separated) name-qname :: (Module.Namespace -> String -> Core.Name)-qname ns name = (Core.Name (Strings.cat [- Module.unNamespace ns,- ".",- name]))- -- | Find the term variant (constructor) for a given term-termVariant :: (Core.Term m -> Mantle.TermVariant)-termVariant term = ((\x -> case x of+termVariant :: (Core.Term -> Mantle.TermVariant)+termVariant x = case x of Core.TermAnnotated _ -> Mantle.TermVariantAnnotated Core.TermApplication _ -> Mantle.TermVariantApplication- Core.TermElement _ -> Mantle.TermVariantElement Core.TermFunction _ -> Mantle.TermVariantFunction Core.TermLet _ -> Mantle.TermVariantLet Core.TermList _ -> Mantle.TermVariantList Core.TermLiteral _ -> Mantle.TermVariantLiteral Core.TermMap _ -> Mantle.TermVariantMap- Core.TermNominal _ -> Mantle.TermVariantNominal Core.TermOptional _ -> Mantle.TermVariantOptional Core.TermProduct _ -> Mantle.TermVariantProduct Core.TermRecord _ -> Mantle.TermVariantRecord Core.TermSet _ -> Mantle.TermVariantSet- Core.TermStream _ -> Mantle.TermVariantStream Core.TermSum _ -> Mantle.TermVariantSum+ Core.TermTyped _ -> Mantle.TermVariantTyped Core.TermUnion _ -> Mantle.TermVariantUnion- Core.TermVariable _ -> Mantle.TermVariantVariable) term)+ Core.TermVariable _ -> Mantle.TermVariantVariable+ Core.TermWrap _ -> Mantle.TermVariantWrap -- | All term (expression) variants, in a canonical order termVariants :: [Mantle.TermVariant]@@ -185,62 +185,152 @@ Mantle.TermVariantAnnotated, Mantle.TermVariantApplication, Mantle.TermVariantLiteral,- Mantle.TermVariantElement, Mantle.TermVariantFunction, Mantle.TermVariantList, Mantle.TermVariantMap,- Mantle.TermVariantNominal, Mantle.TermVariantOptional, Mantle.TermVariantProduct, Mantle.TermVariantRecord, Mantle.TermVariantSet,- Mantle.TermVariantStream, Mantle.TermVariantSum,+ Mantle.TermVariantTyped, Mantle.TermVariantUnion,- Mantle.TermVariantVariable]---- | TODO: temporary. Just a token polymorphic function for testing-testLists :: ([[a]] -> Int)-testLists els = (Lists.length (Lists.concat els))+ Mantle.TermVariantVariable,+ Mantle.TermVariantWrap] -- | Find the type variant (constructor) for a given type-typeVariant :: (Core.Type m -> Mantle.TypeVariant)-typeVariant typ = ((\x -> case x of+typeVariant :: (Core.Type -> Mantle.TypeVariant)+typeVariant x = case x of Core.TypeAnnotated _ -> Mantle.TypeVariantAnnotated Core.TypeApplication _ -> Mantle.TypeVariantApplication- Core.TypeElement _ -> Mantle.TypeVariantElement Core.TypeFunction _ -> Mantle.TypeVariantFunction Core.TypeLambda _ -> Mantle.TypeVariantLambda Core.TypeList _ -> Mantle.TypeVariantList Core.TypeLiteral _ -> Mantle.TypeVariantLiteral Core.TypeMap _ -> Mantle.TypeVariantMap- Core.TypeNominal _ -> Mantle.TypeVariantNominal Core.TypeOptional _ -> Mantle.TypeVariantOptional Core.TypeProduct _ -> Mantle.TypeVariantProduct Core.TypeRecord _ -> Mantle.TypeVariantRecord Core.TypeSet _ -> Mantle.TypeVariantSet- Core.TypeStream _ -> Mantle.TypeVariantStream Core.TypeSum _ -> Mantle.TypeVariantSum Core.TypeUnion _ -> Mantle.TypeVariantUnion- Core.TypeVariable _ -> Mantle.TypeVariantVariable) typ)+ Core.TypeVariable _ -> Mantle.TypeVariantVariable+ Core.TypeWrap _ -> Mantle.TypeVariantWrap -- | All type variants, in a canonical order typeVariants :: [Mantle.TypeVariant] typeVariants = [ Mantle.TypeVariantAnnotated, Mantle.TypeVariantApplication,- Mantle.TypeVariantElement, Mantle.TypeVariantFunction, Mantle.TypeVariantLambda, Mantle.TypeVariantList, Mantle.TypeVariantLiteral, Mantle.TypeVariantMap,- Mantle.TypeVariantNominal,+ Mantle.TypeVariantWrap, Mantle.TypeVariantOptional, Mantle.TypeVariantProduct, Mantle.TypeVariantRecord, Mantle.TypeVariantSet,- Mantle.TypeVariantStream, Mantle.TypeVariantSum, Mantle.TypeVariantUnion, Mantle.TypeVariantVariable]++-- | Capitalize the first letter of a string+capitalize :: (String -> String)+capitalize = (mapFirstLetter Strings.toUpper)++-- | Decapitalize the first letter of a string+decapitalize :: (String -> String)+decapitalize = (mapFirstLetter Strings.toLower)++-- | A helper which maps the first letter of a string to another string+mapFirstLetter :: ((String -> String) -> String -> String)+mapFirstLetter mapping s = + let firstLetter = (mapping (Strings.fromList (Lists.pure (Lists.head list)))) + list = (Strings.toList s)+ in (Logic.ifElse s (Strings.cat2 firstLetter (Strings.fromList (Lists.tail list))) (Strings.isEmpty s))++fieldMap :: ([Core.Field] -> Map Core.Name Core.Term)+fieldMap fields = (Maps.fromList (Lists.map toPair fields)) + where + toPair = (\f -> (Core.fieldName f, (Core.fieldTerm f)))++fieldTypeMap :: ([Core.FieldType] -> Map Core.Name Core.Type)+fieldTypeMap fields = (Maps.fromList (Lists.map toPair fields)) + where + toPair = (\f -> (Core.fieldTypeName f, (Core.fieldTypeType f)))++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)))+ _ -> 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)))+ _ -> False) (Strip.stripType t))++isUnitTerm :: (Core.Term -> Bool)+isUnitTerm t = (Equality.equalTerm (Strip.fullyStripTerm t) (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []})))++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)+elementsToGraph parent schema elements = + let toPair = (\el -> (Graph.elementName el, el))+ in Graph.Graph {+ Graph.graphElements = (Maps.fromList (Lists.map toPair elements)),+ Graph.graphEnvironment = (Graph.graphEnvironment parent),+ Graph.graphTypes = (Graph.graphTypes parent),+ Graph.graphBody = (Graph.graphBody parent),+ Graph.graphPrimitives = (Graph.graphPrimitives parent),+ Graph.graphSchema = schema}++localNameOfEager :: (Core.Name -> String)+localNameOfEager x = (Module.qualifiedNameLocal (qualifyNameEager x))++localNameOfLazy :: (Core.Name -> String)+localNameOfLazy x = (Module.qualifiedNameLocal (qualifyNameLazy x))++namespaceOfEager :: (Core.Name -> Maybe Module.Namespace)+namespaceOfEager x = (Module.qualifiedNameNamespace (qualifyNameEager x))++namespaceOfLazy :: (Core.Name -> Maybe Module.Namespace)+namespaceOfLazy x = (Module.qualifiedNameNamespace (qualifyNameLazy x))++namespaceToFilePath :: (Bool -> Module.FileExtension -> Module.Namespace -> String)+namespaceToFilePath caps ext ns = + let parts = (Lists.map (Logic.ifElse capitalize id_ caps) (Strings.splitOn "/" (Module.unNamespace ns)))+ in (Strings.cat [+ Strings.cat [+ Strings.intercalate "/" parts,+ "."],+ (Module.unFileExtension ext)])++qualifyNameEager :: (Core.Name -> Module.QualifiedName)+qualifyNameEager name = + let parts = (Strings.splitOn "." (Core.unName name))+ in (Logic.ifElse (Module.QualifiedName {+ Module.qualifiedNameNamespace = Nothing,+ Module.qualifiedNameLocal = (Core.unName name)}) (Module.QualifiedName {+ Module.qualifiedNameNamespace = (Just (Module.Namespace (Lists.head parts))),+ Module.qualifiedNameLocal = (Strings.intercalate "." (Lists.tail parts))}) (Equality.equalInt32 1 (Lists.length parts)))++qualifyNameLazy :: (Core.Name -> Module.QualifiedName)+qualifyNameLazy name = + let parts = (Lists.reverse (Strings.splitOn "." (Core.unName name)))+ in (Logic.ifElse (Module.QualifiedName {+ Module.qualifiedNameNamespace = Nothing,+ Module.qualifiedNameLocal = (Core.unName name)}) (Module.QualifiedName {+ Module.qualifiedNameNamespace = (Just (Module.Namespace (Strings.intercalate "." (Lists.reverse (Lists.tail parts))))),+ Module.qualifiedNameLocal = (Lists.head parts)}) (Equality.equalInt32 1 (Lists.length parts)))
+ src/gen-main/haskell/Hydra/Coders.hs view
@@ -0,0 +1,111 @@+-- | Abstractions for paired transformations between languages++module Hydra.Coders where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Mantle as Mantle+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | An evaluation context together with a source language and a target language+data AdapterContext = + AdapterContext {+ adapterContextGraph :: Graph.Graph,+ adapterContextLanguage :: Language,+ adapterContextAdapters :: (Map Core.Name (Compute.Adapter AdapterContext AdapterContext Core.Type Core.Type Core.Term Core.Term))}++_AdapterContext = (Core.Name "hydra/coders.AdapterContext")++_AdapterContext_graph = (Core.Name "graph")++_AdapterContext_language = (Core.Name "language")++_AdapterContext_adapters = (Core.Name "adapters")++-- | Indicates either the 'out' or the 'in' direction of a coder+data CoderDirection = + CoderDirectionEncode |+ CoderDirectionDecode + deriving (Eq, Ord, Read, Show)++_CoderDirection = (Core.Name "hydra/coders.CoderDirection")++_CoderDirection_encode = (Core.Name "encode")++_CoderDirection_decode = (Core.Name "decode")++-- | A named language together with language-specific constraints+data Language = + Language {+ languageName :: LanguageName,+ languageConstraints :: LanguageConstraints}++_Language = (Core.Name "hydra/coders.Language")++_Language_name = (Core.Name "name")++_Language_constraints = (Core.Name "constraints")++-- | A set of constraints on valid type and term expressions, characterizing a language+data LanguageConstraints = + LanguageConstraints {+ -- | All supported elimination variants+ languageConstraintsEliminationVariants :: (Set Mantle.EliminationVariant),+ -- | All supported literal variants+ languageConstraintsLiteralVariants :: (Set Mantle.LiteralVariant),+ -- | All supported float types+ languageConstraintsFloatTypes :: (Set Core.FloatType),+ -- | All supported function variants+ languageConstraintsFunctionVariants :: (Set Mantle.FunctionVariant),+ -- | All supported integer types+ languageConstraintsIntegerTypes :: (Set Core.IntegerType),+ -- | All supported term variants+ languageConstraintsTermVariants :: (Set Mantle.TermVariant),+ -- | All supported type variants+ languageConstraintsTypeVariants :: (Set Mantle.TypeVariant),+ -- | A logical set of types, as a predicate which tests a type for inclusion+ languageConstraintsTypes :: (Core.Type -> Bool)}++_LanguageConstraints = (Core.Name "hydra/coders.LanguageConstraints")++_LanguageConstraints_eliminationVariants = (Core.Name "eliminationVariants")++_LanguageConstraints_literalVariants = (Core.Name "literalVariants")++_LanguageConstraints_floatTypes = (Core.Name "floatTypes")++_LanguageConstraints_functionVariants = (Core.Name "functionVariants")++_LanguageConstraints_integerTypes = (Core.Name "integerTypes")++_LanguageConstraints_termVariants = (Core.Name "termVariants")++_LanguageConstraints_typeVariants = (Core.Name "typeVariants")++_LanguageConstraints_types = (Core.Name "types")++-- | The unique name of a language+newtype LanguageName = + LanguageName {+ unLanguageName :: String}+ deriving (Eq, Ord, Read, Show)++_LanguageName = (Core.Name "hydra/coders.LanguageName")++-- | Specifies either a pre-order or post-order traversal+data TraversalOrder = + -- | Pre-order traversal+ TraversalOrderPre |+ -- | Post-order traversal+ TraversalOrderPost + deriving (Eq, Ord, Read, Show)++_TraversalOrder = (Core.Name "hydra/coders.TraversalOrder")++_TraversalOrder_pre = (Core.Name "pre")++_TraversalOrder_post = (Core.Name "post")
src/gen-main/haskell/Hydra/Compute.hs view
@@ -1,12 +1,12 @@--- | Abstractions for evaluation and transformations+-- | Abstractions for single- and bidirectional transformations module Hydra.Compute where import qualified Hydra.Core as Core-import qualified Hydra.Mantle as Mantle-import Data.List-import Data.Map-import Data.Set+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S -- | A two-level bidirectional encoder which adapts types to types and terms to terms data Adapter s1 s2 t1 t2 v1 v2 = @@ -18,76 +18,25 @@ _Adapter = (Core.Name "hydra/compute.Adapter") -_Adapter_isLossy = (Core.FieldName "isLossy")--_Adapter_source = (Core.FieldName "source")--_Adapter_target = (Core.FieldName "target")--_Adapter_coder = (Core.FieldName "coder")---- | An evaluation context together with a source language and a target language-data AdapterContext m = - AdapterContext {- adapterContextEvaluation :: (Context m),- adapterContextSource :: (Language m),- adapterContextTarget :: (Language m)}--_AdapterContext = (Core.Name "hydra/compute.AdapterContext")--_AdapterContext_evaluation = (Core.FieldName "evaluation")--_AdapterContext_source = (Core.FieldName "source")--_AdapterContext_target = (Core.FieldName "target")---- | A typeclass-like construct providing common functions for working with annotations-data AnnotationClass m = - AnnotationClass {- annotationClassDefault :: m,- annotationClassEqual :: (m -> m -> Bool),- annotationClassCompare :: (m -> m -> Mantle.Comparison),- annotationClassShow :: (m -> String),- annotationClassRead :: (String -> Maybe m),- annotationClassTermMeta :: (Core.Term m -> m),- annotationClassTypeMeta :: (Core.Type m -> m),- annotationClassTermDescription :: (Core.Term m -> Flow (Context m) (Maybe String)),- annotationClassTypeDescription :: (Core.Type m -> Flow (Context m) (Maybe String)),- annotationClassTermType :: (Core.Term m -> Flow (Context m) (Maybe (Core.Type m))),- annotationClassSetTermDescription :: (Context m -> Maybe String -> Core.Term m -> Core.Term m),- annotationClassSetTermType :: (Context m -> Maybe (Core.Type m) -> Core.Term m -> Core.Term m),- annotationClassTypeOf :: (m -> Flow (Context m) (Maybe (Core.Type m))),- annotationClassSetTypeOf :: (Maybe (Core.Type m) -> m -> m)}--_AnnotationClass = (Core.Name "hydra/compute.AnnotationClass")--_AnnotationClass_default = (Core.FieldName "default")--_AnnotationClass_equal = (Core.FieldName "equal")--_AnnotationClass_compare = (Core.FieldName "compare")--_AnnotationClass_show = (Core.FieldName "show")--_AnnotationClass_read = (Core.FieldName "read")--_AnnotationClass_termMeta = (Core.FieldName "termMeta")--_AnnotationClass_typeMeta = (Core.FieldName "typeMeta")+_Adapter_isLossy = (Core.Name "isLossy") -_AnnotationClass_termDescription = (Core.FieldName "termDescription")+_Adapter_source = (Core.Name "source") -_AnnotationClass_typeDescription = (Core.FieldName "typeDescription")+_Adapter_target = (Core.Name "target") -_AnnotationClass_termType = (Core.FieldName "termType")+_Adapter_coder = (Core.Name "coder") -_AnnotationClass_setTermDescription = (Core.FieldName "setTermDescription")+-- | A two-level encoder and decoder, operating both at a type level and an instance (data) level+data Bicoder s1 s2 t1 t2 v1 v2 = + Bicoder {+ bicoderEncode :: (t1 -> Adapter s1 s2 t1 t2 v1 v2),+ bicoderDecode :: (t2 -> Adapter s2 s1 t2 t1 v2 v1)} -_AnnotationClass_setTermType = (Core.FieldName "setTermType")+_Bicoder = (Core.Name "hydra/compute.Bicoder") -_AnnotationClass_typeOf = (Core.FieldName "typeOf")+_Bicoder_encode = (Core.Name "encode") -_AnnotationClass_setTypeOf = (Core.FieldName "setTypeOf")+_Bicoder_decode = (Core.Name "decode") -- | An encoder and decoder; a bidirectional flow between two types data Coder s1 s2 v1 v2 = @@ -97,161 +46,32 @@ _Coder = (Core.Name "hydra/compute.Coder") -_Coder_encode = (Core.FieldName "encode")--_Coder_decode = (Core.FieldName "decode")---- | Indicates either the 'out' or the 'in' direction of a coder-data CoderDirection = - CoderDirectionEncode |- CoderDirectionDecode - deriving (Eq, Ord, Read, Show)--_CoderDirection = (Core.Name "hydra/compute.CoderDirection")--_CoderDirection_encode = (Core.FieldName "encode")--_CoderDirection_decode = (Core.FieldName "decode")---- | An environment containing a graph together with primitive functions and other necessary components for evaluation-data Context m = - Context {- contextGraph :: (Mantle.Graph m),- contextFunctions :: (Map Core.Name (PrimitiveFunction m)),- contextStrategy :: EvaluationStrategy,- contextAnnotations :: (AnnotationClass m)}--_Context = (Core.Name "hydra/compute.Context")--_Context_graph = (Core.FieldName "graph")--_Context_functions = (Core.FieldName "functions")--_Context_strategy = (Core.FieldName "strategy")--_Context_annotations = (Core.FieldName "annotations")---- | Settings which determine how terms are evaluated-data EvaluationStrategy = - EvaluationStrategy {- evaluationStrategyOpaqueTermVariants :: (Set Mantle.TermVariant)}- deriving (Eq, Ord, Read, Show)--_EvaluationStrategy = (Core.Name "hydra/compute.EvaluationStrategy")+_Coder_encode = (Core.Name "encode") -_EvaluationStrategy_opaqueTermVariants = (Core.FieldName "opaqueTermVariants")+_Coder_decode = (Core.Name "decode") -- | A variant of the State monad with built-in logging and error handling-newtype Flow s a = +newtype Flow s x = Flow {- unFlow :: (s -> Trace -> FlowState s a)}+ unFlow :: (s -> Trace -> FlowState s x)} _Flow = (Core.Name "hydra/compute.Flow") -- | The result of evaluating a Flow-data FlowState s a = +data FlowState s x = FlowState {- flowStateValue :: (Maybe a),+ flowStateValue :: (Maybe x), flowStateState :: s, flowStateTrace :: Trace} deriving (Eq, Ord, Read, Show) _FlowState = (Core.Name "hydra/compute.FlowState") -_FlowState_value = (Core.FieldName "value")--_FlowState_state = (Core.FieldName "state")--_FlowState_trace = (Core.FieldName "trace")---- | A named language together with language-specific constraints-data Language m = - Language {- languageName :: LanguageName,- languageConstraints :: (LanguageConstraints m)}--_Language = (Core.Name "hydra/compute.Language")--_Language_name = (Core.FieldName "name")--_Language_constraints = (Core.FieldName "constraints")---- | A set of constraints on valid type and term expressions, characterizing a language-data LanguageConstraints m = - LanguageConstraints {- languageConstraintsEliminationVariants :: (Set Mantle.EliminationVariant),- languageConstraintsLiteralVariants :: (Set Mantle.LiteralVariant),- languageConstraintsFloatTypes :: (Set Core.FloatType),- languageConstraintsFunctionVariants :: (Set Mantle.FunctionVariant),- languageConstraintsIntegerTypes :: (Set Core.IntegerType),- languageConstraintsTermVariants :: (Set Mantle.TermVariant),- languageConstraintsTypeVariants :: (Set Mantle.TypeVariant),- languageConstraintsTypes :: (Core.Type m -> Bool)}--_LanguageConstraints = (Core.Name "hydra/compute.LanguageConstraints")--_LanguageConstraints_eliminationVariants = (Core.FieldName "eliminationVariants")--_LanguageConstraints_literalVariants = (Core.FieldName "literalVariants")--_LanguageConstraints_floatTypes = (Core.FieldName "floatTypes")--_LanguageConstraints_functionVariants = (Core.FieldName "functionVariants")--_LanguageConstraints_integerTypes = (Core.FieldName "integerTypes")--_LanguageConstraints_termVariants = (Core.FieldName "termVariants")--_LanguageConstraints_typeVariants = (Core.FieldName "typeVariants")--_LanguageConstraints_types = (Core.FieldName "types")---- | The unique name of a language-newtype LanguageName = - LanguageName {- -- | The unique name of a language- unLanguageName :: String}- deriving (Eq, Ord, Read, Show)--_LanguageName = (Core.Name "hydra/compute.LanguageName")---- | A built-in metadata container for terms-data Meta = - Meta {- -- | A map of annotation names to annotation values- metaAnnotations :: (Map String (Core.Term Meta))}- deriving (Eq, Ord, Read, Show)--_Meta = (Core.Name "hydra/compute.Meta")--_Meta_annotations = (Core.FieldName "annotations")---- | A built-in function-data PrimitiveFunction m = - PrimitiveFunction {- primitiveFunctionName :: Core.Name,- primitiveFunctionType :: (Core.FunctionType m),- primitiveFunctionImplementation :: ([Core.Term m] -> Flow (Context m) (Core.Term m))}--_PrimitiveFunction = (Core.Name "hydra/compute.PrimitiveFunction")--_PrimitiveFunction_name = (Core.FieldName "name")--_PrimitiveFunction_type = (Core.FieldName "type")--_PrimitiveFunction_implementation = (Core.FieldName "implementation")---- | A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms-data TermCoder m a = - TermCoder {- termCoderType :: (Core.Type m),- termCoderCoder :: (Coder (Context m) (Context m) (Core.Term m) a)}--_TermCoder = (Core.Name "hydra/compute.TermCoder")+_FlowState_value = (Core.Name "value") -_TermCoder_type = (Core.FieldName "type")+_FlowState_state = (Core.Name "state") -_TermCoder_coder = (Core.FieldName "coder")+_FlowState_trace = (Core.Name "trace") -- | A container for logging and error information data Trace = @@ -259,27 +79,13 @@ traceStack :: [String], traceMessages :: [String], -- | A map of string keys to arbitrary terms as values, for application-specific use- traceOther :: (Map String (Core.Term Meta))}+ traceOther :: (Map String Core.Term)} deriving (Eq, Ord, Read, Show) _Trace = (Core.Name "hydra/compute.Trace") -_Trace_stack = (Core.FieldName "stack")--_Trace_messages = (Core.FieldName "messages")--_Trace_other = (Core.FieldName "other")---- | Specifies either a pre-order or post-order traversal-data TraversalOrder = - -- | Pre-order traversal- TraversalOrderPre |- -- | Post-order traversal- TraversalOrderPost - deriving (Eq, Ord, Read, Show)--_TraversalOrder = (Core.Name "hydra/compute.TraversalOrder")+_Trace_stack = (Core.Name "stack") -_TraversalOrder_pre = (Core.FieldName "pre")+_Trace_messages = (Core.Name "messages") -_TraversalOrder_post = (Core.FieldName "post")+_Trace_other = (Core.Name "other")
+ src/gen-main/haskell/Hydra/Constants.hs view
@@ -0,0 +1,19 @@+-- | A module for tier-0 constants.++module Hydra.Constants 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++ignoredVariable :: String+ignoredVariable = "_"++-- | A placeholder name for row types as they are being constructed+placeholderName :: Core.Name+placeholderName = (Core.Name "Placeholder")++maxTraceDepth :: Int+maxTraceDepth = 50
+ src/gen-main/haskell/Hydra/Constraints.hs view
@@ -0,0 +1,36 @@+-- | A model for path- and pattern-based graph constraints, which may be considered as part of the schema of a graph++module Hydra.Constraints where++import qualified Hydra.Core as Core+import qualified Hydra.Query as Query+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | A declared equivalence between two abstract paths in a graph+data PathEquation = + PathEquation {+ pathEquationLeft :: Query.Path,+ pathEquationRight :: Query.Path}+ deriving (Eq, Ord, Read, Show)++_PathEquation = (Core.Name "hydra/constraints.PathEquation")++_PathEquation_left = (Core.Name "left")++_PathEquation_right = (Core.Name "right")++-- | A pattern which, if it matches in a given graph, implies that another pattern must also match. Query variables are shared between the two patterns.+data PatternImplication = + PatternImplication {+ patternImplicationAntecedent :: Query.Pattern,+ patternImplicationConsequent :: Query.Pattern}+ deriving (Eq, Ord, Read, Show)++_PatternImplication = (Core.Name "hydra/constraints.PatternImplication")++_PatternImplication_antecedent = (Core.Name "antecedent")++_PatternImplication_consequent = (Core.Name "consequent")
src/gen-main/haskell/Hydra/Core.hs view
@@ -2,130 +2,138 @@ module Hydra.Core where -import Data.List-import Data.Map-import Data.Set+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S --- | An object, such as a type or term, together with an annotation-data Annotated a m = - Annotated {- annotatedSubject :: a,- annotatedAnnotation :: m}+-- | A term together with an annotation+data AnnotatedTerm = + AnnotatedTerm {+ annotatedTermSubject :: Term,+ annotatedTermAnnotation :: (Map String Term)} deriving (Eq, Ord, Read, Show) -_Annotated = (Name "hydra/core.Annotated")+_AnnotatedTerm = (Name "hydra/core.AnnotatedTerm") -_Annotated_subject = (FieldName "subject")+_AnnotatedTerm_subject = (Name "subject") -_Annotated_annotation = (FieldName "annotation")+_AnnotatedTerm_annotation = (Name "annotation") +-- | A type together with an annotation+data AnnotatedType = + AnnotatedType {+ annotatedTypeSubject :: Type,+ annotatedTypeAnnotation :: (Map String Term)}+ deriving (Eq, Ord, Read, Show)++_AnnotatedType = (Name "hydra/core.AnnotatedType")++_AnnotatedType_subject = (Name "subject")++_AnnotatedType_annotation = (Name "annotation")+ -- | A term which applies a function to an argument-data Application m = +data Application = Application { -- | The left-hand side of the application- applicationFunction :: (Term m),+ applicationFunction :: Term, -- | The right-hand side of the application- applicationArgument :: (Term m)}+ applicationArgument :: Term} deriving (Eq, Ord, Read, Show) _Application = (Name "hydra/core.Application") -_Application_function = (FieldName "function")+_Application_function = (Name "function") -_Application_argument = (FieldName "argument")+_Application_argument = (Name "argument") -- | The type-level analog of an application term-data ApplicationType m = +data ApplicationType = ApplicationType { -- | The left-hand side of the application- applicationTypeFunction :: (Type m),+ applicationTypeFunction :: Type, -- | The right-hand side of the application- applicationTypeArgument :: (Type m)}+ applicationTypeArgument :: Type} deriving (Eq, Ord, Read, Show) _ApplicationType = (Name "hydra/core.ApplicationType") -_ApplicationType_function = (FieldName "function")+_ApplicationType_function = (Name "function") -_ApplicationType_argument = (FieldName "argument")+_ApplicationType_argument = (Name "argument") -- | A union elimination; a case statement-data CaseStatement m = +data CaseStatement = CaseStatement { caseStatementTypeName :: Name,- caseStatementCases :: [Field m]}+ caseStatementDefault :: (Maybe Term),+ caseStatementCases :: [Field]} deriving (Eq, Ord, Read, Show) _CaseStatement = (Name "hydra/core.CaseStatement") -_CaseStatement_typeName = (FieldName "typeName")+_CaseStatement_typeName = (Name "typeName") -_CaseStatement_cases = (FieldName "cases")+_CaseStatement_default = (Name "default") +_CaseStatement_cases = (Name "cases")+ -- | A corresponding elimination for an introduction term-data Elimination m = - -- | Eliminates an element by mapping it to its data term. This is Hydra's delta function.- EliminationElement |+data Elimination = -- | Eliminates a list using a fold function; this function has the signature b -> [a] -> b- EliminationList (Term m) |- -- | Eliminates a nominal term by extracting the wrapped term- EliminationNominal Name |+ EliminationList Term | -- | Eliminates an optional term by matching over the two possible cases- EliminationOptional (OptionalCases m) |+ EliminationOptional OptionalCases |+ -- | Eliminates a tuple by projecting the component at a given 0-indexed offset+ EliminationProduct TupleProjection | -- | Eliminates a record by projecting a given field EliminationRecord Projection | -- | Eliminates a union term by matching over the fields of the union. This is a case statement.- EliminationUnion (CaseStatement m)+ EliminationUnion CaseStatement |+ -- | Unwrap a wrapped term+ EliminationWrap Name deriving (Eq, Ord, Read, Show) _Elimination = (Name "hydra/core.Elimination") -_Elimination_element = (FieldName "element")+_Elimination_list = (Name "list") -_Elimination_list = (FieldName "list")+_Elimination_optional = (Name "optional") -_Elimination_nominal = (FieldName "nominal")+_Elimination_product = (Name "product") -_Elimination_optional = (FieldName "optional")+_Elimination_record = (Name "record") -_Elimination_record = (FieldName "record")+_Elimination_union = (Name "union") -_Elimination_union = (FieldName "union")+_Elimination_wrap = (Name "wrap") --- | A labeled term-data Field m = +-- | A name/term pair+data Field = Field {- fieldName :: FieldName,- fieldTerm :: (Term m)}+ fieldName :: Name,+ fieldTerm :: Term} deriving (Eq, Ord, Read, Show) _Field = (Name "hydra/core.Field") -_Field_name = (FieldName "name")--_Field_term = (FieldName "term")---- | The name of a field, unique within a record or union type-newtype FieldName = - FieldName {- -- | The name of a field, unique within a record or union type- unFieldName :: String}- deriving (Eq, Ord, Read, Show)+_Field_name = (Name "name") -_FieldName = (Name "hydra/core.FieldName")+_Field_term = (Name "term") --- | The name and type of a field-data FieldType m = +-- | A name/type pair+data FieldType = FieldType {- fieldTypeName :: FieldName,- fieldTypeType :: (Type m)}+ fieldTypeName :: Name,+ fieldTypeType :: Type} deriving (Eq, Ord, Read, Show) _FieldType = (Name "hydra/core.FieldType") -_FieldType_name = (FieldName "name")+_FieldType_name = (Name "name") -_FieldType_type = (FieldName "type")+_FieldType_type = (Name "type") -- | A floating-point type data FloatType = @@ -136,11 +144,11 @@ _FloatType = (Name "hydra/core.FloatType") -_FloatType_bigfloat = (FieldName "bigfloat")+_FloatType_bigfloat = (Name "bigfloat") -_FloatType_float32 = (FieldName "float32")+_FloatType_float32 = (Name "float32") -_FloatType_float64 = (FieldName "float64")+_FloatType_float64 = (Name "float64") -- | A floating-point literal value data FloatValue = @@ -154,47 +162,56 @@ _FloatValue = (Name "hydra/core.FloatValue") -_FloatValue_bigfloat = (FieldName "bigfloat")+_FloatValue_bigfloat = (Name "bigfloat") -_FloatValue_float32 = (FieldName "float32")+_FloatValue_float32 = (Name "float32") -_FloatValue_float64 = (FieldName "float64")+_FloatValue_float64 = (Name "float64") -- | A function-data Function m = - -- | Compares a term with a given term of the same type, producing a Comparison- FunctionCompareTo (Term m) |+data Function = -- | An elimination for any of a few term variants- FunctionElimination (Elimination m) |+ FunctionElimination Elimination | -- | A function abstraction (lambda)- FunctionLambda (Lambda m) |+ FunctionLambda Lambda | -- | A reference to a built-in (primitive) function FunctionPrimitive Name deriving (Eq, Ord, Read, Show) _Function = (Name "hydra/core.Function") -_Function_compareTo = (FieldName "compareTo")--_Function_elimination = (FieldName "elimination")+_Function_elimination = (Name "elimination") -_Function_lambda = (FieldName "lambda")+_Function_lambda = (Name "lambda") -_Function_primitive = (FieldName "primitive")+_Function_primitive = (Name "primitive") -- | A function type, also known as an arrow type-data FunctionType m = +data FunctionType = FunctionType {- functionTypeDomain :: (Type m),- functionTypeCodomain :: (Type m)}+ functionTypeDomain :: Type,+ functionTypeCodomain :: Type} deriving (Eq, Ord, Read, Show) _FunctionType = (Name "hydra/core.FunctionType") -_FunctionType_domain = (FieldName "domain")+_FunctionType_domain = (Name "domain") -_FunctionType_codomain = (FieldName "codomain")+_FunctionType_codomain = (Name "codomain") +-- | An instance of a union type; i.e. a string-indexed generalization of inl() or inr()+data Injection = + Injection {+ injectionTypeName :: Name,+ injectionField :: Field}+ deriving (Eq, Ord, Read, Show)++_Injection = (Name "hydra/core.Injection")++_Injection_typeName = (Name "typeName")++_Injection_field = (Name "field")+ -- | An integer type data IntegerType = IntegerTypeBigint |@@ -210,112 +227,125 @@ _IntegerType = (Name "hydra/core.IntegerType") -_IntegerType_bigint = (FieldName "bigint")+_IntegerType_bigint = (Name "bigint") -_IntegerType_int8 = (FieldName "int8")+_IntegerType_int8 = (Name "int8") -_IntegerType_int16 = (FieldName "int16")+_IntegerType_int16 = (Name "int16") -_IntegerType_int32 = (FieldName "int32")+_IntegerType_int32 = (Name "int32") -_IntegerType_int64 = (FieldName "int64")+_IntegerType_int64 = (Name "int64") -_IntegerType_uint8 = (FieldName "uint8")+_IntegerType_uint8 = (Name "uint8") -_IntegerType_uint16 = (FieldName "uint16")+_IntegerType_uint16 = (Name "uint16") -_IntegerType_uint32 = (FieldName "uint32")+_IntegerType_uint32 = (Name "uint32") -_IntegerType_uint64 = (FieldName "uint64")+_IntegerType_uint64 = (Name "uint64") -- | An integer literal value data IntegerValue = -- | An arbitrary-precision integer value IntegerValueBigint Integer | -- | An 8-bit signed integer value- IntegerValueInt8 Int |+ IntegerValueInt8 Int8 | -- | A 16-bit signed integer value (short value)- IntegerValueInt16 Int |+ IntegerValueInt16 Int16 | -- | A 32-bit signed integer value (int value) IntegerValueInt32 Int | -- | A 64-bit signed integer value (long value)- IntegerValueInt64 Integer |+ IntegerValueInt64 Int64 | -- | An 8-bit unsigned integer value (byte)- IntegerValueUint8 Int |+ IntegerValueUint8 Int16 | -- | A 16-bit unsigned integer value IntegerValueUint16 Int | -- | A 32-bit unsigned integer value (unsigned int)- IntegerValueUint32 Integer |+ IntegerValueUint32 Int64 | -- | A 64-bit unsigned integer value (unsigned long) IntegerValueUint64 Integer deriving (Eq, Ord, Read, Show) _IntegerValue = (Name "hydra/core.IntegerValue") -_IntegerValue_bigint = (FieldName "bigint")+_IntegerValue_bigint = (Name "bigint") -_IntegerValue_int8 = (FieldName "int8")+_IntegerValue_int8 = (Name "int8") -_IntegerValue_int16 = (FieldName "int16")+_IntegerValue_int16 = (Name "int16") -_IntegerValue_int32 = (FieldName "int32")+_IntegerValue_int32 = (Name "int32") -_IntegerValue_int64 = (FieldName "int64")+_IntegerValue_int64 = (Name "int64") -_IntegerValue_uint8 = (FieldName "uint8")+_IntegerValue_uint8 = (Name "uint8") -_IntegerValue_uint16 = (FieldName "uint16")+_IntegerValue_uint16 = (Name "uint16") -_IntegerValue_uint32 = (FieldName "uint32")+_IntegerValue_uint32 = (Name "uint32") -_IntegerValue_uint64 = (FieldName "uint64")+_IntegerValue_uint64 = (Name "uint64") -- | A function abstraction (lambda)-data Lambda m = +data Lambda = Lambda { -- | The parameter of the lambda- lambdaParameter :: Variable,+ lambdaParameter :: Name, -- | The body of the lambda- lambdaBody :: (Term m)}+ lambdaBody :: Term} deriving (Eq, Ord, Read, Show) _Lambda = (Name "hydra/core.Lambda") -_Lambda_parameter = (FieldName "parameter")+_Lambda_parameter = (Name "parameter") -_Lambda_body = (FieldName "body")+_Lambda_body = (Name "body") -- | A type abstraction; the type-level analog of a lambda term-data LambdaType m = +data LambdaType = LambdaType {- -- | The parameter of the lambda- lambdaTypeParameter :: VariableType,+ -- | The variable which is bound by the lambda+ lambdaTypeParameter :: Name, -- | The body of the lambda- lambdaTypeBody :: (Type m)}+ lambdaTypeBody :: Type} deriving (Eq, Ord, Read, Show) _LambdaType = (Name "hydra/core.LambdaType") -_LambdaType_parameter = (FieldName "parameter")+_LambdaType_parameter = (Name "parameter") -_LambdaType_body = (FieldName "body")+_LambdaType_body = (Name "body") --- | A 'let' binding-data Let m = +-- | A set of (possibly recursive) 'let' bindings together with an environment in which they are bound+data Let = Let {- letKey :: Variable,- letValue :: (Term m),- letEnvironment :: (Term m)}+ letBindings :: [LetBinding],+ letEnvironment :: Term} deriving (Eq, Ord, Read, Show) _Let = (Name "hydra/core.Let") -_Let_key = (FieldName "key")+_Let_bindings = (Name "bindings") -_Let_value = (FieldName "value")+_Let_environment = (Name "environment") -_Let_environment = (FieldName "environment")+-- | A field with an optional type scheme, used to bind variables to terms in a 'let' expression+data LetBinding = + LetBinding {+ letBindingName :: Name,+ letBindingTerm :: Term,+ letBindingType :: (Maybe TypeScheme)}+ deriving (Eq, Ord, Read, Show) +_LetBinding = (Name "hydra/core.LetBinding")++_LetBinding_name = (Name "name")++_LetBinding_term = (Name "term")++_LetBinding_type = (Name "type")+ -- | A term constant; an instance of a literal type data Literal = -- | A binary literal@@ -332,15 +362,15 @@ _Literal = (Name "hydra/core.Literal") -_Literal_binary = (FieldName "binary")+_Literal_binary = (Name "binary") -_Literal_boolean = (FieldName "boolean")+_Literal_boolean = (Name "boolean") -_Literal_float = (FieldName "float")+_Literal_float = (Name "float") -_Literal_integer = (FieldName "integer")+_Literal_integer = (Name "integer") -_Literal_string = (FieldName "string")+_Literal_string = (Name "string") -- | Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants data LiteralType = @@ -353,304 +383,304 @@ _LiteralType = (Name "hydra/core.LiteralType") -_LiteralType_binary = (FieldName "binary")+_LiteralType_binary = (Name "binary") -_LiteralType_boolean = (FieldName "boolean")+_LiteralType_boolean = (Name "boolean") -_LiteralType_float = (FieldName "float")+_LiteralType_float = (Name "float") -_LiteralType_integer = (FieldName "integer")+_LiteralType_integer = (Name "integer") -_LiteralType_string = (FieldName "string")+_LiteralType_string = (Name "string") -- | A map type-data MapType m = +data MapType = MapType {- mapTypeKeys :: (Type m),- mapTypeValues :: (Type m)}+ mapTypeKeys :: Type,+ mapTypeValues :: Type} deriving (Eq, Ord, Read, Show) _MapType = (Name "hydra/core.MapType") -_MapType_keys = (FieldName "keys")+_MapType_keys = (Name "keys") -_MapType_values = (FieldName "values")+_MapType_values = (Name "values") --- | A unique element name+-- | A symbol which stands for a term, type, or element newtype Name = Name {- -- | A unique element name unName :: String} deriving (Eq, Ord, Read, Show) _Name = (Name "hydra/core.Name") --- | A term annotated with a fixed, named type; an instance of a newtype-data Named m = - Named {- namedTypeName :: Name,- namedTerm :: (Term m)}+-- | A term wrapped in a type name+data WrappedTerm = + WrappedTerm {+ wrappedTermTypeName :: Name,+ wrappedTermObject :: Term} deriving (Eq, Ord, Read, Show) -_Named = (Name "hydra/core.Named")+_WrappedTerm = (Name "hydra/core.WrappedTerm") -_Named_typeName = (FieldName "typeName")+_WrappedTerm_typeName = (Name "typeName") -_Named_term = (FieldName "term")+_WrappedTerm_object = (Name "object") +-- | A type wrapped in a type name+data WrappedType = + WrappedType {+ wrappedTypeTypeName :: Name,+ wrappedTypeObject :: Type}+ deriving (Eq, Ord, Read, Show)++_WrappedType = (Name "hydra/core.WrappedType")++_WrappedType_typeName = (Name "typeName")++_WrappedType_object = (Name "object")+ -- | A case statement for matching optional terms-data OptionalCases m = +data OptionalCases = OptionalCases { -- | A term provided if the optional value is nothing- optionalCasesNothing :: (Term m),- -- | A function which is applied of the optional value is non-nothing- optionalCasesJust :: (Term m)}+ optionalCasesNothing :: Term,+ -- | A function which is applied if the optional value is non-nothing+ optionalCasesJust :: Term} deriving (Eq, Ord, Read, Show) _OptionalCases = (Name "hydra/core.OptionalCases") -_OptionalCases_nothing = (FieldName "nothing")+_OptionalCases_nothing = (Name "nothing") -_OptionalCases_just = (FieldName "just")+_OptionalCases_just = (Name "just") -- | A record elimination; a projection data Projection = Projection {+ -- | The name of the record type projectionTypeName :: Name,- projectionField :: FieldName}+ -- | The name of the projected field+ projectionField :: Name} deriving (Eq, Ord, Read, Show) _Projection = (Name "hydra/core.Projection") -_Projection_typeName = (FieldName "typeName")+_Projection_typeName = (Name "typeName") -_Projection_field = (FieldName "field")+_Projection_field = (Name "field") -- | A record, or labeled tuple; a map of field names to terms-data Record m = +data Record = Record { recordTypeName :: Name,- recordFields :: [Field m]}+ recordFields :: [Field]} deriving (Eq, Ord, Read, Show) _Record = (Name "hydra/core.Record") -_Record_typeName = (FieldName "typeName")+_Record_typeName = (Name "typeName") -_Record_fields = (FieldName "fields")+_Record_fields = (Name "fields") -- | A labeled record or union type-data RowType m = +data RowType = 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. To the extent that field order is preserved, the inherited fields of the extended type precede those of the extension.+ -- | 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 m]}+ rowTypeFields :: [FieldType]} deriving (Eq, Ord, Read, Show) _RowType = (Name "hydra/core.RowType") -_RowType_typeName = (FieldName "typeName")--_RowType_extends = (FieldName "extends")--_RowType_fields = (FieldName "fields")---- | An infinite stream of terms-data Stream m = - Stream {- streamFirst :: (Term m),- streamRest :: (Stream m)}- deriving (Eq, Ord, Read, Show)--_Stream = (Name "hydra/core.Stream")+_RowType_typeName = (Name "typeName") -_Stream_first = (FieldName "first")+_RowType_extends = (Name "extends") -_Stream_rest = (FieldName "rest")+_RowType_fields = (Name "fields") --- | The unlabeled equivalent of a Union term-data Sum m = +-- | The unlabeled equivalent of an Injection term+data Sum = Sum { sumIndex :: Int, sumSize :: Int,- sumTerm :: (Term m)}+ sumTerm :: Term} deriving (Eq, Ord, Read, Show) _Sum = (Name "hydra/core.Sum") -_Sum_index = (FieldName "index")+_Sum_index = (Name "index") -_Sum_size = (FieldName "size")+_Sum_size = (Name "size") -_Sum_term = (FieldName "term")+_Sum_term = (Name "term") -- | A data term-data Term m = +data Term = -- | A term annotated with metadata- TermAnnotated (Annotated (Term m) m) |+ TermAnnotated AnnotatedTerm | -- | A function application- TermApplication (Application m) |- -- | An element reference- TermElement Name |+ TermApplication Application | -- | A function term- TermFunction (Function m) |- TermLet (Let m) |+ TermFunction Function |+ TermLet Let | -- | A list- TermList [Term m] |+ TermList [Term] | -- | A literal value TermLiteral Literal | -- | A map of keys to values- TermMap (Map (Term m) (Term m)) |- TermNominal (Named m) |+ TermMap (Map Term Term) | -- | An optional value- TermOptional (Maybe (Term m)) |+ TermOptional (Maybe Term) | -- | A tuple- TermProduct [Term m] |+ TermProduct [Term] | -- | A record term- TermRecord (Record m) |+ TermRecord Record | -- | A set of values- TermSet (Set (Term m)) |- -- | An infinite stream of terms- TermStream (Stream m) |+ TermSet (Set Term) | -- | A variant tuple- TermSum (Sum m) |- -- | A union term- TermUnion (Union m) |+ TermSum Sum |+ -- | A term annotated with its type+ TermTyped TypedTerm |+ -- | An injection; an instance of a union type+ TermUnion Injection | -- | A variable reference- TermVariable Variable+ TermVariable Name |+ TermWrap WrappedTerm deriving (Eq, Ord, Read, Show) _Term = (Name "hydra/core.Term") -_Term_annotated = (FieldName "annotated")+_Term_annotated = (Name "annotated") -_Term_application = (FieldName "application")+_Term_application = (Name "application") -_Term_element = (FieldName "element")+_Term_function = (Name "function") -_Term_function = (FieldName "function")+_Term_let = (Name "let") -_Term_let = (FieldName "let")+_Term_list = (Name "list") -_Term_list = (FieldName "list")+_Term_literal = (Name "literal") -_Term_literal = (FieldName "literal")+_Term_map = (Name "map") -_Term_map = (FieldName "map")+_Term_optional = (Name "optional") -_Term_nominal = (FieldName "nominal")+_Term_product = (Name "product") -_Term_optional = (FieldName "optional")+_Term_record = (Name "record") -_Term_product = (FieldName "product")+_Term_set = (Name "set") -_Term_record = (FieldName "record")+_Term_sum = (Name "sum") -_Term_set = (FieldName "set")+_Term_typed = (Name "typed") -_Term_stream = (FieldName "stream")+_Term_union = (Name "union") -_Term_sum = (FieldName "sum")+_Term_variable = (Name "variable") -_Term_union = (FieldName "union")+_Term_wrap = (Name "wrap") -_Term_variable = (FieldName "variable")+-- | A tuple elimination; a projection from an integer-indexed product+data TupleProjection = + TupleProjection {+ -- | The arity of the tuple+ tupleProjectionArity :: Int,+ -- | The 0-indexed offset from the beginning of the tuple+ tupleProjectionIndex :: Int}+ deriving (Eq, Ord, Read, Show) +_TupleProjection = (Name "hydra/core.TupleProjection")++_TupleProjection_arity = (Name "arity")++_TupleProjection_index = (Name "index")+ -- | A data type-data Type m = - -- | A type annotated with metadata- TypeAnnotated (Annotated (Type m) m) |- TypeApplication (ApplicationType m) |- TypeElement (Type m) |- TypeFunction (FunctionType m) |- TypeLambda (LambdaType m) |- TypeList (Type m) |+data Type = + TypeAnnotated AnnotatedType |+ TypeApplication ApplicationType |+ TypeFunction FunctionType |+ TypeLambda LambdaType |+ TypeList Type | TypeLiteral LiteralType |- TypeMap (MapType m) |- TypeNominal Name |- TypeOptional (Type m) |- TypeProduct [Type m] |- TypeRecord (RowType m) |- TypeSet (Type m) |- TypeStream (Type m) |- TypeSum [Type m] |- TypeUnion (RowType m) |- TypeVariable VariableType+ TypeMap MapType |+ TypeOptional Type |+ TypeProduct [Type] |+ TypeRecord RowType |+ TypeSet Type |+ TypeSum [Type] |+ TypeUnion RowType |+ TypeVariable Name |+ TypeWrap WrappedType deriving (Eq, Ord, Read, Show) _Type = (Name "hydra/core.Type") -_Type_annotated = (FieldName "annotated")--_Type_application = (FieldName "application")--_Type_element = (FieldName "element")+_Type_annotated = (Name "annotated") -_Type_function = (FieldName "function")+_Type_application = (Name "application") -_Type_lambda = (FieldName "lambda")+_Type_function = (Name "function") -_Type_list = (FieldName "list")+_Type_lambda = (Name "lambda") -_Type_literal = (FieldName "literal")+_Type_list = (Name "list") -_Type_map = (FieldName "map")+_Type_literal = (Name "literal") -_Type_nominal = (FieldName "nominal")+_Type_map = (Name "map") -_Type_optional = (FieldName "optional")+_Type_optional = (Name "optional") -_Type_product = (FieldName "product")+_Type_product = (Name "product") -_Type_record = (FieldName "record")+_Type_record = (Name "record") -_Type_set = (FieldName "set")+_Type_set = (Name "set") -_Type_stream = (FieldName "stream")+_Type_sum = (Name "sum") -_Type_sum = (FieldName "sum")+_Type_union = (Name "union") -_Type_union = (FieldName "union")+_Type_variable = (Name "variable") -_Type_variable = (FieldName "variable")+_Type_wrap = (Name "wrap") --- | A symbol which stands in for a term-newtype Variable = - Variable {- -- | A symbol which stands in for a term- unVariable :: String}+-- | A type expression together with free type variables occurring in the expression+data TypeScheme = + TypeScheme {+ typeSchemeVariables :: [Name],+ typeSchemeType :: Type} deriving (Eq, Ord, Read, Show) -_Variable = (Name "hydra/core.Variable")+_TypeScheme = (Name "hydra/core.TypeScheme") --- | A symbol which stands in for a type-newtype VariableType = - VariableType {- -- | A symbol which stands in for a type- unVariableType :: String}- deriving (Eq, Ord, Read, Show)+_TypeScheme_variables = (Name "variables") -_VariableType = (Name "hydra/core.VariableType")+_TypeScheme_type = (Name "type") --- | An instance of a union type; i.e. a string-indexed generalization of inl() or inr()-data Union m = - Union {- unionTypeName :: Name,- unionField :: (Field m)}+-- | A term together with its type+data TypedTerm = + TypedTerm {+ typedTermTerm :: Term,+ typedTermType :: Type} deriving (Eq, Ord, Read, Show) -_Union = (Name "hydra/core.Union")+_TypedTerm = (Name "hydra/core.TypedTerm") -_Union_typeName = (FieldName "typeName")+_TypedTerm_term = (Name "term") -_Union_field = (FieldName "field")+_TypedTerm_type = (Name "type") --- | An empty record type as a canonical unit type-data UnitType = - UnitType {}+-- | An empty record as a canonical unit value+data Unit = + Unit {} deriving (Eq, Ord, Read, Show) -_UnitType = (Name "hydra/core.UnitType")+_Unit = (Name "hydra/core.Unit")
+ src/gen-main/haskell/Hydra/CoreEncoding.hs view
@@ -0,0 +1,691 @@+-- | Mapping of hydra/core constructs in a host language like Haskell or Java to their native Hydra counterparts as terms. This includes an implementation of LambdaGraph's epsilon encoding (types to terms).++module Hydra.CoreEncoding where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Sets as Sets+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++coreEncodeAnnotatedTerm :: (Core.AnnotatedTerm -> Core.Term)+coreEncodeAnnotatedTerm a = (Core.TermAnnotated (Core.AnnotatedTerm {+ Core.annotatedTermSubject = (coreEncodeTerm (Core.annotatedTermSubject a)),+ Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation a)}))++coreEncodeAnnotatedType :: (Core.AnnotatedType -> Core.Term)+coreEncodeAnnotatedType at = (Core.TermAnnotated (Core.AnnotatedTerm {+ Core.annotatedTermSubject = (coreEncodeType (Core.annotatedTypeSubject at)),+ Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation at)}))++coreEncodeApplication :: (Core.Application -> Core.Term)+coreEncodeApplication app = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Application"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "function"),+ Core.fieldTerm = (coreEncodeTerm (Core.applicationFunction app))},+ Core.Field {+ Core.fieldName = (Core.Name "argument"),+ Core.fieldTerm = (coreEncodeTerm (Core.applicationArgument app))}]}))++coreEncodeApplicationType :: (Core.ApplicationType -> Core.Term)+coreEncodeApplicationType at = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.ApplicationType"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "function"),+ Core.fieldTerm = (coreEncodeType (Core.applicationTypeFunction at))},+ Core.Field {+ Core.fieldName = (Core.Name "argument"),+ Core.fieldTerm = (coreEncodeType (Core.applicationTypeArgument at))}]}))++coreEncodeCaseStatement :: (Core.CaseStatement -> Core.Term)+coreEncodeCaseStatement cs = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.CaseStatement"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (coreEncodeName (Core.caseStatementTypeName cs))},+ Core.Field {+ Core.fieldName = (Core.Name "default"),+ Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeTerm (Core.caseStatementDefault cs)))},+ Core.Field {+ Core.fieldName = (Core.Name "cases"),+ Core.fieldTerm = (Core.TermList (Lists.map coreEncodeField (Core.caseStatementCases cs)))}]}))++coreEncodeElimination :: (Core.Elimination -> Core.Term)+coreEncodeElimination x = case x of+ Core.EliminationList v0 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "list"),+ Core.fieldTerm = (coreEncodeTerm v0)}}))+ Core.EliminationOptional v1 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "optional"),+ Core.fieldTerm = (coreEncodeOptionalCases v1)}}))+ Core.EliminationProduct v2 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "product"),+ Core.fieldTerm = (coreEncodeTupleProjection v2)}}))+ Core.EliminationRecord v3 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "record"),+ Core.fieldTerm = (coreEncodeProjection v3)}}))+ Core.EliminationUnion v4 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "union"),+ Core.fieldTerm = (coreEncodeCaseStatement v4)}}))+ Core.EliminationWrap v5 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "wrap"),+ Core.fieldTerm = (coreEncodeName v5)}}))++coreEncodeField :: (Core.Field -> Core.Term)+coreEncodeField f = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Field"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "name"),+ Core.fieldTerm = (Core.TermWrap (Core.WrappedTerm {+ Core.wrappedTermTypeName = (Core.Name "hydra/core.Name"),+ Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString (Core.unName (Core.fieldName f))))}))},+ Core.Field {+ Core.fieldName = (Core.Name "term"),+ Core.fieldTerm = (coreEncodeTerm (Core.fieldTerm f))}]}))++coreEncodeFieldType :: (Core.FieldType -> Core.Term)+coreEncodeFieldType ft = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.FieldType"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "name"),+ Core.fieldTerm = (coreEncodeName (Core.fieldTypeName ft))},+ Core.Field {+ Core.fieldName = (Core.Name "type"),+ Core.fieldTerm = (coreEncodeType (Core.fieldTypeType ft))}]}))++coreEncodeFloatType :: (Core.FloatType -> Core.Term)+coreEncodeFloatType x = case x of+ Core.FloatTypeBigfloat -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.FloatType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "bigfloat"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.FloatTypeFloat32 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.FloatType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "float32"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.FloatTypeFloat64 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.FloatType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "float64"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))++coreEncodeFloatValue :: (Core.FloatValue -> Core.Term)+coreEncodeFloatValue x = case x of+ Core.FloatValueBigfloat v9 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.FloatValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "bigfloat"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueBigfloat v9)))}}))+ Core.FloatValueFloat32 v10 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.FloatValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "float32"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 v10)))}}))+ Core.FloatValueFloat64 v11 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.FloatValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "float64"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 v11)))}}))++coreEncodeFunction :: (Core.Function -> Core.Term)+coreEncodeFunction x = case x of+ Core.FunctionElimination v12 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Function"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "elimination"),+ Core.fieldTerm = (coreEncodeElimination v12)}}))+ Core.FunctionLambda v13 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Function"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "lambda"),+ Core.fieldTerm = (coreEncodeLambda v13)}}))+ Core.FunctionPrimitive v14 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Function"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "primitive"),+ Core.fieldTerm = (coreEncodeName v14)}}))++coreEncodeFunctionType :: (Core.FunctionType -> Core.Term)+coreEncodeFunctionType ft = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.FunctionType"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "domain"),+ Core.fieldTerm = (coreEncodeType (Core.functionTypeDomain ft))},+ Core.Field {+ Core.fieldName = (Core.Name "codomain"),+ Core.fieldTerm = (coreEncodeType (Core.functionTypeCodomain ft))}]}))++coreEncodeInjection :: (Core.Injection -> Core.Term)+coreEncodeInjection i = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Injection"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (coreEncodeName (Core.injectionTypeName i))},+ Core.Field {+ Core.fieldName = (Core.Name "field"),+ Core.fieldTerm = (coreEncodeField (Core.injectionField i))}]}))++coreEncodeIntegerType :: (Core.IntegerType -> Core.Term)+coreEncodeIntegerType x = case x of+ Core.IntegerTypeBigint -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "bigint"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeInt8 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int8"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeInt16 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int16"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeInt32 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int32"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeInt64 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int64"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeUint8 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint8"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeUint16 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint16"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeUint32 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint32"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.IntegerTypeUint64 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint64"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))++coreEncodeIntegerValue :: (Core.IntegerValue -> Core.Term)+coreEncodeIntegerValue x = case x of+ Core.IntegerValueBigint v24 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "bigint"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueBigint v24)))}}))+ Core.IntegerValueInt8 v25 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int8"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt8 v25)))}}))+ Core.IntegerValueInt16 v26 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int16"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt16 v26)))}}))+ Core.IntegerValueInt32 v27 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int32"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v27)))}}))+ Core.IntegerValueInt64 v28 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "int64"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 v28)))}}))+ Core.IntegerValueUint8 v29 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint8"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint8 v29)))}}))+ Core.IntegerValueUint16 v30 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint16"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint16 v30)))}}))+ Core.IntegerValueUint32 v31 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint32"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 v31)))}}))+ Core.IntegerValueUint64 v32 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "uint64"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint64 v32)))}}))++coreEncodeLambda :: (Core.Lambda -> Core.Term)+coreEncodeLambda l = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Lambda"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "parameter"),+ Core.fieldTerm = (coreEncodeName (Core.lambdaParameter l))},+ Core.Field {+ Core.fieldName = (Core.Name "body"),+ Core.fieldTerm = (coreEncodeTerm (Core.lambdaBody l))}]}))++coreEncodeLambdaType :: (Core.LambdaType -> Core.Term)+coreEncodeLambdaType lt = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.LambdaType"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "parameter"),+ Core.fieldTerm = (coreEncodeName (Core.lambdaTypeParameter lt))},+ Core.Field {+ Core.fieldName = (Core.Name "body"),+ Core.fieldTerm = (coreEncodeType (Core.lambdaTypeBody lt))}]}))++coreEncodeLet :: (Core.Let -> Core.Term)+coreEncodeLet l = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Let"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "bindings"),+ Core.fieldTerm = (Core.TermList (Lists.map coreEncodeLetBinding (Core.letBindings l)))},+ Core.Field {+ Core.fieldName = (Core.Name "environment"),+ Core.fieldTerm = (coreEncodeTerm (Core.letEnvironment l))}]}))++coreEncodeLetBinding :: (Core.LetBinding -> Core.Term)+coreEncodeLetBinding b = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.LetBinding"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "name"),+ Core.fieldTerm = (coreEncodeName (Core.letBindingName b))},+ Core.Field {+ Core.fieldName = (Core.Name "term"),+ Core.fieldTerm = (coreEncodeTerm (Core.letBindingTerm b))},+ Core.Field {+ Core.fieldName = (Core.Name "type"),+ Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeTypeScheme (Core.letBindingType b)))}]}))++coreEncodeLiteral :: (Core.Literal -> Core.Term)+coreEncodeLiteral x = case x of+ Core.LiteralBinary v33 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Literal"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "binary"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralBinary v33))}}))+ Core.LiteralBoolean v34 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Literal"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "boolean"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralBoolean v34))}}))+ Core.LiteralFloat v35 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Literal"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "float"),+ Core.fieldTerm = (coreEncodeFloatValue v35)}}))+ Core.LiteralInteger v36 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Literal"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "integer"),+ Core.fieldTerm = (coreEncodeIntegerValue v36)}}))+ Core.LiteralString v37 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Literal"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "string"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v37))}}))++coreEncodeLiteralType :: (Core.LiteralType -> Core.Term)+coreEncodeLiteralType x = case x of+ Core.LiteralTypeBinary -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "binary"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.LiteralTypeBoolean -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "boolean"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))+ Core.LiteralTypeFloat v40 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "float"),+ Core.fieldTerm = (coreEncodeFloatType v40)}}))+ Core.LiteralTypeInteger v41 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "integer"),+ Core.fieldTerm = (coreEncodeIntegerType v41)}}))+ Core.LiteralTypeString -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "string"),+ Core.fieldTerm = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Unit"),+ Core.recordFields = []}))}}))++coreEncodeMapType :: (Core.MapType -> Core.Term)+coreEncodeMapType mt = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.MapType"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "keys"),+ Core.fieldTerm = (coreEncodeType (Core.mapTypeKeys mt))},+ Core.Field {+ Core.fieldName = (Core.Name "values"),+ Core.fieldTerm = (coreEncodeType (Core.mapTypeValues mt))}]}))++coreEncodeName :: (Core.Name -> Core.Term)+coreEncodeName fn = (Core.TermWrap (Core.WrappedTerm {+ Core.wrappedTermTypeName = (Core.Name "hydra/core.Name"),+ Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString (Core.unName fn)))}))++coreEncodeOptionalCases :: (Core.OptionalCases -> Core.Term)+coreEncodeOptionalCases oc = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.OptionalCases"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "nothing"),+ Core.fieldTerm = (coreEncodeTerm (Core.optionalCasesNothing oc))},+ Core.Field {+ Core.fieldName = (Core.Name "just"),+ Core.fieldTerm = (coreEncodeTerm (Core.optionalCasesJust oc))}]}))++coreEncodeProjection :: (Core.Projection -> Core.Term)+coreEncodeProjection p = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Projection"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (coreEncodeName (Core.projectionTypeName p))},+ Core.Field {+ Core.fieldName = (Core.Name "field"),+ Core.fieldTerm = (coreEncodeName (Core.projectionField p))}]}))++coreEncodeRecord :: (Core.Record -> Core.Term)+coreEncodeRecord r = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Record"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (coreEncodeName (Core.recordTypeName r))},+ Core.Field {+ Core.fieldName = (Core.Name "fields"),+ Core.fieldTerm = (Core.TermList (Lists.map coreEncodeField (Core.recordFields r)))}]}))++coreEncodeRowType :: (Core.RowType -> Core.Term)+coreEncodeRowType rt = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.RowType"),+ Core.recordFields = [+ Core.Field {+ 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)))}]}))++coreEncodeSum :: (Core.Sum -> Core.Term)+coreEncodeSum s = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.Sum"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "index"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumIndex s))))},+ Core.Field {+ Core.fieldName = (Core.Name "size"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumSize s))))},+ Core.Field {+ Core.fieldName = (Core.Name "term"),+ Core.fieldTerm = (coreEncodeTerm (Core.sumTerm s))}]}))++coreEncodeTerm :: (Core.Term -> Core.Term)+coreEncodeTerm x = case x of+ Core.TermAnnotated v43 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "annotated"),+ Core.fieldTerm = (coreEncodeAnnotatedTerm v43)}}))+ Core.TermApplication v44 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "application"),+ Core.fieldTerm = (coreEncodeApplication v44)}}))+ Core.TermFunction v45 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "function"),+ Core.fieldTerm = (coreEncodeFunction v45)}}))+ Core.TermLet v46 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "let"),+ Core.fieldTerm = (coreEncodeLet v46)}}))+ Core.TermLiteral v47 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "literal"),+ Core.fieldTerm = (coreEncodeLiteral v47)}}))+ Core.TermList v48 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "list"),+ Core.fieldTerm = (Core.TermList (Lists.map coreEncodeTerm v48))}}))+ Core.TermOptional v49 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "optional"),+ Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeTerm v49))}}))+ Core.TermProduct v50 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "product"),+ Core.fieldTerm = (Core.TermList (Lists.map coreEncodeTerm v50))}}))+ Core.TermRecord v51 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "record"),+ Core.fieldTerm = (coreEncodeRecord v51)}}))+ Core.TermSet v52 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "set"),+ Core.fieldTerm = (Core.TermSet (Sets.map coreEncodeTerm v52))}}))+ Core.TermSum v53 -> (Core.TermUnion (Core.Injection {+ Core.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "sum"),+ Core.fieldTerm = (coreEncodeSum v53)}}))+ Core.TermUnion v54 -> (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.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.injectionTypeName = (Core.Name "hydra/core.Term"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "wrap"),+ Core.fieldTerm = (coreEncodeWrappedTerm v56)}}))+ _ -> (Core.TermLiteral (Core.LiteralString "not implemented"))++coreEncodeTupleProjection :: (Core.TupleProjection -> Core.Term)+coreEncodeTupleProjection tp = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.TupleProjection"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "arity"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.tupleProjectionArity tp))))},+ Core.Field {+ Core.fieldName = (Core.Name "index"),+ Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.tupleProjectionIndex tp))))}]}))++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.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.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.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.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.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.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.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.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.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.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.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.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.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.injectionTypeName = (Core.Name "hydra/core.Type"),+ Core.injectionField = Core.Field {+ Core.fieldName = (Core.Name "wrap"),+ Core.fieldTerm = (coreEncodeWrappedType v71)}}))++coreEncodeTypeScheme :: (Core.TypeScheme -> Core.Term)+coreEncodeTypeScheme ts = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.TypeScheme"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "variables"),+ Core.fieldTerm = (Core.TermList (Lists.map coreEncodeName (Core.typeSchemeVariables ts)))},+ Core.Field {+ Core.fieldName = (Core.Name "type"),+ Core.fieldTerm = (coreEncodeType (Core.typeSchemeType ts))}]}))++coreEncodeWrappedTerm :: (Core.WrappedTerm -> Core.Term)+coreEncodeWrappedTerm n = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.WrappedTerm"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (coreEncodeName (Core.wrappedTermTypeName n))},+ Core.Field {+ Core.fieldName = (Core.Name "object"),+ Core.fieldTerm = (coreEncodeTerm (Core.wrappedTermObject n))}]}))++coreEncodeWrappedType :: (Core.WrappedType -> Core.Term)+coreEncodeWrappedType nt = (Core.TermRecord (Core.Record {+ Core.recordTypeName = (Core.Name "hydra/core.WrappedType"),+ Core.recordFields = [+ Core.Field {+ Core.fieldName = (Core.Name "typeName"),+ Core.fieldTerm = (coreEncodeName (Core.wrappedTypeTypeName nt))},+ Core.Field {+ Core.fieldName = (Core.Name "object"),+ Core.fieldTerm = (coreEncodeType (Core.wrappedTypeObject nt))}]}))
+ src/gen-main/haskell/Hydra/CoreLanguage.hs view
@@ -0,0 +1,25 @@+-- | Language constraints for Hydra Core++module Hydra.CoreLanguage where++import qualified Hydra.Basics as Basics+import qualified Hydra.Coders as Coders+import qualified Hydra.Lib.Sets as Sets+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | Language constraints for Java+hydraCoreLanguage :: Coders.Language+hydraCoreLanguage = Coders.Language {+ Coders.languageName = (Coders.LanguageName "hydra/core"),+ Coders.languageConstraints = Coders.LanguageConstraints {+ Coders.languageConstraintsEliminationVariants = (Sets.fromList Basics.eliminationVariants),+ Coders.languageConstraintsLiteralVariants = (Sets.fromList Basics.literalVariants),+ Coders.languageConstraintsFloatTypes = (Sets.fromList Basics.floatTypes),+ Coders.languageConstraintsFunctionVariants = (Sets.fromList Basics.functionVariants),+ Coders.languageConstraintsIntegerTypes = (Sets.fromList Basics.integerTypes),+ Coders.languageConstraintsTermVariants = (Sets.fromList Basics.termVariants),+ Coders.languageConstraintsTypeVariants = (Sets.fromList Basics.typeVariants),+ Coders.languageConstraintsTypes = (\_ -> True)}}
− src/gen-main/haskell/Hydra/Ext/Avro/Schema.hs
@@ -1,221 +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.Ext.Avro.Schema where--import qualified Hydra.Core as Core-import qualified Hydra.Ext.Json.Model as Model-import Data.List-import Data.Map-import Data.Set--data Array = - Array {- arrayItems :: Schema}- deriving (Eq, Ord, Read, Show)--_Array = (Core.Name "hydra/ext/avro/schema.Array")--_Array_items = (Core.FieldName "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/avro/schema.Enum")--_Enum_symbols = (Core.FieldName "symbols")--_Enum_default = (Core.FieldName "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 Model.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 Model.Value)}- deriving (Eq, Ord, Read, Show)--_Field = (Core.Name "hydra/ext/avro/schema.Field")--_Field_name = (Core.FieldName "name")--_Field_doc = (Core.FieldName "doc")--_Field_type = (Core.FieldName "type")--_Field_default = (Core.FieldName "default")--_Field_order = (Core.FieldName "order")--_Field_aliases = (Core.FieldName "aliases")--_Field_annotations = (Core.FieldName "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/avro/schema.Fixed")--_Fixed_size = (Core.FieldName "size")--data Map_ = - Map_ {- mapValues :: Schema}- deriving (Eq, Ord, Read, Show)--_Map = (Core.Name "hydra/ext/avro/schema.Map")--_Map_values = (Core.FieldName "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 Model.Value)}- deriving (Eq, Ord, Read, Show)--_Named = (Core.Name "hydra/ext/avro/schema.Named")--_Named_name = (Core.FieldName "name")--_Named_namespace = (Core.FieldName "namespace")--_Named_aliases = (Core.FieldName "aliases")--_Named_doc = (Core.FieldName "doc")--_Named_type = (Core.FieldName "type")--_Named_annotations = (Core.FieldName "annotations")--data NamedType = - NamedTypeEnum Enum_ |- NamedTypeFixed Fixed |- NamedTypeRecord Record- deriving (Eq, Ord, Read, Show)--_NamedType = (Core.Name "hydra/ext/avro/schema.NamedType")--_NamedType_enum = (Core.FieldName "enum")--_NamedType_fixed = (Core.FieldName "fixed")--_NamedType_record = (Core.FieldName "record")--data Order = - OrderAscending |- OrderDescending |- OrderIgnore - deriving (Eq, Ord, Read, Show)--_Order = (Core.Name "hydra/ext/avro/schema.Order")--_Order_ascending = (Core.FieldName "ascending")--_Order_descending = (Core.FieldName "descending")--_Order_ignore = (Core.FieldName "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/avro/schema.Primitive")--_Primitive_null = (Core.FieldName "null")--_Primitive_boolean = (Core.FieldName "boolean")--_Primitive_int = (Core.FieldName "int")--_Primitive_long = (Core.FieldName "long")--_Primitive_float = (Core.FieldName "float")--_Primitive_double = (Core.FieldName "double")--_Primitive_bytes = (Core.FieldName "bytes")--_Primitive_string = (Core.FieldName "string")--data Record = - Record {- -- | a JSON array, listing fields- recordFields :: [Field]}- deriving (Eq, Ord, Read, Show)--_Record = (Core.Name "hydra/ext/avro/schema.Record")--_Record_fields = (Core.FieldName "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/avro/schema.Schema")--_Schema_array = (Core.FieldName "array")--_Schema_map = (Core.FieldName "map")--_Schema_named = (Core.FieldName "named")--_Schema_primitive = (Core.FieldName "primitive")--_Schema_reference = (Core.FieldName "reference")--_Schema_union = (Core.FieldName "union")--newtype Union = - Union {- unUnion :: [Schema]}- deriving (Eq, Ord, Read, Show)--_Union = (Core.Name "hydra/ext/avro/schema.Union")
− src/gen-main/haskell/Hydra/Ext/Graphql/Syntax.hs
@@ -1,1413 +0,0 @@--- | A GraphQL model. Based on the (extended) BNF at:--- | https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary--module Hydra.Ext.Graphql.Syntax where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set--newtype Name = - Name {- unName :: String}- deriving (Eq, Ord, Read, Show)--_Name = (Core.Name "hydra/ext/graphql/syntax.Name")--newtype IntValue = - IntValue {- unIntValue :: String}- deriving (Eq, Ord, Read, Show)--_IntValue = (Core.Name "hydra/ext/graphql/syntax.IntValue")--newtype FloatValue = - FloatValue {- unFloatValue :: String}- deriving (Eq, Ord, Read, Show)--_FloatValue = (Core.Name "hydra/ext/graphql/syntax.FloatValue")--newtype StringValue = - StringValue {- unStringValue :: String}- deriving (Eq, Ord, Read, Show)--_StringValue = (Core.Name "hydra/ext/graphql/syntax.StringValue")--newtype Document = - Document {- unDocument :: [Definition]}- deriving (Eq, Ord, Read, Show)--_Document = (Core.Name "hydra/ext/graphql/syntax.Document")--data Definition = - DefinitionExecutable ExecutableDefinition |- DefinitionTypeSystem TypeSystemDefinitionOrExtension- deriving (Eq, Ord, Read, Show)--_Definition = (Core.Name "hydra/ext/graphql/syntax.Definition")--_Definition_executable = (Core.FieldName "executable")--_Definition_typeSystem = (Core.FieldName "typeSystem")--newtype ExecutableDocument = - ExecutableDocument {- unExecutableDocument :: [ExecutableDefinition]}- deriving (Eq, Ord, Read, Show)--_ExecutableDocument = (Core.Name "hydra/ext/graphql/syntax.ExecutableDocument")--data ExecutableDefinition = - ExecutableDefinitionOperation OperationDefinition |- ExecutableDefinitionFragment FragmentDefinition- deriving (Eq, Ord, Read, Show)--_ExecutableDefinition = (Core.Name "hydra/ext/graphql/syntax.ExecutableDefinition")--_ExecutableDefinition_operation = (Core.FieldName "operation")--_ExecutableDefinition_fragment = (Core.FieldName "fragment")--data OperationDefinition = - OperationDefinitionSequence OperationDefinition_Sequence |- OperationDefinitionSelectionSet SelectionSet- deriving (Eq, Ord, Read, Show)--_OperationDefinition = (Core.Name "hydra/ext/graphql/syntax.OperationDefinition")--_OperationDefinition_sequence = (Core.FieldName "sequence")--_OperationDefinition_selectionSet = (Core.FieldName "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/graphql/syntax.OperationDefinition.Sequence")--_OperationDefinition_Sequence_operationType = (Core.FieldName "operationType")--_OperationDefinition_Sequence_name = (Core.FieldName "name")--_OperationDefinition_Sequence_variablesDefinition = (Core.FieldName "variablesDefinition")--_OperationDefinition_Sequence_directives = (Core.FieldName "directives")--_OperationDefinition_Sequence_selectionSet = (Core.FieldName "selectionSet")--data OperationType = - OperationTypeQuery |- OperationTypeMutation |- OperationTypeSubscription - deriving (Eq, Ord, Read, Show)--_OperationType = (Core.Name "hydra/ext/graphql/syntax.OperationType")--_OperationType_query = (Core.FieldName "query")--_OperationType_mutation = (Core.FieldName "mutation")--_OperationType_subscription = (Core.FieldName "subscription")--data SelectionSet = - SelectionSet {- selectionSetListOfSelection :: [Selection]}- deriving (Eq, Ord, Read, Show)--_SelectionSet = (Core.Name "hydra/ext/graphql/syntax.SelectionSet")--_SelectionSet_listOfSelection = (Core.FieldName "listOfSelection")--data Selection = - SelectionField Field |- SelectionFragmentSpread FragmentSpread |- SelectionInlineFragment InlineFragment- deriving (Eq, Ord, Read, Show)--_Selection = (Core.Name "hydra/ext/graphql/syntax.Selection")--_Selection_field = (Core.FieldName "field")--_Selection_fragmentSpread = (Core.FieldName "fragmentSpread")--_Selection_inlineFragment = (Core.FieldName "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/graphql/syntax.Field")--_Field_alias = (Core.FieldName "alias")--_Field_name = (Core.FieldName "name")--_Field_arguments = (Core.FieldName "arguments")--_Field_directives = (Core.FieldName "directives")--_Field_selectionSet = (Core.FieldName "selectionSet")--data Alias = - AliasName Name |- AliasColon - deriving (Eq, Ord, Read, Show)--_Alias = (Core.Name "hydra/ext/graphql/syntax.Alias")--_Alias_name = (Core.FieldName "name")--_Alias_colon = (Core.FieldName "colon")--data Arguments = - Arguments {- argumentsListOfArgument :: [Argument]}- deriving (Eq, Ord, Read, Show)--_Arguments = (Core.Name "hydra/ext/graphql/syntax.Arguments")--_Arguments_listOfArgument = (Core.FieldName "listOfArgument")--data Argument = - Argument {- argumentName :: Name,- argumentValue :: Value}- deriving (Eq, Ord, Read, Show)--_Argument = (Core.Name "hydra/ext/graphql/syntax.Argument")--_Argument_name = (Core.FieldName "name")--_Argument_value = (Core.FieldName "value")--data FragmentSpread = - FragmentSpread {- fragmentSpreadFragmentName :: FragmentName,- fragmentSpreadDirectives :: (Maybe Directives)}- deriving (Eq, Ord, Read, Show)--_FragmentSpread = (Core.Name "hydra/ext/graphql/syntax.FragmentSpread")--_FragmentSpread_fragmentName = (Core.FieldName "fragmentName")--_FragmentSpread_directives = (Core.FieldName "directives")--data InlineFragment = - InlineFragment {- inlineFragmentTypeCondition :: (Maybe TypeCondition),- inlineFragmentDirectives :: (Maybe Directives),- inlineFragmentSelectionSet :: SelectionSet}- deriving (Eq, Ord, Read, Show)--_InlineFragment = (Core.Name "hydra/ext/graphql/syntax.InlineFragment")--_InlineFragment_typeCondition = (Core.FieldName "typeCondition")--_InlineFragment_directives = (Core.FieldName "directives")--_InlineFragment_selectionSet = (Core.FieldName "selectionSet")--data FragmentDefinition = - FragmentDefinition {- fragmentDefinitionFragmentName :: FragmentName,- fragmentDefinitionTypeCondition :: TypeCondition,- fragmentDefinitionDirectives :: (Maybe Directives),- fragmentDefinitionSelectionSet :: SelectionSet}- deriving (Eq, Ord, Read, Show)--_FragmentDefinition = (Core.Name "hydra/ext/graphql/syntax.FragmentDefinition")--_FragmentDefinition_fragmentName = (Core.FieldName "fragmentName")--_FragmentDefinition_typeCondition = (Core.FieldName "typeCondition")--_FragmentDefinition_directives = (Core.FieldName "directives")--_FragmentDefinition_selectionSet = (Core.FieldName "selectionSet")--newtype FragmentName = - FragmentName {- unFragmentName :: Name}- deriving (Eq, Ord, Read, Show)--_FragmentName = (Core.Name "hydra/ext/graphql/syntax.FragmentName")--data TypeCondition = - TypeConditionOn |- TypeConditionNamedType NamedType- deriving (Eq, Ord, Read, Show)--_TypeCondition = (Core.Name "hydra/ext/graphql/syntax.TypeCondition")--_TypeCondition_on = (Core.FieldName "on")--_TypeCondition_namedType = (Core.FieldName "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/graphql/syntax.Value")--_Value_variable = (Core.FieldName "variable")--_Value_int = (Core.FieldName "int")--_Value_float = (Core.FieldName "float")--_Value_string = (Core.FieldName "string")--_Value_boolean = (Core.FieldName "boolean")--_Value_null = (Core.FieldName "null")--_Value_enum = (Core.FieldName "enum")--_Value_list = (Core.FieldName "list")--_Value_object = (Core.FieldName "object")--data BooleanValue = - BooleanValueTrue |- BooleanValueFalse - deriving (Eq, Ord, Read, Show)--_BooleanValue = (Core.Name "hydra/ext/graphql/syntax.BooleanValue")--_BooleanValue_true = (Core.FieldName "true")--_BooleanValue_false = (Core.FieldName "false")--data NullValue = - NullValue {}- deriving (Eq, Ord, Read, Show)--_NullValue = (Core.Name "hydra/ext/graphql/syntax.NullValue")--data EnumValue = - EnumValue {- enumValueName :: Name}- deriving (Eq, Ord, Read, Show)--_EnumValue = (Core.Name "hydra/ext/graphql/syntax.EnumValue")--_EnumValue_name = (Core.FieldName "name")--data ListValue = - ListValueSequence ListValue_Sequence |- ListValueSequence2 ListValue_Sequence2- deriving (Eq, Ord, Read, Show)--_ListValue = (Core.Name "hydra/ext/graphql/syntax.ListValue")--_ListValue_sequence = (Core.FieldName "sequence")--_ListValue_sequence2 = (Core.FieldName "sequence2")--data ListValue_Sequence = - ListValue_Sequence {}- deriving (Eq, Ord, Read, Show)--_ListValue_Sequence = (Core.Name "hydra/ext/graphql/syntax.ListValue.Sequence")--data ListValue_Sequence2 = - ListValue_Sequence2 {- listValue_Sequence2ListOfValue :: [Value]}- deriving (Eq, Ord, Read, Show)--_ListValue_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.ListValue.Sequence2")--_ListValue_Sequence2_listOfValue = (Core.FieldName "listOfValue")--data ObjectValue = - ObjectValueSequence ObjectValue_Sequence |- ObjectValueSequence2 ObjectValue_Sequence2- deriving (Eq, Ord, Read, Show)--_ObjectValue = (Core.Name "hydra/ext/graphql/syntax.ObjectValue")--_ObjectValue_sequence = (Core.FieldName "sequence")--_ObjectValue_sequence2 = (Core.FieldName "sequence2")--data ObjectValue_Sequence = - ObjectValue_Sequence {}- deriving (Eq, Ord, Read, Show)--_ObjectValue_Sequence = (Core.Name "hydra/ext/graphql/syntax.ObjectValue.Sequence")--data ObjectValue_Sequence2 = - ObjectValue_Sequence2 {- objectValue_Sequence2ListOfObjectField :: [ObjectField]}- deriving (Eq, Ord, Read, Show)--_ObjectValue_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.ObjectValue.Sequence2")--_ObjectValue_Sequence2_listOfObjectField = (Core.FieldName "listOfObjectField")--data ObjectField = - ObjectField {- objectFieldName :: Name,- objectFieldValue :: Value}- deriving (Eq, Ord, Read, Show)--_ObjectField = (Core.Name "hydra/ext/graphql/syntax.ObjectField")--_ObjectField_name = (Core.FieldName "name")--_ObjectField_value = (Core.FieldName "value")--data VariablesDefinition = - VariablesDefinition {- variablesDefinitionVariable :: Variable,- variablesDefinitionType :: Type,- variablesDefinitionDefaultValue :: (Maybe DefaultValue),- variablesDefinitionDirectives :: (Maybe Directives)}- deriving (Eq, Ord, Read, Show)--_VariablesDefinition = (Core.Name "hydra/ext/graphql/syntax.VariablesDefinition")--_VariablesDefinition_variable = (Core.FieldName "variable")--_VariablesDefinition_type = (Core.FieldName "type")--_VariablesDefinition_defaultValue = (Core.FieldName "defaultValue")--_VariablesDefinition_directives = (Core.FieldName "directives")--newtype Variable = - Variable {- unVariable :: Name}- deriving (Eq, Ord, Read, Show)--_Variable = (Core.Name "hydra/ext/graphql/syntax.Variable")--data DefaultValue = - DefaultValue {- defaultValueValue :: Value}- deriving (Eq, Ord, Read, Show)--_DefaultValue = (Core.Name "hydra/ext/graphql/syntax.DefaultValue")--_DefaultValue_value = (Core.FieldName "value")--data Type = - TypeNamed NamedType |- TypeList ListType |- TypeNonNull NonNullType- deriving (Eq, Ord, Read, Show)--_Type = (Core.Name "hydra/ext/graphql/syntax.Type")--_Type_named = (Core.FieldName "named")--_Type_list = (Core.FieldName "list")--_Type_nonNull = (Core.FieldName "nonNull")--newtype NamedType = - NamedType {- unNamedType :: Name}- deriving (Eq, Ord, Read, Show)--_NamedType = (Core.Name "hydra/ext/graphql/syntax.NamedType")--data ListType = - ListType {- listTypeType :: Type}- deriving (Eq, Ord, Read, Show)--_ListType = (Core.Name "hydra/ext/graphql/syntax.ListType")--_ListType_type = (Core.FieldName "type")--data NonNullType = - NonNullTypeNamed NonNullType_Named |- NonNullTypeList NonNullType_List- deriving (Eq, Ord, Read, Show)--_NonNullType = (Core.Name "hydra/ext/graphql/syntax.NonNullType")--_NonNullType_named = (Core.FieldName "named")--_NonNullType_list = (Core.FieldName "list")--data NonNullType_Named = - NonNullType_Named {- nonNullType_NamedNamedType :: NamedType}- deriving (Eq, Ord, Read, Show)--_NonNullType_Named = (Core.Name "hydra/ext/graphql/syntax.NonNullType.Named")--_NonNullType_Named_namedType = (Core.FieldName "namedType")--data NonNullType_List = - NonNullType_List {- nonNullType_ListListType :: ListType}- deriving (Eq, Ord, Read, Show)--_NonNullType_List = (Core.Name "hydra/ext/graphql/syntax.NonNullType.List")--_NonNullType_List_listType = (Core.FieldName "listType")--newtype Directives = - Directives {- unDirectives :: [Directive]}- deriving (Eq, Ord, Read, Show)--_Directives = (Core.Name "hydra/ext/graphql/syntax.Directives")--data Directive = - Directive {- directiveName :: Name,- directiveArguments :: (Maybe Arguments)}- deriving (Eq, Ord, Read, Show)--_Directive = (Core.Name "hydra/ext/graphql/syntax.Directive")--_Directive_name = (Core.FieldName "name")--_Directive_arguments = (Core.FieldName "arguments")--newtype TypeSystemDocment = - TypeSystemDocment {- unTypeSystemDocment :: [TypeSystemDefinition]}- deriving (Eq, Ord, Read, Show)--_TypeSystemDocment = (Core.Name "hydra/ext/graphql/syntax.TypeSystemDocment")--data TypeSystemDefinition = - TypeSystemDefinitionSchema SchemaDefinition |- TypeSystemDefinitionType TypeDefinition |- TypeSystemDefinitionDirective DirectiveDefinition- deriving (Eq, Ord, Read, Show)--_TypeSystemDefinition = (Core.Name "hydra/ext/graphql/syntax.TypeSystemDefinition")--_TypeSystemDefinition_schema = (Core.FieldName "schema")--_TypeSystemDefinition_type = (Core.FieldName "type")--_TypeSystemDefinition_directive = (Core.FieldName "directive")--newtype TypeSystemExtensionDocument = - TypeSystemExtensionDocument {- unTypeSystemExtensionDocument :: [TypeSystemDefinitionOrExtension]}- deriving (Eq, Ord, Read, Show)--_TypeSystemExtensionDocument = (Core.Name "hydra/ext/graphql/syntax.TypeSystemExtensionDocument")--data TypeSystemDefinitionOrExtension = - TypeSystemDefinitionOrExtensionDefinition TypeSystemDefinition |- TypeSystemDefinitionOrExtensionExtension TypeSystemExtension- deriving (Eq, Ord, Read, Show)--_TypeSystemDefinitionOrExtension = (Core.Name "hydra/ext/graphql/syntax.TypeSystemDefinitionOrExtension")--_TypeSystemDefinitionOrExtension_definition = (Core.FieldName "definition")--_TypeSystemDefinitionOrExtension_extension = (Core.FieldName "extension")--data TypeSystemExtension = - TypeSystemExtensionSchema SchemaExtension |- TypeSystemExtensionType TypeExtension- deriving (Eq, Ord, Read, Show)--_TypeSystemExtension = (Core.Name "hydra/ext/graphql/syntax.TypeSystemExtension")--_TypeSystemExtension_schema = (Core.FieldName "schema")--_TypeSystemExtension_type = (Core.FieldName "type")--data SchemaDefinition = - SchemaDefinition {- schemaDefinitionDescription :: (Maybe Description),- schemaDefinitionDirectives :: (Maybe Directives),- schemaDefinitionRootOperationTypeDefinition :: RootOperationTypeDefinition}- deriving (Eq, Ord, Read, Show)--_SchemaDefinition = (Core.Name "hydra/ext/graphql/syntax.SchemaDefinition")--_SchemaDefinition_description = (Core.FieldName "description")--_SchemaDefinition_directives = (Core.FieldName "directives")--_SchemaDefinition_rootOperationTypeDefinition = (Core.FieldName "rootOperationTypeDefinition")--data SchemaExtension = - SchemaExtensionSequence SchemaExtension_Sequence |- SchemaExtensionSequence2 SchemaExtension_Sequence2- deriving (Eq, Ord, Read, Show)--_SchemaExtension = (Core.Name "hydra/ext/graphql/syntax.SchemaExtension")--_SchemaExtension_sequence = (Core.FieldName "sequence")--_SchemaExtension_sequence2 = (Core.FieldName "sequence2")--data SchemaExtension_Sequence = - SchemaExtension_Sequence {- schemaExtension_SequenceDirectives :: (Maybe Directives),- schemaExtension_SequenceRootOperationTypeDefinition :: RootOperationTypeDefinition}- deriving (Eq, Ord, Read, Show)--_SchemaExtension_Sequence = (Core.Name "hydra/ext/graphql/syntax.SchemaExtension.Sequence")--_SchemaExtension_Sequence_directives = (Core.FieldName "directives")--_SchemaExtension_Sequence_rootOperationTypeDefinition = (Core.FieldName "rootOperationTypeDefinition")--data SchemaExtension_Sequence2 = - SchemaExtension_Sequence2 {- schemaExtension_Sequence2Directives :: Directives}- deriving (Eq, Ord, Read, Show)--_SchemaExtension_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.SchemaExtension.Sequence2")--_SchemaExtension_Sequence2_directives = (Core.FieldName "directives")--data RootOperationTypeDefinition = - RootOperationTypeDefinition {- rootOperationTypeDefinitionOperationType :: OperationType,- rootOperationTypeDefinitionNamedType :: NamedType}- deriving (Eq, Ord, Read, Show)--_RootOperationTypeDefinition = (Core.Name "hydra/ext/graphql/syntax.RootOperationTypeDefinition")--_RootOperationTypeDefinition_operationType = (Core.FieldName "operationType")--_RootOperationTypeDefinition_namedType = (Core.FieldName "namedType")--newtype Description = - Description {- unDescription :: StringValue}- deriving (Eq, Ord, Read, Show)--_Description = (Core.Name "hydra/ext/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/graphql/syntax.TypeDefinition")--_TypeDefinition_scalar = (Core.FieldName "scalar")--_TypeDefinition_object = (Core.FieldName "object")--_TypeDefinition_interface = (Core.FieldName "interface")--_TypeDefinition_union = (Core.FieldName "union")--_TypeDefinition_enum = (Core.FieldName "enum")--_TypeDefinition_inputObject = (Core.FieldName "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/graphql/syntax.TypeExtension")--_TypeExtension_scalar = (Core.FieldName "scalar")--_TypeExtension_object = (Core.FieldName "object")--_TypeExtension_interface = (Core.FieldName "interface")--_TypeExtension_union = (Core.FieldName "union")--_TypeExtension_enum = (Core.FieldName "enum")--_TypeExtension_inputObject = (Core.FieldName "inputObject")--data ScalarTypeDefinition = - ScalarTypeDefinition {- scalarTypeDefinitionDescription :: (Maybe Description),- scalarTypeDefinitionName :: Name,- scalarTypeDefinitionDirectives :: (Maybe Directives)}- deriving (Eq, Ord, Read, Show)--_ScalarTypeDefinition = (Core.Name "hydra/ext/graphql/syntax.ScalarTypeDefinition")--_ScalarTypeDefinition_description = (Core.FieldName "description")--_ScalarTypeDefinition_name = (Core.FieldName "name")--_ScalarTypeDefinition_directives = (Core.FieldName "directives")--data ScalarTypeExtension = - ScalarTypeExtension {- scalarTypeExtensionName :: Name,- scalarTypeExtensionDirectives :: Directives}- deriving (Eq, Ord, Read, Show)--_ScalarTypeExtension = (Core.Name "hydra/ext/graphql/syntax.ScalarTypeExtension")--_ScalarTypeExtension_name = (Core.FieldName "name")--_ScalarTypeExtension_directives = (Core.FieldName "directives")--data ObjectTypeDefinition = - ObjectTypeDefinitionSequence ObjectTypeDefinition_Sequence |- ObjectTypeDefinitionSequence2 ObjectTypeDefinition_Sequence2- deriving (Eq, Ord, Read, Show)--_ObjectTypeDefinition = (Core.Name "hydra/ext/graphql/syntax.ObjectTypeDefinition")--_ObjectTypeDefinition_sequence = (Core.FieldName "sequence")--_ObjectTypeDefinition_sequence2 = (Core.FieldName "sequence2")--data ObjectTypeDefinition_Sequence = - ObjectTypeDefinition_Sequence {- objectTypeDefinition_SequenceDescription :: (Maybe Description),- objectTypeDefinition_SequenceName :: Name,- objectTypeDefinition_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces),- objectTypeDefinition_SequenceDirectives :: (Maybe Directives),- objectTypeDefinition_SequenceFieldsDefinition :: FieldsDefinition}- deriving (Eq, Ord, Read, Show)--_ObjectTypeDefinition_Sequence = (Core.Name "hydra/ext/graphql/syntax.ObjectTypeDefinition.Sequence")--_ObjectTypeDefinition_Sequence_description = (Core.FieldName "description")--_ObjectTypeDefinition_Sequence_name = (Core.FieldName "name")--_ObjectTypeDefinition_Sequence_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_ObjectTypeDefinition_Sequence_directives = (Core.FieldName "directives")--_ObjectTypeDefinition_Sequence_fieldsDefinition = (Core.FieldName "fieldsDefinition")--data ObjectTypeDefinition_Sequence2 = - ObjectTypeDefinition_Sequence2 {- objectTypeDefinition_Sequence2Description :: (Maybe Description),- objectTypeDefinition_Sequence2Name :: Name,- objectTypeDefinition_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces),- objectTypeDefinition_Sequence2Directives :: (Maybe Directives)}- deriving (Eq, Ord, Read, Show)--_ObjectTypeDefinition_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.ObjectTypeDefinition.Sequence2")--_ObjectTypeDefinition_Sequence2_description = (Core.FieldName "description")--_ObjectTypeDefinition_Sequence2_name = (Core.FieldName "name")--_ObjectTypeDefinition_Sequence2_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_ObjectTypeDefinition_Sequence2_directives = (Core.FieldName "directives")--data ObjectTypeExtension = - ObjectTypeExtensionSequence ObjectTypeExtension_Sequence |- ObjectTypeExtensionSequence2 ObjectTypeExtension_Sequence2 |- ObjectTypeExtensionSequence3 ObjectTypeExtension_Sequence3- deriving (Eq, Ord, Read, Show)--_ObjectTypeExtension = (Core.Name "hydra/ext/graphql/syntax.ObjectTypeExtension")--_ObjectTypeExtension_sequence = (Core.FieldName "sequence")--_ObjectTypeExtension_sequence2 = (Core.FieldName "sequence2")--_ObjectTypeExtension_sequence3 = (Core.FieldName "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/graphql/syntax.ObjectTypeExtension.Sequence")--_ObjectTypeExtension_Sequence_name = (Core.FieldName "name")--_ObjectTypeExtension_Sequence_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_ObjectTypeExtension_Sequence_directives = (Core.FieldName "directives")--_ObjectTypeExtension_Sequence_fieldsDefinition = (Core.FieldName "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/graphql/syntax.ObjectTypeExtension.Sequence2")--_ObjectTypeExtension_Sequence2_name = (Core.FieldName "name")--_ObjectTypeExtension_Sequence2_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_ObjectTypeExtension_Sequence2_directives = (Core.FieldName "directives")--data ObjectTypeExtension_Sequence3 = - ObjectTypeExtension_Sequence3 {- objectTypeExtension_Sequence3Name :: Name,- objectTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces}- deriving (Eq, Ord, Read, Show)--_ObjectTypeExtension_Sequence3 = (Core.Name "hydra/ext/graphql/syntax.ObjectTypeExtension.Sequence3")--_ObjectTypeExtension_Sequence3_name = (Core.FieldName "name")--_ObjectTypeExtension_Sequence3_implementsInterfaces = (Core.FieldName "implementsInterfaces")--data ImplementsInterfaces = - ImplementsInterfacesSequence ImplementsInterfaces_Sequence |- ImplementsInterfacesSequence2 ImplementsInterfaces_Sequence2- deriving (Eq, Ord, Read, Show)--_ImplementsInterfaces = (Core.Name "hydra/ext/graphql/syntax.ImplementsInterfaces")--_ImplementsInterfaces_sequence = (Core.FieldName "sequence")--_ImplementsInterfaces_sequence2 = (Core.FieldName "sequence2")--data ImplementsInterfaces_Sequence = - ImplementsInterfaces_Sequence {- implementsInterfaces_SequenceImplementsInterfaces :: ImplementsInterfaces,- implementsInterfaces_SequenceNamedType :: NamedType}- deriving (Eq, Ord, Read, Show)--_ImplementsInterfaces_Sequence = (Core.Name "hydra/ext/graphql/syntax.ImplementsInterfaces.Sequence")--_ImplementsInterfaces_Sequence_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_ImplementsInterfaces_Sequence_namedType = (Core.FieldName "namedType")--data ImplementsInterfaces_Sequence2 = - ImplementsInterfaces_Sequence2 {- implementsInterfaces_Sequence2Amp :: (Maybe ()),- implementsInterfaces_Sequence2NamedType :: NamedType}- deriving (Eq, Ord, Read, Show)--_ImplementsInterfaces_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.ImplementsInterfaces.Sequence2")--_ImplementsInterfaces_Sequence2_amp = (Core.FieldName "amp")--_ImplementsInterfaces_Sequence2_namedType = (Core.FieldName "namedType")--data FieldsDefinition = - FieldsDefinition {- fieldsDefinitionListOfFieldDefinition :: [FieldDefinition]}- deriving (Eq, Ord, Read, Show)--_FieldsDefinition = (Core.Name "hydra/ext/graphql/syntax.FieldsDefinition")--_FieldsDefinition_listOfFieldDefinition = (Core.FieldName "listOfFieldDefinition")--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/graphql/syntax.FieldDefinition")--_FieldDefinition_description = (Core.FieldName "description")--_FieldDefinition_name = (Core.FieldName "name")--_FieldDefinition_argumentsDefinition = (Core.FieldName "argumentsDefinition")--_FieldDefinition_type = (Core.FieldName "type")--_FieldDefinition_directives = (Core.FieldName "directives")--data ArgumentsDefinition = - ArgumentsDefinition {- argumentsDefinitionListOfInputValueDefinition :: [InputValueDefinition]}- deriving (Eq, Ord, Read, Show)--_ArgumentsDefinition = (Core.Name "hydra/ext/graphql/syntax.ArgumentsDefinition")--_ArgumentsDefinition_listOfInputValueDefinition = (Core.FieldName "listOfInputValueDefinition")--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/graphql/syntax.InputValueDefinition")--_InputValueDefinition_description = (Core.FieldName "description")--_InputValueDefinition_name = (Core.FieldName "name")--_InputValueDefinition_type = (Core.FieldName "type")--_InputValueDefinition_defaultValue = (Core.FieldName "defaultValue")--_InputValueDefinition_directives = (Core.FieldName "directives")--data InterfaceTypeDefinition = - InterfaceTypeDefinitionSequence InterfaceTypeDefinition_Sequence |- InterfaceTypeDefinitionSequence2 InterfaceTypeDefinition_Sequence2- deriving (Eq, Ord, Read, Show)--_InterfaceTypeDefinition = (Core.Name "hydra/ext/graphql/syntax.InterfaceTypeDefinition")--_InterfaceTypeDefinition_sequence = (Core.FieldName "sequence")--_InterfaceTypeDefinition_sequence2 = (Core.FieldName "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/graphql/syntax.InterfaceTypeDefinition.Sequence")--_InterfaceTypeDefinition_Sequence_description = (Core.FieldName "description")--_InterfaceTypeDefinition_Sequence_name = (Core.FieldName "name")--_InterfaceTypeDefinition_Sequence_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_InterfaceTypeDefinition_Sequence_directives = (Core.FieldName "directives")--_InterfaceTypeDefinition_Sequence_fieldsDefinition = (Core.FieldName "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/graphql/syntax.InterfaceTypeDefinition.Sequence2")--_InterfaceTypeDefinition_Sequence2_description = (Core.FieldName "description")--_InterfaceTypeDefinition_Sequence2_name = (Core.FieldName "name")--_InterfaceTypeDefinition_Sequence2_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_InterfaceTypeDefinition_Sequence2_directives = (Core.FieldName "directives")--data InterfaceTypeExtension = - InterfaceTypeExtensionSequence InterfaceTypeExtension_Sequence |- InterfaceTypeExtensionSequence2 InterfaceTypeExtension_Sequence2 |- InterfaceTypeExtensionSequence3 InterfaceTypeExtension_Sequence3- deriving (Eq, Ord, Read, Show)--_InterfaceTypeExtension = (Core.Name "hydra/ext/graphql/syntax.InterfaceTypeExtension")--_InterfaceTypeExtension_sequence = (Core.FieldName "sequence")--_InterfaceTypeExtension_sequence2 = (Core.FieldName "sequence2")--_InterfaceTypeExtension_sequence3 = (Core.FieldName "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/graphql/syntax.InterfaceTypeExtension.Sequence")--_InterfaceTypeExtension_Sequence_name = (Core.FieldName "name")--_InterfaceTypeExtension_Sequence_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_InterfaceTypeExtension_Sequence_directives = (Core.FieldName "directives")--_InterfaceTypeExtension_Sequence_fieldsDefinition = (Core.FieldName "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/graphql/syntax.InterfaceTypeExtension.Sequence2")--_InterfaceTypeExtension_Sequence2_name = (Core.FieldName "name")--_InterfaceTypeExtension_Sequence2_implementsInterfaces = (Core.FieldName "implementsInterfaces")--_InterfaceTypeExtension_Sequence2_directives = (Core.FieldName "directives")--data InterfaceTypeExtension_Sequence3 = - InterfaceTypeExtension_Sequence3 {- interfaceTypeExtension_Sequence3Name :: Name,- interfaceTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces}- deriving (Eq, Ord, Read, Show)--_InterfaceTypeExtension_Sequence3 = (Core.Name "hydra/ext/graphql/syntax.InterfaceTypeExtension.Sequence3")--_InterfaceTypeExtension_Sequence3_name = (Core.FieldName "name")--_InterfaceTypeExtension_Sequence3_implementsInterfaces = (Core.FieldName "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/graphql/syntax.UnionTypeDefinition")--_UnionTypeDefinition_description = (Core.FieldName "description")--_UnionTypeDefinition_name = (Core.FieldName "name")--_UnionTypeDefinition_directives = (Core.FieldName "directives")--_UnionTypeDefinition_unionMemberTypes = (Core.FieldName "unionMemberTypes")--data UnionMemberTypes = - UnionMemberTypesSequence UnionMemberTypes_Sequence |- UnionMemberTypesSequence2 UnionMemberTypes_Sequence2- deriving (Eq, Ord, Read, Show)--_UnionMemberTypes = (Core.Name "hydra/ext/graphql/syntax.UnionMemberTypes")--_UnionMemberTypes_sequence = (Core.FieldName "sequence")--_UnionMemberTypes_sequence2 = (Core.FieldName "sequence2")--data UnionMemberTypes_Sequence = - UnionMemberTypes_Sequence {- unionMemberTypes_SequenceUnionMemberTypes :: UnionMemberTypes,- unionMemberTypes_SequenceNamedType :: NamedType}- deriving (Eq, Ord, Read, Show)--_UnionMemberTypes_Sequence = (Core.Name "hydra/ext/graphql/syntax.UnionMemberTypes.Sequence")--_UnionMemberTypes_Sequence_unionMemberTypes = (Core.FieldName "unionMemberTypes")--_UnionMemberTypes_Sequence_namedType = (Core.FieldName "namedType")--data UnionMemberTypes_Sequence2 = - UnionMemberTypes_Sequence2 {- unionMemberTypes_Sequence2Or :: (Maybe ()),- unionMemberTypes_Sequence2NamedType :: NamedType}- deriving (Eq, Ord, Read, Show)--_UnionMemberTypes_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.UnionMemberTypes.Sequence2")--_UnionMemberTypes_Sequence2_or = (Core.FieldName "or")--_UnionMemberTypes_Sequence2_namedType = (Core.FieldName "namedType")--data UnionTypeExtension = - UnionTypeExtensionSequence UnionTypeExtension_Sequence |- UnionTypeExtensionSequence2 UnionTypeExtension_Sequence2- deriving (Eq, Ord, Read, Show)--_UnionTypeExtension = (Core.Name "hydra/ext/graphql/syntax.UnionTypeExtension")--_UnionTypeExtension_sequence = (Core.FieldName "sequence")--_UnionTypeExtension_sequence2 = (Core.FieldName "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/graphql/syntax.UnionTypeExtension.Sequence")--_UnionTypeExtension_Sequence_name = (Core.FieldName "name")--_UnionTypeExtension_Sequence_directives = (Core.FieldName "directives")--_UnionTypeExtension_Sequence_unionMemberTypes = (Core.FieldName "unionMemberTypes")--data UnionTypeExtension_Sequence2 = - UnionTypeExtension_Sequence2 {- unionTypeExtension_Sequence2Name :: Name,- unionTypeExtension_Sequence2Directives :: Directives}- deriving (Eq, Ord, Read, Show)--_UnionTypeExtension_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.UnionTypeExtension.Sequence2")--_UnionTypeExtension_Sequence2_name = (Core.FieldName "name")--_UnionTypeExtension_Sequence2_directives = (Core.FieldName "directives")--data EnumTypeDefinition = - EnumTypeDefinitionSequence EnumTypeDefinition_Sequence |- EnumTypeDefinitionSequence2 EnumTypeDefinition_Sequence2- deriving (Eq, Ord, Read, Show)--_EnumTypeDefinition = (Core.Name "hydra/ext/graphql/syntax.EnumTypeDefinition")--_EnumTypeDefinition_sequence = (Core.FieldName "sequence")--_EnumTypeDefinition_sequence2 = (Core.FieldName "sequence2")--data EnumTypeDefinition_Sequence = - EnumTypeDefinition_Sequence {- enumTypeDefinition_SequenceDescription :: (Maybe Description),- enumTypeDefinition_SequenceName :: Name,- enumTypeDefinition_SequenceDirectives :: (Maybe Directives),- enumTypeDefinition_SequenceEnumValuesDefinition :: EnumValuesDefinition}- deriving (Eq, Ord, Read, Show)--_EnumTypeDefinition_Sequence = (Core.Name "hydra/ext/graphql/syntax.EnumTypeDefinition.Sequence")--_EnumTypeDefinition_Sequence_description = (Core.FieldName "description")--_EnumTypeDefinition_Sequence_name = (Core.FieldName "name")--_EnumTypeDefinition_Sequence_directives = (Core.FieldName "directives")--_EnumTypeDefinition_Sequence_enumValuesDefinition = (Core.FieldName "enumValuesDefinition")--data EnumTypeDefinition_Sequence2 = - EnumTypeDefinition_Sequence2 {- enumTypeDefinition_Sequence2Description :: (Maybe Description),- enumTypeDefinition_Sequence2Directives :: (Maybe Directives)}- deriving (Eq, Ord, Read, Show)--_EnumTypeDefinition_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.EnumTypeDefinition.Sequence2")--_EnumTypeDefinition_Sequence2_description = (Core.FieldName "description")--_EnumTypeDefinition_Sequence2_directives = (Core.FieldName "directives")--data EnumValuesDefinition = - EnumValuesDefinition {- enumValuesDefinitionListOfEnumValueDefinition :: [EnumValueDefinition]}- deriving (Eq, Ord, Read, Show)--_EnumValuesDefinition = (Core.Name "hydra/ext/graphql/syntax.EnumValuesDefinition")--_EnumValuesDefinition_listOfEnumValueDefinition = (Core.FieldName "listOfEnumValueDefinition")--data EnumValueDefinition = - EnumValueDefinition {- enumValueDefinitionDescription :: (Maybe Description),- enumValueDefinitionEnumValue :: EnumValue,- enumValueDefinitionDirectives :: (Maybe Directives)}- deriving (Eq, Ord, Read, Show)--_EnumValueDefinition = (Core.Name "hydra/ext/graphql/syntax.EnumValueDefinition")--_EnumValueDefinition_description = (Core.FieldName "description")--_EnumValueDefinition_enumValue = (Core.FieldName "enumValue")--_EnumValueDefinition_directives = (Core.FieldName "directives")--data EnumTypeExtension = - EnumTypeExtensionSequence EnumTypeExtension_Sequence |- EnumTypeExtensionSequence2 EnumTypeExtension_Sequence2- deriving (Eq, Ord, Read, Show)--_EnumTypeExtension = (Core.Name "hydra/ext/graphql/syntax.EnumTypeExtension")--_EnumTypeExtension_sequence = (Core.FieldName "sequence")--_EnumTypeExtension_sequence2 = (Core.FieldName "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/graphql/syntax.EnumTypeExtension.Sequence")--_EnumTypeExtension_Sequence_name = (Core.FieldName "name")--_EnumTypeExtension_Sequence_directives = (Core.FieldName "directives")--_EnumTypeExtension_Sequence_enumValuesDefinition = (Core.FieldName "enumValuesDefinition")--data EnumTypeExtension_Sequence2 = - EnumTypeExtension_Sequence2 {- enumTypeExtension_Sequence2Name :: Name,- enumTypeExtension_Sequence2Directives :: Directives}- deriving (Eq, Ord, Read, Show)--_EnumTypeExtension_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.EnumTypeExtension.Sequence2")--_EnumTypeExtension_Sequence2_name = (Core.FieldName "name")--_EnumTypeExtension_Sequence2_directives = (Core.FieldName "directives")--data InputObjectTypeDefinition = - InputObjectTypeDefinitionSequence InputObjectTypeDefinition_Sequence |- InputObjectTypeDefinitionSequence2 InputObjectTypeDefinition_Sequence2- deriving (Eq, Ord, Read, Show)--_InputObjectTypeDefinition = (Core.Name "hydra/ext/graphql/syntax.InputObjectTypeDefinition")--_InputObjectTypeDefinition_sequence = (Core.FieldName "sequence")--_InputObjectTypeDefinition_sequence2 = (Core.FieldName "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/graphql/syntax.InputObjectTypeDefinition.Sequence")--_InputObjectTypeDefinition_Sequence_description = (Core.FieldName "description")--_InputObjectTypeDefinition_Sequence_name = (Core.FieldName "name")--_InputObjectTypeDefinition_Sequence_directives = (Core.FieldName "directives")--_InputObjectTypeDefinition_Sequence_inputFieldsDefinition = (Core.FieldName "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/graphql/syntax.InputObjectTypeDefinition.Sequence2")--_InputObjectTypeDefinition_Sequence2_description = (Core.FieldName "description")--_InputObjectTypeDefinition_Sequence2_name = (Core.FieldName "name")--_InputObjectTypeDefinition_Sequence2_directives = (Core.FieldName "directives")--data InputFieldsDefinition = - InputFieldsDefinition {- inputFieldsDefinitionListOfInputValueDefinition :: [InputValueDefinition]}- deriving (Eq, Ord, Read, Show)--_InputFieldsDefinition = (Core.Name "hydra/ext/graphql/syntax.InputFieldsDefinition")--_InputFieldsDefinition_listOfInputValueDefinition = (Core.FieldName "listOfInputValueDefinition")--data InputObjectTypeExtension = - InputObjectTypeExtensionSequence InputObjectTypeExtension_Sequence |- InputObjectTypeExtensionSequence2 InputObjectTypeExtension_Sequence2- deriving (Eq, Ord, Read, Show)--_InputObjectTypeExtension = (Core.Name "hydra/ext/graphql/syntax.InputObjectTypeExtension")--_InputObjectTypeExtension_sequence = (Core.FieldName "sequence")--_InputObjectTypeExtension_sequence2 = (Core.FieldName "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/graphql/syntax.InputObjectTypeExtension.Sequence")--_InputObjectTypeExtension_Sequence_name = (Core.FieldName "name")--_InputObjectTypeExtension_Sequence_directives = (Core.FieldName "directives")--_InputObjectTypeExtension_Sequence_inputFieldsDefinition = (Core.FieldName "inputFieldsDefinition")--data InputObjectTypeExtension_Sequence2 = - InputObjectTypeExtension_Sequence2 {- inputObjectTypeExtension_Sequence2Name :: Name,- inputObjectTypeExtension_Sequence2Directives :: Directives}- deriving (Eq, Ord, Read, Show)--_InputObjectTypeExtension_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.InputObjectTypeExtension.Sequence2")--_InputObjectTypeExtension_Sequence2_name = (Core.FieldName "name")--_InputObjectTypeExtension_Sequence2_directives = (Core.FieldName "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/graphql/syntax.DirectiveDefinition")--_DirectiveDefinition_description = (Core.FieldName "description")--_DirectiveDefinition_name = (Core.FieldName "name")--_DirectiveDefinition_argumentsDefinition = (Core.FieldName "argumentsDefinition")--_DirectiveDefinition_repeatable = (Core.FieldName "repeatable")--_DirectiveDefinition_directiveLocations = (Core.FieldName "directiveLocations")--data DirectiveLocations = - DirectiveLocationsSequence DirectiveLocations_Sequence |- DirectiveLocationsSequence2 DirectiveLocations_Sequence2- deriving (Eq, Ord, Read, Show)--_DirectiveLocations = (Core.Name "hydra/ext/graphql/syntax.DirectiveLocations")--_DirectiveLocations_sequence = (Core.FieldName "sequence")--_DirectiveLocations_sequence2 = (Core.FieldName "sequence2")--data DirectiveLocations_Sequence = - DirectiveLocations_Sequence {- directiveLocations_SequenceDirectiveLocations :: DirectiveLocations,- directiveLocations_SequenceDirectiveLocation :: DirectiveLocation}- deriving (Eq, Ord, Read, Show)--_DirectiveLocations_Sequence = (Core.Name "hydra/ext/graphql/syntax.DirectiveLocations.Sequence")--_DirectiveLocations_Sequence_directiveLocations = (Core.FieldName "directiveLocations")--_DirectiveLocations_Sequence_directiveLocation = (Core.FieldName "directiveLocation")--data DirectiveLocations_Sequence2 = - DirectiveLocations_Sequence2 {- directiveLocations_Sequence2Or :: (Maybe ()),- directiveLocations_Sequence2DirectiveLocation :: DirectiveLocation}- deriving (Eq, Ord, Read, Show)--_DirectiveLocations_Sequence2 = (Core.Name "hydra/ext/graphql/syntax.DirectiveLocations.Sequence2")--_DirectiveLocations_Sequence2_or = (Core.FieldName "or")--_DirectiveLocations_Sequence2_directiveLocation = (Core.FieldName "directiveLocation")--data DirectiveLocation = - DirectiveLocationExecutable ExecutableDirectiveLocation |- DirectiveLocationTypeSystem TypeSystemDirectiveLocation- deriving (Eq, Ord, Read, Show)--_DirectiveLocation = (Core.Name "hydra/ext/graphql/syntax.DirectiveLocation")--_DirectiveLocation_executable = (Core.FieldName "executable")--_DirectiveLocation_typeSystem = (Core.FieldName "typeSystem")--data ExecutableDirectiveLocation = - ExecutableDirectiveLocationQUERY |- ExecutableDirectiveLocationMUTATION |- ExecutableDirectiveLocationSUBSCRIPTION |- ExecutableDirectiveLocationFIELD |- ExecutableDirectiveLocationFRAGMENTLowbarDEFINITION |- ExecutableDirectiveLocationFRAGMENTLowbarSPREAD |- ExecutableDirectiveLocationINLINELowbarFRAGMENT |- ExecutableDirectiveLocationVARIABLELowbarDEFINITION - deriving (Eq, Ord, Read, Show)--_ExecutableDirectiveLocation = (Core.Name "hydra/ext/graphql/syntax.ExecutableDirectiveLocation")--_ExecutableDirectiveLocation_qUERY = (Core.FieldName "qUERY")--_ExecutableDirectiveLocation_mUTATION = (Core.FieldName "mUTATION")--_ExecutableDirectiveLocation_sUBSCRIPTION = (Core.FieldName "sUBSCRIPTION")--_ExecutableDirectiveLocation_fIELD = (Core.FieldName "fIELD")--_ExecutableDirectiveLocation_fRAGMENTLowbarDEFINITION = (Core.FieldName "fRAGMENTLowbarDEFINITION")--_ExecutableDirectiveLocation_fRAGMENTLowbarSPREAD = (Core.FieldName "fRAGMENTLowbarSPREAD")--_ExecutableDirectiveLocation_iNLINELowbarFRAGMENT = (Core.FieldName "iNLINELowbarFRAGMENT")--_ExecutableDirectiveLocation_vARIABLELowbarDEFINITION = (Core.FieldName "vARIABLELowbarDEFINITION")--data TypeSystemDirectiveLocation = - TypeSystemDirectiveLocationSCHEMA |- TypeSystemDirectiveLocationSCALAR |- TypeSystemDirectiveLocationOBJECT |- TypeSystemDirectiveLocationFIELDLowbarDEFINITION |- TypeSystemDirectiveLocationARGUMENTLowbarDEFINITION |- TypeSystemDirectiveLocationINTERFACE |- TypeSystemDirectiveLocationUNION |- TypeSystemDirectiveLocationENUM |- TypeSystemDirectiveLocationENUMLowbarVALUE |- TypeSystemDirectiveLocationINPUTLowbarOBJECT |- TypeSystemDirectiveLocationINPUTLowbarFIELDLowbarDEFINITION - deriving (Eq, Ord, Read, Show)--_TypeSystemDirectiveLocation = (Core.Name "hydra/ext/graphql/syntax.TypeSystemDirectiveLocation")--_TypeSystemDirectiveLocation_sCHEMA = (Core.FieldName "sCHEMA")--_TypeSystemDirectiveLocation_sCALAR = (Core.FieldName "sCALAR")--_TypeSystemDirectiveLocation_oBJECT = (Core.FieldName "oBJECT")--_TypeSystemDirectiveLocation_fIELDLowbarDEFINITION = (Core.FieldName "fIELDLowbarDEFINITION")--_TypeSystemDirectiveLocation_aRGUMENTLowbarDEFINITION = (Core.FieldName "aRGUMENTLowbarDEFINITION")--_TypeSystemDirectiveLocation_iNTERFACE = (Core.FieldName "iNTERFACE")--_TypeSystemDirectiveLocation_uNION = (Core.FieldName "uNION")--_TypeSystemDirectiveLocation_eNUM = (Core.FieldName "eNUM")--_TypeSystemDirectiveLocation_eNUMLowbarVALUE = (Core.FieldName "eNUMLowbarVALUE")--_TypeSystemDirectiveLocation_iNPUTLowbarOBJECT = (Core.FieldName "iNPUTLowbarOBJECT")--_TypeSystemDirectiveLocation_iNPUTLowbarFIELDLowbarDEFINITION = (Core.FieldName "iNPUTLowbarFIELDLowbarDEFINITION")
− src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs
@@ -1,892 +0,0 @@--- | 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.List-import Data.Map-import Data.Set---- | 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.FieldName "pattern")--_Alternative_rhs = (Core.FieldName "rhs")--_Alternative_binds = (Core.FieldName "binds")---- | A type assertion-data Assertion = - Assertion {- assertionName :: Name,- assertionTypes :: [Type]}- deriving (Eq, Ord, Read, Show)--_Assertion = (Core.Name "hydra/ext/haskell/ast.Assertion")--_Assertion_name = (Core.FieldName "name")--_Assertion_types = (Core.FieldName "types")---- | The right-hand side of a pattern-matching alternative-newtype CaseRhs = - CaseRhs {- -- | The right-hand side of a pattern-matching alternative- 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.FieldName "ordinary")--_Constructor_record = (Core.FieldName "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.FieldName "name")--_Constructor_Ordinary_fields = (Core.FieldName "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.FieldName "name")--_Constructor_Record_fields = (Core.FieldName "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.FieldName "body")--_ConstructorWithComments_comments = (Core.FieldName "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.FieldName "keyword")--_DataDeclaration_context = (Core.FieldName "context")--_DataDeclaration_head = (Core.FieldName "head")--_DataDeclaration_constructors = (Core.FieldName "constructors")--_DataDeclaration_deriving = (Core.FieldName "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.FieldName "data")--_DataDeclaration_Keyword_newtype = (Core.FieldName "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.FieldName "body")--_DeclarationWithComments_comments = (Core.FieldName "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.FieldName "data")--_Declaration_type = (Core.FieldName "type")--_Declaration_valueBinding = (Core.FieldName "valueBinding")--_Declaration_typedBinding = (Core.FieldName "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.FieldName "application")--_DeclarationHead_parens = (Core.FieldName "parens")--_DeclarationHead_simple = (Core.FieldName "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.FieldName "function")--_DeclarationHead_Application_operand = (Core.FieldName "operand")---- | A 'deriving' statement-newtype Deriving = - Deriving {- -- | A 'deriving' statement- 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.FieldName "declaration")--_Export_module = (Core.FieldName "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.FieldName "application")--_Expression_case = (Core.FieldName "case")--_Expression_constructRecord = (Core.FieldName "constructRecord")--_Expression_do = (Core.FieldName "do")--_Expression_if = (Core.FieldName "if")--_Expression_infixApplication = (Core.FieldName "infixApplication")--_Expression_literal = (Core.FieldName "literal")--_Expression_lambda = (Core.FieldName "lambda")--_Expression_leftSection = (Core.FieldName "leftSection")--_Expression_let = (Core.FieldName "let")--_Expression_list = (Core.FieldName "list")--_Expression_parens = (Core.FieldName "parens")--_Expression_prefixApplication = (Core.FieldName "prefixApplication")--_Expression_rightSection = (Core.FieldName "rightSection")--_Expression_tuple = (Core.FieldName "tuple")--_Expression_typeSignature = (Core.FieldName "typeSignature")--_Expression_updateRecord = (Core.FieldName "updateRecord")--_Expression_variable = (Core.FieldName "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.FieldName "function")--_Expression_Application_argument = (Core.FieldName "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.FieldName "case")--_Expression_Case_alternatives = (Core.FieldName "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.FieldName "name")--_Expression_ConstructRecord_fields = (Core.FieldName "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.FieldName "condition")--_Expression_If_then = (Core.FieldName "then")--_Expression_If_else = (Core.FieldName "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.FieldName "lhs")--_Expression_InfixApplication_operator = (Core.FieldName "operator")--_Expression_InfixApplication_rhs = (Core.FieldName "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.FieldName "bindings")--_Expression_Lambda_inner = (Core.FieldName "inner")---- | A 'let' expression-data Expression_Let = - Expression_Let {- expression_LetBindings :: [Pattern],- expression_LetInner :: Expression}- deriving (Eq, Ord, Read, Show)--_Expression_Let = (Core.Name "hydra/ext/haskell/ast.Expression.Let")--_Expression_Let_bindings = (Core.FieldName "bindings")--_Expression_Let_inner = (Core.FieldName "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.FieldName "operator")--_Expression_PrefixApplication_rhs = (Core.FieldName "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.FieldName "operator")--_Expression_Section_expression = (Core.FieldName "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.FieldName "inner")--_Expression_TypeSignature_type = (Core.FieldName "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.FieldName "inner")--_Expression_UpdateRecord_fields = (Core.FieldName "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.FieldName "name")--_Field_type = (Core.FieldName "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.FieldName "field")--_FieldWithComments_comments = (Core.FieldName "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.FieldName "name")--_FieldUpdate_value = (Core.FieldName "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.FieldName "qualified")--_Import_module = (Core.FieldName "module")--_Import_as = (Core.FieldName "as")--_Import_spec = (Core.FieldName "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.FieldName "list")--_Import_Spec_hiding = (Core.FieldName "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.FieldName "pattern")--_ImportModifier_type = (Core.FieldName "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.FieldName "modifier")--_ImportExportSpec_name = (Core.FieldName "name")--_ImportExportSpec_subspec = (Core.FieldName "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.FieldName "all")--_ImportExportSpec_Subspec_list = (Core.FieldName "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.FieldName "char")--_Literal_double = (Core.FieldName "double")--_Literal_float = (Core.FieldName "float")--_Literal_int = (Core.FieldName "int")--_Literal_integer = (Core.FieldName "integer")--_Literal_string = (Core.FieldName "string")--data LocalBinding = - LocalBindingSignature TypeSignature |- LocalBindingValue ValueBinding- deriving (Eq, Ord, Read, Show)--_LocalBinding = (Core.Name "hydra/ext/haskell/ast.LocalBinding")--_LocalBinding_signature = (Core.FieldName "signature")--_LocalBinding_value = (Core.FieldName "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.FieldName "head")--_Module_imports = (Core.FieldName "imports")--_Module_declarations = (Core.FieldName "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.FieldName "comments")--_ModuleHead_name = (Core.FieldName "name")--_ModuleHead_exports = (Core.FieldName "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.FieldName "implicit")--_Name_normal = (Core.FieldName "normal")--_Name_parens = (Core.FieldName "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.FieldName "backtick")--_Operator_normal = (Core.FieldName "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.FieldName "application")--_Pattern_as = (Core.FieldName "as")--_Pattern_list = (Core.FieldName "list")--_Pattern_literal = (Core.FieldName "literal")--_Pattern_name = (Core.FieldName "name")--_Pattern_parens = (Core.FieldName "parens")--_Pattern_record = (Core.FieldName "record")--_Pattern_tuple = (Core.FieldName "tuple")--_Pattern_typed = (Core.FieldName "typed")--_Pattern_wildcard = (Core.FieldName "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.FieldName "name")--_Pattern_Application_args = (Core.FieldName "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.FieldName "name")--_Pattern_As_inner = (Core.FieldName "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.FieldName "name")--_Pattern_Record_fields = (Core.FieldName "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.FieldName "inner")--_Pattern_Typed_type = (Core.FieldName "type")--data PatternField = - PatternField {- patternFieldName :: Name,- patternFieldPattern :: Pattern}- deriving (Eq, Ord, Read, Show)--_PatternField = (Core.Name "hydra/ext/haskell/ast.PatternField")--_PatternField_name = (Core.FieldName "name")--_PatternField_pattern = (Core.FieldName "pattern")--data QualifiedName = - QualifiedName {- qualifiedNameQualifiers :: [NamePart],- qualifiedNameUnqualified :: NamePart}- deriving (Eq, Ord, Read, Show)--_QualifiedName = (Core.Name "hydra/ext/haskell/ast.QualifiedName")--_QualifiedName_qualifiers = (Core.FieldName "qualifiers")--_QualifiedName_unqualified = (Core.FieldName "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 |- 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.FieldName "application")--_Type_function = (Core.FieldName "function")--_Type_infix = (Core.FieldName "infix")--_Type_list = (Core.FieldName "list")--_Type_parens = (Core.FieldName "parens")--_Type_tuple = (Core.FieldName "tuple")--_Type_variable = (Core.FieldName "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.FieldName "context")--_Type_Application_argument = (Core.FieldName "argument")--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.FieldName "domain")--_Type_Function_codomain = (Core.FieldName "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.FieldName "lhs")--_Type_Infix_operator = (Core.FieldName "operator")--_Type_Infix_rhs = (Core.FieldName "rhs")--data TypeDeclaration = - TypeDeclaration {- typeDeclarationName :: DeclarationHead,- typeDeclarationType :: Type}- deriving (Eq, Ord, Read, Show)--_TypeDeclaration = (Core.Name "hydra/ext/haskell/ast.TypeDeclaration")--_TypeDeclaration_name = (Core.FieldName "name")--_TypeDeclaration_type = (Core.FieldName "type")--data TypeSignature = - TypeSignature {- typeSignatureName :: Name,- typeSignatureType :: Type}- deriving (Eq, Ord, Read, Show)--_TypeSignature = (Core.Name "hydra/ext/haskell/ast.TypeSignature")--_TypeSignature_name = (Core.FieldName "name")--_TypeSignature_type = (Core.FieldName "type")--data TypedBinding = - TypedBinding {- typedBindingTypeSignature :: TypeSignature,- typedBindingValueBinding :: ValueBinding}- deriving (Eq, Ord, Read, Show)--_TypedBinding = (Core.Name "hydra/ext/haskell/ast.TypedBinding")--_TypedBinding_typeSignature = (Core.FieldName "typeSignature")--_TypedBinding_valueBinding = (Core.FieldName "valueBinding")--data ValueBinding = - ValueBindingSimple ValueBinding_Simple- deriving (Eq, Ord, Read, Show)--_ValueBinding = (Core.Name "hydra/ext/haskell/ast.ValueBinding")--_ValueBinding_simple = (Core.FieldName "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.FieldName "pattern")--_ValueBinding_Simple_rhs = (Core.FieldName "rhs")--_ValueBinding_Simple_localBindings = (Core.FieldName "localBindings")--newtype Variable = - Variable {- unVariable :: Name}- deriving (Eq, Ord, Read, Show)--_Variable = (Core.Name "hydra/ext/haskell/ast.Variable")
− src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs
@@ -1,3280 +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.Ext.Java.Syntax where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set--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.FieldName "null")--_Literal_integer = (Core.FieldName "integer")--_Literal_floatingPoint = (Core.FieldName "floatingPoint")--_Literal_boolean = (Core.FieldName "boolean")--_Literal_character = (Core.FieldName "character")--_Literal_string = (Core.FieldName "string")---- | Note: this is an approximation which ignores encoding-newtype IntegerLiteral = - IntegerLiteral {- -- | Note: this is an approximation which ignores encoding- 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 {- -- | Note: this is an approximation which ignores encoding- 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 {- -- | Note: this is an approximation which ignores encoding- 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.FieldName "primitive")--_Type_reference = (Core.FieldName "reference")--data PrimitiveTypeWithAnnotations = - PrimitiveTypeWithAnnotations {- primitiveTypeWithAnnotationsType :: PrimitiveType,- primitiveTypeWithAnnotationsAnnotations :: [Annotation]}- deriving (Eq, Ord, Read, Show)--_PrimitiveTypeWithAnnotations = (Core.Name "hydra/ext/java/syntax.PrimitiveTypeWithAnnotations")--_PrimitiveTypeWithAnnotations_type = (Core.FieldName "type")--_PrimitiveTypeWithAnnotations_annotations = (Core.FieldName "annotations")--data PrimitiveType = - PrimitiveTypeNumeric NumericType |- PrimitiveTypeBoolean - deriving (Eq, Ord, Read, Show)--_PrimitiveType = (Core.Name "hydra/ext/java/syntax.PrimitiveType")--_PrimitiveType_numeric = (Core.FieldName "numeric")--_PrimitiveType_boolean = (Core.FieldName "boolean")--data NumericType = - NumericTypeIntegral IntegralType |- NumericTypeFloatingPoint FloatingPointType- deriving (Eq, Ord, Read, Show)--_NumericType = (Core.Name "hydra/ext/java/syntax.NumericType")--_NumericType_integral = (Core.FieldName "integral")--_NumericType_floatingPoint = (Core.FieldName "floatingPoint")--data IntegralType = - IntegralTypeByte |- IntegralTypeShort |- IntegralTypeInt |- IntegralTypeLong |- IntegralTypeChar - deriving (Eq, Ord, Read, Show)--_IntegralType = (Core.Name "hydra/ext/java/syntax.IntegralType")--_IntegralType_byte = (Core.FieldName "byte")--_IntegralType_short = (Core.FieldName "short")--_IntegralType_int = (Core.FieldName "int")--_IntegralType_long = (Core.FieldName "long")--_IntegralType_char = (Core.FieldName "char")--data FloatingPointType = - FloatingPointTypeFloat |- FloatingPointTypeDouble - deriving (Eq, Ord, Read, Show)--_FloatingPointType = (Core.Name "hydra/ext/java/syntax.FloatingPointType")--_FloatingPointType_float = (Core.FieldName "float")--_FloatingPointType_double = (Core.FieldName "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.FieldName "classOrInterface")--_ReferenceType_variable = (Core.FieldName "variable")--_ReferenceType_array = (Core.FieldName "array")--data ClassOrInterfaceType = - ClassOrInterfaceTypeClass ClassType |- ClassOrInterfaceTypeInterface InterfaceType- deriving (Eq, Ord, Read, Show)--_ClassOrInterfaceType = (Core.Name "hydra/ext/java/syntax.ClassOrInterfaceType")--_ClassOrInterfaceType_class = (Core.FieldName "class")--_ClassOrInterfaceType_interface = (Core.FieldName "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.FieldName "annotations")--_ClassType_qualifier = (Core.FieldName "qualifier")--_ClassType_identifier = (Core.FieldName "identifier")--_ClassType_arguments = (Core.FieldName "arguments")--data ClassTypeQualifier = - ClassTypeQualifierNone |- ClassTypeQualifierPackage PackageName |- ClassTypeQualifierParent ClassOrInterfaceType- deriving (Eq, Ord, Read, Show)--_ClassTypeQualifier = (Core.Name "hydra/ext/java/syntax.ClassTypeQualifier")--_ClassTypeQualifier_none = (Core.FieldName "none")--_ClassTypeQualifier_package = (Core.FieldName "package")--_ClassTypeQualifier_parent = (Core.FieldName "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.FieldName "annotations")--_TypeVariable_identifier = (Core.FieldName "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.FieldName "dims")--_ArrayType_variant = (Core.FieldName "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.FieldName "primitive")--_ArrayType_Variant_classOrInterface = (Core.FieldName "classOrInterface")--_ArrayType_Variant_variable = (Core.FieldName "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.FieldName "modifiers")--_TypeParameter_identifier = (Core.FieldName "identifier")--_TypeParameter_bound = (Core.FieldName "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.FieldName "variable")--_TypeBound_classOrInterface = (Core.FieldName "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.FieldName "type")--_TypeBound_ClassOrInterface_additional = (Core.FieldName "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.FieldName "reference")--_TypeArgument_wildcard = (Core.FieldName "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.FieldName "annotations")--_Wildcard_wildcard = (Core.FieldName "wildcard")--data WildcardBounds = - WildcardBoundsExtends ReferenceType |- WildcardBoundsSuper ReferenceType- deriving (Eq, Ord, Read, Show)--_WildcardBounds = (Core.Name "hydra/ext/java/syntax.WildcardBounds")--_WildcardBounds_extends = (Core.FieldName "extends")--_WildcardBounds_super = (Core.FieldName "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.FieldName "identifier")--_ModuleName_name = (Core.FieldName "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.FieldName "identifier")--_TypeName_qualifier = (Core.FieldName "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.FieldName "qualifier")--_ExpressionName_identifier = (Core.FieldName "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.FieldName "ordinary")--_CompilationUnit_modular = (Core.FieldName "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.FieldName "package")--_OrdinaryCompilationUnit_imports = (Core.FieldName "imports")--_OrdinaryCompilationUnit_types = (Core.FieldName "types")--data ModularCompilationUnit = - ModularCompilationUnit {- modularCompilationUnitImports :: [ImportDeclaration],- modularCompilationUnitModule :: ModuleDeclaration}- deriving (Eq, Ord, Read, Show)--_ModularCompilationUnit = (Core.Name "hydra/ext/java/syntax.ModularCompilationUnit")--_ModularCompilationUnit_imports = (Core.FieldName "imports")--_ModularCompilationUnit_module = (Core.FieldName "module")--data PackageDeclaration = - PackageDeclaration {- packageDeclarationModifiers :: [PackageModifier],- packageDeclarationIdentifiers :: [Identifier]}- deriving (Eq, Ord, Read, Show)--_PackageDeclaration = (Core.Name "hydra/ext/java/syntax.PackageDeclaration")--_PackageDeclaration_modifiers = (Core.FieldName "modifiers")--_PackageDeclaration_identifiers = (Core.FieldName "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.FieldName "singleType")--_ImportDeclaration_typeImportOnDemand = (Core.FieldName "typeImportOnDemand")--_ImportDeclaration_singleStaticImport = (Core.FieldName "singleStaticImport")--_ImportDeclaration_staticImportOnDemand = (Core.FieldName "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.FieldName "typeName")--_SingleStaticImportDeclaration_identifier = (Core.FieldName "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.FieldName "class")--_TypeDeclaration_interface = (Core.FieldName "interface")--_TypeDeclaration_none = (Core.FieldName "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.FieldName "value")--_TypeDeclarationWithComments_comments = (Core.FieldName "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.FieldName "annotations")--_ModuleDeclaration_open = (Core.FieldName "open")--_ModuleDeclaration_identifiers = (Core.FieldName "identifiers")--_ModuleDeclaration_directives = (Core.FieldName "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.FieldName "requires")--_ModuleDirective_exports = (Core.FieldName "exports")--_ModuleDirective_opens = (Core.FieldName "opens")--_ModuleDirective_uses = (Core.FieldName "uses")--_ModuleDirective_provides = (Core.FieldName "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.FieldName "modifiers")--_ModuleDirective_Requires_module = (Core.FieldName "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.FieldName "package")--_ModuleDirective_ExportsOrOpens_modules = (Core.FieldName "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.FieldName "to")--_ModuleDirective_Provides_with = (Core.FieldName "with")--data RequiresModifier = - RequiresModifierTransitive |- RequiresModifierStatic - deriving (Eq, Ord, Read, Show)--_RequiresModifier = (Core.Name "hydra/ext/java/syntax.RequiresModifier")--_RequiresModifier_transitive = (Core.FieldName "transitive")--_RequiresModifier_static = (Core.FieldName "static")--data ClassDeclaration = - ClassDeclarationNormal NormalClassDeclaration |- ClassDeclarationEnum EnumDeclaration- deriving (Eq, Ord, Read, Show)--_ClassDeclaration = (Core.Name "hydra/ext/java/syntax.ClassDeclaration")--_ClassDeclaration_normal = (Core.FieldName "normal")--_ClassDeclaration_enum = (Core.FieldName "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.FieldName "modifiers")--_NormalClassDeclaration_identifier = (Core.FieldName "identifier")--_NormalClassDeclaration_parameters = (Core.FieldName "parameters")--_NormalClassDeclaration_extends = (Core.FieldName "extends")--_NormalClassDeclaration_implements = (Core.FieldName "implements")--_NormalClassDeclaration_body = (Core.FieldName "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.FieldName "annotation")--_ClassModifier_public = (Core.FieldName "public")--_ClassModifier_protected = (Core.FieldName "protected")--_ClassModifier_private = (Core.FieldName "private")--_ClassModifier_abstract = (Core.FieldName "abstract")--_ClassModifier_static = (Core.FieldName "static")--_ClassModifier_final = (Core.FieldName "final")--_ClassModifier_strictfp = (Core.FieldName "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.FieldName "classMember")--_ClassBodyDeclaration_instanceInitializer = (Core.FieldName "instanceInitializer")--_ClassBodyDeclaration_staticInitializer = (Core.FieldName "staticInitializer")--_ClassBodyDeclaration_constructorDeclaration = (Core.FieldName "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.FieldName "value")--_ClassBodyDeclarationWithComments_comments = (Core.FieldName "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.FieldName "field")--_ClassMemberDeclaration_method = (Core.FieldName "method")--_ClassMemberDeclaration_class = (Core.FieldName "class")--_ClassMemberDeclaration_interface = (Core.FieldName "interface")--_ClassMemberDeclaration_none = (Core.FieldName "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.FieldName "modifiers")--_FieldDeclaration_unannType = (Core.FieldName "unannType")--_FieldDeclaration_variableDeclarators = (Core.FieldName "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.FieldName "annotation")--_FieldModifier_public = (Core.FieldName "public")--_FieldModifier_protected = (Core.FieldName "protected")--_FieldModifier_private = (Core.FieldName "private")--_FieldModifier_static = (Core.FieldName "static")--_FieldModifier_final = (Core.FieldName "final")--_FieldModifier_transient = (Core.FieldName "transient")--_FieldModifier_volatile = (Core.FieldName "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.FieldName "id")--_VariableDeclarator_initializer = (Core.FieldName "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.FieldName "identifier")--_VariableDeclaratorId_dims = (Core.FieldName "dims")--data VariableInitializer = - VariableInitializerExpression Expression |- VariableInitializerArrayInitializer ArrayInitializer- deriving (Eq, Ord, Read, Show)--_VariableInitializer = (Core.Name "hydra/ext/java/syntax.VariableInitializer")--_VariableInitializer_expression = (Core.FieldName "expression")--_VariableInitializer_arrayInitializer = (Core.FieldName "arrayInitializer")---- | A Type which does not allow annotations-newtype UnannType = - UnannType {- -- | A Type which does not allow annotations- 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 {- -- | A ClassType which does not allow annotations- 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.FieldName "annotations")--_MethodDeclaration_modifiers = (Core.FieldName "modifiers")--_MethodDeclaration_header = (Core.FieldName "header")--_MethodDeclaration_body = (Core.FieldName "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.FieldName "annotation")--_MethodModifier_public = (Core.FieldName "public")--_MethodModifier_protected = (Core.FieldName "protected")--_MethodModifier_private = (Core.FieldName "private")--_MethodModifier_abstract = (Core.FieldName "abstract")--_MethodModifier_static = (Core.FieldName "static")--_MethodModifier_final = (Core.FieldName "final")--_MethodModifier_synchronized = (Core.FieldName "synchronized")--_MethodModifier_native = (Core.FieldName "native")--_MethodModifier_strictfb = (Core.FieldName "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.FieldName "parameters")--_MethodHeader_result = (Core.FieldName "result")--_MethodHeader_declarator = (Core.FieldName "declarator")--_MethodHeader_throws = (Core.FieldName "throws")--data Result = - ResultType UnannType |- ResultVoid - deriving (Eq, Ord, Read, Show)--_Result = (Core.Name "hydra/ext/java/syntax.Result")--_Result_type = (Core.FieldName "type")--_Result_void = (Core.FieldName "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.FieldName "identifier")--_MethodDeclarator_receiverParameter = (Core.FieldName "receiverParameter")--_MethodDeclarator_formalParameters = (Core.FieldName "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.FieldName "annotations")--_ReceiverParameter_unannType = (Core.FieldName "unannType")--_ReceiverParameter_identifier = (Core.FieldName "identifier")--data FormalParameter = - FormalParameterSimple FormalParameter_Simple |- FormalParameterVariableArity VariableArityParameter- deriving (Eq, Ord, Read, Show)--_FormalParameter = (Core.Name "hydra/ext/java/syntax.FormalParameter")--_FormalParameter_simple = (Core.FieldName "simple")--_FormalParameter_variableArity = (Core.FieldName "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.FieldName "modifiers")--_FormalParameter_Simple_type = (Core.FieldName "type")--_FormalParameter_Simple_id = (Core.FieldName "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.FieldName "modifiers")--_VariableArityParameter_type = (Core.FieldName "type")--_VariableArityParameter_annotations = (Core.FieldName "annotations")--_VariableArityParameter_identifier = (Core.FieldName "identifier")--data VariableModifier = - VariableModifierAnnotation Annotation |- VariableModifierFinal - deriving (Eq, Ord, Read, Show)--_VariableModifier = (Core.Name "hydra/ext/java/syntax.VariableModifier")--_VariableModifier_annotation = (Core.FieldName "annotation")--_VariableModifier_final = (Core.FieldName "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.FieldName "class")--_ExceptionType_variable = (Core.FieldName "variable")--data MethodBody = - MethodBodyBlock Block |- MethodBodyNone - deriving (Eq, Ord, Read, Show)--_MethodBody = (Core.Name "hydra/ext/java/syntax.MethodBody")--_MethodBody_block = (Core.FieldName "block")--_MethodBody_none = (Core.FieldName "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.FieldName "modifiers")--_ConstructorDeclaration_constructor = (Core.FieldName "constructor")--_ConstructorDeclaration_throws = (Core.FieldName "throws")--_ConstructorDeclaration_body = (Core.FieldName "body")--data ConstructorModifier = - ConstructorModifierAnnotation Annotation |- ConstructorModifierPublic |- ConstructorModifierProtected |- ConstructorModifierPrivate - deriving (Eq, Ord, Read, Show)--_ConstructorModifier = (Core.Name "hydra/ext/java/syntax.ConstructorModifier")--_ConstructorModifier_annotation = (Core.FieldName "annotation")--_ConstructorModifier_public = (Core.FieldName "public")--_ConstructorModifier_protected = (Core.FieldName "protected")--_ConstructorModifier_private = (Core.FieldName "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.FieldName "parameters")--_ConstructorDeclarator_name = (Core.FieldName "name")--_ConstructorDeclarator_receiverParameter = (Core.FieldName "receiverParameter")--_ConstructorDeclarator_formalParameters = (Core.FieldName "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.FieldName "invocation")--_ConstructorBody_statements = (Core.FieldName "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.FieldName "typeArguments")--_ExplicitConstructorInvocation_arguments = (Core.FieldName "arguments")--_ExplicitConstructorInvocation_variant = (Core.FieldName "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.FieldName "this")--_ExplicitConstructorInvocation_Variant_super = (Core.FieldName "super")--_ExplicitConstructorInvocation_Variant_primary = (Core.FieldName "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.FieldName "modifiers")--_EnumDeclaration_identifier = (Core.FieldName "identifier")--_EnumDeclaration_implements = (Core.FieldName "implements")--_EnumDeclaration_body = (Core.FieldName "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.FieldName "constants")--_EnumBody_Element_bodyDeclarations = (Core.FieldName "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.FieldName "modifiers")--_EnumConstant_identifier = (Core.FieldName "identifier")--_EnumConstant_arguments = (Core.FieldName "arguments")--_EnumConstant_body = (Core.FieldName "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.FieldName "normalInterface")--_InterfaceDeclaration_annotationType = (Core.FieldName "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.FieldName "modifiers")--_NormalInterfaceDeclaration_identifier = (Core.FieldName "identifier")--_NormalInterfaceDeclaration_parameters = (Core.FieldName "parameters")--_NormalInterfaceDeclaration_extends = (Core.FieldName "extends")--_NormalInterfaceDeclaration_body = (Core.FieldName "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.FieldName "annotation")--_InterfaceModifier_public = (Core.FieldName "public")--_InterfaceModifier_protected = (Core.FieldName "protected")--_InterfaceModifier_private = (Core.FieldName "private")--_InterfaceModifier_abstract = (Core.FieldName "abstract")--_InterfaceModifier_static = (Core.FieldName "static")--_InterfaceModifier_strictfb = (Core.FieldName "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.FieldName "constant")--_InterfaceMemberDeclaration_interfaceMethod = (Core.FieldName "interfaceMethod")--_InterfaceMemberDeclaration_class = (Core.FieldName "class")--_InterfaceMemberDeclaration_interface = (Core.FieldName "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.FieldName "modifiers")--_ConstantDeclaration_type = (Core.FieldName "type")--_ConstantDeclaration_variables = (Core.FieldName "variables")--data ConstantModifier = - ConstantModifierAnnotation Annotation |- ConstantModifierPublic |- ConstantModifierStatic |- ConstantModifierFinal - deriving (Eq, Ord, Read, Show)--_ConstantModifier = (Core.Name "hydra/ext/java/syntax.ConstantModifier")--_ConstantModifier_annotation = (Core.FieldName "annotation")--_ConstantModifier_public = (Core.FieldName "public")--_ConstantModifier_static = (Core.FieldName "static")--_ConstantModifier_final = (Core.FieldName "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.FieldName "modifiers")--_InterfaceMethodDeclaration_header = (Core.FieldName "header")--_InterfaceMethodDeclaration_body = (Core.FieldName "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.FieldName "annotation")--_InterfaceMethodModifier_public = (Core.FieldName "public")--_InterfaceMethodModifier_private = (Core.FieldName "private")--_InterfaceMethodModifier_abstract = (Core.FieldName "abstract")--_InterfaceMethodModifier_default = (Core.FieldName "default")--_InterfaceMethodModifier_static = (Core.FieldName "static")--_InterfaceMethodModifier_strictfp = (Core.FieldName "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.FieldName "modifiers")--_AnnotationTypeDeclaration_identifier = (Core.FieldName "identifier")--_AnnotationTypeDeclaration_body = (Core.FieldName "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.FieldName "annotationType")--_AnnotationTypeMemberDeclaration_constant = (Core.FieldName "constant")--_AnnotationTypeMemberDeclaration_class = (Core.FieldName "class")--_AnnotationTypeMemberDeclaration_interface = (Core.FieldName "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.FieldName "modifiers")--_AnnotationTypeElementDeclaration_type = (Core.FieldName "type")--_AnnotationTypeElementDeclaration_identifier = (Core.FieldName "identifier")--_AnnotationTypeElementDeclaration_dims = (Core.FieldName "dims")--_AnnotationTypeElementDeclaration_default = (Core.FieldName "default")--data AnnotationTypeElementModifier = - AnnotationTypeElementModifierPublic Annotation |- AnnotationTypeElementModifierAbstract - deriving (Eq, Ord, Read, Show)--_AnnotationTypeElementModifier = (Core.Name "hydra/ext/java/syntax.AnnotationTypeElementModifier")--_AnnotationTypeElementModifier_public = (Core.FieldName "public")--_AnnotationTypeElementModifier_abstract = (Core.FieldName "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.FieldName "normal")--_Annotation_marker = (Core.FieldName "marker")--_Annotation_singleElement = (Core.FieldName "singleElement")--data NormalAnnotation = - NormalAnnotation {- normalAnnotationTypeName :: TypeName,- normalAnnotationPairs :: [ElementValuePair]}- deriving (Eq, Ord, Read, Show)--_NormalAnnotation = (Core.Name "hydra/ext/java/syntax.NormalAnnotation")--_NormalAnnotation_typeName = (Core.FieldName "typeName")--_NormalAnnotation_pairs = (Core.FieldName "pairs")--data ElementValuePair = - ElementValuePair {- elementValuePairKey :: Identifier,- elementValuePairValue :: ElementValue}- deriving (Eq, Ord, Read, Show)--_ElementValuePair = (Core.Name "hydra/ext/java/syntax.ElementValuePair")--_ElementValuePair_key = (Core.FieldName "key")--_ElementValuePair_value = (Core.FieldName "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.FieldName "conditionalExpression")--_ElementValue_elementValueArrayInitializer = (Core.FieldName "elementValueArrayInitializer")--_ElementValue_annotation = (Core.FieldName "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.FieldName "name")--_SingleElementAnnotation_value = (Core.FieldName "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.FieldName "localVariableDeclaration")--_BlockStatement_class = (Core.FieldName "class")--_BlockStatement_statement = (Core.FieldName "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.FieldName "modifiers")--_LocalVariableDeclaration_type = (Core.FieldName "type")--_LocalVariableDeclaration_declarators = (Core.FieldName "declarators")--data LocalVariableType = - LocalVariableTypeType UnannType |- LocalVariableTypeVar - deriving (Eq, Ord, Read, Show)--_LocalVariableType = (Core.Name "hydra/ext/java/syntax.LocalVariableType")--_LocalVariableType_type = (Core.FieldName "type")--_LocalVariableType_var = (Core.FieldName "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.FieldName "withoutTrailing")--_Statement_labeled = (Core.FieldName "labeled")--_Statement_ifThen = (Core.FieldName "ifThen")--_Statement_ifThenElse = (Core.FieldName "ifThenElse")--_Statement_while = (Core.FieldName "while")--_Statement_for = (Core.FieldName "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.FieldName "withoutTrailing")--_StatementNoShortIf_labeled = (Core.FieldName "labeled")--_StatementNoShortIf_ifThenElse = (Core.FieldName "ifThenElse")--_StatementNoShortIf_while = (Core.FieldName "while")--_StatementNoShortIf_for = (Core.FieldName "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.FieldName "block")--_StatementWithoutTrailingSubstatement_empty = (Core.FieldName "empty")--_StatementWithoutTrailingSubstatement_expression = (Core.FieldName "expression")--_StatementWithoutTrailingSubstatement_assert = (Core.FieldName "assert")--_StatementWithoutTrailingSubstatement_switch = (Core.FieldName "switch")--_StatementWithoutTrailingSubstatement_do = (Core.FieldName "do")--_StatementWithoutTrailingSubstatement_break = (Core.FieldName "break")--_StatementWithoutTrailingSubstatement_continue = (Core.FieldName "continue")--_StatementWithoutTrailingSubstatement_return = (Core.FieldName "return")--_StatementWithoutTrailingSubstatement_synchronized = (Core.FieldName "synchronized")--_StatementWithoutTrailingSubstatement_throw = (Core.FieldName "throw")--_StatementWithoutTrailingSubstatement_try = (Core.FieldName "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.FieldName "identifier")--_LabeledStatement_statement = (Core.FieldName "statement")--data LabeledStatementNoShortIf = - LabeledStatementNoShortIf {- labeledStatementNoShortIfIdentifier :: Identifier,- labeledStatementNoShortIfStatement :: StatementNoShortIf}- deriving (Eq, Ord, Read, Show)--_LabeledStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.LabeledStatementNoShortIf")--_LabeledStatementNoShortIf_identifier = (Core.FieldName "identifier")--_LabeledStatementNoShortIf_statement = (Core.FieldName "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.FieldName "assignment")--_StatementExpression_preIncrement = (Core.FieldName "preIncrement")--_StatementExpression_preDecrement = (Core.FieldName "preDecrement")--_StatementExpression_postIncrement = (Core.FieldName "postIncrement")--_StatementExpression_postDecrement = (Core.FieldName "postDecrement")--_StatementExpression_methodInvocation = (Core.FieldName "methodInvocation")--_StatementExpression_classInstanceCreation = (Core.FieldName "classInstanceCreation")--data IfThenStatement = - IfThenStatement {- ifThenStatementExpression :: Expression,- ifThenStatementStatement :: Statement}- deriving (Eq, Ord, Read, Show)--_IfThenStatement = (Core.Name "hydra/ext/java/syntax.IfThenStatement")--_IfThenStatement_expression = (Core.FieldName "expression")--_IfThenStatement_statement = (Core.FieldName "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.FieldName "cond")--_IfThenElseStatement_then = (Core.FieldName "then")--_IfThenElseStatement_else = (Core.FieldName "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.FieldName "cond")--_IfThenElseStatementNoShortIf_then = (Core.FieldName "then")--_IfThenElseStatementNoShortIf_else = (Core.FieldName "else")--data AssertStatement = - AssertStatementSingle Expression |- AssertStatementPair AssertStatement_Pair- deriving (Eq, Ord, Read, Show)--_AssertStatement = (Core.Name "hydra/ext/java/syntax.AssertStatement")--_AssertStatement_single = (Core.FieldName "single")--_AssertStatement_pair = (Core.FieldName "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.FieldName "first")--_AssertStatement_Pair_second = (Core.FieldName "second")--data SwitchStatement = - SwitchStatement {- switchStatementCond :: Expression,- switchStatementBlock :: SwitchBlock}- deriving (Eq, Ord, Read, Show)--_SwitchStatement = (Core.Name "hydra/ext/java/syntax.SwitchStatement")--_SwitchStatement_cond = (Core.FieldName "cond")--_SwitchStatement_block = (Core.FieldName "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.FieldName "statements")--_SwitchBlock_Pair_labels = (Core.FieldName "labels")--data SwitchBlockStatementGroup = - SwitchBlockStatementGroup {- switchBlockStatementGroupLabels :: [SwitchLabel],- switchBlockStatementGroupStatements :: [BlockStatement]}- deriving (Eq, Ord, Read, Show)--_SwitchBlockStatementGroup = (Core.Name "hydra/ext/java/syntax.SwitchBlockStatementGroup")--_SwitchBlockStatementGroup_labels = (Core.FieldName "labels")--_SwitchBlockStatementGroup_statements = (Core.FieldName "statements")--data SwitchLabel = - SwitchLabelConstant ConstantExpression |- SwitchLabelEnumConstant EnumConstantName |- SwitchLabelDefault - deriving (Eq, Ord, Read, Show)--_SwitchLabel = (Core.Name "hydra/ext/java/syntax.SwitchLabel")--_SwitchLabel_constant = (Core.FieldName "constant")--_SwitchLabel_enumConstant = (Core.FieldName "enumConstant")--_SwitchLabel_default = (Core.FieldName "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.FieldName "cond")--_WhileStatement_body = (Core.FieldName "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.FieldName "cond")--_WhileStatementNoShortIf_body = (Core.FieldName "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.FieldName "body")--_DoStatement_conde = (Core.FieldName "conde")--data ForStatement = - ForStatementBasic BasicForStatement |- ForStatementEnhanced EnhancedForStatement- deriving (Eq, Ord, Read, Show)--_ForStatement = (Core.Name "hydra/ext/java/syntax.ForStatement")--_ForStatement_basic = (Core.FieldName "basic")--_ForStatement_enhanced = (Core.FieldName "enhanced")--data ForStatementNoShortIf = - ForStatementNoShortIfBasic BasicForStatementNoShortIf |- ForStatementNoShortIfEnhanced EnhancedForStatementNoShortIf- deriving (Eq, Ord, Read, Show)--_ForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.ForStatementNoShortIf")--_ForStatementNoShortIf_basic = (Core.FieldName "basic")--_ForStatementNoShortIf_enhanced = (Core.FieldName "enhanced")--data BasicForStatement = - BasicForStatement {- basicForStatementCond :: ForCond,- basicForStatementBody :: Statement}- deriving (Eq, Ord, Read, Show)--_BasicForStatement = (Core.Name "hydra/ext/java/syntax.BasicForStatement")--_BasicForStatement_cond = (Core.FieldName "cond")--_BasicForStatement_body = (Core.FieldName "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.FieldName "init")--_ForCond_cond = (Core.FieldName "cond")--_ForCond_update = (Core.FieldName "update")--data BasicForStatementNoShortIf = - BasicForStatementNoShortIf {- basicForStatementNoShortIfCond :: ForCond,- basicForStatementNoShortIfBody :: StatementNoShortIf}- deriving (Eq, Ord, Read, Show)--_BasicForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.BasicForStatementNoShortIf")--_BasicForStatementNoShortIf_cond = (Core.FieldName "cond")--_BasicForStatementNoShortIf_body = (Core.FieldName "body")--data ForInit = - ForInitStatements [StatementExpression] |- ForInitLocalVariable LocalVariableDeclaration- deriving (Eq, Ord, Read, Show)--_ForInit = (Core.Name "hydra/ext/java/syntax.ForInit")--_ForInit_statements = (Core.FieldName "statements")--_ForInit_localVariable = (Core.FieldName "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.FieldName "cond")--_EnhancedForStatement_body = (Core.FieldName "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.FieldName "modifiers")--_EnhancedForCond_type = (Core.FieldName "type")--_EnhancedForCond_id = (Core.FieldName "id")--_EnhancedForCond_expression = (Core.FieldName "expression")--data EnhancedForStatementNoShortIf = - EnhancedForStatementNoShortIf {- enhancedForStatementNoShortIfCond :: EnhancedForCond,- enhancedForStatementNoShortIfBody :: StatementNoShortIf}- deriving (Eq, Ord, Read, Show)--_EnhancedForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.EnhancedForStatementNoShortIf")--_EnhancedForStatementNoShortIf_cond = (Core.FieldName "cond")--_EnhancedForStatementNoShortIf_body = (Core.FieldName "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.FieldName "expression")--_SynchronizedStatement_block = (Core.FieldName "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.FieldName "simple")--_TryStatement_withFinally = (Core.FieldName "withFinally")--_TryStatement_withResources = (Core.FieldName "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.FieldName "block")--_TryStatement_Simple_catches = (Core.FieldName "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.FieldName "block")--_TryStatement_WithFinally_catches = (Core.FieldName "catches")--_TryStatement_WithFinally_finally = (Core.FieldName "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.FieldName "parameter")--_CatchClause_block = (Core.FieldName "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.FieldName "modifiers")--_CatchFormalParameter_type = (Core.FieldName "type")--_CatchFormalParameter_id = (Core.FieldName "id")--data CatchType = - CatchType {- catchTypeType :: UnannClassType,- catchTypeTypes :: [ClassType]}- deriving (Eq, Ord, Read, Show)--_CatchType = (Core.Name "hydra/ext/java/syntax.CatchType")--_CatchType_type = (Core.FieldName "type")--_CatchType_types = (Core.FieldName "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.FieldName "resourceSpecification")--_TryWithResourcesStatement_block = (Core.FieldName "block")--_TryWithResourcesStatement_catches = (Core.FieldName "catches")--_TryWithResourcesStatement_finally = (Core.FieldName "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.FieldName "local")--_Resource_variable = (Core.FieldName "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.FieldName "modifiers")--_Resource_Local_type = (Core.FieldName "type")--_Resource_Local_identifier = (Core.FieldName "identifier")--_Resource_Local_expression = (Core.FieldName "expression")--data VariableAccess = - VariableAccessExpressionName ExpressionName |- VariableAccessFieldAccess FieldAccess- deriving (Eq, Ord, Read, Show)--_VariableAccess = (Core.Name "hydra/ext/java/syntax.VariableAccess")--_VariableAccess_expressionName = (Core.FieldName "expressionName")--_VariableAccess_fieldAccess = (Core.FieldName "fieldAccess")--data Primary = - PrimaryNoNewArray PrimaryNoNewArray |- PrimaryArrayCreation ArrayCreationExpression- deriving (Eq, Ord, Read, Show)--_Primary = (Core.Name "hydra/ext/java/syntax.Primary")--_Primary_noNewArray = (Core.FieldName "noNewArray")--_Primary_arrayCreation = (Core.FieldName "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.FieldName "literal")--_PrimaryNoNewArray_classLiteral = (Core.FieldName "classLiteral")--_PrimaryNoNewArray_this = (Core.FieldName "this")--_PrimaryNoNewArray_dotThis = (Core.FieldName "dotThis")--_PrimaryNoNewArray_parens = (Core.FieldName "parens")--_PrimaryNoNewArray_classInstance = (Core.FieldName "classInstance")--_PrimaryNoNewArray_fieldAccess = (Core.FieldName "fieldAccess")--_PrimaryNoNewArray_arrayAccess = (Core.FieldName "arrayAccess")--_PrimaryNoNewArray_methodInvocation = (Core.FieldName "methodInvocation")--_PrimaryNoNewArray_methodReference = (Core.FieldName "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.FieldName "type")--_ClassLiteral_numericType = (Core.FieldName "numericType")--_ClassLiteral_boolean = (Core.FieldName "boolean")--_ClassLiteral_void = (Core.FieldName "void")--data TypeNameArray = - TypeNameArraySimple TypeName |- TypeNameArrayArray TypeNameArray- deriving (Eq, Ord, Read, Show)--_TypeNameArray = (Core.Name "hydra/ext/java/syntax.TypeNameArray")--_TypeNameArray_simple = (Core.FieldName "simple")--_TypeNameArray_array = (Core.FieldName "array")--data NumericTypeArray = - NumericTypeArraySimple NumericType |- NumericTypeArrayArray NumericTypeArray- deriving (Eq, Ord, Read, Show)--_NumericTypeArray = (Core.Name "hydra/ext/java/syntax.NumericTypeArray")--_NumericTypeArray_simple = (Core.FieldName "simple")--_NumericTypeArray_array = (Core.FieldName "array")--data BooleanArray = - BooleanArraySimple |- BooleanArrayArray BooleanArray- deriving (Eq, Ord, Read, Show)--_BooleanArray = (Core.Name "hydra/ext/java/syntax.BooleanArray")--_BooleanArray_simple = (Core.FieldName "simple")--_BooleanArray_array = (Core.FieldName "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.FieldName "qualifier")--_ClassInstanceCreationExpression_expression = (Core.FieldName "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.FieldName "expression")--_ClassInstanceCreationExpression_Qualifier_primary = (Core.FieldName "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.FieldName "typeArguments")--_UnqualifiedClassInstanceCreationExpression_classOrInterface = (Core.FieldName "classOrInterface")--_UnqualifiedClassInstanceCreationExpression_arguments = (Core.FieldName "arguments")--_UnqualifiedClassInstanceCreationExpression_body = (Core.FieldName "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.FieldName "identifiers")--_ClassOrInterfaceTypeToInstantiate_typeArguments = (Core.FieldName "typeArguments")--data AnnotatedIdentifier = - AnnotatedIdentifier {- annotatedIdentifierAnnotations :: [Annotation],- annotatedIdentifierIdentifier :: Identifier}- deriving (Eq, Ord, Read, Show)--_AnnotatedIdentifier = (Core.Name "hydra/ext/java/syntax.AnnotatedIdentifier")--_AnnotatedIdentifier_annotations = (Core.FieldName "annotations")--_AnnotatedIdentifier_identifier = (Core.FieldName "identifier")--data TypeArgumentsOrDiamond = - TypeArgumentsOrDiamondArguments [TypeArgument] |- TypeArgumentsOrDiamondDiamond - deriving (Eq, Ord, Read, Show)--_TypeArgumentsOrDiamond = (Core.Name "hydra/ext/java/syntax.TypeArgumentsOrDiamond")--_TypeArgumentsOrDiamond_arguments = (Core.FieldName "arguments")--_TypeArgumentsOrDiamond_diamond = (Core.FieldName "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.FieldName "qualifier")--_FieldAccess_identifier = (Core.FieldName "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.FieldName "primary")--_FieldAccess_Qualifier_super = (Core.FieldName "super")--_FieldAccess_Qualifier_typed = (Core.FieldName "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.FieldName "expression")--_ArrayAccess_variant = (Core.FieldName "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.FieldName "name")--_ArrayAccess_Variant_primary = (Core.FieldName "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.FieldName "header")--_MethodInvocation_arguments = (Core.FieldName "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.FieldName "simple")--_MethodInvocation_Header_complex = (Core.FieldName "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.FieldName "variant")--_MethodInvocation_Complex_typeArguments = (Core.FieldName "typeArguments")--_MethodInvocation_Complex_identifier = (Core.FieldName "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.FieldName "type")--_MethodInvocation_Variant_expression = (Core.FieldName "expression")--_MethodInvocation_Variant_primary = (Core.FieldName "primary")--_MethodInvocation_Variant_super = (Core.FieldName "super")--_MethodInvocation_Variant_typeSuper = (Core.FieldName "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.FieldName "expression")--_MethodReference_primary = (Core.FieldName "primary")--_MethodReference_referenceType = (Core.FieldName "referenceType")--_MethodReference_super = (Core.FieldName "super")--_MethodReference_new = (Core.FieldName "new")--_MethodReference_array = (Core.FieldName "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.FieldName "name")--_MethodReference_Expression_typeArguments = (Core.FieldName "typeArguments")--_MethodReference_Expression_identifier = (Core.FieldName "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.FieldName "primary")--_MethodReference_Primary_typeArguments = (Core.FieldName "typeArguments")--_MethodReference_Primary_identifier = (Core.FieldName "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.FieldName "referenceType")--_MethodReference_ReferenceType_typeArguments = (Core.FieldName "typeArguments")--_MethodReference_ReferenceType_identifier = (Core.FieldName "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.FieldName "typeArguments")--_MethodReference_Super_identifier = (Core.FieldName "identifier")--_MethodReference_Super_super = (Core.FieldName "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.FieldName "classType")--_MethodReference_New_typeArguments = (Core.FieldName "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.FieldName "primitive")--_ArrayCreationExpression_classOrInterface = (Core.FieldName "classOrInterface")--_ArrayCreationExpression_primitiveArray = (Core.FieldName "primitiveArray")--_ArrayCreationExpression_classOrInterfaceArray = (Core.FieldName "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.FieldName "type")--_ArrayCreationExpression_Primitive_dimExprs = (Core.FieldName "dimExprs")--_ArrayCreationExpression_Primitive_dims = (Core.FieldName "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.FieldName "type")--_ArrayCreationExpression_ClassOrInterface_dimExprs = (Core.FieldName "dimExprs")--_ArrayCreationExpression_ClassOrInterface_dims = (Core.FieldName "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.FieldName "type")--_ArrayCreationExpression_PrimitiveArray_dims = (Core.FieldName "dims")--_ArrayCreationExpression_PrimitiveArray_array = (Core.FieldName "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.FieldName "type")--_ArrayCreationExpression_ClassOrInterfaceArray_dims = (Core.FieldName "dims")--_ArrayCreationExpression_ClassOrInterfaceArray_array = (Core.FieldName "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.FieldName "annotations")--_DimExpr_expression = (Core.FieldName "expression")--data Expression = - ExpressionLambda LambdaExpression |- ExpressionAssignment AssignmentExpression- deriving (Eq, Ord, Read, Show)--_Expression = (Core.Name "hydra/ext/java/syntax.Expression")--_Expression_lambda = (Core.FieldName "lambda")--_Expression_assignment = (Core.FieldName "assignment")--data LambdaExpression = - LambdaExpression {- lambdaExpressionParameters :: LambdaParameters,- lambdaExpressionBody :: LambdaBody}- deriving (Eq, Ord, Read, Show)--_LambdaExpression = (Core.Name "hydra/ext/java/syntax.LambdaExpression")--_LambdaExpression_parameters = (Core.FieldName "parameters")--_LambdaExpression_body = (Core.FieldName "body")--data LambdaParameters = - LambdaParametersTuple [LambdaParameters] |- LambdaParametersSingle Identifier- deriving (Eq, Ord, Read, Show)--_LambdaParameters = (Core.Name "hydra/ext/java/syntax.LambdaParameters")--_LambdaParameters_tuple = (Core.FieldName "tuple")--_LambdaParameters_single = (Core.FieldName "single")--data LambdaParameter = - LambdaParameterNormal LambdaParameter_Normal |- LambdaParameterVariableArity VariableArityParameter- deriving (Eq, Ord, Read, Show)--_LambdaParameter = (Core.Name "hydra/ext/java/syntax.LambdaParameter")--_LambdaParameter_normal = (Core.FieldName "normal")--_LambdaParameter_variableArity = (Core.FieldName "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.FieldName "modifiers")--_LambdaParameter_Normal_type = (Core.FieldName "type")--_LambdaParameter_Normal_id = (Core.FieldName "id")--data LambdaParameterType = - LambdaParameterTypeType UnannType |- LambdaParameterTypeVar - deriving (Eq, Ord, Read, Show)--_LambdaParameterType = (Core.Name "hydra/ext/java/syntax.LambdaParameterType")--_LambdaParameterType_type = (Core.FieldName "type")--_LambdaParameterType_var = (Core.FieldName "var")--data LambdaBody = - LambdaBodyExpression Expression |- LambdaBodyBlock Block- deriving (Eq, Ord, Read, Show)--_LambdaBody = (Core.Name "hydra/ext/java/syntax.LambdaBody")--_LambdaBody_expression = (Core.FieldName "expression")--_LambdaBody_block = (Core.FieldName "block")--data AssignmentExpression = - AssignmentExpressionConditional ConditionalExpression |- AssignmentExpressionAssignment Assignment- deriving (Eq, Ord, Read, Show)--_AssignmentExpression = (Core.Name "hydra/ext/java/syntax.AssignmentExpression")--_AssignmentExpression_conditional = (Core.FieldName "conditional")--_AssignmentExpression_assignment = (Core.FieldName "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.FieldName "lhs")--_Assignment_op = (Core.FieldName "op")--_Assignment_expression = (Core.FieldName "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.FieldName "expressionName")--_LeftHandSide_fieldAccess = (Core.FieldName "fieldAccess")--_LeftHandSide_arrayAccess = (Core.FieldName "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.FieldName "simple")--_AssignmentOperator_times = (Core.FieldName "times")--_AssignmentOperator_div = (Core.FieldName "div")--_AssignmentOperator_mod = (Core.FieldName "mod")--_AssignmentOperator_plus = (Core.FieldName "plus")--_AssignmentOperator_minus = (Core.FieldName "minus")--_AssignmentOperator_shiftLeft = (Core.FieldName "shiftLeft")--_AssignmentOperator_shiftRight = (Core.FieldName "shiftRight")--_AssignmentOperator_shiftRightZeroFill = (Core.FieldName "shiftRightZeroFill")--_AssignmentOperator_and = (Core.FieldName "and")--_AssignmentOperator_xor = (Core.FieldName "xor")--_AssignmentOperator_or = (Core.FieldName "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.FieldName "simple")--_ConditionalExpression_ternaryCond = (Core.FieldName "ternaryCond")--_ConditionalExpression_ternaryLambda = (Core.FieldName "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.FieldName "cond")--_ConditionalExpression_TernaryCond_ifTrue = (Core.FieldName "ifTrue")--_ConditionalExpression_TernaryCond_ifFalse = (Core.FieldName "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.FieldName "cond")--_ConditionalExpression_TernaryLambda_ifTrue = (Core.FieldName "ifTrue")--_ConditionalExpression_TernaryLambda_ifFalse = (Core.FieldName "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.FieldName "unary")--_EqualityExpression_equal = (Core.FieldName "equal")--_EqualityExpression_notEqual = (Core.FieldName "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.FieldName "lhs")--_EqualityExpression_Binary_rhs = (Core.FieldName "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.FieldName "simple")--_RelationalExpression_lessThan = (Core.FieldName "lessThan")--_RelationalExpression_greaterThan = (Core.FieldName "greaterThan")--_RelationalExpression_lessThanEqual = (Core.FieldName "lessThanEqual")--_RelationalExpression_greaterThanEqual = (Core.FieldName "greaterThanEqual")--_RelationalExpression_instanceof = (Core.FieldName "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.FieldName "lhs")--_RelationalExpression_LessThan_rhs = (Core.FieldName "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.FieldName "lhs")--_RelationalExpression_GreaterThan_rhs = (Core.FieldName "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.FieldName "lhs")--_RelationalExpression_LessThanEqual_rhs = (Core.FieldName "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.FieldName "lhs")--_RelationalExpression_GreaterThanEqual_rhs = (Core.FieldName "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.FieldName "lhs")--_RelationalExpression_InstanceOf_rhs = (Core.FieldName "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.FieldName "unary")--_ShiftExpression_shiftLeft = (Core.FieldName "shiftLeft")--_ShiftExpression_shiftRight = (Core.FieldName "shiftRight")--_ShiftExpression_shiftRightZeroFill = (Core.FieldName "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.FieldName "lhs")--_ShiftExpression_Binary_rhs = (Core.FieldName "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.FieldName "unary")--_AdditiveExpression_plus = (Core.FieldName "plus")--_AdditiveExpression_minus = (Core.FieldName "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.FieldName "lhs")--_AdditiveExpression_Binary_rhs = (Core.FieldName "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.FieldName "unary")--_MultiplicativeExpression_times = (Core.FieldName "times")--_MultiplicativeExpression_divide = (Core.FieldName "divide")--_MultiplicativeExpression_mod = (Core.FieldName "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.FieldName "lhs")--_MultiplicativeExpression_Binary_rhs = (Core.FieldName "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.FieldName "preIncrement")--_UnaryExpression_preDecrement = (Core.FieldName "preDecrement")--_UnaryExpression_plus = (Core.FieldName "plus")--_UnaryExpression_minus = (Core.FieldName "minus")--_UnaryExpression_other = (Core.FieldName "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.FieldName "postfix")--_UnaryExpressionNotPlusMinus_tilde = (Core.FieldName "tilde")--_UnaryExpressionNotPlusMinus_not = (Core.FieldName "not")--_UnaryExpressionNotPlusMinus_cast = (Core.FieldName "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.FieldName "primary")--_PostfixExpression_name = (Core.FieldName "name")--_PostfixExpression_postIncrement = (Core.FieldName "postIncrement")--_PostfixExpression_postDecrement = (Core.FieldName "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.FieldName "primitive")--_CastExpression_notPlusMinus = (Core.FieldName "notPlusMinus")--_CastExpression_lambda = (Core.FieldName "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.FieldName "type")--_CastExpression_Primitive_expression = (Core.FieldName "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.FieldName "refAndBounds")--_CastExpression_NotPlusMinus_expression = (Core.FieldName "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.FieldName "refAndBounds")--_CastExpression_Lambda_expression = (Core.FieldName "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.FieldName "type")--_CastExpression_RefAndBounds_bounds = (Core.FieldName "bounds")--newtype ConstantExpression = - ConstantExpression {- unConstantExpression :: Expression}- deriving (Eq, Ord, Read, Show)--_ConstantExpression = (Core.Name "hydra/ext/java/syntax.ConstantExpression")
− src/gen-main/haskell/Hydra/Ext/Json/Model.hs
@@ -1,32 +0,0 @@--- | A JSON syntax model. See the BNF at https://www.json.org--module Hydra.Ext.Json.Model where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | A JSON value-data Value = - ValueArray [Value] |- ValueBoolean Bool |- ValueNull |- ValueNumber Double |- ValueObject (Map String Value) |- ValueString String- deriving (Eq, Ord, Read, Show)--_Value = (Core.Name "hydra/ext/json/model.Value")--_Value_array = (Core.FieldName "array")--_Value_boolean = (Core.FieldName "boolean")--_Value_null = (Core.FieldName "null")--_Value_number = (Core.FieldName "number")--_Value_object = (Core.FieldName "object")--_Value_string = (Core.FieldName "string")
− src/gen-main/haskell/Hydra/Ext/Owl/Syntax.hs
@@ -1,1211 +0,0 @@--- | An OWL 2 syntax model. See https://www.w3.org/TR/owl2-syntax--module Hydra.Ext.Owl.Syntax where--import qualified Hydra.Core as Core-import qualified Hydra.Ext.Rdf.Syntax as Syntax-import qualified Hydra.Ext.Xml.Schema as Schema-import Data.List-import Data.Map-import Data.Set--data Ontology = - Ontology {- ontologyDirectImports :: [Ontology],- ontologyAnnotations :: [Annotation],- ontologyAxioms :: [Axiom]}- deriving (Eq, Ord, Read, Show)--_Ontology = (Core.Name "hydra/ext/owl/syntax.Ontology")--_Ontology_directImports = (Core.FieldName "directImports")--_Ontology_annotations = (Core.FieldName "annotations")--_Ontology_axioms = (Core.FieldName "axioms")--data Declaration = - Declaration {- declarationAnnotations :: [Annotation],- declarationEntity :: Entity}- deriving (Eq, Ord, Read, Show)--_Declaration = (Core.Name "hydra/ext/owl/syntax.Declaration")--_Declaration_annotations = (Core.FieldName "annotations")--_Declaration_entity = (Core.FieldName "entity")--data Entity = - EntityAnnotationProperty AnnotationProperty |- EntityClass Class |- EntityDataProperty DataProperty |- EntityDatatype Datatype |- EntityNamedIndividual NamedIndividual |- EntityObjectProperty ObjectProperty- deriving (Eq, Ord, Read, Show)--_Entity = (Core.Name "hydra/ext/owl/syntax.Entity")--_Entity_annotationProperty = (Core.FieldName "annotationProperty")--_Entity_class = (Core.FieldName "class")--_Entity_dataProperty = (Core.FieldName "dataProperty")--_Entity_datatype = (Core.FieldName "datatype")--_Entity_namedIndividual = (Core.FieldName "namedIndividual")--_Entity_objectProperty = (Core.FieldName "objectProperty")--data AnnotationSubject = - AnnotationSubjectIri Syntax.Iri |- AnnotationSubjectAnonymousIndividual AnonymousIndividual- deriving (Eq, Ord, Read, Show)--_AnnotationSubject = (Core.Name "hydra/ext/owl/syntax.AnnotationSubject")--_AnnotationSubject_iri = (Core.FieldName "iri")--_AnnotationSubject_anonymousIndividual = (Core.FieldName "anonymousIndividual")--data AnnotationValue = - AnnotationValueAnonymousIndividual AnonymousIndividual |- AnnotationValueIri Syntax.Iri |- AnnotationValueLiteral Syntax.Literal- deriving (Eq, Ord, Read, Show)--_AnnotationValue = (Core.Name "hydra/ext/owl/syntax.AnnotationValue")--_AnnotationValue_anonymousIndividual = (Core.FieldName "anonymousIndividual")--_AnnotationValue_iri = (Core.FieldName "iri")--_AnnotationValue_literal = (Core.FieldName "literal")--data Annotation = - Annotation {- annotationAnnotations :: [Annotation],- annotationProperty :: AnnotationProperty,- annotationValue :: AnnotationValue}- deriving (Eq, Ord, Read, Show)--_Annotation = (Core.Name "hydra/ext/owl/syntax.Annotation")--_Annotation_annotations = (Core.FieldName "annotations")--_Annotation_property = (Core.FieldName "property")--_Annotation_value = (Core.FieldName "value")--data AnnotationAxiom = - AnnotationAxiomAnnotationAssertion AnnotationAssertion |- AnnotationAxiomAnnotationPropertyDomain AnnotationPropertyDomain |- AnnotationAxiomAnnotationPropertyRange AnnotationPropertyRange |- AnnotationAxiomSubAnnotationPropertyOf SubAnnotationPropertyOf- deriving (Eq, Ord, Read, Show)--_AnnotationAxiom = (Core.Name "hydra/ext/owl/syntax.AnnotationAxiom")--_AnnotationAxiom_annotationAssertion = (Core.FieldName "annotationAssertion")--_AnnotationAxiom_annotationPropertyDomain = (Core.FieldName "annotationPropertyDomain")--_AnnotationAxiom_annotationPropertyRange = (Core.FieldName "annotationPropertyRange")--_AnnotationAxiom_subAnnotationPropertyOf = (Core.FieldName "subAnnotationPropertyOf")--data AnnotationAssertion = - AnnotationAssertion {- annotationAssertionAnnotations :: [Annotation],- annotationAssertionProperty :: AnnotationProperty,- annotationAssertionSubject :: AnnotationSubject,- annotationAssertionValue :: AnnotationValue}- deriving (Eq, Ord, Read, Show)--_AnnotationAssertion = (Core.Name "hydra/ext/owl/syntax.AnnotationAssertion")--_AnnotationAssertion_annotations = (Core.FieldName "annotations")--_AnnotationAssertion_property = (Core.FieldName "property")--_AnnotationAssertion_subject = (Core.FieldName "subject")--_AnnotationAssertion_value = (Core.FieldName "value")--data SubAnnotationPropertyOf = - SubAnnotationPropertyOf {- subAnnotationPropertyOfAnnotations :: [Annotation],- subAnnotationPropertyOfSubProperty :: AnnotationProperty,- subAnnotationPropertyOfSuperProperty :: AnnotationProperty}- deriving (Eq, Ord, Read, Show)--_SubAnnotationPropertyOf = (Core.Name "hydra/ext/owl/syntax.SubAnnotationPropertyOf")--_SubAnnotationPropertyOf_annotations = (Core.FieldName "annotations")--_SubAnnotationPropertyOf_subProperty = (Core.FieldName "subProperty")--_SubAnnotationPropertyOf_superProperty = (Core.FieldName "superProperty")--data AnnotationPropertyDomain = - AnnotationPropertyDomain {- annotationPropertyDomainAnnotations :: [Annotation],- annotationPropertyDomainProperty :: AnnotationProperty,- annotationPropertyDomainIri :: Syntax.Iri}- deriving (Eq, Ord, Read, Show)--_AnnotationPropertyDomain = (Core.Name "hydra/ext/owl/syntax.AnnotationPropertyDomain")--_AnnotationPropertyDomain_annotations = (Core.FieldName "annotations")--_AnnotationPropertyDomain_property = (Core.FieldName "property")--_AnnotationPropertyDomain_iri = (Core.FieldName "iri")--data AnnotationPropertyRange = - AnnotationPropertyRange {- annotationPropertyRangeAnnotations :: [Annotation],- annotationPropertyRangeProperty :: AnnotationProperty,- annotationPropertyRangeIri :: Syntax.Iri}- deriving (Eq, Ord, Read, Show)--_AnnotationPropertyRange = (Core.Name "hydra/ext/owl/syntax.AnnotationPropertyRange")--_AnnotationPropertyRange_annotations = (Core.FieldName "annotations")--_AnnotationPropertyRange_property = (Core.FieldName "property")--_AnnotationPropertyRange_iri = (Core.FieldName "iri")---- | See https://www.w3.org/TR/owl2-syntax/#Classes-data Class = - Class {}- deriving (Eq, Ord, Read, Show)--_Class = (Core.Name "hydra/ext/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/ext/owl/syntax.Datatype")--_Datatype_xmlSchema = (Core.FieldName "xmlSchema")--_Datatype_other = (Core.FieldName "other")---- | See https://www.w3.org/TR/owl2-syntax/#Object_Properties-data ObjectProperty = - ObjectProperty {}- deriving (Eq, Ord, Read, Show)--_ObjectProperty = (Core.Name "hydra/ext/owl/syntax.ObjectProperty")--data DataProperty = - DataProperty {}- deriving (Eq, Ord, Read, Show)--_DataProperty = (Core.Name "hydra/ext/owl/syntax.DataProperty")--data AnnotationProperty = - AnnotationProperty {}- deriving (Eq, Ord, Read, Show)--_AnnotationProperty = (Core.Name "hydra/ext/owl/syntax.AnnotationProperty")--data Individual = - IndividualNamed NamedIndividual |- IndividualAnonymous AnonymousIndividual- deriving (Eq, Ord, Read, Show)--_Individual = (Core.Name "hydra/ext/owl/syntax.Individual")--_Individual_named = (Core.FieldName "named")--_Individual_anonymous = (Core.FieldName "anonymous")--data NamedIndividual = - NamedIndividual {}- deriving (Eq, Ord, Read, Show)--_NamedIndividual = (Core.Name "hydra/ext/owl/syntax.NamedIndividual")--data AnonymousIndividual = - AnonymousIndividual {}- deriving (Eq, Ord, Read, Show)--_AnonymousIndividual = (Core.Name "hydra/ext/owl/syntax.AnonymousIndividual")--data ObjectPropertyExpression = - ObjectPropertyExpressionObject ObjectProperty |- ObjectPropertyExpressionInverseObject InverseObjectProperty- deriving (Eq, Ord, Read, Show)--_ObjectPropertyExpression = (Core.Name "hydra/ext/owl/syntax.ObjectPropertyExpression")--_ObjectPropertyExpression_object = (Core.FieldName "object")--_ObjectPropertyExpression_inverseObject = (Core.FieldName "inverseObject")--newtype InverseObjectProperty = - InverseObjectProperty {- unInverseObjectProperty :: ObjectProperty}- deriving (Eq, Ord, Read, Show)--_InverseObjectProperty = (Core.Name "hydra/ext/owl/syntax.InverseObjectProperty")--newtype DataPropertyExpression = - DataPropertyExpression {- unDataPropertyExpression :: DataProperty}- deriving (Eq, Ord, Read, Show)--_DataPropertyExpression = (Core.Name "hydra/ext/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/ext/owl/syntax.DataRange")--_DataRange_dataComplementOf = (Core.FieldName "dataComplementOf")--_DataRange_dataIntersectionOf = (Core.FieldName "dataIntersectionOf")--_DataRange_dataOneOf = (Core.FieldName "dataOneOf")--_DataRange_dataUnionOf = (Core.FieldName "dataUnionOf")--_DataRange_datatype = (Core.FieldName "datatype")--_DataRange_datatypeRestriction = (Core.FieldName "datatypeRestriction")---- | See https://www.w3.org/TR/owl2-syntax/#Intersection_of_Data_Ranges-newtype DataIntersectionOf = - DataIntersectionOf {- -- | See https://www.w3.org/TR/owl2-syntax/#Intersection_of_Data_Ranges- unDataIntersectionOf :: [DataRange]}- deriving (Eq, Ord, Read, Show)--_DataIntersectionOf = (Core.Name "hydra/ext/owl/syntax.DataIntersectionOf")---- | See https://www.w3.org/TR/owl2-syntax/#Union_of_Data_Ranges-newtype DataUnionOf = - DataUnionOf {- -- | See https://www.w3.org/TR/owl2-syntax/#Union_of_Data_Ranges- unDataUnionOf :: [DataRange]}- deriving (Eq, Ord, Read, Show)--_DataUnionOf = (Core.Name "hydra/ext/owl/syntax.DataUnionOf")---- | See https://www.w3.org/TR/owl2-syntax/#Complement_of_Data_Ranges-newtype DataComplementOf = - DataComplementOf {- -- | See https://www.w3.org/TR/owl2-syntax/#Complement_of_Data_Ranges- unDataComplementOf :: DataRange}- deriving (Eq, Ord, Read, Show)--_DataComplementOf = (Core.Name "hydra/ext/owl/syntax.DataComplementOf")---- | See https://www.w3.org/TR/owl2-syntax/#Enumeration_of_Literals-newtype DataOneOf = - DataOneOf {- -- | See https://www.w3.org/TR/owl2-syntax/#Enumeration_of_Literals- unDataOneOf :: [Syntax.Literal]}- deriving (Eq, Ord, Read, Show)--_DataOneOf = (Core.Name "hydra/ext/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/ext/owl/syntax.DatatypeRestriction")--_DatatypeRestriction_datatype = (Core.FieldName "datatype")--_DatatypeRestriction_constraints = (Core.FieldName "constraints")--data DatatypeRestriction_Constraint = - DatatypeRestriction_Constraint {- datatypeRestriction_ConstraintConstrainingFacet :: DatatypeRestriction_ConstrainingFacet,- datatypeRestriction_ConstraintRestrictionValue :: Syntax.Literal}- deriving (Eq, Ord, Read, Show)--_DatatypeRestriction_Constraint = (Core.Name "hydra/ext/owl/syntax.DatatypeRestriction.Constraint")--_DatatypeRestriction_Constraint_constrainingFacet = (Core.FieldName "constrainingFacet")--_DatatypeRestriction_Constraint_restrictionValue = (Core.FieldName "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/ext/owl/syntax.DatatypeRestriction.ConstrainingFacet")--_DatatypeRestriction_ConstrainingFacet_xmlSchema = (Core.FieldName "xmlSchema")--_DatatypeRestriction_ConstrainingFacet_other = (Core.FieldName "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/ext/owl/syntax.ClassExpression")--_ClassExpression_class = (Core.FieldName "class")--_ClassExpression_dataSomeValuesFrom = (Core.FieldName "dataSomeValuesFrom")--_ClassExpression_dataAllValuesFrom = (Core.FieldName "dataAllValuesFrom")--_ClassExpression_dataHasValue = (Core.FieldName "dataHasValue")--_ClassExpression_dataMinCardinality = (Core.FieldName "dataMinCardinality")--_ClassExpression_dataMaxCardinality = (Core.FieldName "dataMaxCardinality")--_ClassExpression_dataExactCardinality = (Core.FieldName "dataExactCardinality")--_ClassExpression_objectAllValuesFrom = (Core.FieldName "objectAllValuesFrom")--_ClassExpression_objectExactCardinality = (Core.FieldName "objectExactCardinality")--_ClassExpression_objectHasSelf = (Core.FieldName "objectHasSelf")--_ClassExpression_objectHasValue = (Core.FieldName "objectHasValue")--_ClassExpression_objectIntersectionOf = (Core.FieldName "objectIntersectionOf")--_ClassExpression_objectMaxCardinality = (Core.FieldName "objectMaxCardinality")--_ClassExpression_objectMinCardinality = (Core.FieldName "objectMinCardinality")--_ClassExpression_objectOneOf = (Core.FieldName "objectOneOf")--_ClassExpression_objectSomeValuesFrom = (Core.FieldName "objectSomeValuesFrom")--_ClassExpression_objectUnionOf = (Core.FieldName "objectUnionOf")--newtype ObjectIntersectionOf = - ObjectIntersectionOf {- unObjectIntersectionOf :: [ClassExpression]}- deriving (Eq, Ord, Read, Show)--_ObjectIntersectionOf = (Core.Name "hydra/ext/owl/syntax.ObjectIntersectionOf")--newtype ObjectUnionOf = - ObjectUnionOf {- unObjectUnionOf :: [ClassExpression]}- deriving (Eq, Ord, Read, Show)--_ObjectUnionOf = (Core.Name "hydra/ext/owl/syntax.ObjectUnionOf")--newtype ObjectComplementOf = - ObjectComplementOf {- unObjectComplementOf :: ClassExpression}- deriving (Eq, Ord, Read, Show)--_ObjectComplementOf = (Core.Name "hydra/ext/owl/syntax.ObjectComplementOf")--newtype ObjectOneOf = - ObjectOneOf {- unObjectOneOf :: [Individual]}- deriving (Eq, Ord, Read, Show)--_ObjectOneOf = (Core.Name "hydra/ext/owl/syntax.ObjectOneOf")--data ObjectSomeValuesFrom = - ObjectSomeValuesFrom {- objectSomeValuesFromProperty :: ObjectPropertyExpression,- objectSomeValuesFromClass :: ClassExpression}- deriving (Eq, Ord, Read, Show)--_ObjectSomeValuesFrom = (Core.Name "hydra/ext/owl/syntax.ObjectSomeValuesFrom")--_ObjectSomeValuesFrom_property = (Core.FieldName "property")--_ObjectSomeValuesFrom_class = (Core.FieldName "class")--data ObjectAllValuesFrom = - ObjectAllValuesFrom {- objectAllValuesFromProperty :: ObjectPropertyExpression,- objectAllValuesFromClass :: ClassExpression}- deriving (Eq, Ord, Read, Show)--_ObjectAllValuesFrom = (Core.Name "hydra/ext/owl/syntax.ObjectAllValuesFrom")--_ObjectAllValuesFrom_property = (Core.FieldName "property")--_ObjectAllValuesFrom_class = (Core.FieldName "class")--data ObjectHasValue = - ObjectHasValue {- objectHasValueProperty :: ObjectPropertyExpression,- objectHasValueIndividual :: Individual}- deriving (Eq, Ord, Read, Show)--_ObjectHasValue = (Core.Name "hydra/ext/owl/syntax.ObjectHasValue")--_ObjectHasValue_property = (Core.FieldName "property")--_ObjectHasValue_individual = (Core.FieldName "individual")--newtype ObjectHasSelf = - ObjectHasSelf {- unObjectHasSelf :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_ObjectHasSelf = (Core.Name "hydra/ext/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/ext/owl/syntax.ObjectMinCardinality")--_ObjectMinCardinality_bound = (Core.FieldName "bound")--_ObjectMinCardinality_property = (Core.FieldName "property")--_ObjectMinCardinality_class = (Core.FieldName "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/ext/owl/syntax.ObjectMaxCardinality")--_ObjectMaxCardinality_bound = (Core.FieldName "bound")--_ObjectMaxCardinality_property = (Core.FieldName "property")--_ObjectMaxCardinality_class = (Core.FieldName "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/ext/owl/syntax.ObjectExactCardinality")--_ObjectExactCardinality_bound = (Core.FieldName "bound")--_ObjectExactCardinality_property = (Core.FieldName "property")--_ObjectExactCardinality_class = (Core.FieldName "class")--data DataSomeValuesFrom = - DataSomeValuesFrom {- dataSomeValuesFromProperty :: [DataPropertyExpression],- dataSomeValuesFromRange :: DataRange}- deriving (Eq, Ord, Read, Show)--_DataSomeValuesFrom = (Core.Name "hydra/ext/owl/syntax.DataSomeValuesFrom")--_DataSomeValuesFrom_property = (Core.FieldName "property")--_DataSomeValuesFrom_range = (Core.FieldName "range")--data DataAllValuesFrom = - DataAllValuesFrom {- dataAllValuesFromProperty :: [DataPropertyExpression],- dataAllValuesFromRange :: DataRange}- deriving (Eq, Ord, Read, Show)--_DataAllValuesFrom = (Core.Name "hydra/ext/owl/syntax.DataAllValuesFrom")--_DataAllValuesFrom_property = (Core.FieldName "property")--_DataAllValuesFrom_range = (Core.FieldName "range")--data DataHasValue = - DataHasValue {- dataHasValueProperty :: DataPropertyExpression,- dataHasValueValue :: Syntax.Literal}- deriving (Eq, Ord, Read, Show)--_DataHasValue = (Core.Name "hydra/ext/owl/syntax.DataHasValue")--_DataHasValue_property = (Core.FieldName "property")--_DataHasValue_value = (Core.FieldName "value")--data DataMinCardinality = - DataMinCardinality {- dataMinCardinalityBound :: Integer,- dataMinCardinalityProperty :: DataPropertyExpression,- dataMinCardinalityRange :: [DataRange]}- deriving (Eq, Ord, Read, Show)--_DataMinCardinality = (Core.Name "hydra/ext/owl/syntax.DataMinCardinality")--_DataMinCardinality_bound = (Core.FieldName "bound")--_DataMinCardinality_property = (Core.FieldName "property")--_DataMinCardinality_range = (Core.FieldName "range")--data DataMaxCardinality = - DataMaxCardinality {- dataMaxCardinalityBound :: Integer,- dataMaxCardinalityProperty :: DataPropertyExpression,- dataMaxCardinalityRange :: [DataRange]}- deriving (Eq, Ord, Read, Show)--_DataMaxCardinality = (Core.Name "hydra/ext/owl/syntax.DataMaxCardinality")--_DataMaxCardinality_bound = (Core.FieldName "bound")--_DataMaxCardinality_property = (Core.FieldName "property")--_DataMaxCardinality_range = (Core.FieldName "range")--data DataExactCardinality = - DataExactCardinality {- dataExactCardinalityBound :: Integer,- dataExactCardinalityProperty :: DataPropertyExpression,- dataExactCardinalityRange :: [DataRange]}- deriving (Eq, Ord, Read, Show)--_DataExactCardinality = (Core.Name "hydra/ext/owl/syntax.DataExactCardinality")--_DataExactCardinality_bound = (Core.FieldName "bound")--_DataExactCardinality_property = (Core.FieldName "property")--_DataExactCardinality_range = (Core.FieldName "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/ext/owl/syntax.Axiom")--_Axiom_annotationAxiom = (Core.FieldName "annotationAxiom")--_Axiom_assertion = (Core.FieldName "assertion")--_Axiom_classAxiom = (Core.FieldName "classAxiom")--_Axiom_dataPropertyAxiom = (Core.FieldName "dataPropertyAxiom")--_Axiom_datatypeDefinition = (Core.FieldName "datatypeDefinition")--_Axiom_declaration = (Core.FieldName "declaration")--_Axiom_hasKey = (Core.FieldName "hasKey")--_Axiom_objectPropertyAxiom = (Core.FieldName "objectPropertyAxiom")--data ClassAxiom = - ClassAxiomDisjointClasses DisjointClasses |- ClassAxiomDisjointUnion DisjointUnion |- ClassAxiomEquivalentClasses EquivalentClasses |- ClassAxiomSubClassOf SubClassOf- deriving (Eq, Ord, Read, Show)--_ClassAxiom = (Core.Name "hydra/ext/owl/syntax.ClassAxiom")--_ClassAxiom_disjointClasses = (Core.FieldName "disjointClasses")--_ClassAxiom_disjointUnion = (Core.FieldName "disjointUnion")--_ClassAxiom_equivalentClasses = (Core.FieldName "equivalentClasses")--_ClassAxiom_subClassOf = (Core.FieldName "subClassOf")--data SubClassOf = - SubClassOf {- subClassOfAnnotations :: [Annotation],- subClassOfSubClass :: ClassExpression,- subClassOfSuperClass :: ClassExpression}- deriving (Eq, Ord, Read, Show)--_SubClassOf = (Core.Name "hydra/ext/owl/syntax.SubClassOf")--_SubClassOf_annotations = (Core.FieldName "annotations")--_SubClassOf_subClass = (Core.FieldName "subClass")--_SubClassOf_superClass = (Core.FieldName "superClass")--data EquivalentClasses = - EquivalentClasses {- equivalentClassesAnnotations :: [Annotation],- equivalentClassesClasses :: [ClassExpression]}- deriving (Eq, Ord, Read, Show)--_EquivalentClasses = (Core.Name "hydra/ext/owl/syntax.EquivalentClasses")--_EquivalentClasses_annotations = (Core.FieldName "annotations")--_EquivalentClasses_classes = (Core.FieldName "classes")--data DisjointClasses = - DisjointClasses {- disjointClassesAnnotations :: [Annotation],- disjointClassesClasses :: [ClassExpression]}- deriving (Eq, Ord, Read, Show)--_DisjointClasses = (Core.Name "hydra/ext/owl/syntax.DisjointClasses")--_DisjointClasses_annotations = (Core.FieldName "annotations")--_DisjointClasses_classes = (Core.FieldName "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/ext/owl/syntax.DisjointUnion")--_DisjointUnion_annotations = (Core.FieldName "annotations")--_DisjointUnion_class = (Core.FieldName "class")--_DisjointUnion_classes = (Core.FieldName "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/ext/owl/syntax.ObjectPropertyAxiom")--_ObjectPropertyAxiom_asymmetricObjectProperty = (Core.FieldName "asymmetricObjectProperty")--_ObjectPropertyAxiom_disjointObjectProperties = (Core.FieldName "disjointObjectProperties")--_ObjectPropertyAxiom_equivalentObjectProperties = (Core.FieldName "equivalentObjectProperties")--_ObjectPropertyAxiom_functionalObjectProperty = (Core.FieldName "functionalObjectProperty")--_ObjectPropertyAxiom_inverseFunctionalObjectProperty = (Core.FieldName "inverseFunctionalObjectProperty")--_ObjectPropertyAxiom_inverseObjectProperties = (Core.FieldName "inverseObjectProperties")--_ObjectPropertyAxiom_irreflexiveObjectProperty = (Core.FieldName "irreflexiveObjectProperty")--_ObjectPropertyAxiom_objectPropertyDomain = (Core.FieldName "objectPropertyDomain")--_ObjectPropertyAxiom_objectPropertyRange = (Core.FieldName "objectPropertyRange")--_ObjectPropertyAxiom_reflexiveObjectProperty = (Core.FieldName "reflexiveObjectProperty")--_ObjectPropertyAxiom_subObjectPropertyOf = (Core.FieldName "subObjectPropertyOf")--_ObjectPropertyAxiom_symmetricObjectProperty = (Core.FieldName "symmetricObjectProperty")--_ObjectPropertyAxiom_transitiveObjectProperty = (Core.FieldName "transitiveObjectProperty")--data SubObjectPropertyOf = - SubObjectPropertyOf {- subObjectPropertyOfAnnotations :: [Annotation],- subObjectPropertyOfSubProperty :: [ObjectPropertyExpression],- subObjectPropertyOfSuperProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_SubObjectPropertyOf = (Core.Name "hydra/ext/owl/syntax.SubObjectPropertyOf")--_SubObjectPropertyOf_annotations = (Core.FieldName "annotations")--_SubObjectPropertyOf_subProperty = (Core.FieldName "subProperty")--_SubObjectPropertyOf_superProperty = (Core.FieldName "superProperty")--data EquivalentObjectProperties = - EquivalentObjectProperties {- equivalentObjectPropertiesAnnotations :: [Annotation],- equivalentObjectPropertiesProperties :: [ObjectPropertyExpression]}- deriving (Eq, Ord, Read, Show)--_EquivalentObjectProperties = (Core.Name "hydra/ext/owl/syntax.EquivalentObjectProperties")--_EquivalentObjectProperties_annotations = (Core.FieldName "annotations")--_EquivalentObjectProperties_properties = (Core.FieldName "properties")--data DisjointObjectProperties = - DisjointObjectProperties {- disjointObjectPropertiesAnnotations :: [Annotation],- disjointObjectPropertiesProperties :: [ObjectPropertyExpression]}- deriving (Eq, Ord, Read, Show)--_DisjointObjectProperties = (Core.Name "hydra/ext/owl/syntax.DisjointObjectProperties")--_DisjointObjectProperties_annotations = (Core.FieldName "annotations")--_DisjointObjectProperties_properties = (Core.FieldName "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/ext/owl/syntax.ObjectPropertyDomain")--_ObjectPropertyDomain_annotations = (Core.FieldName "annotations")--_ObjectPropertyDomain_property = (Core.FieldName "property")--_ObjectPropertyDomain_domain = (Core.FieldName "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/ext/owl/syntax.ObjectPropertyRange")--_ObjectPropertyRange_annotations = (Core.FieldName "annotations")--_ObjectPropertyRange_property = (Core.FieldName "property")--_ObjectPropertyRange_range = (Core.FieldName "range")--data InverseObjectProperties = - InverseObjectProperties {- inverseObjectPropertiesAnnotations :: [Annotation],- inverseObjectPropertiesProperty1 :: ObjectPropertyExpression,- inverseObjectPropertiesProperty2 :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_InverseObjectProperties = (Core.Name "hydra/ext/owl/syntax.InverseObjectProperties")--_InverseObjectProperties_annotations = (Core.FieldName "annotations")--_InverseObjectProperties_property1 = (Core.FieldName "property1")--_InverseObjectProperties_property2 = (Core.FieldName "property2")--data FunctionalObjectProperty = - FunctionalObjectProperty {- functionalObjectPropertyAnnotations :: [Annotation],- functionalObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_FunctionalObjectProperty = (Core.Name "hydra/ext/owl/syntax.FunctionalObjectProperty")--_FunctionalObjectProperty_annotations = (Core.FieldName "annotations")--_FunctionalObjectProperty_property = (Core.FieldName "property")--data InverseFunctionalObjectProperty = - InverseFunctionalObjectProperty {- inverseFunctionalObjectPropertyAnnotations :: [Annotation],- inverseFunctionalObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_InverseFunctionalObjectProperty = (Core.Name "hydra/ext/owl/syntax.InverseFunctionalObjectProperty")--_InverseFunctionalObjectProperty_annotations = (Core.FieldName "annotations")--_InverseFunctionalObjectProperty_property = (Core.FieldName "property")--data ReflexiveObjectProperty = - ReflexiveObjectProperty {- reflexiveObjectPropertyAnnotations :: [Annotation],- reflexiveObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_ReflexiveObjectProperty = (Core.Name "hydra/ext/owl/syntax.ReflexiveObjectProperty")--_ReflexiveObjectProperty_annotations = (Core.FieldName "annotations")--_ReflexiveObjectProperty_property = (Core.FieldName "property")--data IrreflexiveObjectProperty = - IrreflexiveObjectProperty {- irreflexiveObjectPropertyAnnotations :: [Annotation],- irreflexiveObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_IrreflexiveObjectProperty = (Core.Name "hydra/ext/owl/syntax.IrreflexiveObjectProperty")--_IrreflexiveObjectProperty_annotations = (Core.FieldName "annotations")--_IrreflexiveObjectProperty_property = (Core.FieldName "property")--data SymmetricObjectProperty = - SymmetricObjectProperty {- symmetricObjectPropertyAnnotations :: [Annotation],- symmetricObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_SymmetricObjectProperty = (Core.Name "hydra/ext/owl/syntax.SymmetricObjectProperty")--_SymmetricObjectProperty_annotations = (Core.FieldName "annotations")--_SymmetricObjectProperty_property = (Core.FieldName "property")--data AsymmetricObjectProperty = - AsymmetricObjectProperty {- asymmetricObjectPropertyAnnotations :: [Annotation],- asymmetricObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_AsymmetricObjectProperty = (Core.Name "hydra/ext/owl/syntax.AsymmetricObjectProperty")--_AsymmetricObjectProperty_annotations = (Core.FieldName "annotations")--_AsymmetricObjectProperty_property = (Core.FieldName "property")--data TransitiveObjectProperty = - TransitiveObjectProperty {- transitiveObjectPropertyAnnotations :: [Annotation],- transitiveObjectPropertyProperty :: ObjectPropertyExpression}- deriving (Eq, Ord, Read, Show)--_TransitiveObjectProperty = (Core.Name "hydra/ext/owl/syntax.TransitiveObjectProperty")--_TransitiveObjectProperty_annotations = (Core.FieldName "annotations")--_TransitiveObjectProperty_property = (Core.FieldName "property")--data DataPropertyAxiom = - DataPropertyAxiomDataPropertyAxiom DataPropertyAxiom |- DataPropertyAxiomDataPropertyRange DataPropertyRange |- DataPropertyAxiomDisjointDataProperties DisjointDataProperties |- DataPropertyAxiomEquivalentDataProperties EquivalentDataProperties |- DataPropertyAxiomFunctionalDataProperty FunctionalDataProperty |- DataPropertyAxiomSubDataPropertyOf SubDataPropertyOf- deriving (Eq, Ord, Read, Show)--_DataPropertyAxiom = (Core.Name "hydra/ext/owl/syntax.DataPropertyAxiom")--_DataPropertyAxiom_dataPropertyAxiom = (Core.FieldName "dataPropertyAxiom")--_DataPropertyAxiom_dataPropertyRange = (Core.FieldName "dataPropertyRange")--_DataPropertyAxiom_disjointDataProperties = (Core.FieldName "disjointDataProperties")--_DataPropertyAxiom_equivalentDataProperties = (Core.FieldName "equivalentDataProperties")--_DataPropertyAxiom_functionalDataProperty = (Core.FieldName "functionalDataProperty")--_DataPropertyAxiom_subDataPropertyOf = (Core.FieldName "subDataPropertyOf")--data SubDataPropertyOf = - SubDataPropertyOf {- subDataPropertyOfAnnotations :: [Annotation],- subDataPropertyOfSubProperty :: DataPropertyExpression,- subDataPropertyOfSuperProperty :: DataPropertyExpression}- deriving (Eq, Ord, Read, Show)--_SubDataPropertyOf = (Core.Name "hydra/ext/owl/syntax.SubDataPropertyOf")--_SubDataPropertyOf_annotations = (Core.FieldName "annotations")--_SubDataPropertyOf_subProperty = (Core.FieldName "subProperty")--_SubDataPropertyOf_superProperty = (Core.FieldName "superProperty")--data EquivalentDataProperties = - EquivalentDataProperties {- equivalentDataPropertiesAnnotations :: [Annotation],- equivalentDataPropertiesProperties :: [DataPropertyExpression]}- deriving (Eq, Ord, Read, Show)--_EquivalentDataProperties = (Core.Name "hydra/ext/owl/syntax.EquivalentDataProperties")--_EquivalentDataProperties_annotations = (Core.FieldName "annotations")--_EquivalentDataProperties_properties = (Core.FieldName "properties")--data DisjointDataProperties = - DisjointDataProperties {- disjointDataPropertiesAnnotations :: [Annotation],- disjointDataPropertiesProperties :: [DataPropertyExpression]}- deriving (Eq, Ord, Read, Show)--_DisjointDataProperties = (Core.Name "hydra/ext/owl/syntax.DisjointDataProperties")--_DisjointDataProperties_annotations = (Core.FieldName "annotations")--_DisjointDataProperties_properties = (Core.FieldName "properties")--data DataPropertyDomain = - DataPropertyDomain {- dataPropertyDomainAnnotations :: [Annotation],- dataPropertyDomainProperty :: DataPropertyExpression,- dataPropertyDomainDomain :: ClassExpression}- deriving (Eq, Ord, Read, Show)--_DataPropertyDomain = (Core.Name "hydra/ext/owl/syntax.DataPropertyDomain")--_DataPropertyDomain_annotations = (Core.FieldName "annotations")--_DataPropertyDomain_property = (Core.FieldName "property")--_DataPropertyDomain_domain = (Core.FieldName "domain")--data DataPropertyRange = - DataPropertyRange {- dataPropertyRangeAnnotations :: [Annotation],- dataPropertyRangeProperty :: DataPropertyExpression,- dataPropertyRangeRange :: ClassExpression}- deriving (Eq, Ord, Read, Show)--_DataPropertyRange = (Core.Name "hydra/ext/owl/syntax.DataPropertyRange")--_DataPropertyRange_annotations = (Core.FieldName "annotations")--_DataPropertyRange_property = (Core.FieldName "property")--_DataPropertyRange_range = (Core.FieldName "range")--data FunctionalDataProperty = - FunctionalDataProperty {- functionalDataPropertyAnnotations :: [Annotation],- functionalDataPropertyProperty :: DataPropertyExpression}- deriving (Eq, Ord, Read, Show)--_FunctionalDataProperty = (Core.Name "hydra/ext/owl/syntax.FunctionalDataProperty")--_FunctionalDataProperty_annotations = (Core.FieldName "annotations")--_FunctionalDataProperty_property = (Core.FieldName "property")--data DatatypeDefinition = - DatatypeDefinition {- datatypeDefinitionAnnotations :: [Annotation],- datatypeDefinitionDatatype :: Datatype,- datatypeDefinitionRange :: DataRange}- deriving (Eq, Ord, Read, Show)--_DatatypeDefinition = (Core.Name "hydra/ext/owl/syntax.DatatypeDefinition")--_DatatypeDefinition_annotations = (Core.FieldName "annotations")--_DatatypeDefinition_datatype = (Core.FieldName "datatype")--_DatatypeDefinition_range = (Core.FieldName "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/ext/owl/syntax.HasKey")--_HasKey_annotations = (Core.FieldName "annotations")--_HasKey_class = (Core.FieldName "class")--_HasKey_objectProperties = (Core.FieldName "objectProperties")--_HasKey_dataProperties = (Core.FieldName "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/ext/owl/syntax.Assertion")--_Assertion_classAssertion = (Core.FieldName "classAssertion")--_Assertion_dataPropertyAssertion = (Core.FieldName "dataPropertyAssertion")--_Assertion_differentIndividuals = (Core.FieldName "differentIndividuals")--_Assertion_objectPropertyAssertion = (Core.FieldName "objectPropertyAssertion")--_Assertion_negativeDataPropertyAssertion = (Core.FieldName "negativeDataPropertyAssertion")--_Assertion_negativeObjectPropertyAssertion = (Core.FieldName "negativeObjectPropertyAssertion")--_Assertion_sameIndividual = (Core.FieldName "sameIndividual")--data SameIndividual = - SameIndividual {- sameIndividualAnnotations :: [Annotation],- sameIndividualIndividuals :: [Individual]}- deriving (Eq, Ord, Read, Show)--_SameIndividual = (Core.Name "hydra/ext/owl/syntax.SameIndividual")--_SameIndividual_annotations = (Core.FieldName "annotations")--_SameIndividual_individuals = (Core.FieldName "individuals")--data DifferentIndividuals = - DifferentIndividuals {- differentIndividualsAnnotations :: [Annotation],- differentIndividualsIndividuals :: [Individual]}- deriving (Eq, Ord, Read, Show)--_DifferentIndividuals = (Core.Name "hydra/ext/owl/syntax.DifferentIndividuals")--_DifferentIndividuals_annotations = (Core.FieldName "annotations")--_DifferentIndividuals_individuals = (Core.FieldName "individuals")--data ClassAssertion = - ClassAssertion {- classAssertionAnnotations :: [Annotation],- classAssertionClass :: ClassExpression,- classAssertionIndividual :: Individual}- deriving (Eq, Ord, Read, Show)--_ClassAssertion = (Core.Name "hydra/ext/owl/syntax.ClassAssertion")--_ClassAssertion_annotations = (Core.FieldName "annotations")--_ClassAssertion_class = (Core.FieldName "class")--_ClassAssertion_individual = (Core.FieldName "individual")--data ObjectPropertyAssertion = - ObjectPropertyAssertion {- objectPropertyAssertionAnnotations :: [Annotation],- objectPropertyAssertionProperty :: ObjectPropertyExpression,- objectPropertyAssertionSource :: Individual,- objectPropertyAssertionTarget :: Individual}- deriving (Eq, Ord, Read, Show)--_ObjectPropertyAssertion = (Core.Name "hydra/ext/owl/syntax.ObjectPropertyAssertion")--_ObjectPropertyAssertion_annotations = (Core.FieldName "annotations")--_ObjectPropertyAssertion_property = (Core.FieldName "property")--_ObjectPropertyAssertion_source = (Core.FieldName "source")--_ObjectPropertyAssertion_target = (Core.FieldName "target")--data NegativeObjectPropertyAssertion = - NegativeObjectPropertyAssertion {- negativeObjectPropertyAssertionAnnotations :: [Annotation],- negativeObjectPropertyAssertionProperty :: ObjectPropertyExpression,- negativeObjectPropertyAssertionSource :: Individual,- negativeObjectPropertyAssertionTarget :: Individual}- deriving (Eq, Ord, Read, Show)--_NegativeObjectPropertyAssertion = (Core.Name "hydra/ext/owl/syntax.NegativeObjectPropertyAssertion")--_NegativeObjectPropertyAssertion_annotations = (Core.FieldName "annotations")--_NegativeObjectPropertyAssertion_property = (Core.FieldName "property")--_NegativeObjectPropertyAssertion_source = (Core.FieldName "source")--_NegativeObjectPropertyAssertion_target = (Core.FieldName "target")--data DataPropertyAssertion = - DataPropertyAssertion {- dataPropertyAssertionAnnotations :: [Annotation],- dataPropertyAssertionProperty :: DataPropertyExpression,- dataPropertyAssertionSource :: Individual,- dataPropertyAssertionTarget :: Individual}- deriving (Eq, Ord, Read, Show)--_DataPropertyAssertion = (Core.Name "hydra/ext/owl/syntax.DataPropertyAssertion")--_DataPropertyAssertion_annotations = (Core.FieldName "annotations")--_DataPropertyAssertion_property = (Core.FieldName "property")--_DataPropertyAssertion_source = (Core.FieldName "source")--_DataPropertyAssertion_target = (Core.FieldName "target")--data NegativeDataPropertyAssertion = - NegativeDataPropertyAssertion {- negativeDataPropertyAssertionAnnotations :: [Annotation],- negativeDataPropertyAssertionProperty :: DataPropertyExpression,- negativeDataPropertyAssertionSource :: Individual,- negativeDataPropertyAssertionTarget :: Individual}- deriving (Eq, Ord, Read, Show)--_NegativeDataPropertyAssertion = (Core.Name "hydra/ext/owl/syntax.NegativeDataPropertyAssertion")--_NegativeDataPropertyAssertion_annotations = (Core.FieldName "annotations")--_NegativeDataPropertyAssertion_property = (Core.FieldName "property")--_NegativeDataPropertyAssertion_source = (Core.FieldName "source")--_NegativeDataPropertyAssertion_target = (Core.FieldName "target")
− src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs
@@ -1,267 +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.Ext.Pegasus.Pdl where--import qualified Hydra.Core as Core-import qualified Hydra.Ext.Json.Model as Model-import Data.List-import Data.Map-import Data.Set---- | 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.FieldName "doc")--_Annotations_deprecated = (Core.FieldName "deprecated")--data EnumField = - EnumField {- enumFieldName :: EnumFieldName,- enumFieldAnnotations :: Annotations}- deriving (Eq, Ord, Read, Show)--_EnumField = (Core.Name "hydra/ext/pegasus/pdl.EnumField")--_EnumField_name = (Core.FieldName "name")--_EnumField_annotations = (Core.FieldName "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.FieldName "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.FieldName "qualifiedName")--_NamedSchema_type = (Core.FieldName "type")--_NamedSchema_annotations = (Core.FieldName "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.FieldName "record")--_NamedSchema_Type_enum = (Core.FieldName "enum")--_NamedSchema_Type_typeref = (Core.FieldName "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.FieldName "boolean")--_PrimitiveType_bytes = (Core.FieldName "bytes")--_PrimitiveType_double = (Core.FieldName "double")--_PrimitiveType_float = (Core.FieldName "float")--_PrimitiveType_int = (Core.FieldName "int")--_PrimitiveType_long = (Core.FieldName "long")--_PrimitiveType_string = (Core.FieldName "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 Model.Value)}- deriving (Eq, Ord, Read, Show)--_Property = (Core.Name "hydra/ext/pegasus/pdl.Property")--_Property_key = (Core.FieldName "key")--_Property_value = (Core.FieldName "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.FieldName "name")--_QualifiedName_namespace = (Core.FieldName "namespace")--data RecordField = - RecordField {- recordFieldName :: FieldName,- recordFieldValue :: Schema,- recordFieldOptional :: Bool,- recordFieldDefault :: (Maybe Model.Value),- recordFieldAnnotations :: Annotations}- deriving (Eq, Ord, Read, Show)--_RecordField = (Core.Name "hydra/ext/pegasus/pdl.RecordField")--_RecordField_name = (Core.FieldName "name")--_RecordField_value = (Core.FieldName "value")--_RecordField_optional = (Core.FieldName "optional")--_RecordField_default = (Core.FieldName "default")--_RecordField_annotations = (Core.FieldName "annotations")--data RecordSchema = - RecordSchema {- recordSchemaFields :: [RecordField],- recordSchemaIncludes :: [NamedSchema]}- deriving (Eq, Ord, Read, Show)--_RecordSchema = (Core.Name "hydra/ext/pegasus/pdl.RecordSchema")--_RecordSchema_fields = (Core.FieldName "fields")--_RecordSchema_includes = (Core.FieldName "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.FieldName "array")--_Schema_fixed = (Core.FieldName "fixed")--_Schema_inline = (Core.FieldName "inline")--_Schema_map = (Core.FieldName "map")--_Schema_named = (Core.FieldName "named")--_Schema_null = (Core.FieldName "null")--_Schema_primitive = (Core.FieldName "primitive")--_Schema_union = (Core.FieldName "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.FieldName "namespace")--_SchemaFile_package = (Core.FieldName "package")--_SchemaFile_imports = (Core.FieldName "imports")--_SchemaFile_schemas = (Core.FieldName "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.FieldName "alias")--_UnionMember_value = (Core.FieldName "value")--_UnionMember_annotations = (Core.FieldName "annotations")--newtype UnionSchema = - UnionSchema {- unUnionSchema :: [UnionMember]}- deriving (Eq, Ord, Read, Show)--_UnionSchema = (Core.Name "hydra/ext/pegasus/pdl.UnionSchema")
− src/gen-main/haskell/Hydra/Ext/Rdf/Syntax.hs
@@ -1,185 +0,0 @@--- | An RDF 1.1 syntax model--module Hydra.Ext.Rdf.Syntax where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set--newtype BlankNode = - BlankNode {- unBlankNode :: String}- deriving (Eq, Ord, Read, Show)--_BlankNode = (Core.Name "hydra/ext/rdf/syntax.BlankNode")---- | Stand-in for rdfs:Class-data RdfsClass = - RdfsClass {}- deriving (Eq, Ord, Read, Show)--_RdfsClass = (Core.Name "hydra/ext/rdf/syntax.RdfsClass")--newtype Dataset = - Dataset {- unDataset :: (Set Quad)}- deriving (Eq, Ord, Read, Show)--_Dataset = (Core.Name "hydra/ext/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/rdf/syntax.Description")--_Description_subject = (Core.FieldName "subject")--_Description_graph = (Core.FieldName "graph")--newtype Graph = - Graph {- unGraph :: (Set Triple)}- deriving (Eq, Ord, Read, Show)--_Graph = (Core.Name "hydra/ext/rdf/syntax.Graph")---- | An Internationalized Resource Identifier-newtype Iri = - Iri {- -- | An Internationalized Resource Identifier- unIri :: String}- deriving (Eq, Ord, Read, Show)--_Iri = (Core.Name "hydra/ext/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/rdf/syntax.IriOrLiteral")--_IriOrLiteral_iri = (Core.FieldName "iri")--_IriOrLiteral_literal = (Core.FieldName "literal")---- | A convenience type which provides at most one string value per language, and optionally a value without a language-newtype LangStrings = - LangStrings {- -- | A convenience type which provides at most one string value per language, and optionally a value without a language- unLangStrings :: (Map (Maybe LanguageTag) String)}- deriving (Eq, Ord, Read, Show)--_LangStrings = (Core.Name "hydra/ext/rdf/syntax.LangStrings")---- | A BCP47 language tag-newtype LanguageTag = - LanguageTag {- -- | A BCP47 language tag- unLanguageTag :: String}- deriving (Eq, Ord, Read, Show)--_LanguageTag = (Core.Name "hydra/ext/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/rdf/syntax.Literal")--_Literal_lexicalForm = (Core.FieldName "lexicalForm")--_Literal_datatypeIri = (Core.FieldName "datatypeIri")--_Literal_languageTag = (Core.FieldName "languageTag")--data Node = - NodeIri Iri |- NodeBnode BlankNode |- NodeLiteral Literal- deriving (Eq, Ord, Read, Show)--_Node = (Core.Name "hydra/ext/rdf/syntax.Node")--_Node_iri = (Core.FieldName "iri")--_Node_bnode = (Core.FieldName "bnode")--_Node_literal = (Core.FieldName "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/rdf/syntax.Property")--_Property_domain = (Core.FieldName "domain")--_Property_range = (Core.FieldName "range")--_Property_subPropertyOf = (Core.FieldName "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/rdf/syntax.Quad")--_Quad_subject = (Core.FieldName "subject")--_Quad_predicate = (Core.FieldName "predicate")--_Quad_object = (Core.FieldName "object")--_Quad_graph = (Core.FieldName "graph")--data Resource = - ResourceIri Iri |- ResourceBnode BlankNode- deriving (Eq, Ord, Read, Show)--_Resource = (Core.Name "hydra/ext/rdf/syntax.Resource")--_Resource_iri = (Core.FieldName "iri")--_Resource_bnode = (Core.FieldName "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/rdf/syntax.Triple")--_Triple_subject = (Core.FieldName "subject")--_Triple_predicate = (Core.FieldName "predicate")--_Triple_object = (Core.FieldName "object")
− src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs
@@ -1,2264 +0,0 @@--- | A Scala syntax model based on Scalameta (https://scalameta.org)--module Hydra.Ext.Scala.Meta where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set--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.FieldName "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.FieldName "ref")--_Tree_stat = (Core.FieldName "stat")--_Tree_type = (Core.FieldName "type")--_Tree_bounds = (Core.FieldName "bounds")--_Tree_pat = (Core.FieldName "pat")--_Tree_member = (Core.FieldName "member")--_Tree_ctor = (Core.FieldName "ctor")--_Tree_template = (Core.FieldName "template")--_Tree_mod = (Core.FieldName "mod")--_Tree_enumerator = (Core.FieldName "enumerator")--_Tree_importer = (Core.FieldName "importer")--_Tree_importee = (Core.FieldName "importee")--_Tree_caseTree = (Core.FieldName "caseTree")--_Tree_source = (Core.FieldName "source")--_Tree_quasi = (Core.FieldName "quasi")--data Ref = - RefName Name |- RefInit Init- deriving (Eq, Ord, Read, Show)--_Ref = (Core.Name "hydra/ext/scala/meta.Ref")--_Ref_name = (Core.FieldName "name")--_Ref_init = (Core.FieldName "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.FieldName "term")--_Stat_decl = (Core.FieldName "decl")--_Stat_defn = (Core.FieldName "defn")--_Stat_importExport = (Core.FieldName "importExport")--data Name = - NameValue String |- NameAnonymous |- NameIndeterminate PredefString- deriving (Eq, Ord, Read, Show)--_Name = (Core.Name "hydra/ext/scala/meta.Name")--_Name_value = (Core.FieldName "value")--_Name_anonymous = (Core.FieldName "anonymous")--_Name_indeterminate = (Core.FieldName "indeterminate")--data Lit = - LitNull |- LitInt Int |- LitDouble Double |- LitFloat Float |- LitByte Int |- LitShort Int |- LitChar Int |- LitLong Integer |- LitBoolean Bool |- LitUnit |- LitString String |- LitSymbol ScalaSymbol- deriving (Eq, Ord, Read, Show)--_Lit = (Core.Name "hydra/ext/scala/meta.Lit")--_Lit_null = (Core.FieldName "null")--_Lit_int = (Core.FieldName "int")--_Lit_double = (Core.FieldName "double")--_Lit_float = (Core.FieldName "float")--_Lit_byte = (Core.FieldName "byte")--_Lit_short = (Core.FieldName "short")--_Lit_char = (Core.FieldName "char")--_Lit_long = (Core.FieldName "long")--_Lit_boolean = (Core.FieldName "boolean")--_Lit_unit = (Core.FieldName "unit")--_Lit_string = (Core.FieldName "string")--_Lit_symbol = (Core.FieldName "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.FieldName "lit")--_Data_ref = (Core.FieldName "ref")--_Data_interpolate = (Core.FieldName "interpolate")--_Data_xml = (Core.FieldName "xml")--_Data_apply = (Core.FieldName "apply")--_Data_applyUsing = (Core.FieldName "applyUsing")--_Data_applyType = (Core.FieldName "applyType")--_Data_assign = (Core.FieldName "assign")--_Data_return = (Core.FieldName "return")--_Data_throw = (Core.FieldName "throw")--_Data_ascribe = (Core.FieldName "ascribe")--_Data_annotate = (Core.FieldName "annotate")--_Data_tuple = (Core.FieldName "tuple")--_Data_block = (Core.FieldName "block")--_Data_endMarker = (Core.FieldName "endMarker")--_Data_if = (Core.FieldName "if")--_Data_quotedMacroExpr = (Core.FieldName "quotedMacroExpr")--_Data_quotedMacroType = (Core.FieldName "quotedMacroType")--_Data_splicedMacroExpr = (Core.FieldName "splicedMacroExpr")--_Data_match = (Core.FieldName "match")--_Data_try = (Core.FieldName "try")--_Data_tryWithHandler = (Core.FieldName "tryWithHandler")--_Data_functionData = (Core.FieldName "functionData")--_Data_polyFunction = (Core.FieldName "polyFunction")--_Data_partialFunction = (Core.FieldName "partialFunction")--_Data_while = (Core.FieldName "while")--_Data_do = (Core.FieldName "do")--_Data_for = (Core.FieldName "for")--_Data_forYield = (Core.FieldName "forYield")--_Data_new = (Core.FieldName "new")--_Data_newAnonymous = (Core.FieldName "newAnonymous")--_Data_placeholder = (Core.FieldName "placeholder")--_Data_eta = (Core.FieldName "eta")--_Data_repeated = (Core.FieldName "repeated")--_Data_param = (Core.FieldName "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.FieldName "this")--_Data_Ref_super = (Core.FieldName "super")--_Data_Ref_name = (Core.FieldName "name")--_Data_Ref_anonymous = (Core.FieldName "anonymous")--_Data_Ref_select = (Core.FieldName "select")--_Data_Ref_applyUnary = (Core.FieldName "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.FieldName "thisp")--_Data_Super_superp = (Core.FieldName "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.FieldName "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.FieldName "qual")--_Data_Select_name = (Core.FieldName "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.FieldName "prefix")--_Data_Interpolate_parts = (Core.FieldName "parts")--_Data_Interpolate_args = (Core.FieldName "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.FieldName "parts")--_Data_Xml_args = (Core.FieldName "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.FieldName "fun")--_Data_Apply_args = (Core.FieldName "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.FieldName "fun")--_Data_ApplyUsing_targs = (Core.FieldName "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.FieldName "lhs")--_Data_ApplyType_op = (Core.FieldName "op")--_Data_ApplyType_targs = (Core.FieldName "targs")--_Data_ApplyType_args = (Core.FieldName "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.FieldName "lhs")--_Data_ApplyInfix_op = (Core.FieldName "op")--_Data_ApplyInfix_targs = (Core.FieldName "targs")--_Data_ApplyInfix_args = (Core.FieldName "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.FieldName "op")--_Data_ApplyUnary_arg = (Core.FieldName "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.FieldName "lhs")--_Data_Assign_rhs = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "expr")--_Data_Ascribe_tpe = (Core.FieldName "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.FieldName "expr")--_Data_Annotate_annots = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "cond")--_Data_If_thenp = (Core.FieldName "thenp")--_Data_If_elsep = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "expr")--_Data_Match_cases = (Core.FieldName "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.FieldName "expr")--_Data_Try_catchp = (Core.FieldName "catchp")--_Data_Try_finallyp = (Core.FieldName "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.FieldName "expr")--_Data_TryWithHandler_catchp = (Core.FieldName "catchp")--_Data_TryWithHandler_finallyp = (Core.FieldName "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.FieldName "contextFunction")--_Data_FunctionData_function = (Core.FieldName "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.FieldName "params")--_Data_ContextFunction_body = (Core.FieldName "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.FieldName "params")--_Data_Function_body = (Core.FieldName "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.FieldName "tparams")--_Data_PolyFunction_body = (Core.FieldName "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.FieldName "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.FieldName "expr")--_Data_While_body = (Core.FieldName "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.FieldName "body")--_Data_Do_expr = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "mods")--_Data_Param_name = (Core.FieldName "name")--_Data_Param_decltpe = (Core.FieldName "decltpe")--_Data_Param_default = (Core.FieldName "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.FieldName "ref")--_Type_anonymousName = (Core.FieldName "anonymousName")--_Type_apply = (Core.FieldName "apply")--_Type_applyInfix = (Core.FieldName "applyInfix")--_Type_functionType = (Core.FieldName "functionType")--_Type_polyFunction = (Core.FieldName "polyFunction")--_Type_implicitFunction = (Core.FieldName "implicitFunction")--_Type_tuple = (Core.FieldName "tuple")--_Type_with = (Core.FieldName "with")--_Type_and = (Core.FieldName "and")--_Type_or = (Core.FieldName "or")--_Type_refine = (Core.FieldName "refine")--_Type_existential = (Core.FieldName "existential")--_Type_annotate = (Core.FieldName "annotate")--_Type_lambda = (Core.FieldName "lambda")--_Type_macro = (Core.FieldName "macro")--_Type_method = (Core.FieldName "method")--_Type_placeholder = (Core.FieldName "placeholder")--_Type_byName = (Core.FieldName "byName")--_Type_repeated = (Core.FieldName "repeated")--_Type_var = (Core.FieldName "var")--_Type_typedParam = (Core.FieldName "typedParam")--_Type_match = (Core.FieldName "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.FieldName "name")--_Type_Ref_select = (Core.FieldName "select")--_Type_Ref_project = (Core.FieldName "project")--_Type_Ref_singleton = (Core.FieldName "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.FieldName "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.FieldName "qual")--_Type_Select_name = (Core.FieldName "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.FieldName "qual")--_Type_Project_name = (Core.FieldName "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.FieldName "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.FieldName "tpe")--_Type_Apply_args = (Core.FieldName "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.FieldName "lhs")--_Type_ApplyInfix_op = (Core.FieldName "op")--_Type_ApplyInfix_rhs = (Core.FieldName "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.FieldName "function")--_Type_FunctionType_contextFunction = (Core.FieldName "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.FieldName "params")--_Type_Function_res = (Core.FieldName "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.FieldName "tparams")--_Type_PolyFunction_tpe = (Core.FieldName "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.FieldName "params")--_Type_ContextFunction_res = (Core.FieldName "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.FieldName "params")--_Type_ImplicitFunction_res = (Core.FieldName "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.FieldName "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.FieldName "lhs")--_Type_With_rhs = (Core.FieldName "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.FieldName "lhs")--_Type_And_rhs = (Core.FieldName "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.FieldName "lhs")--_Type_Or_rhs = (Core.FieldName "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.FieldName "tpe")--_Type_Refine_stats = (Core.FieldName "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.FieldName "tpe")--_Type_Existential_stats = (Core.FieldName "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.FieldName "tpe")--_Type_Annotate_annots = (Core.FieldName "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.FieldName "tparams")--_Type_Lambda_tpe = (Core.FieldName "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.FieldName "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.FieldName "paramss")--_Type_Method_tpe = (Core.FieldName "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.FieldName "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.FieldName "lo")--_Type_Bounds_hi = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "name")--_Type_TypedParam_typ = (Core.FieldName "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.FieldName "mods")--_Type_Param_name = (Core.FieldName "name")--_Type_Param_tparams = (Core.FieldName "tparams")--_Type_Param_tbounds = (Core.FieldName "tbounds")--_Type_Param_vbounds = (Core.FieldName "vbounds")--_Type_Param_cbounds = (Core.FieldName "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.FieldName "tpe")--_Type_Match_cases = (Core.FieldName "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.FieldName "var")--_Pat_wildcard = (Core.FieldName "wildcard")--_Pat_seqWildcard = (Core.FieldName "seqWildcard")--_Pat_bind = (Core.FieldName "bind")--_Pat_alternative = (Core.FieldName "alternative")--_Pat_tuple = (Core.FieldName "tuple")--_Pat_repeated = (Core.FieldName "repeated")--_Pat_extract = (Core.FieldName "extract")--_Pat_extractInfix = (Core.FieldName "extractInfix")--_Pat_interpolate = (Core.FieldName "interpolate")--_Pat_xml = (Core.FieldName "xml")--_Pat_typed = (Core.FieldName "typed")--_Pat_macro = (Core.FieldName "macro")--_Pat_given = (Core.FieldName "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.FieldName "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.FieldName "lhs")--_Pat_Bind_rhs = (Core.FieldName "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.FieldName "lhs")--_Pat_Alternative_rhs = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "fun")--_Pat_Extract_args = (Core.FieldName "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.FieldName "lhs")--_Pat_ExtractInfix_op = (Core.FieldName "op")--_Pat_ExtractInfix_rhs = (Core.FieldName "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.FieldName "prefix")--_Pat_Interpolate_parts = (Core.FieldName "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.FieldName "parts")--_Pat_Xml_args = (Core.FieldName "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.FieldName "lhs")--_Pat_Typed_rhs = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "term")--_Member_type = (Core.FieldName "type")--_Member_termParam = (Core.FieldName "termParam")--_Member_typeParam = (Core.FieldName "typeParam")--_Member_self = (Core.FieldName "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.FieldName "pkg")--_Member_Data_object = (Core.FieldName "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.FieldName "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.FieldName "val")--_Decl_var = (Core.FieldName "var")--_Decl_def = (Core.FieldName "def")--_Decl_type = (Core.FieldName "type")--_Decl_given = (Core.FieldName "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.FieldName "mods")--_Decl_Val_pats = (Core.FieldName "pats")--_Decl_Val_decltpe = (Core.FieldName "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.FieldName "mods")--_Decl_Var_pats = (Core.FieldName "pats")--_Decl_Var_decltpe = (Core.FieldName "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.FieldName "mods")--_Decl_Def_name = (Core.FieldName "name")--_Decl_Def_tparams = (Core.FieldName "tparams")--_Decl_Def_paramss = (Core.FieldName "paramss")--_Decl_Def_decltpe = (Core.FieldName "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.FieldName "mods")--_Decl_Type_name = (Core.FieldName "name")--_Decl_Type_tparams = (Core.FieldName "tparams")--_Decl_Type_bounds = (Core.FieldName "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.FieldName "mods")--_Decl_Given_name = (Core.FieldName "name")--_Decl_Given_tparams = (Core.FieldName "tparams")--_Decl_Given_sparams = (Core.FieldName "sparams")--_Decl_Given_decltpe = (Core.FieldName "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.FieldName "val")--_Defn_var = (Core.FieldName "var")--_Defn_given = (Core.FieldName "given")--_Defn_enum = (Core.FieldName "enum")--_Defn_enumCase = (Core.FieldName "enumCase")--_Defn_repeatedEnumCase = (Core.FieldName "repeatedEnumCase")--_Defn_givenAlias = (Core.FieldName "givenAlias")--_Defn_extensionGroup = (Core.FieldName "extensionGroup")--_Defn_def = (Core.FieldName "def")--_Defn_macro = (Core.FieldName "macro")--_Defn_type = (Core.FieldName "type")--_Defn_class = (Core.FieldName "class")--_Defn_trait = (Core.FieldName "trait")--_Defn_object = (Core.FieldName "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.FieldName "mods")--_Defn_Val_pats = (Core.FieldName "pats")--_Defn_Val_decltpe = (Core.FieldName "decltpe")--_Defn_Val_rhs = (Core.FieldName "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.FieldName "mods")--_Defn_Var_pats = (Core.FieldName "pats")--_Defn_Var_decltpe = (Core.FieldName "decltpe")--_Defn_Var_rhs = (Core.FieldName "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.FieldName "mods")--_Defn_Given_name = (Core.FieldName "name")--_Defn_Given_tparams = (Core.FieldName "tparams")--_Defn_Given_sparams = (Core.FieldName "sparams")--_Defn_Given_templ = (Core.FieldName "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.FieldName "mods")--_Defn_Enum_name = (Core.FieldName "name")--_Defn_Enum_tparams = (Core.FieldName "tparams")--_Defn_Enum_ctor = (Core.FieldName "ctor")--_Defn_Enum_template = (Core.FieldName "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.FieldName "mods")--_Defn_EnumCase_name = (Core.FieldName "name")--_Defn_EnumCase_tparams = (Core.FieldName "tparams")--_Defn_EnumCase_ctor = (Core.FieldName "ctor")--_Defn_EnumCase_inits = (Core.FieldName "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.FieldName "mods")--_Defn_RepeatedEnumCase_cases = (Core.FieldName "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.FieldName "mods")--_Defn_GivenAlias_name = (Core.FieldName "name")--_Defn_GivenAlias_tparams = (Core.FieldName "tparams")--_Defn_GivenAlias_sparams = (Core.FieldName "sparams")--_Defn_GivenAlias_decltpe = (Core.FieldName "decltpe")--_Defn_GivenAlias_body = (Core.FieldName "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.FieldName "tparams")--_Defn_ExtensionGroup_parmss = (Core.FieldName "parmss")--_Defn_ExtensionGroup_body = (Core.FieldName "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.FieldName "mods")--_Defn_Def_name = (Core.FieldName "name")--_Defn_Def_tparams = (Core.FieldName "tparams")--_Defn_Def_paramss = (Core.FieldName "paramss")--_Defn_Def_decltpe = (Core.FieldName "decltpe")--_Defn_Def_body = (Core.FieldName "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.FieldName "mods")--_Defn_Macro_name = (Core.FieldName "name")--_Defn_Macro_tparams = (Core.FieldName "tparams")--_Defn_Macro_paramss = (Core.FieldName "paramss")--_Defn_Macro_decltpe = (Core.FieldName "decltpe")--_Defn_Macro_body = (Core.FieldName "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.FieldName "mods")--_Defn_Type_name = (Core.FieldName "name")--_Defn_Type_tparams = (Core.FieldName "tparams")--_Defn_Type_body = (Core.FieldName "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.FieldName "mods")--_Defn_Class_name = (Core.FieldName "name")--_Defn_Class_tparams = (Core.FieldName "tparams")--_Defn_Class_ctor = (Core.FieldName "ctor")--_Defn_Class_template = (Core.FieldName "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.FieldName "mods")--_Defn_Trait_name = (Core.FieldName "name")--_Defn_Trait_tparams = (Core.FieldName "tparams")--_Defn_Trait_ctor = (Core.FieldName "ctor")--_Defn_Trait_template = (Core.FieldName "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.FieldName "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.FieldName "name")--_Pkg_ref = (Core.FieldName "ref")--_Pkg_stats = (Core.FieldName "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.FieldName "mods")--_Pkg_Object_name = (Core.FieldName "name")--_Pkg_Object_template = (Core.FieldName "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.FieldName "primary")--_Ctor_secondary = (Core.FieldName "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.FieldName "mods")--_Ctor_Primary_name = (Core.FieldName "name")--_Ctor_Primary_paramss = (Core.FieldName "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.FieldName "mods")--_Ctor_Secondary_name = (Core.FieldName "name")--_Ctor_Secondary_paramss = (Core.FieldName "paramss")--_Ctor_Secondary_init = (Core.FieldName "init")--_Ctor_Secondary_stats = (Core.FieldName "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.FieldName "tpe")--_Init_name = (Core.FieldName "name")--_Init_argss = (Core.FieldName "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.FieldName "early")--_Template_inits = (Core.FieldName "inits")--_Template_self = (Core.FieldName "self")--_Template_stats = (Core.FieldName "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.FieldName "annot")--_Mod_private = (Core.FieldName "private")--_Mod_protected = (Core.FieldName "protected")--_Mod_implicit = (Core.FieldName "implicit")--_Mod_final = (Core.FieldName "final")--_Mod_sealed = (Core.FieldName "sealed")--_Mod_open = (Core.FieldName "open")--_Mod_super = (Core.FieldName "super")--_Mod_override = (Core.FieldName "override")--_Mod_case = (Core.FieldName "case")--_Mod_abstract = (Core.FieldName "abstract")--_Mod_covariant = (Core.FieldName "covariant")--_Mod_contravariant = (Core.FieldName "contravariant")--_Mod_lazy = (Core.FieldName "lazy")--_Mod_valParam = (Core.FieldName "valParam")--_Mod_varParam = (Core.FieldName "varParam")--_Mod_infix = (Core.FieldName "infix")--_Mod_inline = (Core.FieldName "inline")--_Mod_using = (Core.FieldName "using")--_Mod_opaque = (Core.FieldName "opaque")--_Mod_transparent = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "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.FieldName "generator")--_Enumerator_caseGenerator = (Core.FieldName "caseGenerator")--_Enumerator_val = (Core.FieldName "val")--_Enumerator_guard = (Core.FieldName "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.FieldName "pat")--_Enumerator_Generator_rhs = (Core.FieldName "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.FieldName "pat")--_Enumerator_CaseGenerator_rhs = (Core.FieldName "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.FieldName "pat")--_Enumerator_Val_rhs = (Core.FieldName "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.FieldName "cond")--data ImportExportStat = - ImportExportStatImport Import |- ImportExportStatExport Export- deriving (Eq, Ord, Read, Show)--_ImportExportStat = (Core.Name "hydra/ext/scala/meta.ImportExportStat")--_ImportExportStat_import = (Core.FieldName "import")--_ImportExportStat_export = (Core.FieldName "export")--data Import = - Import {- importImporters :: [Importer]}- deriving (Eq, Ord, Read, Show)--_Import = (Core.Name "hydra/ext/scala/meta.Import")--_Import_importers = (Core.FieldName "importers")--data Export = - Export {- exportImporters :: [Importer]}- deriving (Eq, Ord, Read, Show)--_Export = (Core.Name "hydra/ext/scala/meta.Export")--_Export_importers = (Core.FieldName "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.FieldName "ref")--_Importer_importees = (Core.FieldName "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.FieldName "wildcard")--_Importee_given = (Core.FieldName "given")--_Importee_givenAll = (Core.FieldName "givenAll")--_Importee_name = (Core.FieldName "name")--_Importee_rename = (Core.FieldName "rename")--_Importee_unimport = (Core.FieldName "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.FieldName "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.FieldName "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.FieldName "name")--_Importee_Rename_rename = (Core.FieldName "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.FieldName "name")--data CaseTree = - CaseTreeCase Case |- CaseTreeTypeCase TypeCase- deriving (Eq, Ord, Read, Show)--_CaseTree = (Core.Name "hydra/ext/scala/meta.CaseTree")--_CaseTree_case = (Core.FieldName "case")--_CaseTree_typeCase = (Core.FieldName "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.FieldName "pat")--_Case_cond = (Core.FieldName "cond")--_Case_body = (Core.FieldName "body")--data TypeCase = - TypeCase {- typeCasePat :: Type,- typeCaseBody :: Type}- deriving (Eq, Ord, Read, Show)--_TypeCase = (Core.Name "hydra/ext/scala/meta.TypeCase")--_TypeCase_pat = (Core.FieldName "pat")--_TypeCase_body = (Core.FieldName "body")--data Source = - Source {- sourceStats :: [Stat]}- deriving (Eq, Ord, Read, Show)--_Source = (Core.Name "hydra/ext/scala/meta.Source")--_Source_stats = (Core.FieldName "stats")--data Quasi = - Quasi {}- deriving (Eq, Ord, Read, Show)--_Quasi = (Core.Name "hydra/ext/scala/meta.Quasi")
− src/gen-main/haskell/Hydra/Ext/Shacl/Model.hs
@@ -1,357 +0,0 @@--- | A SHACL syntax model. See https://www.w3.org/TR/shacl--module Hydra.Ext.Shacl.Model where--import qualified Hydra.Core as Core-import qualified Hydra.Ext.Rdf.Syntax as Syntax-import Data.List-import Data.Map-import Data.Set---- | 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/shacl/model.Closed")--_Closed_isClosed = (Core.FieldName "isClosed")--_Closed_ignoredProperties = (Core.FieldName "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/shacl/model.CommonConstraint")--_CommonConstraint_and = (Core.FieldName "and")--_CommonConstraint_closed = (Core.FieldName "closed")--_CommonConstraint_class = (Core.FieldName "class")--_CommonConstraint_datatype = (Core.FieldName "datatype")--_CommonConstraint_disjoint = (Core.FieldName "disjoint")--_CommonConstraint_equals = (Core.FieldName "equals")--_CommonConstraint_hasValue = (Core.FieldName "hasValue")--_CommonConstraint_in = (Core.FieldName "in")--_CommonConstraint_languageIn = (Core.FieldName "languageIn")--_CommonConstraint_nodeKind = (Core.FieldName "nodeKind")--_CommonConstraint_node = (Core.FieldName "node")--_CommonConstraint_not = (Core.FieldName "not")--_CommonConstraint_maxExclusive = (Core.FieldName "maxExclusive")--_CommonConstraint_maxInclusive = (Core.FieldName "maxInclusive")--_CommonConstraint_maxLength = (Core.FieldName "maxLength")--_CommonConstraint_minExclusive = (Core.FieldName "minExclusive")--_CommonConstraint_minInclusive = (Core.FieldName "minInclusive")--_CommonConstraint_minLength = (Core.FieldName "minLength")--_CommonConstraint_pattern = (Core.FieldName "pattern")--_CommonConstraint_property = (Core.FieldName "property")--_CommonConstraint_or = (Core.FieldName "or")--_CommonConstraint_xone = (Core.FieldName "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/shacl/model.CommonProperties")--_CommonProperties_constraints = (Core.FieldName "constraints")--_CommonProperties_deactivated = (Core.FieldName "deactivated")--_CommonProperties_message = (Core.FieldName "message")--_CommonProperties_severity = (Core.FieldName "severity")--_CommonProperties_targetClass = (Core.FieldName "targetClass")--_CommonProperties_targetNode = (Core.FieldName "targetNode")--_CommonProperties_targetObjectsOf = (Core.FieldName "targetObjectsOf")--_CommonProperties_targetSubjectsOf = (Core.FieldName "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/shacl/model.Definition")--_Definition_iri = (Core.FieldName "iri")--_Definition_target = (Core.FieldName "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/shacl/model.NodeKind")--_NodeKind_blankNode = (Core.FieldName "blankNode")--_NodeKind_iri = (Core.FieldName "iri")--_NodeKind_literal = (Core.FieldName "literal")--_NodeKind_blankNodeOrIri = (Core.FieldName "blankNodeOrIri")--_NodeKind_blankNodeOrLiteral = (Core.FieldName "blankNodeOrLiteral")--_NodeKind_iriOrLiteral = (Core.FieldName "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/shacl/model.NodeShape")--_NodeShape_common = (Core.FieldName "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/shacl/model.Pattern")--_Pattern_regex = (Core.FieldName "regex")--_Pattern_flags = (Core.FieldName "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/shacl/model.PropertyShape")--_PropertyShape_common = (Core.FieldName "common")--_PropertyShape_constraints = (Core.FieldName "constraints")--_PropertyShape_defaultValue = (Core.FieldName "defaultValue")--_PropertyShape_description = (Core.FieldName "description")--_PropertyShape_name = (Core.FieldName "name")--_PropertyShape_order = (Core.FieldName "order")--_PropertyShape_path = (Core.FieldName "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/shacl/model.PropertyShapeConstraint")--_PropertyShapeConstraint_lessThan = (Core.FieldName "lessThan")--_PropertyShapeConstraint_lessThanOrEquals = (Core.FieldName "lessThanOrEquals")--_PropertyShapeConstraint_maxCount = (Core.FieldName "maxCount")--_PropertyShapeConstraint_minCount = (Core.FieldName "minCount")--_PropertyShapeConstraint_uniqueLang = (Core.FieldName "uniqueLang")--_PropertyShapeConstraint_qualifiedValueShape = (Core.FieldName "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/shacl/model.QualifiedValueShape")--_QualifiedValueShape_qualifiedValueShape = (Core.FieldName "qualifiedValueShape")--_QualifiedValueShape_qualifiedMaxCount = (Core.FieldName "qualifiedMaxCount")--_QualifiedValueShape_qualifiedMinCount = (Core.FieldName "qualifiedMinCount")--_QualifiedValueShape_qualifiedValueShapesDisjoint = (Core.FieldName "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/shacl/model.Reference")--_Reference_named = (Core.FieldName "named")--_Reference_anonymous = (Core.FieldName "anonymous")--_Reference_definition = (Core.FieldName "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/shacl/model.Severity")--_Severity_info = (Core.FieldName "info")--_Severity_warning = (Core.FieldName "warning")--_Severity_violation = (Core.FieldName "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/shacl/model.Shape")--_Shape_node = (Core.FieldName "node")--_Shape_property = (Core.FieldName "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 {- -- | 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- unShapesGraph :: (Set (Definition Shape))}- deriving (Eq, Ord, Read, Show)--_ShapesGraph = (Core.Name "hydra/ext/shacl/model.ShapesGraph")
− src/gen-main/haskell/Hydra/Ext/Shex/Syntax.hs
@@ -1,1818 +0,0 @@--- | A Shex model. Based on the BNF at:--- | https://github.com/shexSpec/grammar/blob/master/bnf--module Hydra.Ext.Shex.Syntax where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set--data ShexDoc = - ShexDoc {- shexDocListOfDirective :: [Directive],- shexDocSequence :: (Maybe ShexDoc_Sequence_Option),- shexDocPrefixDecl :: PrefixDecl}- deriving (Eq, Ord, Read, Show)--_ShexDoc = (Core.Name "hydra/ext/shex/syntax.ShexDoc")--_ShexDoc_listOfDirective = (Core.FieldName "listOfDirective")--_ShexDoc_sequence = (Core.FieldName "sequence")--_ShexDoc_prefixDecl = (Core.FieldName "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/ext/shex/syntax.ShexDoc.Sequence.Option")--_ShexDoc_Sequence_Option_alts = (Core.FieldName "alts")--_ShexDoc_Sequence_Option_listOfStatement = (Core.FieldName "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/ext/shex/syntax.ShexDoc.Sequence.Option.Alts")--_ShexDoc_Sequence_Option_Alts_notStartAction = (Core.FieldName "notStartAction")--_ShexDoc_Sequence_Option_Alts_startActions = (Core.FieldName "startActions")--data Directive = - DirectiveBaseDecl BaseDecl |- DirectivePrefixDecl PrefixDecl- deriving (Eq, Ord, Read, Show)--_Directive = (Core.Name "hydra/ext/shex/syntax.Directive")--_Directive_baseDecl = (Core.FieldName "baseDecl")--_Directive_prefixDecl = (Core.FieldName "prefixDecl")--data BaseDecl = - BaseDecl {- baseDeclIriRef :: IriRef}- deriving (Eq, Ord, Read, Show)--_BaseDecl = (Core.Name "hydra/ext/shex/syntax.BaseDecl")--_BaseDecl_iriRef = (Core.FieldName "iriRef")--data PrefixDecl = - PrefixDecl {- prefixDeclPnameNs :: PnameNs,- prefixDeclIriRef :: IriRef}- deriving (Eq, Ord, Read, Show)--_PrefixDecl = (Core.Name "hydra/ext/shex/syntax.PrefixDecl")--_PrefixDecl_pnameNs = (Core.FieldName "pnameNs")--_PrefixDecl_iriRef = (Core.FieldName "iriRef")--data NotStartAction = - NotStartActionStart NotStartAction_Start |- NotStartActionShapeExprDecl NotStartAction_ShapeExprDecl- deriving (Eq, Ord, Read, Show)--_NotStartAction = (Core.Name "hydra/ext/shex/syntax.NotStartAction")--_NotStartAction_start = (Core.FieldName "start")--_NotStartAction_shapeExprDecl = (Core.FieldName "shapeExprDecl")--data NotStartAction_Start = - NotStartAction_Start {- notStartAction_StartShapeExpression :: ShapeExpression}- deriving (Eq, Ord, Read, Show)--_NotStartAction_Start = (Core.Name "hydra/ext/shex/syntax.NotStartAction.Start")--_NotStartAction_Start_shapeExpression = (Core.FieldName "shapeExpression")--data NotStartAction_ShapeExprDecl = - NotStartAction_ShapeExprDecl {- notStartAction_ShapeExprDeclShapeExprLabel :: ShapeExprLabel,- notStartAction_ShapeExprDeclAlts :: NotStartAction_ShapeExprDecl_Alts}- deriving (Eq, Ord, Read, Show)--_NotStartAction_ShapeExprDecl = (Core.Name "hydra/ext/shex/syntax.NotStartAction.ShapeExprDecl")--_NotStartAction_ShapeExprDecl_shapeExprLabel = (Core.FieldName "shapeExprLabel")--_NotStartAction_ShapeExprDecl_alts = (Core.FieldName "alts")--data NotStartAction_ShapeExprDecl_Alts = - NotStartAction_ShapeExprDecl_AltsShapeExpression ShapeExpression |- NotStartAction_ShapeExprDecl_AltsEXTERNAL - deriving (Eq, Ord, Read, Show)--_NotStartAction_ShapeExprDecl_Alts = (Core.Name "hydra/ext/shex/syntax.NotStartAction.ShapeExprDecl.Alts")--_NotStartAction_ShapeExprDecl_Alts_shapeExpression = (Core.FieldName "shapeExpression")--_NotStartAction_ShapeExprDecl_Alts_eXTERNAL = (Core.FieldName "eXTERNAL")--newtype StartActions = - StartActions {- unStartActions :: [CodeDecl]}- deriving (Eq, Ord, Read, Show)--_StartActions = (Core.Name "hydra/ext/shex/syntax.StartActions")--data Statement = - StatementDirective Directive |- StatementNotStartAction NotStartAction- deriving (Eq, Ord, Read, Show)--_Statement = (Core.Name "hydra/ext/shex/syntax.Statement")--_Statement_directive = (Core.FieldName "directive")--_Statement_notStartAction = (Core.FieldName "notStartAction")--newtype ShapeExpression = - ShapeExpression {- unShapeExpression :: ShapeOr}- deriving (Eq, Ord, Read, Show)--_ShapeExpression = (Core.Name "hydra/ext/shex/syntax.ShapeExpression")--newtype InlineShapeExpression = - InlineShapeExpression {- unInlineShapeExpression :: InlineShapeOr}- deriving (Eq, Ord, Read, Show)--_InlineShapeExpression = (Core.Name "hydra/ext/shex/syntax.InlineShapeExpression")--data ShapeOr = - ShapeOr {- shapeOrShapeAnd :: ShapeAnd,- shapeOrListOfSequence :: [ShapeOr_ListOfSequence_Elmt]}- deriving (Eq, Ord, Read, Show)--_ShapeOr = (Core.Name "hydra/ext/shex/syntax.ShapeOr")--_ShapeOr_shapeAnd = (Core.FieldName "shapeAnd")--_ShapeOr_listOfSequence = (Core.FieldName "listOfSequence")--data ShapeOr_ListOfSequence_Elmt = - ShapeOr_ListOfSequence_Elmt {- shapeOr_ListOfSequence_ElmtShapeAnd :: ShapeAnd}- deriving (Eq, Ord, Read, Show)--_ShapeOr_ListOfSequence_Elmt = (Core.Name "hydra/ext/shex/syntax.ShapeOr.ListOfSequence.Elmt")--_ShapeOr_ListOfSequence_Elmt_shapeAnd = (Core.FieldName "shapeAnd")--data InlineShapeOr = - InlineShapeOr {- inlineShapeOrShapeAnd :: ShapeAnd,- inlineShapeOrListOfSequence :: [InlineShapeOr_ListOfSequence_Elmt]}- deriving (Eq, Ord, Read, Show)--_InlineShapeOr = (Core.Name "hydra/ext/shex/syntax.InlineShapeOr")--_InlineShapeOr_shapeAnd = (Core.FieldName "shapeAnd")--_InlineShapeOr_listOfSequence = (Core.FieldName "listOfSequence")--data InlineShapeOr_ListOfSequence_Elmt = - InlineShapeOr_ListOfSequence_Elmt {- inlineShapeOr_ListOfSequence_ElmtInlineShapeAnd :: InlineShapeAnd}- deriving (Eq, Ord, Read, Show)--_InlineShapeOr_ListOfSequence_Elmt = (Core.Name "hydra/ext/shex/syntax.InlineShapeOr.ListOfSequence.Elmt")--_InlineShapeOr_ListOfSequence_Elmt_inlineShapeAnd = (Core.FieldName "inlineShapeAnd")--data ShapeAnd = - ShapeAnd {- shapeAndShapeNot :: ShapeNot,- shapeAndListOfSequence :: [ShapeAnd_ListOfSequence_Elmt]}- deriving (Eq, Ord, Read, Show)--_ShapeAnd = (Core.Name "hydra/ext/shex/syntax.ShapeAnd")--_ShapeAnd_shapeNot = (Core.FieldName "shapeNot")--_ShapeAnd_listOfSequence = (Core.FieldName "listOfSequence")--data ShapeAnd_ListOfSequence_Elmt = - ShapeAnd_ListOfSequence_Elmt {- shapeAnd_ListOfSequence_ElmtShapeNot :: ShapeNot}- deriving (Eq, Ord, Read, Show)--_ShapeAnd_ListOfSequence_Elmt = (Core.Name "hydra/ext/shex/syntax.ShapeAnd.ListOfSequence.Elmt")--_ShapeAnd_ListOfSequence_Elmt_shapeNot = (Core.FieldName "shapeNot")--data InlineShapeAnd = - InlineShapeAnd {- inlineShapeAndInlineShapeNot :: InlineShapeNot,- inlineShapeAndListOfSequence :: [InlineShapeAnd_ListOfSequence_Elmt]}- deriving (Eq, Ord, Read, Show)--_InlineShapeAnd = (Core.Name "hydra/ext/shex/syntax.InlineShapeAnd")--_InlineShapeAnd_inlineShapeNot = (Core.FieldName "inlineShapeNot")--_InlineShapeAnd_listOfSequence = (Core.FieldName "listOfSequence")--data InlineShapeAnd_ListOfSequence_Elmt = - InlineShapeAnd_ListOfSequence_Elmt {- inlineShapeAnd_ListOfSequence_ElmtInlineShapeNot :: InlineShapeNot}- deriving (Eq, Ord, Read, Show)--_InlineShapeAnd_ListOfSequence_Elmt = (Core.Name "hydra/ext/shex/syntax.InlineShapeAnd.ListOfSequence.Elmt")--_InlineShapeAnd_ListOfSequence_Elmt_inlineShapeNot = (Core.FieldName "inlineShapeNot")--data ShapeNot = - ShapeNot {- shapeNotNOT :: (Maybe ()),- shapeNotShapeAtom :: ShapeAtom}- deriving (Eq, Ord, Read, Show)--_ShapeNot = (Core.Name "hydra/ext/shex/syntax.ShapeNot")--_ShapeNot_nOT = (Core.FieldName "nOT")--_ShapeNot_shapeAtom = (Core.FieldName "shapeAtom")--data InlineShapeNot = - InlineShapeNot {- inlineShapeNotNOT :: (Maybe ()),- inlineShapeNotInlineShapeAtom :: InlineShapeAtom}- deriving (Eq, Ord, Read, Show)--_InlineShapeNot = (Core.Name "hydra/ext/shex/syntax.InlineShapeNot")--_InlineShapeNot_nOT = (Core.FieldName "nOT")--_InlineShapeNot_inlineShapeAtom = (Core.FieldName "inlineShapeAtom")--data ShapeAtom = - ShapeAtomSequence ShapeAtom_Sequence |- ShapeAtomShapeOrRef ShapeOrRef |- ShapeAtomSequence2 ShapeAtom_Sequence2 |- ShapeAtomPeriod - deriving (Eq, Ord, Read, Show)--_ShapeAtom = (Core.Name "hydra/ext/shex/syntax.ShapeAtom")--_ShapeAtom_sequence = (Core.FieldName "sequence")--_ShapeAtom_shapeOrRef = (Core.FieldName "shapeOrRef")--_ShapeAtom_sequence2 = (Core.FieldName "sequence2")--_ShapeAtom_period = (Core.FieldName "period")--data ShapeAtom_Sequence = - ShapeAtom_Sequence {- shapeAtom_SequenceNodeConstraint :: NodeConstraint,- shapeAtom_SequenceShapeOrRef :: (Maybe ShapeOrRef)}- deriving (Eq, Ord, Read, Show)--_ShapeAtom_Sequence = (Core.Name "hydra/ext/shex/syntax.ShapeAtom.Sequence")--_ShapeAtom_Sequence_nodeConstraint = (Core.FieldName "nodeConstraint")--_ShapeAtom_Sequence_shapeOrRef = (Core.FieldName "shapeOrRef")--data ShapeAtom_Sequence2 = - ShapeAtom_Sequence2 {- shapeAtom_Sequence2ShapeExpression :: ShapeExpression}- deriving (Eq, Ord, Read, Show)--_ShapeAtom_Sequence2 = (Core.Name "hydra/ext/shex/syntax.ShapeAtom.Sequence2")--_ShapeAtom_Sequence2_shapeExpression = (Core.FieldName "shapeExpression")--data InlineShapeAtom = - InlineShapeAtomSequence InlineShapeAtom_Sequence |- InlineShapeAtomSequence2 InlineShapeAtom_Sequence2 |- InlineShapeAtomSequence3 InlineShapeAtom_Sequence3 |- InlineShapeAtomPeriod - deriving (Eq, Ord, Read, Show)--_InlineShapeAtom = (Core.Name "hydra/ext/shex/syntax.InlineShapeAtom")--_InlineShapeAtom_sequence = (Core.FieldName "sequence")--_InlineShapeAtom_sequence2 = (Core.FieldName "sequence2")--_InlineShapeAtom_sequence3 = (Core.FieldName "sequence3")--_InlineShapeAtom_period = (Core.FieldName "period")--data InlineShapeAtom_Sequence = - InlineShapeAtom_Sequence {- inlineShapeAtom_SequenceNodeConstraint :: NodeConstraint,- inlineShapeAtom_SequenceInlineShapeOrRef :: (Maybe InlineShapeOrRef)}- deriving (Eq, Ord, Read, Show)--_InlineShapeAtom_Sequence = (Core.Name "hydra/ext/shex/syntax.InlineShapeAtom.Sequence")--_InlineShapeAtom_Sequence_nodeConstraint = (Core.FieldName "nodeConstraint")--_InlineShapeAtom_Sequence_inlineShapeOrRef = (Core.FieldName "inlineShapeOrRef")--data InlineShapeAtom_Sequence2 = - InlineShapeAtom_Sequence2 {- inlineShapeAtom_Sequence2InlineShapeOrRef :: InlineShapeOrRef,- inlineShapeAtom_Sequence2NodeConstraint :: (Maybe NodeConstraint)}- deriving (Eq, Ord, Read, Show)--_InlineShapeAtom_Sequence2 = (Core.Name "hydra/ext/shex/syntax.InlineShapeAtom.Sequence2")--_InlineShapeAtom_Sequence2_inlineShapeOrRef = (Core.FieldName "inlineShapeOrRef")--_InlineShapeAtom_Sequence2_nodeConstraint = (Core.FieldName "nodeConstraint")--data InlineShapeAtom_Sequence3 = - InlineShapeAtom_Sequence3 {- inlineShapeAtom_Sequence3ShapeExpression :: ShapeExpression}- deriving (Eq, Ord, Read, Show)--_InlineShapeAtom_Sequence3 = (Core.Name "hydra/ext/shex/syntax.InlineShapeAtom.Sequence3")--_InlineShapeAtom_Sequence3_shapeExpression = (Core.FieldName "shapeExpression")--data ShapeOrRef = - ShapeOrRefShapeDefinition ShapeDefinition |- ShapeOrRefAtpNameLn AtpNameLn |- ShapeOrRefAtpNameNs AtpNameNs |- ShapeOrRefSequence ShapeOrRef_Sequence- deriving (Eq, Ord, Read, Show)--_ShapeOrRef = (Core.Name "hydra/ext/shex/syntax.ShapeOrRef")--_ShapeOrRef_shapeDefinition = (Core.FieldName "shapeDefinition")--_ShapeOrRef_atpNameLn = (Core.FieldName "atpNameLn")--_ShapeOrRef_atpNameNs = (Core.FieldName "atpNameNs")--_ShapeOrRef_sequence = (Core.FieldName "sequence")--data ShapeOrRef_Sequence = - ShapeOrRef_Sequence {- shapeOrRef_SequenceShapeExprLabel :: ShapeExprLabel}- deriving (Eq, Ord, Read, Show)--_ShapeOrRef_Sequence = (Core.Name "hydra/ext/shex/syntax.ShapeOrRef.Sequence")--_ShapeOrRef_Sequence_shapeExprLabel = (Core.FieldName "shapeExprLabel")--data InlineShapeOrRef = - InlineShapeOrRefInlineShapeDefinition InlineShapeDefinition |- InlineShapeOrRefAtpNameLn AtpNameLn |- InlineShapeOrRefAtpNameNs AtpNameNs |- InlineShapeOrRefSequence InlineShapeOrRef_Sequence- deriving (Eq, Ord, Read, Show)--_InlineShapeOrRef = (Core.Name "hydra/ext/shex/syntax.InlineShapeOrRef")--_InlineShapeOrRef_inlineShapeDefinition = (Core.FieldName "inlineShapeDefinition")--_InlineShapeOrRef_atpNameLn = (Core.FieldName "atpNameLn")--_InlineShapeOrRef_atpNameNs = (Core.FieldName "atpNameNs")--_InlineShapeOrRef_sequence = (Core.FieldName "sequence")--data InlineShapeOrRef_Sequence = - InlineShapeOrRef_Sequence {- inlineShapeOrRef_SequenceShapeExprLabel :: ShapeExprLabel}- deriving (Eq, Ord, Read, Show)--_InlineShapeOrRef_Sequence = (Core.Name "hydra/ext/shex/syntax.InlineShapeOrRef.Sequence")--_InlineShapeOrRef_Sequence_shapeExprLabel = (Core.FieldName "shapeExprLabel")--data NodeConstraint = - NodeConstraintSequence NodeConstraint_Sequence |- NodeConstraintSequence2 NodeConstraint_Sequence2 |- NodeConstraintSequence3 NodeConstraint_Sequence3 |- NodeConstraintSequence4 NodeConstraint_Sequence4 |- NodeConstraintSequence5 NodeConstraint_Sequence5 |- NodeConstraintListOfXsFacet [XsFacet]- deriving (Eq, Ord, Read, Show)--_NodeConstraint = (Core.Name "hydra/ext/shex/syntax.NodeConstraint")--_NodeConstraint_sequence = (Core.FieldName "sequence")--_NodeConstraint_sequence2 = (Core.FieldName "sequence2")--_NodeConstraint_sequence3 = (Core.FieldName "sequence3")--_NodeConstraint_sequence4 = (Core.FieldName "sequence4")--_NodeConstraint_sequence5 = (Core.FieldName "sequence5")--_NodeConstraint_listOfXsFacet = (Core.FieldName "listOfXsFacet")--data NodeConstraint_Sequence = - NodeConstraint_Sequence {- nodeConstraint_SequenceListOfXsFacet :: [XsFacet]}- deriving (Eq, Ord, Read, Show)--_NodeConstraint_Sequence = (Core.Name "hydra/ext/shex/syntax.NodeConstraint.Sequence")--_NodeConstraint_Sequence_listOfXsFacet = (Core.FieldName "listOfXsFacet")--data NodeConstraint_Sequence2 = - NodeConstraint_Sequence2 {- nodeConstraint_Sequence2NonLiteralKind :: NonLiteralKind,- nodeConstraint_Sequence2ListOfStringFacet :: [StringFacet]}- deriving (Eq, Ord, Read, Show)--_NodeConstraint_Sequence2 = (Core.Name "hydra/ext/shex/syntax.NodeConstraint.Sequence2")--_NodeConstraint_Sequence2_nonLiteralKind = (Core.FieldName "nonLiteralKind")--_NodeConstraint_Sequence2_listOfStringFacet = (Core.FieldName "listOfStringFacet")--data NodeConstraint_Sequence3 = - NodeConstraint_Sequence3 {- nodeConstraint_Sequence3Datatype :: Datatype,- nodeConstraint_Sequence3ListOfXsFacet :: [XsFacet]}- deriving (Eq, Ord, Read, Show)--_NodeConstraint_Sequence3 = (Core.Name "hydra/ext/shex/syntax.NodeConstraint.Sequence3")--_NodeConstraint_Sequence3_datatype = (Core.FieldName "datatype")--_NodeConstraint_Sequence3_listOfXsFacet = (Core.FieldName "listOfXsFacet")--data NodeConstraint_Sequence4 = - NodeConstraint_Sequence4 {- nodeConstraint_Sequence4ValueSet :: ValueSet,- nodeConstraint_Sequence4ListOfXsFacet :: [XsFacet]}- deriving (Eq, Ord, Read, Show)--_NodeConstraint_Sequence4 = (Core.Name "hydra/ext/shex/syntax.NodeConstraint.Sequence4")--_NodeConstraint_Sequence4_valueSet = (Core.FieldName "valueSet")--_NodeConstraint_Sequence4_listOfXsFacet = (Core.FieldName "listOfXsFacet")--data NodeConstraint_Sequence5 = - NodeConstraint_Sequence5 {- nodeConstraint_Sequence5ValueSet :: ValueSet,- nodeConstraint_Sequence5ListOfXsFacet :: [XsFacet]}- deriving (Eq, Ord, Read, Show)--_NodeConstraint_Sequence5 = (Core.Name "hydra/ext/shex/syntax.NodeConstraint.Sequence5")--_NodeConstraint_Sequence5_valueSet = (Core.FieldName "valueSet")--_NodeConstraint_Sequence5_listOfXsFacet = (Core.FieldName "listOfXsFacet")--data NonLiteralKind = - NonLiteralKindIRI |- NonLiteralKindBNODE |- NonLiteralKindNONLITERAL - deriving (Eq, Ord, Read, Show)--_NonLiteralKind = (Core.Name "hydra/ext/shex/syntax.NonLiteralKind")--_NonLiteralKind_iRI = (Core.FieldName "iRI")--_NonLiteralKind_bNODE = (Core.FieldName "bNODE")--_NonLiteralKind_nONLITERAL = (Core.FieldName "nONLITERAL")--data XsFacet = - XsFacetStringFacet StringFacet |- XsFacetNumericFacet NumericFacet- deriving (Eq, Ord, Read, Show)--_XsFacet = (Core.Name "hydra/ext/shex/syntax.XsFacet")--_XsFacet_stringFacet = (Core.FieldName "stringFacet")--_XsFacet_numericFacet = (Core.FieldName "numericFacet")--data StringFacet = - StringFacetSequence StringFacet_Sequence |- StringFacetRegexp Regexp- deriving (Eq, Ord, Read, Show)--_StringFacet = (Core.Name "hydra/ext/shex/syntax.StringFacet")--_StringFacet_sequence = (Core.FieldName "sequence")--_StringFacet_regexp = (Core.FieldName "regexp")--data StringFacet_Sequence = - StringFacet_Sequence {- stringFacet_SequenceStringLength :: StringLength,- stringFacet_SequenceInteger :: Integer_}- deriving (Eq, Ord, Read, Show)--_StringFacet_Sequence = (Core.Name "hydra/ext/shex/syntax.StringFacet.Sequence")--_StringFacet_Sequence_stringLength = (Core.FieldName "stringLength")--_StringFacet_Sequence_integer = (Core.FieldName "integer")--data StringLength = - StringLengthLENGTH |- StringLengthMINLENGTH |- StringLengthMAXLENGTH - deriving (Eq, Ord, Read, Show)--_StringLength = (Core.Name "hydra/ext/shex/syntax.StringLength")--_StringLength_lENGTH = (Core.FieldName "lENGTH")--_StringLength_mINLENGTH = (Core.FieldName "mINLENGTH")--_StringLength_mAXLENGTH = (Core.FieldName "mAXLENGTH")--data NumericFacet = - NumericFacetSequence NumericFacet_Sequence |- NumericFacetSequence2 NumericFacet_Sequence2- deriving (Eq, Ord, Read, Show)--_NumericFacet = (Core.Name "hydra/ext/shex/syntax.NumericFacet")--_NumericFacet_sequence = (Core.FieldName "sequence")--_NumericFacet_sequence2 = (Core.FieldName "sequence2")--data NumericFacet_Sequence = - NumericFacet_Sequence {- numericFacet_SequenceNumericRange :: NumericRange,- numericFacet_SequenceNumericLiteral :: NumericLiteral}- deriving (Eq, Ord, Read, Show)--_NumericFacet_Sequence = (Core.Name "hydra/ext/shex/syntax.NumericFacet.Sequence")--_NumericFacet_Sequence_numericRange = (Core.FieldName "numericRange")--_NumericFacet_Sequence_numericLiteral = (Core.FieldName "numericLiteral")--data NumericFacet_Sequence2 = - NumericFacet_Sequence2 {- numericFacet_Sequence2NumericLength :: NumericLength,- numericFacet_Sequence2Integer :: Integer_}- deriving (Eq, Ord, Read, Show)--_NumericFacet_Sequence2 = (Core.Name "hydra/ext/shex/syntax.NumericFacet.Sequence2")--_NumericFacet_Sequence2_numericLength = (Core.FieldName "numericLength")--_NumericFacet_Sequence2_integer = (Core.FieldName "integer")--data NumericRange = - NumericRangeMININCLUSIVE |- NumericRangeMINEXCLUSIVE |- NumericRangeMAXINCLUSIVE |- NumericRangeMAXEXCLUSIVE - deriving (Eq, Ord, Read, Show)--_NumericRange = (Core.Name "hydra/ext/shex/syntax.NumericRange")--_NumericRange_mININCLUSIVE = (Core.FieldName "mININCLUSIVE")--_NumericRange_mINEXCLUSIVE = (Core.FieldName "mINEXCLUSIVE")--_NumericRange_mAXINCLUSIVE = (Core.FieldName "mAXINCLUSIVE")--_NumericRange_mAXEXCLUSIVE = (Core.FieldName "mAXEXCLUSIVE")--data NumericLength = - NumericLengthTOTALDIGITS |- NumericLengthFRACTIONDIGITS - deriving (Eq, Ord, Read, Show)--_NumericLength = (Core.Name "hydra/ext/shex/syntax.NumericLength")--_NumericLength_tOTALDIGITS = (Core.FieldName "tOTALDIGITS")--_NumericLength_fRACTIONDIGITS = (Core.FieldName "fRACTIONDIGITS")--data ShapeDefinition = - ShapeDefinition {- shapeDefinitionListOfAlts :: [ShapeDefinition_ListOfAlts_Elmt],- shapeDefinitionTripleExpression :: (Maybe TripleExpression),- shapeDefinitionListOfAnnotation :: [Annotation],- shapeDefinitionSemanticActions :: SemanticActions}- deriving (Eq, Ord, Read, Show)--_ShapeDefinition = (Core.Name "hydra/ext/shex/syntax.ShapeDefinition")--_ShapeDefinition_listOfAlts = (Core.FieldName "listOfAlts")--_ShapeDefinition_tripleExpression = (Core.FieldName "tripleExpression")--_ShapeDefinition_listOfAnnotation = (Core.FieldName "listOfAnnotation")--_ShapeDefinition_semanticActions = (Core.FieldName "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/ext/shex/syntax.ShapeDefinition.ListOfAlts.Elmt")--_ShapeDefinition_ListOfAlts_Elmt_includeSet = (Core.FieldName "includeSet")--_ShapeDefinition_ListOfAlts_Elmt_extraPropertySet = (Core.FieldName "extraPropertySet")--_ShapeDefinition_ListOfAlts_Elmt_cLOSED = (Core.FieldName "cLOSED")--data InlineShapeDefinition = - InlineShapeDefinition {- inlineShapeDefinitionListOfAlts :: [InlineShapeDefinition_ListOfAlts_Elmt],- inlineShapeDefinitionTripleExpression :: (Maybe TripleExpression)}- deriving (Eq, Ord, Read, Show)--_InlineShapeDefinition = (Core.Name "hydra/ext/shex/syntax.InlineShapeDefinition")--_InlineShapeDefinition_listOfAlts = (Core.FieldName "listOfAlts")--_InlineShapeDefinition_tripleExpression = (Core.FieldName "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/ext/shex/syntax.InlineShapeDefinition.ListOfAlts.Elmt")--_InlineShapeDefinition_ListOfAlts_Elmt_includeSet = (Core.FieldName "includeSet")--_InlineShapeDefinition_ListOfAlts_Elmt_extraPropertySet = (Core.FieldName "extraPropertySet")--_InlineShapeDefinition_ListOfAlts_Elmt_cLOSED = (Core.FieldName "cLOSED")--data ExtraPropertySet = - ExtraPropertySet {- extraPropertySetListOfPredicate :: [Predicate]}- deriving (Eq, Ord, Read, Show)--_ExtraPropertySet = (Core.Name "hydra/ext/shex/syntax.ExtraPropertySet")--_ExtraPropertySet_listOfPredicate = (Core.FieldName "listOfPredicate")--newtype TripleExpression = - TripleExpression {- unTripleExpression :: OneOfTripleExpr}- deriving (Eq, Ord, Read, Show)--_TripleExpression = (Core.Name "hydra/ext/shex/syntax.TripleExpression")--data OneOfTripleExpr = - OneOfTripleExprGroupTripleExpr GroupTripleExpr |- OneOfTripleExprMultiElementOneOf MultiElementOneOf- deriving (Eq, Ord, Read, Show)--_OneOfTripleExpr = (Core.Name "hydra/ext/shex/syntax.OneOfTripleExpr")--_OneOfTripleExpr_groupTripleExpr = (Core.FieldName "groupTripleExpr")--_OneOfTripleExpr_multiElementOneOf = (Core.FieldName "multiElementOneOf")--data MultiElementOneOf = - MultiElementOneOf {- multiElementOneOfGroupTripleExpr :: GroupTripleExpr,- multiElementOneOfListOfSequence :: [MultiElementOneOf_ListOfSequence_Elmt]}- deriving (Eq, Ord, Read, Show)--_MultiElementOneOf = (Core.Name "hydra/ext/shex/syntax.MultiElementOneOf")--_MultiElementOneOf_groupTripleExpr = (Core.FieldName "groupTripleExpr")--_MultiElementOneOf_listOfSequence = (Core.FieldName "listOfSequence")--data MultiElementOneOf_ListOfSequence_Elmt = - MultiElementOneOf_ListOfSequence_Elmt {- multiElementOneOf_ListOfSequence_ElmtGroupTripleExpr :: GroupTripleExpr}- deriving (Eq, Ord, Read, Show)--_MultiElementOneOf_ListOfSequence_Elmt = (Core.Name "hydra/ext/shex/syntax.MultiElementOneOf.ListOfSequence.Elmt")--_MultiElementOneOf_ListOfSequence_Elmt_groupTripleExpr = (Core.FieldName "groupTripleExpr")--data InnerTripleExpr = - InnerTripleExprMultiElementGroup MultiElementGroup |- InnerTripleExprMultiElementOneOf MultiElementOneOf- deriving (Eq, Ord, Read, Show)--_InnerTripleExpr = (Core.Name "hydra/ext/shex/syntax.InnerTripleExpr")--_InnerTripleExpr_multiElementGroup = (Core.FieldName "multiElementGroup")--_InnerTripleExpr_multiElementOneOf = (Core.FieldName "multiElementOneOf")--data GroupTripleExpr = - GroupTripleExprSingleElementGroup SingleElementGroup |- GroupTripleExprMultiElementGroup MultiElementGroup- deriving (Eq, Ord, Read, Show)--_GroupTripleExpr = (Core.Name "hydra/ext/shex/syntax.GroupTripleExpr")--_GroupTripleExpr_singleElementGroup = (Core.FieldName "singleElementGroup")--_GroupTripleExpr_multiElementGroup = (Core.FieldName "multiElementGroup")--data SingleElementGroup = - SingleElementGroup {- singleElementGroupUnaryTripleExpr :: UnaryTripleExpr,- singleElementGroupSemi :: (Maybe ())}- deriving (Eq, Ord, Read, Show)--_SingleElementGroup = (Core.Name "hydra/ext/shex/syntax.SingleElementGroup")--_SingleElementGroup_unaryTripleExpr = (Core.FieldName "unaryTripleExpr")--_SingleElementGroup_semi = (Core.FieldName "semi")--data MultiElementGroup = - MultiElementGroup {- multiElementGroupUnaryTripleExpr :: UnaryTripleExpr,- multiElementGroupListOfSequence :: [MultiElementGroup_ListOfSequence_Elmt],- multiElementGroupSemi :: (Maybe ())}- deriving (Eq, Ord, Read, Show)--_MultiElementGroup = (Core.Name "hydra/ext/shex/syntax.MultiElementGroup")--_MultiElementGroup_unaryTripleExpr = (Core.FieldName "unaryTripleExpr")--_MultiElementGroup_listOfSequence = (Core.FieldName "listOfSequence")--_MultiElementGroup_semi = (Core.FieldName "semi")--data MultiElementGroup_ListOfSequence_Elmt = - MultiElementGroup_ListOfSequence_Elmt {- multiElementGroup_ListOfSequence_ElmtUnaryTripleExpr :: UnaryTripleExpr}- deriving (Eq, Ord, Read, Show)--_MultiElementGroup_ListOfSequence_Elmt = (Core.Name "hydra/ext/shex/syntax.MultiElementGroup.ListOfSequence.Elmt")--_MultiElementGroup_ListOfSequence_Elmt_unaryTripleExpr = (Core.FieldName "unaryTripleExpr")--data UnaryTripleExpr = - UnaryTripleExprSequence UnaryTripleExpr_Sequence |- UnaryTripleExprInclude Include- deriving (Eq, Ord, Read, Show)--_UnaryTripleExpr = (Core.Name "hydra/ext/shex/syntax.UnaryTripleExpr")--_UnaryTripleExpr_sequence = (Core.FieldName "sequence")--_UnaryTripleExpr_include = (Core.FieldName "include")--data UnaryTripleExpr_Sequence = - UnaryTripleExpr_Sequence {- unaryTripleExpr_SequenceSequence :: (Maybe UnaryTripleExpr_Sequence_Sequence_Option),- unaryTripleExpr_SequenceAlts :: UnaryTripleExpr_Sequence_Alts}- deriving (Eq, Ord, Read, Show)--_UnaryTripleExpr_Sequence = (Core.Name "hydra/ext/shex/syntax.UnaryTripleExpr.Sequence")--_UnaryTripleExpr_Sequence_sequence = (Core.FieldName "sequence")--_UnaryTripleExpr_Sequence_alts = (Core.FieldName "alts")--data UnaryTripleExpr_Sequence_Sequence_Option = - UnaryTripleExpr_Sequence_Sequence_Option {- unaryTripleExpr_Sequence_Sequence_OptionTripleExprLabel :: TripleExprLabel}- deriving (Eq, Ord, Read, Show)--_UnaryTripleExpr_Sequence_Sequence_Option = (Core.Name "hydra/ext/shex/syntax.UnaryTripleExpr.Sequence.Sequence.Option")--_UnaryTripleExpr_Sequence_Sequence_Option_tripleExprLabel = (Core.FieldName "tripleExprLabel")--data UnaryTripleExpr_Sequence_Alts = - UnaryTripleExpr_Sequence_AltsTripleConstraint TripleConstraint |- UnaryTripleExpr_Sequence_AltsBracketedTripleExpr BracketedTripleExpr- deriving (Eq, Ord, Read, Show)--_UnaryTripleExpr_Sequence_Alts = (Core.Name "hydra/ext/shex/syntax.UnaryTripleExpr.Sequence.Alts")--_UnaryTripleExpr_Sequence_Alts_tripleConstraint = (Core.FieldName "tripleConstraint")--_UnaryTripleExpr_Sequence_Alts_bracketedTripleExpr = (Core.FieldName "bracketedTripleExpr")--data BracketedTripleExpr = - BracketedTripleExpr {- bracketedTripleExprInnerTripleExpr :: InnerTripleExpr,- bracketedTripleExprCardinality :: (Maybe Cardinality),- bracketedTripleExprListOfAnnotation :: [Annotation],- bracketedTripleExprSemanticActions :: SemanticActions}- deriving (Eq, Ord, Read, Show)--_BracketedTripleExpr = (Core.Name "hydra/ext/shex/syntax.BracketedTripleExpr")--_BracketedTripleExpr_innerTripleExpr = (Core.FieldName "innerTripleExpr")--_BracketedTripleExpr_cardinality = (Core.FieldName "cardinality")--_BracketedTripleExpr_listOfAnnotation = (Core.FieldName "listOfAnnotation")--_BracketedTripleExpr_semanticActions = (Core.FieldName "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/ext/shex/syntax.TripleConstraint")--_TripleConstraint_senseFlags = (Core.FieldName "senseFlags")--_TripleConstraint_predicate = (Core.FieldName "predicate")--_TripleConstraint_inlineShapeExpression = (Core.FieldName "inlineShapeExpression")--_TripleConstraint_cardinality = (Core.FieldName "cardinality")--_TripleConstraint_listOfAnnotation = (Core.FieldName "listOfAnnotation")--_TripleConstraint_semanticActions = (Core.FieldName "semanticActions")--data Cardinality = - CardinalityAst |- CardinalityPlus |- CardinalityQuest |- CardinalityRepeatRange RepeatRange- deriving (Eq, Ord, Read, Show)--_Cardinality = (Core.Name "hydra/ext/shex/syntax.Cardinality")--_Cardinality_ast = (Core.FieldName "ast")--_Cardinality_plus = (Core.FieldName "plus")--_Cardinality_quest = (Core.FieldName "quest")--_Cardinality_repeatRange = (Core.FieldName "repeatRange")--data SenseFlags = - SenseFlags {}- deriving (Eq, Ord, Read, Show)--_SenseFlags = (Core.Name "hydra/ext/shex/syntax.SenseFlags")--data ValueSet = - ValueSet {- valueSetListOfValueSetValue :: [ValueSetValue]}- deriving (Eq, Ord, Read, Show)--_ValueSet = (Core.Name "hydra/ext/shex/syntax.ValueSet")--_ValueSet_listOfValueSetValue = (Core.FieldName "listOfValueSetValue")--data ValueSetValue = - ValueSetValueIriRange IriRange |- ValueSetValueLiteral Literal- deriving (Eq, Ord, Read, Show)--_ValueSetValue = (Core.Name "hydra/ext/shex/syntax.ValueSetValue")--_ValueSetValue_iriRange = (Core.FieldName "iriRange")--_ValueSetValue_literal = (Core.FieldName "literal")--data IriRange = - IriRangeSequence IriRange_Sequence |- IriRangeSequence2 IriRange_Sequence2- deriving (Eq, Ord, Read, Show)--_IriRange = (Core.Name "hydra/ext/shex/syntax.IriRange")--_IriRange_sequence = (Core.FieldName "sequence")--_IriRange_sequence2 = (Core.FieldName "sequence2")--data IriRange_Sequence = - IriRange_Sequence {- iriRange_SequenceIri :: Iri,- iriRange_SequenceSequence :: (Maybe IriRange_Sequence_Sequence_Option)}- deriving (Eq, Ord, Read, Show)--_IriRange_Sequence = (Core.Name "hydra/ext/shex/syntax.IriRange.Sequence")--_IriRange_Sequence_iri = (Core.FieldName "iri")--_IriRange_Sequence_sequence = (Core.FieldName "sequence")--data IriRange_Sequence_Sequence_Option = - IriRange_Sequence_Sequence_Option {- iriRange_Sequence_Sequence_OptionListOfExclusion :: [Exclusion]}- deriving (Eq, Ord, Read, Show)--_IriRange_Sequence_Sequence_Option = (Core.Name "hydra/ext/shex/syntax.IriRange.Sequence.Sequence.Option")--_IriRange_Sequence_Sequence_Option_listOfExclusion = (Core.FieldName "listOfExclusion")--data IriRange_Sequence2 = - IriRange_Sequence2 {- iriRange_Sequence2ListOfExclusion :: [Exclusion]}- deriving (Eq, Ord, Read, Show)--_IriRange_Sequence2 = (Core.Name "hydra/ext/shex/syntax.IriRange.Sequence2")--_IriRange_Sequence2_listOfExclusion = (Core.FieldName "listOfExclusion")--data Exclusion = - Exclusion {- exclusionIri :: Iri}- deriving (Eq, Ord, Read, Show)--_Exclusion = (Core.Name "hydra/ext/shex/syntax.Exclusion")--_Exclusion_iri = (Core.FieldName "iri")--data Include = - Include {- includeTripleExprLabel :: TripleExprLabel}- deriving (Eq, Ord, Read, Show)--_Include = (Core.Name "hydra/ext/shex/syntax.Include")--_Include_tripleExprLabel = (Core.FieldName "tripleExprLabel")--data Annotation = - Annotation {- annotationPredicate :: Predicate,- annotationAlts :: Annotation_Alts}- deriving (Eq, Ord, Read, Show)--_Annotation = (Core.Name "hydra/ext/shex/syntax.Annotation")--_Annotation_predicate = (Core.FieldName "predicate")--_Annotation_alts = (Core.FieldName "alts")--data Annotation_Alts = - Annotation_AltsIri Iri |- Annotation_AltsLiteral Literal- deriving (Eq, Ord, Read, Show)--_Annotation_Alts = (Core.Name "hydra/ext/shex/syntax.Annotation.Alts")--_Annotation_Alts_iri = (Core.FieldName "iri")--_Annotation_Alts_literal = (Core.FieldName "literal")--newtype SemanticActions = - SemanticActions {- unSemanticActions :: [CodeDecl]}- deriving (Eq, Ord, Read, Show)--_SemanticActions = (Core.Name "hydra/ext/shex/syntax.SemanticActions")--data CodeDecl = - CodeDecl {- codeDeclIri :: Iri,- codeDeclAlts :: CodeDecl_Alts}- deriving (Eq, Ord, Read, Show)--_CodeDecl = (Core.Name "hydra/ext/shex/syntax.CodeDecl")--_CodeDecl_iri = (Core.FieldName "iri")--_CodeDecl_alts = (Core.FieldName "alts")--data CodeDecl_Alts = - CodeDecl_AltsCode Code |- CodeDecl_AltsPercnt - deriving (Eq, Ord, Read, Show)--_CodeDecl_Alts = (Core.Name "hydra/ext/shex/syntax.CodeDecl.Alts")--_CodeDecl_Alts_code = (Core.FieldName "code")--_CodeDecl_Alts_percnt = (Core.FieldName "percnt")--data Literal = - LiteralRdfLiteral RdfLiteral |- LiteralNumericLiteral NumericLiteral |- LiteralBooleanLiteral BooleanLiteral- deriving (Eq, Ord, Read, Show)--_Literal = (Core.Name "hydra/ext/shex/syntax.Literal")--_Literal_rdfLiteral = (Core.FieldName "rdfLiteral")--_Literal_numericLiteral = (Core.FieldName "numericLiteral")--_Literal_booleanLiteral = (Core.FieldName "booleanLiteral")--data Predicate = - PredicateIri Iri |- PredicateRdfType RdfType- deriving (Eq, Ord, Read, Show)--_Predicate = (Core.Name "hydra/ext/shex/syntax.Predicate")--_Predicate_iri = (Core.FieldName "iri")--_Predicate_rdfType = (Core.FieldName "rdfType")--newtype Datatype = - Datatype {- unDatatype :: Iri}- deriving (Eq, Ord, Read, Show)--_Datatype = (Core.Name "hydra/ext/shex/syntax.Datatype")--data ShapeExprLabel = - ShapeExprLabelIri Iri |- ShapeExprLabelBlankNode BlankNode- deriving (Eq, Ord, Read, Show)--_ShapeExprLabel = (Core.Name "hydra/ext/shex/syntax.ShapeExprLabel")--_ShapeExprLabel_iri = (Core.FieldName "iri")--_ShapeExprLabel_blankNode = (Core.FieldName "blankNode")--data TripleExprLabel = - TripleExprLabel {- tripleExprLabelAlts :: TripleExprLabel_Alts}- deriving (Eq, Ord, Read, Show)--_TripleExprLabel = (Core.Name "hydra/ext/shex/syntax.TripleExprLabel")--_TripleExprLabel_alts = (Core.FieldName "alts")--data TripleExprLabel_Alts = - TripleExprLabel_AltsIri Iri |- TripleExprLabel_AltsBlankNode BlankNode- deriving (Eq, Ord, Read, Show)--_TripleExprLabel_Alts = (Core.Name "hydra/ext/shex/syntax.TripleExprLabel.Alts")--_TripleExprLabel_Alts_iri = (Core.FieldName "iri")--_TripleExprLabel_Alts_blankNode = (Core.FieldName "blankNode")--data NumericLiteral = - NumericLiteralInteger Integer_ |- NumericLiteralDecimal Decimal |- NumericLiteralDouble Double_- deriving (Eq, Ord, Read, Show)--_NumericLiteral = (Core.Name "hydra/ext/shex/syntax.NumericLiteral")--_NumericLiteral_integer = (Core.FieldName "integer")--_NumericLiteral_decimal = (Core.FieldName "decimal")--_NumericLiteral_double = (Core.FieldName "double")--data RdfLiteral = - RdfLiteral {- rdfLiteralString :: String_,- rdfLiteralAlts :: (Maybe RdfLiteral_Alts_Option)}- deriving (Eq, Ord, Read, Show)--_RdfLiteral = (Core.Name "hydra/ext/shex/syntax.RdfLiteral")--_RdfLiteral_string = (Core.FieldName "string")--_RdfLiteral_alts = (Core.FieldName "alts")--data RdfLiteral_Alts_Option = - RdfLiteral_Alts_OptionLangTag LangTag |- RdfLiteral_Alts_OptionSequence RdfLiteral_Alts_Option_Sequence- deriving (Eq, Ord, Read, Show)--_RdfLiteral_Alts_Option = (Core.Name "hydra/ext/shex/syntax.RdfLiteral.Alts.Option")--_RdfLiteral_Alts_Option_langTag = (Core.FieldName "langTag")--_RdfLiteral_Alts_Option_sequence = (Core.FieldName "sequence")--data RdfLiteral_Alts_Option_Sequence = - RdfLiteral_Alts_Option_Sequence {- rdfLiteral_Alts_Option_SequenceDatatype :: Datatype}- deriving (Eq, Ord, Read, Show)--_RdfLiteral_Alts_Option_Sequence = (Core.Name "hydra/ext/shex/syntax.RdfLiteral.Alts.Option.Sequence")--_RdfLiteral_Alts_Option_Sequence_datatype = (Core.FieldName "datatype")--data BooleanLiteral = - BooleanLiteralTrue |- BooleanLiteralFalse - deriving (Eq, Ord, Read, Show)--_BooleanLiteral = (Core.Name "hydra/ext/shex/syntax.BooleanLiteral")--_BooleanLiteral_true = (Core.FieldName "true")--_BooleanLiteral_false = (Core.FieldName "false")--data String_ = - StringStringLiteral1 StringLiteral1 |- StringStringLiteralLong1 StringLiteralLong1 |- StringStringLiteral2 StringLiteral2 |- StringStringLiteralLong2 StringLiteralLong2- deriving (Eq, Ord, Read, Show)--_String = (Core.Name "hydra/ext/shex/syntax.String")--_String_stringLiteral1 = (Core.FieldName "stringLiteral1")--_String_stringLiteralLong1 = (Core.FieldName "stringLiteralLong1")--_String_stringLiteral2 = (Core.FieldName "stringLiteral2")--_String_stringLiteralLong2 = (Core.FieldName "stringLiteralLong2")--data Iri = - IriIriRef IriRef |- IriPrefixedName PrefixedName- deriving (Eq, Ord, Read, Show)--_Iri = (Core.Name "hydra/ext/shex/syntax.Iri")--_Iri_iriRef = (Core.FieldName "iriRef")--_Iri_prefixedName = (Core.FieldName "prefixedName")--data PrefixedName = - PrefixedNamePnameLn PnameLn |- PrefixedNamePnameNs PnameNs- deriving (Eq, Ord, Read, Show)--_PrefixedName = (Core.Name "hydra/ext/shex/syntax.PrefixedName")--_PrefixedName_pnameLn = (Core.FieldName "pnameLn")--_PrefixedName_pnameNs = (Core.FieldName "pnameNs")--newtype BlankNode = - BlankNode {- unBlankNode :: BlankNodeLabel}- deriving (Eq, Ord, Read, Show)--_BlankNode = (Core.Name "hydra/ext/shex/syntax.BlankNode")--data IncludeSet = - IncludeSet {- includeSetListOfShapeExprLabel :: [ShapeExprLabel]}- deriving (Eq, Ord, Read, Show)--_IncludeSet = (Core.Name "hydra/ext/shex/syntax.IncludeSet")--_IncludeSet_listOfShapeExprLabel = (Core.FieldName "listOfShapeExprLabel")--data Code = - Code {- codeListOfAlts :: [Code_ListOfAlts_Elmt]}- deriving (Eq, Ord, Read, Show)--_Code = (Core.Name "hydra/ext/shex/syntax.Code")--_Code_listOfAlts = (Core.FieldName "listOfAlts")--data Code_ListOfAlts_Elmt = - Code_ListOfAlts_ElmtRegex String |- Code_ListOfAlts_ElmtSequence Code_ListOfAlts_Elmt_Sequence |- Code_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_Code_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.Code.ListOfAlts.Elmt")--_Code_ListOfAlts_Elmt_regex = (Core.FieldName "regex")--_Code_ListOfAlts_Elmt_sequence = (Core.FieldName "sequence")--_Code_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data Code_ListOfAlts_Elmt_Sequence = - Code_ListOfAlts_Elmt_Sequence {- code_ListOfAlts_Elmt_SequenceRegex :: String}- deriving (Eq, Ord, Read, Show)--_Code_ListOfAlts_Elmt_Sequence = (Core.Name "hydra/ext/shex/syntax.Code.ListOfAlts.Elmt.Sequence")--_Code_ListOfAlts_Elmt_Sequence_regex = (Core.FieldName "regex")--data RepeatRange = - RepeatRange {- repeatRangeInteger :: Integer_,- repeatRangeSequence :: (Maybe RepeatRange_Sequence_Option)}- deriving (Eq, Ord, Read, Show)--_RepeatRange = (Core.Name "hydra/ext/shex/syntax.RepeatRange")--_RepeatRange_integer = (Core.FieldName "integer")--_RepeatRange_sequence = (Core.FieldName "sequence")--data RepeatRange_Sequence_Option = - RepeatRange_Sequence_Option {- repeatRange_Sequence_OptionAlts :: (Maybe (Maybe RepeatRange_Sequence_Option_Alts_Option_Option))}- deriving (Eq, Ord, Read, Show)--_RepeatRange_Sequence_Option = (Core.Name "hydra/ext/shex/syntax.RepeatRange.Sequence.Option")--_RepeatRange_Sequence_Option_alts = (Core.FieldName "alts")--data RepeatRange_Sequence_Option_Alts_Option_Option = - RepeatRange_Sequence_Option_Alts_Option_OptionInteger Integer_ |- RepeatRange_Sequence_Option_Alts_Option_OptionAst - deriving (Eq, Ord, Read, Show)--_RepeatRange_Sequence_Option_Alts_Option_Option = (Core.Name "hydra/ext/shex/syntax.RepeatRange.Sequence.Option.Alts.Option.Option")--_RepeatRange_Sequence_Option_Alts_Option_Option_integer = (Core.FieldName "integer")--_RepeatRange_Sequence_Option_Alts_Option_Option_ast = (Core.FieldName "ast")--data RdfType = - RdfType {}- deriving (Eq, Ord, Read, Show)--_RdfType = (Core.Name "hydra/ext/shex/syntax.RdfType")--data IriRef = - IriRef {- iriRefListOfAlts :: [IriRef_ListOfAlts_Elmt]}- deriving (Eq, Ord, Read, Show)--_IriRef = (Core.Name "hydra/ext/shex/syntax.IriRef")--_IriRef_listOfAlts = (Core.FieldName "listOfAlts")--data IriRef_ListOfAlts_Elmt = - IriRef_ListOfAlts_ElmtRegex String |- IriRef_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_IriRef_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.IriRef.ListOfAlts.Elmt")--_IriRef_ListOfAlts_Elmt_regex = (Core.FieldName "regex")--_IriRef_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data PnameNs = - PnameNs {- pnameNsPnPrefix :: (Maybe PnPrefix)}- deriving (Eq, Ord, Read, Show)--_PnameNs = (Core.Name "hydra/ext/shex/syntax.PnameNs")--_PnameNs_pnPrefix = (Core.FieldName "pnPrefix")--data PnameLn = - PnameLn {- pnameLnPnameNs :: PnameNs,- pnameLnPnLocal :: PnLocal}- deriving (Eq, Ord, Read, Show)--_PnameLn = (Core.Name "hydra/ext/shex/syntax.PnameLn")--_PnameLn_pnameNs = (Core.FieldName "pnameNs")--_PnameLn_pnLocal = (Core.FieldName "pnLocal")--data AtpNameNs = - AtpNameNs {- atpNameNsPnPrefix :: (Maybe PnPrefix)}- deriving (Eq, Ord, Read, Show)--_AtpNameNs = (Core.Name "hydra/ext/shex/syntax.AtpNameNs")--_AtpNameNs_pnPrefix = (Core.FieldName "pnPrefix")--data AtpNameLn = - AtpNameLn {- atpNameLnPnameNs :: PnameNs,- atpNameLnPnLocal :: PnLocal}- deriving (Eq, Ord, Read, Show)--_AtpNameLn = (Core.Name "hydra/ext/shex/syntax.AtpNameLn")--_AtpNameLn_pnameNs = (Core.FieldName "pnameNs")--_AtpNameLn_pnLocal = (Core.FieldName "pnLocal")--data Regexp = - Regexp {- regexpListOfAlts :: [Regexp_ListOfAlts_Elmt],- regexpListOfRegex :: [String]}- deriving (Eq, Ord, Read, Show)--_Regexp = (Core.Name "hydra/ext/shex/syntax.Regexp")--_Regexp_listOfAlts = (Core.FieldName "listOfAlts")--_Regexp_listOfRegex = (Core.FieldName "listOfRegex")--data Regexp_ListOfAlts_Elmt = - Regexp_ListOfAlts_ElmtRegex String |- Regexp_ListOfAlts_ElmtSequence Regexp_ListOfAlts_Elmt_Sequence |- Regexp_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_Regexp_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.Regexp.ListOfAlts.Elmt")--_Regexp_ListOfAlts_Elmt_regex = (Core.FieldName "regex")--_Regexp_ListOfAlts_Elmt_sequence = (Core.FieldName "sequence")--_Regexp_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data Regexp_ListOfAlts_Elmt_Sequence = - Regexp_ListOfAlts_Elmt_Sequence {- regexp_ListOfAlts_Elmt_SequenceRegex :: String}- deriving (Eq, Ord, Read, Show)--_Regexp_ListOfAlts_Elmt_Sequence = (Core.Name "hydra/ext/shex/syntax.Regexp.ListOfAlts.Elmt.Sequence")--_Regexp_ListOfAlts_Elmt_Sequence_regex = (Core.FieldName "regex")--data BlankNodeLabel = - BlankNodeLabel {- blankNodeLabelAlts :: BlankNodeLabel_Alts,- blankNodeLabelListOfAlts :: (Maybe [BlankNodeLabel_ListOfAlts_Option_Elmt]),- blankNodeLabelPnChars :: PnChars}- deriving (Eq, Ord, Read, Show)--_BlankNodeLabel = (Core.Name "hydra/ext/shex/syntax.BlankNodeLabel")--_BlankNodeLabel_alts = (Core.FieldName "alts")--_BlankNodeLabel_listOfAlts = (Core.FieldName "listOfAlts")--_BlankNodeLabel_pnChars = (Core.FieldName "pnChars")--data BlankNodeLabel_Alts = - BlankNodeLabel_AltsPnCharsU PnCharsU |- BlankNodeLabel_AltsRegex String- deriving (Eq, Ord, Read, Show)--_BlankNodeLabel_Alts = (Core.Name "hydra/ext/shex/syntax.BlankNodeLabel.Alts")--_BlankNodeLabel_Alts_pnCharsU = (Core.FieldName "pnCharsU")--_BlankNodeLabel_Alts_regex = (Core.FieldName "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/ext/shex/syntax.BlankNodeLabel.ListOfAlts.Option.Elmt")--_BlankNodeLabel_ListOfAlts_Option_Elmt_pnChars = (Core.FieldName "pnChars")--_BlankNodeLabel_ListOfAlts_Option_Elmt_period = (Core.FieldName "period")--newtype LangTag = - LangTag {- unLangTag :: String}- deriving (Eq, Ord, Read, Show)--_LangTag = (Core.Name "hydra/ext/shex/syntax.LangTag")--newtype Integer_ = - Integer_ {- unInteger :: String}- deriving (Eq, Ord, Read, Show)--_Integer = (Core.Name "hydra/ext/shex/syntax.Integer")--newtype Decimal = - Decimal {- unDecimal :: String}- deriving (Eq, Ord, Read, Show)--_Decimal = (Core.Name "hydra/ext/shex/syntax.Decimal")--newtype Double_ = - Double_ {- unDouble :: String}- deriving (Eq, Ord, Read, Show)--_Double = (Core.Name "hydra/ext/shex/syntax.Double")--data StringLiteral1 = - StringLiteral1 {- stringLiteral1ListOfAlts :: [StringLiteral1_ListOfAlts_Elmt]}- deriving (Eq, Ord, Read, Show)--_StringLiteral1 = (Core.Name "hydra/ext/shex/syntax.StringLiteral1")--_StringLiteral1_listOfAlts = (Core.FieldName "listOfAlts")--data StringLiteral1_ListOfAlts_Elmt = - StringLiteral1_ListOfAlts_ElmtRegex String |- StringLiteral1_ListOfAlts_ElmtEchar Echar |- StringLiteral1_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_StringLiteral1_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.StringLiteral1.ListOfAlts.Elmt")--_StringLiteral1_ListOfAlts_Elmt_regex = (Core.FieldName "regex")--_StringLiteral1_ListOfAlts_Elmt_echar = (Core.FieldName "echar")--_StringLiteral1_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data StringLiteral2 = - StringLiteral2 {- stringLiteral2ListOfAlts :: [StringLiteral2_ListOfAlts_Elmt]}- deriving (Eq, Ord, Read, Show)--_StringLiteral2 = (Core.Name "hydra/ext/shex/syntax.StringLiteral2")--_StringLiteral2_listOfAlts = (Core.FieldName "listOfAlts")--data StringLiteral2_ListOfAlts_Elmt = - StringLiteral2_ListOfAlts_ElmtRegex String |- StringLiteral2_ListOfAlts_ElmtEchar Echar |- StringLiteral2_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_StringLiteral2_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.StringLiteral2.ListOfAlts.Elmt")--_StringLiteral2_ListOfAlts_Elmt_regex = (Core.FieldName "regex")--_StringLiteral2_ListOfAlts_Elmt_echar = (Core.FieldName "echar")--_StringLiteral2_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data StringLiteralLong1 = - StringLiteralLong1 {- stringLiteralLong1ListOfAlts :: [StringLiteralLong1_ListOfAlts_Elmt]}- deriving (Eq, Ord, Read, Show)--_StringLiteralLong1 = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong1")--_StringLiteralLong1_listOfAlts = (Core.FieldName "listOfAlts")--data StringLiteralLong1_ListOfAlts_Elmt = - StringLiteralLong1_ListOfAlts_ElmtSequence StringLiteralLong1_ListOfAlts_Elmt_Sequence |- StringLiteralLong1_ListOfAlts_ElmtEchar Echar |- StringLiteralLong1_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_StringLiteralLong1_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong1.ListOfAlts.Elmt")--_StringLiteralLong1_ListOfAlts_Elmt_sequence = (Core.FieldName "sequence")--_StringLiteralLong1_ListOfAlts_Elmt_echar = (Core.FieldName "echar")--_StringLiteralLong1_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data StringLiteralLong1_ListOfAlts_Elmt_Sequence = - StringLiteralLong1_ListOfAlts_Elmt_Sequence {- stringLiteralLong1_ListOfAlts_Elmt_SequenceAlts :: (Maybe StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option),- stringLiteralLong1_ListOfAlts_Elmt_SequenceRegex :: String}- deriving (Eq, Ord, Read, Show)--_StringLiteralLong1_ListOfAlts_Elmt_Sequence = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong1.ListOfAlts.Elmt.Sequence")--_StringLiteralLong1_ListOfAlts_Elmt_Sequence_alts = (Core.FieldName "alts")--_StringLiteralLong1_ListOfAlts_Elmt_Sequence_regex = (Core.FieldName "regex")--data StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option = - StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_OptionApos |- StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_OptionSequence StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence- deriving (Eq, Ord, Read, Show)--_StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong1.ListOfAlts.Elmt.Sequence.Alts.Option")--_StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option_apos = (Core.FieldName "apos")--_StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option_sequence = (Core.FieldName "sequence")--data StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence = - StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence {}- deriving (Eq, Ord, Read, Show)--_StringLiteralLong1_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong1.ListOfAlts.Elmt.Sequence.Alts.Option.Sequence")--data StringLiteralLong2 = - StringLiteralLong2 {- stringLiteralLong2ListOfAlts :: [StringLiteralLong2_ListOfAlts_Elmt]}- deriving (Eq, Ord, Read, Show)--_StringLiteralLong2 = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong2")--_StringLiteralLong2_listOfAlts = (Core.FieldName "listOfAlts")--data StringLiteralLong2_ListOfAlts_Elmt = - StringLiteralLong2_ListOfAlts_ElmtSequence StringLiteralLong2_ListOfAlts_Elmt_Sequence |- StringLiteralLong2_ListOfAlts_ElmtEchar Echar |- StringLiteralLong2_ListOfAlts_ElmtUchar Uchar- deriving (Eq, Ord, Read, Show)--_StringLiteralLong2_ListOfAlts_Elmt = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong2.ListOfAlts.Elmt")--_StringLiteralLong2_ListOfAlts_Elmt_sequence = (Core.FieldName "sequence")--_StringLiteralLong2_ListOfAlts_Elmt_echar = (Core.FieldName "echar")--_StringLiteralLong2_ListOfAlts_Elmt_uchar = (Core.FieldName "uchar")--data StringLiteralLong2_ListOfAlts_Elmt_Sequence = - StringLiteralLong2_ListOfAlts_Elmt_Sequence {- stringLiteralLong2_ListOfAlts_Elmt_SequenceAlts :: (Maybe StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option),- stringLiteralLong2_ListOfAlts_Elmt_SequenceRegex :: String}- deriving (Eq, Ord, Read, Show)--_StringLiteralLong2_ListOfAlts_Elmt_Sequence = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong2.ListOfAlts.Elmt.Sequence")--_StringLiteralLong2_ListOfAlts_Elmt_Sequence_alts = (Core.FieldName "alts")--_StringLiteralLong2_ListOfAlts_Elmt_Sequence_regex = (Core.FieldName "regex")--data StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option = - StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_OptionQuot |- StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_OptionSequence StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence- deriving (Eq, Ord, Read, Show)--_StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong2.ListOfAlts.Elmt.Sequence.Alts.Option")--_StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option_quot = (Core.FieldName "quot")--_StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option_sequence = (Core.FieldName "sequence")--data StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence = - StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence {}- deriving (Eq, Ord, Read, Show)--_StringLiteralLong2_ListOfAlts_Elmt_Sequence_Alts_Option_Sequence = (Core.Name "hydra/ext/shex/syntax.StringLiteralLong2.ListOfAlts.Elmt.Sequence.Alts.Option.Sequence")--data Uchar = - UcharSequence Uchar_Sequence |- UcharSequence2 Uchar_Sequence2- deriving (Eq, Ord, Read, Show)--_Uchar = (Core.Name "hydra/ext/shex/syntax.Uchar")--_Uchar_sequence = (Core.FieldName "sequence")--_Uchar_sequence2 = (Core.FieldName "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/ext/shex/syntax.Uchar.Sequence")--_Uchar_Sequence_hex = (Core.FieldName "hex")--_Uchar_Sequence_hex2 = (Core.FieldName "hex2")--_Uchar_Sequence_hex3 = (Core.FieldName "hex3")--_Uchar_Sequence_hex4 = (Core.FieldName "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/ext/shex/syntax.Uchar.Sequence2")--_Uchar_Sequence2_hex = (Core.FieldName "hex")--_Uchar_Sequence2_hex2 = (Core.FieldName "hex2")--_Uchar_Sequence2_hex3 = (Core.FieldName "hex3")--_Uchar_Sequence2_hex4 = (Core.FieldName "hex4")--_Uchar_Sequence2_hex5 = (Core.FieldName "hex5")--_Uchar_Sequence2_hex6 = (Core.FieldName "hex6")--_Uchar_Sequence2_hex7 = (Core.FieldName "hex7")--_Uchar_Sequence2_hex8 = (Core.FieldName "hex8")--data Echar = - Echar {- echarRegex :: String}- deriving (Eq, Ord, Read, Show)--_Echar = (Core.Name "hydra/ext/shex/syntax.Echar")--_Echar_regex = (Core.FieldName "regex")--data PnCharsBase = - PnCharsBaseRegex String |- PnCharsBaseRegex2 String- deriving (Eq, Ord, Read, Show)--_PnCharsBase = (Core.Name "hydra/ext/shex/syntax.PnCharsBase")--_PnCharsBase_regex = (Core.FieldName "regex")--_PnCharsBase_regex2 = (Core.FieldName "regex2")--data PnCharsU = - PnCharsUPnCharsBase PnCharsBase |- PnCharsULowbar - deriving (Eq, Ord, Read, Show)--_PnCharsU = (Core.Name "hydra/ext/shex/syntax.PnCharsU")--_PnCharsU_pnCharsBase = (Core.FieldName "pnCharsBase")--_PnCharsU_lowbar = (Core.FieldName "lowbar")--data PnChars = - PnCharsPnCharsU PnCharsU |- PnCharsMinus |- PnCharsRegex String- deriving (Eq, Ord, Read, Show)--_PnChars = (Core.Name "hydra/ext/shex/syntax.PnChars")--_PnChars_pnCharsU = (Core.FieldName "pnCharsU")--_PnChars_minus = (Core.FieldName "minus")--_PnChars_regex = (Core.FieldName "regex")--data PnPrefix = - PnPrefix {- pnPrefixPnCharsBase :: PnCharsBase,- pnPrefixSequence :: (Maybe PnPrefix_Sequence_Option)}- deriving (Eq, Ord, Read, Show)--_PnPrefix = (Core.Name "hydra/ext/shex/syntax.PnPrefix")--_PnPrefix_pnCharsBase = (Core.FieldName "pnCharsBase")--_PnPrefix_sequence = (Core.FieldName "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/ext/shex/syntax.PnPrefix.Sequence.Option")--_PnPrefix_Sequence_Option_alts = (Core.FieldName "alts")--_PnPrefix_Sequence_Option_pnChars = (Core.FieldName "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/ext/shex/syntax.PnPrefix.Sequence.Option.Alts")--_PnPrefix_Sequence_Option_Alts_pnChars = (Core.FieldName "pnChars")--_PnPrefix_Sequence_Option_Alts_period = (Core.FieldName "period")--data PnLocal = - PnLocal {- pnLocalAlts :: PnLocal_Alts,- pnLocalSequence :: (Maybe PnLocal_Sequence_Option)}- deriving (Eq, Ord, Read, Show)--_PnLocal = (Core.Name "hydra/ext/shex/syntax.PnLocal")--_PnLocal_alts = (Core.FieldName "alts")--_PnLocal_sequence = (Core.FieldName "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/ext/shex/syntax.PnLocal.Alts")--_PnLocal_Alts_pnCharsU = (Core.FieldName "pnCharsU")--_PnLocal_Alts_colon = (Core.FieldName "colon")--_PnLocal_Alts_regex = (Core.FieldName "regex")--_PnLocal_Alts_plx = (Core.FieldName "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/ext/shex/syntax.PnLocal.Sequence.Option")--_PnLocal_Sequence_Option_listOfAlts = (Core.FieldName "listOfAlts")--_PnLocal_Sequence_Option_alts = (Core.FieldName "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/ext/shex/syntax.PnLocal.Sequence.Option.ListOfAlts.Elmt")--_PnLocal_Sequence_Option_ListOfAlts_Elmt_pnChars = (Core.FieldName "pnChars")--_PnLocal_Sequence_Option_ListOfAlts_Elmt_period = (Core.FieldName "period")--_PnLocal_Sequence_Option_ListOfAlts_Elmt_colon = (Core.FieldName "colon")--_PnLocal_Sequence_Option_ListOfAlts_Elmt_plx = (Core.FieldName "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/ext/shex/syntax.PnLocal.Sequence.Option.Alts")--_PnLocal_Sequence_Option_Alts_pnChars = (Core.FieldName "pnChars")--_PnLocal_Sequence_Option_Alts_colon = (Core.FieldName "colon")--_PnLocal_Sequence_Option_Alts_plx = (Core.FieldName "plx")--data Plx = - PlxPercent Percent |- PlxPnLocalEsc PnLocalEsc- deriving (Eq, Ord, Read, Show)--_Plx = (Core.Name "hydra/ext/shex/syntax.Plx")--_Plx_percent = (Core.FieldName "percent")--_Plx_pnLocalEsc = (Core.FieldName "pnLocalEsc")--data Percent = - Percent {- percentHex :: Hex,- percentHex2 :: Hex}- deriving (Eq, Ord, Read, Show)--_Percent = (Core.Name "hydra/ext/shex/syntax.Percent")--_Percent_hex = (Core.FieldName "hex")--_Percent_hex2 = (Core.FieldName "hex2")--newtype Hex = - Hex {- unHex :: String}- deriving (Eq, Ord, Read, Show)--_Hex = (Core.Name "hydra/ext/shex/syntax.Hex")--data PnLocalEsc = - PnLocalEsc {- pnLocalEscRegex :: String}- deriving (Eq, Ord, Read, Show)--_PnLocalEsc = (Core.Name "hydra/ext/shex/syntax.PnLocalEsc")--_PnLocalEsc_regex = (Core.FieldName "regex")
− src/gen-main/haskell/Hydra/Ext/Tinkerpop/Features.hs
@@ -1,321 +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.Ext.Tinkerpop.Features where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | 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/ext/tinkerpop/features.DataTypeFeatures")--_DataTypeFeatures_supportsBooleanArrayValues = (Core.FieldName "supportsBooleanArrayValues")--_DataTypeFeatures_supportsBooleanValues = (Core.FieldName "supportsBooleanValues")--_DataTypeFeatures_supportsByteArrayValues = (Core.FieldName "supportsByteArrayValues")--_DataTypeFeatures_supportsByteValues = (Core.FieldName "supportsByteValues")--_DataTypeFeatures_supportsDoubleArrayValues = (Core.FieldName "supportsDoubleArrayValues")--_DataTypeFeatures_supportsDoubleValues = (Core.FieldName "supportsDoubleValues")--_DataTypeFeatures_supportsFloatArrayValues = (Core.FieldName "supportsFloatArrayValues")--_DataTypeFeatures_supportsFloatValues = (Core.FieldName "supportsFloatValues")--_DataTypeFeatures_supportsIntegerArrayValues = (Core.FieldName "supportsIntegerArrayValues")--_DataTypeFeatures_supportsIntegerValues = (Core.FieldName "supportsIntegerValues")--_DataTypeFeatures_supportsLongArrayValues = (Core.FieldName "supportsLongArrayValues")--_DataTypeFeatures_supportsLongValues = (Core.FieldName "supportsLongValues")--_DataTypeFeatures_supportsMapValues = (Core.FieldName "supportsMapValues")--_DataTypeFeatures_supportsMixedListValues = (Core.FieldName "supportsMixedListValues")--_DataTypeFeatures_supportsSerializableValues = (Core.FieldName "supportsSerializableValues")--_DataTypeFeatures_supportsStringArrayValues = (Core.FieldName "supportsStringArrayValues")--_DataTypeFeatures_supportsStringValues = (Core.FieldName "supportsStringValues")--_DataTypeFeatures_supportsUniformListValues = (Core.FieldName "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/ext/tinkerpop/features.EdgeFeatures")--_EdgeFeatures_elementFeatures = (Core.FieldName "elementFeatures")--_EdgeFeatures_properties = (Core.FieldName "properties")--_EdgeFeatures_supportsAddEdges = (Core.FieldName "supportsAddEdges")--_EdgeFeatures_supportsRemoveEdges = (Core.FieldName "supportsRemoveEdges")--_EdgeFeatures_supportsUpsert = (Core.FieldName "supportsUpsert")---- | Features that are related to Edge Property objects.-data EdgePropertyFeatures = - EdgePropertyFeatures {- edgePropertyFeaturesPropertyFeatures :: PropertyFeatures}- deriving (Eq, Ord, Read, Show)--_EdgePropertyFeatures = (Core.Name "hydra/ext/tinkerpop/features.EdgePropertyFeatures")--_EdgePropertyFeatures_propertyFeatures = (Core.FieldName "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/ext/tinkerpop/features.ElementFeatures")--_ElementFeatures_supportsAddProperty = (Core.FieldName "supportsAddProperty")--_ElementFeatures_supportsAnyIds = (Core.FieldName "supportsAnyIds")--_ElementFeatures_supportsCustomIds = (Core.FieldName "supportsCustomIds")--_ElementFeatures_supportsNumericIds = (Core.FieldName "supportsNumericIds")--_ElementFeatures_supportsRemoveProperty = (Core.FieldName "supportsRemoveProperty")--_ElementFeatures_supportsStringIds = (Core.FieldName "supportsStringIds")--_ElementFeatures_supportsUserSuppliedIds = (Core.FieldName "supportsUserSuppliedIds")--_ElementFeatures_supportsUuidIds = (Core.FieldName "supportsUuidIds")---- | Additional features which are needed for the complete specification of language constraints in Hydra, above and beyond TinkerPop Graph.Features-data ExtraFeatures m = - ExtraFeatures {- extraFeaturesSupportsMapKey :: (Core.Type m -> Bool)}--_ExtraFeatures = (Core.Name "hydra/ext/tinkerpop/features.ExtraFeatures")--_ExtraFeatures_supportsMapKey = (Core.FieldName "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/ext/tinkerpop/features.Features")--_Features_edge = (Core.FieldName "edge")--_Features_graph = (Core.FieldName "graph")--_Features_vertex = (Core.FieldName "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/ext/tinkerpop/features.GraphFeatures")--_GraphFeatures_supportsComputer = (Core.FieldName "supportsComputer")--_GraphFeatures_supportsConcurrentAccess = (Core.FieldName "supportsConcurrentAccess")--_GraphFeatures_supportsIoRead = (Core.FieldName "supportsIoRead")--_GraphFeatures_supportsIoWrite = (Core.FieldName "supportsIoWrite")--_GraphFeatures_supportsPersistence = (Core.FieldName "supportsPersistence")--_GraphFeatures_supportsThreadedTransactions = (Core.FieldName "supportsThreadedTransactions")--_GraphFeatures_supportsTransactions = (Core.FieldName "supportsTransactions")--_GraphFeatures_variables = (Core.FieldName "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/ext/tinkerpop/features.PropertyFeatures")--_PropertyFeatures_dataTypeFeatures = (Core.FieldName "dataTypeFeatures")--_PropertyFeatures_supportsProperties = (Core.FieldName "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/ext/tinkerpop/features.VariableFeatures")--_VariableFeatures_dataTypeFeatures = (Core.FieldName "dataTypeFeatures")--_VariableFeatures_supportsVariables = (Core.FieldName "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/ext/tinkerpop/features.VertexFeatures")--_VertexFeatures_elementFeatures = (Core.FieldName "elementFeatures")--_VertexFeatures_properties = (Core.FieldName "properties")--_VertexFeatures_supportsAddVertices = (Core.FieldName "supportsAddVertices")--_VertexFeatures_supportsDuplicateMultiProperties = (Core.FieldName "supportsDuplicateMultiProperties")--_VertexFeatures_supportsMetaProperties = (Core.FieldName "supportsMetaProperties")--_VertexFeatures_supportsMultiProperties = (Core.FieldName "supportsMultiProperties")--_VertexFeatures_supportsRemoveVertices = (Core.FieldName "supportsRemoveVertices")--_VertexFeatures_supportsUpsert = (Core.FieldName "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/ext/tinkerpop/features.VertexPropertyFeatures")--_VertexPropertyFeatures_dataTypeFeatures = (Core.FieldName "dataTypeFeatures")--_VertexPropertyFeatures_propertyFeatures = (Core.FieldName "propertyFeatures")--_VertexPropertyFeatures_elementFeatures = (Core.FieldName "elementFeatures")--_VertexPropertyFeatures_supportsRemove = (Core.FieldName "supportsRemove")
− src/gen-main/haskell/Hydra/Ext/Tinkerpop/Typed.hs
@@ -1,220 +0,0 @@-module Hydra.Ext.Tinkerpop.Typed where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | The type of a collection, such as a list of strings or an optional integer value-data CollectionType = - CollectionTypeList Type |- CollectionTypeMap Type |- CollectionTypeOptional Type |- CollectionTypeSet Type- deriving (Eq, Ord, Read, Show)--_CollectionType = (Core.Name "hydra/ext/tinkerpop/typed.CollectionType")--_CollectionType_list = (Core.FieldName "list")--_CollectionType_map = (Core.FieldName "map")--_CollectionType_optional = (Core.FieldName "optional")--_CollectionType_set = (Core.FieldName "set")---- | A collection of values, such as a list of strings or an optional integer value-data CollectionValue = - CollectionValueList [Value] |- CollectionValueMap (Map Key Value) |- CollectionValueOptional (Maybe Value) |- CollectionValueSet (Set Value)- deriving (Eq, Ord, Read, Show)--_CollectionValue = (Core.Name "hydra/ext/tinkerpop/typed.CollectionValue")--_CollectionValue_list = (Core.FieldName "list")--_CollectionValue_map = (Core.FieldName "map")--_CollectionValue_optional = (Core.FieldName "optional")--_CollectionValue_set = (Core.FieldName "set")---- | An edge, comprised of an id, an out-vertex and in-vertex id, and zero or more properties-data Edge = - Edge {- edgeId :: EdgeId,- edgeLabel :: Label,- edgeOut :: VertexId,- edgeIn :: VertexId,- edgeProperties :: (Map Key Value)}- deriving (Eq, Ord, Read, Show)--_Edge = (Core.Name "hydra/ext/tinkerpop/typed.Edge")--_Edge_id = (Core.FieldName "id")--_Edge_label = (Core.FieldName "label")--_Edge_out = (Core.FieldName "out")--_Edge_in = (Core.FieldName "in")--_Edge_properties = (Core.FieldName "properties")---- | A literal value representing an edge id-newtype EdgeId = - EdgeId {- -- | A literal value representing an edge id- unEdgeId :: Core.Literal}- deriving (Eq, Ord, Read, Show)--_EdgeId = (Core.Name "hydra/ext/tinkerpop/typed.EdgeId")---- | The type of a reference to an edge by id-newtype EdgeIdType = - EdgeIdType {- -- | The type of a reference to an edge by id- unEdgeIdType :: EdgeType}- deriving (Eq, Ord, Read, Show)--_EdgeIdType = (Core.Name "hydra/ext/tinkerpop/typed.EdgeIdType")---- | The type of an edge, with characteristic id, out-vertex, in-vertex, and property types-data EdgeType = - EdgeType {- edgeTypeId :: Core.LiteralType,- edgeTypeOut :: VertexIdType,- edgeTypeIn :: VertexIdType,- edgeTypeProperties :: (Map Key Type)}- deriving (Eq, Ord, Read, Show)--_EdgeType = (Core.Name "hydra/ext/tinkerpop/typed.EdgeType")--_EdgeType_id = (Core.FieldName "id")--_EdgeType_out = (Core.FieldName "out")--_EdgeType_in = (Core.FieldName "in")--_EdgeType_properties = (Core.FieldName "properties")---- | A vertex or edge id-data Id = - IdVertex VertexId |- IdEdge EdgeId- deriving (Eq, Ord, Read, Show)--_Id = (Core.Name "hydra/ext/tinkerpop/typed.Id")--_Id_vertex = (Core.FieldName "vertex")--_Id_edge = (Core.FieldName "edge")---- | The type of a reference to a strongly-typed element (vertex or edge) by id-data IdType = - IdTypeVertex VertexType |- IdTypeEdge EdgeType- deriving (Eq, Ord, Read, Show)--_IdType = (Core.Name "hydra/ext/tinkerpop/typed.IdType")--_IdType_vertex = (Core.FieldName "vertex")--_IdType_edge = (Core.FieldName "edge")---- | A property key or map key-newtype Key = - Key {- -- | A property key or map key- unKey :: String}- deriving (Eq, Ord, Read, Show)--_Key = (Core.Name "hydra/ext/tinkerpop/typed.Key")---- | A vertex or edge label-newtype Label = - Label {- -- | A vertex or edge label- unLabel :: String}- deriving (Eq, Ord, Read, Show)--_Label = (Core.Name "hydra/ext/tinkerpop/typed.Label")---- | The type of a value, such as a property value-data Type = - TypeLiteral Core.LiteralType |- TypeCollection CollectionType |- TypeElement IdType- deriving (Eq, Ord, Read, Show)--_Type = (Core.Name "hydra/ext/tinkerpop/typed.Type")--_Type_literal = (Core.FieldName "literal")--_Type_collection = (Core.FieldName "collection")--_Type_element = (Core.FieldName "element")---- | A concrete value such as a number or string, a collection of other values, or an element reference-data Value = - ValueLiteral Core.Literal |- ValueCollection CollectionValue |- ValueElement Id- deriving (Eq, Ord, Read, Show)--_Value = (Core.Name "hydra/ext/tinkerpop/typed.Value")--_Value_literal = (Core.FieldName "literal")--_Value_collection = (Core.FieldName "collection")--_Value_element = (Core.FieldName "element")---- | A vertex, comprised of an id and zero or more properties-data Vertex = - Vertex {- vertexId :: VertexId,- vertexLabel :: Label,- vertexProperties :: (Map Key Value)}- deriving (Eq, Ord, Read, Show)--_Vertex = (Core.Name "hydra/ext/tinkerpop/typed.Vertex")--_Vertex_id = (Core.FieldName "id")--_Vertex_label = (Core.FieldName "label")--_Vertex_properties = (Core.FieldName "properties")---- | A literal value representing a vertex id-newtype VertexId = - VertexId {- -- | A literal value representing a vertex id- unVertexId :: Core.Literal}- deriving (Eq, Ord, Read, Show)--_VertexId = (Core.Name "hydra/ext/tinkerpop/typed.VertexId")---- | The type of a reference to a vertex by id-newtype VertexIdType = - VertexIdType {- -- | The type of a reference to a vertex by id- unVertexIdType :: VertexType}- deriving (Eq, Ord, Read, Show)--_VertexIdType = (Core.Name "hydra/ext/tinkerpop/typed.VertexIdType")---- | The type of a vertex, with characteristic id and property types-data VertexType = - VertexType {- vertexTypeId :: Core.LiteralType,- vertexTypeProperties :: (Map Key Type)}- deriving (Eq, Ord, Read, Show)--_VertexType = (Core.Name "hydra/ext/tinkerpop/typed.VertexType")--_VertexType_id = (Core.FieldName "id")--_VertexType_properties = (Core.FieldName "properties")
− src/gen-main/haskell/Hydra/Ext/Tinkerpop/V3.hs
@@ -1,111 +0,0 @@--- | A simple TinkerPop version 3 syntax model--module Hydra.Ext.Tinkerpop.V3 where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | An edge-data Edge v e p = - Edge {- edgeLabel :: EdgeLabel,- edgeId :: e,- edgeOut :: v,- edgeIn :: v,- edgeProperties :: (Map PropertyKey p)}- deriving (Eq, Ord, Read, Show)--_Edge = (Core.Name "hydra/ext/tinkerpop/v3.Edge")--_Edge_label = (Core.FieldName "label")--_Edge_id = (Core.FieldName "id")--_Edge_out = (Core.FieldName "out")--_Edge_in = (Core.FieldName "in")--_Edge_properties = (Core.FieldName "properties")---- | The (required) label of an edge-newtype EdgeLabel = - EdgeLabel {- -- | The (required) label of an edge- unEdgeLabel :: String}- deriving (Eq, Ord, Read, Show)--_EdgeLabel = (Core.Name "hydra/ext/tinkerpop/v3.EdgeLabel")---- | Either a vertex or an edge-data Element v e p = - ElementVertex (Vertex v p) |- ElementEdge (Edge v e p)- deriving (Eq, Ord, Read, Show)--_Element = (Core.Name "hydra/ext/tinkerpop/v3.Element")--_Element_vertex = (Core.FieldName "vertex")--_Element_edge = (Core.FieldName "edge")---- | A graph; a self-contained collection of vertices and edges-data Graph v e p = - Graph {- graphVertices :: (Set (Vertex v p)),- graphEdges :: (Set (Edge v e p))}- deriving (Eq, Ord, Read, Show)--_Graph = (Core.Name "hydra/ext/tinkerpop/v3.Graph")--_Graph_vertices = (Core.FieldName "vertices")--_Graph_edges = (Core.FieldName "edges")---- | A key/value property-data Property p = - Property {- propertyKey :: PropertyKey,- propertyValue :: p}- deriving (Eq, Ord, Read, Show)--_Property = (Core.Name "hydra/ext/tinkerpop/v3.Property")--_Property_key = (Core.FieldName "key")--_Property_value = (Core.FieldName "value")---- | A property key-newtype PropertyKey = - PropertyKey {- -- | A property key- unPropertyKey :: String}- deriving (Eq, Ord, Read, Show)--_PropertyKey = (Core.Name "hydra/ext/tinkerpop/v3.PropertyKey")---- | A vertex-data Vertex v p = - Vertex {- vertexLabel :: VertexLabel,- vertexId :: v,- vertexProperties :: (Map PropertyKey p)}- deriving (Eq, Ord, Read, Show)--_Vertex = (Core.Name "hydra/ext/tinkerpop/v3.Vertex")--_Vertex_label = (Core.FieldName "label")--_Vertex_id = (Core.FieldName "id")--_Vertex_properties = (Core.FieldName "properties")---- | The label of a vertex. The default (null) vertex is represented by the empty string-newtype VertexLabel = - VertexLabel {- -- | The label of a vertex. The default (null) vertex is represented by the empty string- unVertexLabel :: String}- deriving (Eq, Ord, Read, Show)--_VertexLabel = (Core.Name "hydra/ext/tinkerpop/v3.VertexLabel")
− src/gen-main/haskell/Hydra/Ext/Xml/Schema.hs
@@ -1,464 +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.Ext.Xml.Schema where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set--newtype AnySimpleType = - AnySimpleType {- unAnySimpleType :: String}- deriving (Eq, Ord, Read, Show)--_AnySimpleType = (Core.Name "hydra/ext/xml/schema.AnySimpleType")--newtype AnyType = - AnyType {- unAnyType :: String}- deriving (Eq, Ord, Read, Show)--_AnyType = (Core.Name "hydra/ext/xml/schema.AnyType")--newtype AnyURI = - AnyURI {- unAnyURI :: String}- deriving (Eq, Ord, Read, Show)--_AnyURI = (Core.Name "hydra/ext/xml/schema.AnyURI")--newtype Base64Binary = - Base64Binary {- unBase64Binary :: String}- deriving (Eq, Ord, Read, Show)--_Base64Binary = (Core.Name "hydra/ext/xml/schema.Base64Binary")--newtype Boolean = - Boolean {- unBoolean :: Bool}- deriving (Eq, Ord, Read, Show)--_Boolean = (Core.Name "hydra/ext/xml/schema.Boolean")--newtype Byte = - Byte {- unByte :: Int}- deriving (Eq, Ord, Read, Show)--_Byte = (Core.Name "hydra/ext/xml/schema.Byte")--newtype Date = - Date {- unDate :: String}- deriving (Eq, Ord, Read, Show)--_Date = (Core.Name "hydra/ext/xml/schema.Date")--newtype DateTime = - DateTime {- unDateTime :: String}- deriving (Eq, Ord, Read, Show)--_DateTime = (Core.Name "hydra/ext/xml/schema.DateTime")--newtype Decimal = - Decimal {- unDecimal :: String}- deriving (Eq, Ord, Read, Show)--_Decimal = (Core.Name "hydra/ext/xml/schema.Decimal")--newtype Double_ = - Double_ {- unDouble :: Double}- deriving (Eq, Ord, Read, Show)--_Double = (Core.Name "hydra/ext/xml/schema.Double")--newtype Duration = - Duration {- unDuration :: String}- deriving (Eq, Ord, Read, Show)--_Duration = (Core.Name "hydra/ext/xml/schema.Duration")--newtype ENTITIES = - ENTITIES {- unENTITIES :: String}- deriving (Eq, Ord, Read, Show)--_ENTITIES = (Core.Name "hydra/ext/xml/schema.ENTITIES")--newtype ENTITY = - ENTITY {- unENTITY :: String}- deriving (Eq, Ord, Read, Show)--_ENTITY = (Core.Name "hydra/ext/xml/schema.ENTITY")--newtype Float_ = - Float_ {- unFloat :: Float}- deriving (Eq, Ord, Read, Show)--_Float = (Core.Name "hydra/ext/xml/schema.Float")--newtype GDay = - GDay {- unGDay :: String}- deriving (Eq, Ord, Read, Show)--_GDay = (Core.Name "hydra/ext/xml/schema.GDay")--newtype GMonth = - GMonth {- unGMonth :: String}- deriving (Eq, Ord, Read, Show)--_GMonth = (Core.Name "hydra/ext/xml/schema.GMonth")--newtype GMonthDay = - GMonthDay {- unGMonthDay :: String}- deriving (Eq, Ord, Read, Show)--_GMonthDay = (Core.Name "hydra/ext/xml/schema.GMonthDay")--newtype GYear = - GYear {- unGYear :: String}- deriving (Eq, Ord, Read, Show)--_GYear = (Core.Name "hydra/ext/xml/schema.GYear")--newtype GYearMonth = - GYearMonth {- unGYearMonth :: String}- deriving (Eq, Ord, Read, Show)--_GYearMonth = (Core.Name "hydra/ext/xml/schema.GYearMonth")--newtype HexBinary = - HexBinary {- unHexBinary :: String}- deriving (Eq, Ord, Read, Show)--_HexBinary = (Core.Name "hydra/ext/xml/schema.HexBinary")--newtype ID = - ID {- unID :: String}- deriving (Eq, Ord, Read, Show)--_ID = (Core.Name "hydra/ext/xml/schema.ID")--newtype IDREF = - IDREF {- unIDREF :: String}- deriving (Eq, Ord, Read, Show)--_IDREF = (Core.Name "hydra/ext/xml/schema.IDREF")--newtype IDREFS = - IDREFS {- unIDREFS :: String}- deriving (Eq, Ord, Read, Show)--_IDREFS = (Core.Name "hydra/ext/xml/schema.IDREFS")--newtype Int_ = - Int_ {- unInt :: Int}- deriving (Eq, Ord, Read, Show)--_Int = (Core.Name "hydra/ext/xml/schema.Int")--newtype Integer_ = - Integer_ {- unInteger :: Integer}- deriving (Eq, Ord, Read, Show)--_Integer = (Core.Name "hydra/ext/xml/schema.Integer")--newtype Language = - Language {- unLanguage :: String}- deriving (Eq, Ord, Read, Show)--_Language = (Core.Name "hydra/ext/xml/schema.Language")--newtype Long = - Long {- unLong :: Integer}- deriving (Eq, Ord, Read, Show)--_Long = (Core.Name "hydra/ext/xml/schema.Long")--newtype NMTOKEN = - NMTOKEN {- unNMTOKEN :: String}- deriving (Eq, Ord, Read, Show)--_NMTOKEN = (Core.Name "hydra/ext/xml/schema.NMTOKEN")--newtype NOTATION = - NOTATION {- unNOTATION :: String}- deriving (Eq, Ord, Read, Show)--_NOTATION = (Core.Name "hydra/ext/xml/schema.NOTATION")--newtype Name = - Name {- unName :: String}- deriving (Eq, Ord, Read, Show)--_Name = (Core.Name "hydra/ext/xml/schema.Name")--newtype NegativeInteger = - NegativeInteger {- unNegativeInteger :: Integer}- deriving (Eq, Ord, Read, Show)--_NegativeInteger = (Core.Name "hydra/ext/xml/schema.NegativeInteger")--newtype NonNegativeInteger = - NonNegativeInteger {- unNonNegativeInteger :: Integer}- deriving (Eq, Ord, Read, Show)--_NonNegativeInteger = (Core.Name "hydra/ext/xml/schema.NonNegativeInteger")--newtype NonPositiveInteger = - NonPositiveInteger {- unNonPositiveInteger :: Integer}- deriving (Eq, Ord, Read, Show)--_NonPositiveInteger = (Core.Name "hydra/ext/xml/schema.NonPositiveInteger")--newtype NormalizedString = - NormalizedString {- unNormalizedString :: String}- deriving (Eq, Ord, Read, Show)--_NormalizedString = (Core.Name "hydra/ext/xml/schema.NormalizedString")--newtype PositiveInteger = - PositiveInteger {- unPositiveInteger :: Integer}- deriving (Eq, Ord, Read, Show)--_PositiveInteger = (Core.Name "hydra/ext/xml/schema.PositiveInteger")--newtype QName = - QName {- unQName :: String}- deriving (Eq, Ord, Read, Show)--_QName = (Core.Name "hydra/ext/xml/schema.QName")--newtype Short = - Short {- unShort :: Int}- deriving (Eq, Ord, Read, Show)--_Short = (Core.Name "hydra/ext/xml/schema.Short")--newtype String_ = - String_ {- unString :: String}- deriving (Eq, Ord, Read, Show)--_String = (Core.Name "hydra/ext/xml/schema.String")--newtype Time = - Time {- unTime :: String}- deriving (Eq, Ord, Read, Show)--_Time = (Core.Name "hydra/ext/xml/schema.Time")--newtype Token = - Token {- unToken :: String}- deriving (Eq, Ord, Read, Show)--_Token = (Core.Name "hydra/ext/xml/schema.Token")--newtype UnsignedByte = - UnsignedByte {- unUnsignedByte :: Int}- deriving (Eq, Ord, Read, Show)--_UnsignedByte = (Core.Name "hydra/ext/xml/schema.UnsignedByte")--newtype UnsignedInt = - UnsignedInt {- unUnsignedInt :: Integer}- deriving (Eq, Ord, Read, Show)--_UnsignedInt = (Core.Name "hydra/ext/xml/schema.UnsignedInt")--newtype UnsignedLong = - UnsignedLong {- unUnsignedLong :: Integer}- deriving (Eq, Ord, Read, Show)--_UnsignedLong = (Core.Name "hydra/ext/xml/schema.UnsignedLong")--newtype UnsignedShort = - UnsignedShort {- unUnsignedShort :: Int}- deriving (Eq, Ord, Read, Show)--_UnsignedShort = (Core.Name "hydra/ext/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/ext/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/ext/xml/schema.Datatype")--_Datatype_anySimpleType = (Core.FieldName "anySimpleType")--_Datatype_anyType = (Core.FieldName "anyType")--_Datatype_anyURI = (Core.FieldName "anyURI")--_Datatype_base64Binary = (Core.FieldName "base64Binary")--_Datatype_boolean = (Core.FieldName "boolean")--_Datatype_byte = (Core.FieldName "byte")--_Datatype_date = (Core.FieldName "date")--_Datatype_dateTime = (Core.FieldName "dateTime")--_Datatype_decimal = (Core.FieldName "decimal")--_Datatype_double = (Core.FieldName "double")--_Datatype_duration = (Core.FieldName "duration")--_Datatype_ENTITIES = (Core.FieldName "ENTITIES")--_Datatype_ENTITY = (Core.FieldName "ENTITY")--_Datatype_float = (Core.FieldName "float")--_Datatype_gDay = (Core.FieldName "gDay")--_Datatype_gMonth = (Core.FieldName "gMonth")--_Datatype_gMonthDay = (Core.FieldName "gMonthDay")--_Datatype_gYear = (Core.FieldName "gYear")--_Datatype_gYearMonth = (Core.FieldName "gYearMonth")--_Datatype_hexBinary = (Core.FieldName "hexBinary")--_Datatype_ID = (Core.FieldName "ID")--_Datatype_IDREF = (Core.FieldName "IDREF")--_Datatype_IDREFS = (Core.FieldName "IDREFS")--_Datatype_int = (Core.FieldName "int")--_Datatype_integer = (Core.FieldName "integer")--_Datatype_language = (Core.FieldName "language")--_Datatype_long = (Core.FieldName "long")--_Datatype_NMTOKEN = (Core.FieldName "NMTOKEN")--_Datatype_NOTATION = (Core.FieldName "NOTATION")--_Datatype_name = (Core.FieldName "name")--_Datatype_negativeInteger = (Core.FieldName "negativeInteger")--_Datatype_nonNegativeInteger = (Core.FieldName "nonNegativeInteger")--_Datatype_nonPositiveInteger = (Core.FieldName "nonPositiveInteger")--_Datatype_normalizedString = (Core.FieldName "normalizedString")--_Datatype_positiveInteger = (Core.FieldName "positiveInteger")--_Datatype_qName = (Core.FieldName "qName")--_Datatype_short = (Core.FieldName "short")--_Datatype_string = (Core.FieldName "string")--_Datatype_time = (Core.FieldName "time")--_Datatype_token = (Core.FieldName "token")--_Datatype_unsignedByte = (Core.FieldName "unsignedByte")--_Datatype_unsignedInt = (Core.FieldName "unsignedInt")--_Datatype_unsignedLong = (Core.FieldName "unsignedLong")--_Datatype_unsignedShort = (Core.FieldName "unsignedShort")
− src/gen-main/haskell/Hydra/Ext/Yaml/Model.hs
@@ -1,53 +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.Ext.Yaml.Model where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | A YAML node (value)-data Node = - NodeMapping (Map Node Node) |- NodeScalar Scalar |- NodeSequence [Node]- deriving (Eq, Ord, Read, Show)--_Node = (Core.Name "hydra/ext/yaml/model.Node")--_Node_mapping = (Core.FieldName "mapping")--_Node_scalar = (Core.FieldName "scalar")--_Node_sequence = (Core.FieldName "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/yaml/model.Scalar")--_Scalar_bool = (Core.FieldName "bool")--_Scalar_float = (Core.FieldName "float")--_Scalar_int = (Core.FieldName "int")--_Scalar_null = (Core.FieldName "null")--_Scalar_str = (Core.FieldName "str")
+ src/gen-main/haskell/Hydra/Extras.hs view
@@ -0,0 +1,62 @@+-- | Basic functions which depend on primitive functions++module Hydra.Extras where++import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Math as Math+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Module as Module+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++functionArity :: (Core.Function -> Int)+functionArity x = case x of+ Core.FunctionElimination _ -> 1+ Core.FunctionLambda v232 -> (Math.add 1 (termArity (Core.lambdaBody v232)))+ Core.FunctionPrimitive _ -> 42++lookupPrimitive :: (Graph.Graph -> Core.Name -> Maybe Graph.Primitive)+lookupPrimitive g name = (Maps.lookup name (Graph.graphPrimitives g))++-- | Find the arity (expected number of arguments) of a primitive constant or function+primitiveArity :: (Graph.Primitive -> Int)+primitiveArity x = (typeArity (Graph.primitiveType x))++-- | Construct a qualified (dot-separated) name+qname :: (Module.Namespace -> String -> Core.Name)+qname ns name = (Core.Name (Strings.cat [+ Module.unNamespace ns,+ ".",+ name]))++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)+ _ -> 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)))+ _ -> 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)))+ _ -> [+ t]) t)++getAnnotation :: (String -> Map String Core.Term -> Maybe Core.Term)+getAnnotation key ann = (Maps.lookup key ann)
src/gen-main/haskell/Hydra/Grammar.hs view
@@ -3,14 +3,14 @@ module Hydra.Grammar where import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S -- | A constant pattern newtype Constant = Constant {- -- | A constant pattern unConstant :: String} deriving (Eq, Ord, Read, Show) @@ -19,7 +19,6 @@ -- | An enhanced Backus-Naur form (BNF) grammar newtype Grammar = Grammar {- -- | An enhanced Backus-Naur form (BNF) grammar unGrammar :: [Production]} deriving (Eq, Ord, Read, Show) @@ -28,7 +27,6 @@ -- | A name for a pattern newtype Label = Label {- -- | A name for a pattern unLabel :: String} deriving (Eq, Ord, Read, Show) @@ -43,9 +41,9 @@ _LabeledPattern = (Core.Name "hydra/grammar.LabeledPattern") -_LabeledPattern_label = (Core.FieldName "label")+_LabeledPattern_label = (Core.Name "label") -_LabeledPattern_pattern = (Core.FieldName "pattern")+_LabeledPattern_pattern = (Core.Name "pattern") -- | A pattern which matches valid expressions in the language data Pattern = @@ -64,27 +62,27 @@ _Pattern = (Core.Name "hydra/grammar.Pattern") -_Pattern_nil = (Core.FieldName "nil")+_Pattern_nil = (Core.Name "nil") -_Pattern_ignored = (Core.FieldName "ignored")+_Pattern_ignored = (Core.Name "ignored") -_Pattern_labeled = (Core.FieldName "labeled")+_Pattern_labeled = (Core.Name "labeled") -_Pattern_constant = (Core.FieldName "constant")+_Pattern_constant = (Core.Name "constant") -_Pattern_regex = (Core.FieldName "regex")+_Pattern_regex = (Core.Name "regex") -_Pattern_nonterminal = (Core.FieldName "nonterminal")+_Pattern_nonterminal = (Core.Name "nonterminal") -_Pattern_sequence = (Core.FieldName "sequence")+_Pattern_sequence = (Core.Name "sequence") -_Pattern_alternatives = (Core.FieldName "alternatives")+_Pattern_alternatives = (Core.Name "alternatives") -_Pattern_option = (Core.FieldName "option")+_Pattern_option = (Core.Name "option") -_Pattern_star = (Core.FieldName "star")+_Pattern_star = (Core.Name "star") -_Pattern_plus = (Core.FieldName "plus")+_Pattern_plus = (Core.Name "plus") -- | A BNF production data Production = @@ -95,14 +93,13 @@ _Production = (Core.Name "hydra/grammar.Production") -_Production_symbol = (Core.FieldName "symbol")+_Production_symbol = (Core.Name "symbol") -_Production_pattern = (Core.FieldName "pattern")+_Production_pattern = (Core.Name "pattern") -- | A regular expression newtype Regex = Regex {- -- | A regular expression unRegex :: String} deriving (Eq, Ord, Read, Show) @@ -111,7 +108,6 @@ -- | A nonterminal symbol newtype Symbol = Symbol {- -- | A nonterminal symbol unSymbol :: String} deriving (Eq, Ord, Read, Show)
+ src/gen-main/haskell/Hydra/Graph.hs view
@@ -0,0 +1,110 @@+-- | The extension to graphs of Hydra's core type system (hydra/core)++module Hydra.Graph where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | An equality judgement: less than, equal to, or greater than+data Comparison = + ComparisonLessThan |+ ComparisonEqualTo |+ ComparisonGreaterThan + deriving (Eq, Ord, Read, Show)++_Comparison = (Core.Name "hydra/graph.Comparison")++_Comparison_lessThan = (Core.Name "lessThan")++_Comparison_equalTo = (Core.Name "equalTo")++_Comparison_greaterThan = (Core.Name "greaterThan")++-- | A graph, or set of name/term bindings together with parameters (annotations, primitives) and a schema graph+data Graph = + Graph {+ -- | All of the elements in the graph+ graphElements :: (Map Core.Name Element),+ -- | 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),+ -- | The body of the term which generated this context+ graphBody :: Core.Term,+ -- | All supported primitive constants and functions, by name+ graphPrimitives :: (Map Core.Name Primitive),+ -- | The schema of this graph. If this parameter is omitted (nothing), the graph is its own schema graph.+ graphSchema :: (Maybe Graph)}++_Graph = (Core.Name "hydra/graph.Graph")++_Graph_elements = (Core.Name "elements")++_Graph_environment = (Core.Name "environment")++_Graph_types = (Core.Name "types")++_Graph_body = (Core.Name "body")++_Graph_primitives = (Core.Name "primitives")++_Graph_schema = (Core.Name "schema")++-- | A graph element, having a name, data term (value), and schema term (type)+data Element = + Element {+ elementName :: Core.Name,+ elementData :: Core.Term}+ deriving (Eq, Ord, Read, Show)++_Element = (Core.Name "hydra/graph.Element")++_Element_name = (Core.Name "name")++_Element_data = (Core.Name "data")++-- | A built-in function+data Primitive = + Primitive {+ -- | The unique name of the primitive function+ primitiveName :: Core.Name,+ -- | The type signature of the primitive function+ primitiveType :: Core.Type,+ -- | A concrete implementation of the primitive function+ primitiveImplementation :: ([Core.Term] -> Compute.Flow Graph Core.Term)}++_Primitive = (Core.Name "hydra/graph.Primitive")++_Primitive_name = (Core.Name "name")++_Primitive_type = (Core.Name "type")++_Primitive_implementation = (Core.Name "implementation")++-- | A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms+data TermCoder x = + TermCoder {+ termCoderType :: Core.Type,+ termCoderCoder :: (Compute.Coder Graph Graph Core.Term x)}++_TermCoder = (Core.Name "hydra/graph.TermCoder")++_TermCoder_type = (Core.Name "type")++_TermCoder_coder = (Core.Name "coder")++-- | Any of a small number of built-in type classes+data TypeClass = + TypeClassEquality |+ TypeClassOrdering + deriving (Eq, Ord, Read, Show)++_TypeClass = (Core.Name "hydra/graph.TypeClass")++_TypeClass_equality = (Core.Name "equality")++_TypeClass_ordering = (Core.Name "ordering")
+ src/gen-main/haskell/Hydra/Json.hs view
@@ -0,0 +1,33 @@+-- | A JSON syntax model. See the BNF at https://www.json.org++module Hydra.Json 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 JSON value+data Value = + ValueArray [Value] |+ ValueBoolean Bool |+ ValueNull |+ ValueNumber Double |+ ValueObject (Map String Value) |+ ValueString String+ deriving (Eq, Ord, Read, Show)++_Value = (Core.Name "hydra/json.Value")++_Value_array = (Core.Name "array")++_Value_boolean = (Core.Name "boolean")++_Value_null = (Core.Name "null")++_Value_number = (Core.Name "number")++_Value_object = (Core.Name "object")++_Value_string = (Core.Name "string")
+ src/gen-main/haskell/Hydra/Langs/Avro/Schema.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Cypher/Features.hs view
@@ -0,0 +1,935 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Cypher/OpenCypher.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Graphql/Syntax.hs view
@@ -0,0 +1,1299 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Haskell/Ast.hs view
@@ -0,0 +1,917 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Java/Language.hs view
@@ -0,0 +1,237 @@+-- | 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"]
+ src/gen-main/haskell/Hydra/Langs/Java/Syntax.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Json/Decoding.hs view
@@ -0,0 +1,50 @@+-- | 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))
+ src/gen-main/haskell/Hydra/Langs/Kusto/Kql.hs view
@@ -0,0 +1,695 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Owl/Syntax.hs view
@@ -0,0 +1,1208 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Parquet/Delta.hs view
@@ -0,0 +1,122 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Parquet/Format.hs view
@@ -0,0 +1,977 @@+-- | 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 <array-field>[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 <Application> version <App Version> (build <App Build Hash>). 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")
+ src/gen-main/haskell/Hydra/Langs/Pegasus/Pdl.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Protobuf/Any.hs view
@@ -0,0 +1,24 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Protobuf/Language.hs view
@@ -0,0 +1,90 @@+-- | 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"]
+ src/gen-main/haskell/Hydra/Langs/Protobuf/Proto3.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Protobuf/SourceContext.hs view
@@ -0,0 +1,20 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Rdf/Syntax.hs view
@@ -0,0 +1,183 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/RelationalModel.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Scala/Meta.hs view
@@ -0,0 +1,2265 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Shacl/Model.hs view
@@ -0,0 +1,357 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Shex/Syntax.hs view
@@ -0,0 +1,1607 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Sql/Ansi.hs view
@@ -0,0 +1,1373 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Tabular.hs view
@@ -0,0 +1,40 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Tinkerpop/Features.hs view
@@ -0,0 +1,322 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Tinkerpop/Gremlin.hs view
@@ -0,0 +1,2409 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Tinkerpop/Mappings.hs view
@@ -0,0 +1,183 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Tinkerpop/PropertyGraph.hs view
@@ -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.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")
+ src/gen-main/haskell/Hydra/Langs/Tinkerpop/Queries.hs view
@@ -0,0 +1,329 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Tinkerpop/Validate.hs view
@@ -0,0 +1,143 @@+-- | 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)])
+ src/gen-main/haskell/Hydra/Langs/Xml/Schema.hs view
@@ -0,0 +1,465 @@+-- | 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")
+ src/gen-main/haskell/Hydra/Langs/Yaml/Model.hs view
@@ -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.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")
src/gen-main/haskell/Hydra/Mantle.hs view
@@ -3,68 +3,49 @@ module Hydra.Mantle where import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | An equality judgement: less than, equal to, or greater than-data Comparison = - ComparisonLessThan |- ComparisonEqualTo |- ComparisonGreaterThan - deriving (Eq, Ord, Read, Show)--_Comparison = (Core.Name "hydra/mantle.Comparison")--_Comparison_lessThan = (Core.FieldName "lessThan")--_Comparison_equalTo = (Core.FieldName "equalTo")--_Comparison_greaterThan = (Core.FieldName "greaterThan")+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S --- | A graph element, having a name, data term (value), and schema term (type)-data Element m = - Element {- elementName :: Core.Name,- elementSchema :: (Core.Term m),- elementData :: (Core.Term m)}+-- | A disjoint union between a 'left' type and a 'right' type+data Either_ a b = + EitherLeft a |+ EitherRight b deriving (Eq, Ord, Read, Show) -_Element = (Core.Name "hydra/mantle.Element")--_Element_name = (Core.FieldName "name")+_Either = (Core.Name "hydra/mantle.Either") -_Element_schema = (Core.FieldName "schema")+_Either_left = (Core.Name "left") -_Element_data = (Core.FieldName "data")+_Either_right = (Core.Name "right") -- | The identifier of an elimination constructor data EliminationVariant = - EliminationVariantElement | EliminationVariantList |- EliminationVariantNominal | EliminationVariantOptional |+ EliminationVariantProduct | EliminationVariantRecord |- EliminationVariantUnion + EliminationVariantUnion |+ EliminationVariantWrap deriving (Eq, Ord, Read, Show) _EliminationVariant = (Core.Name "hydra/mantle.EliminationVariant") -_EliminationVariant_element = (Core.FieldName "element")+_EliminationVariant_list = (Core.Name "list") -_EliminationVariant_list = (Core.FieldName "list")+_EliminationVariant_optional = (Core.Name "optional") -_EliminationVariant_nominal = (Core.FieldName "nominal")+_EliminationVariant_product = (Core.Name "product") -_EliminationVariant_optional = (Core.FieldName "optional")+_EliminationVariant_record = (Core.Name "record") -_EliminationVariant_record = (Core.FieldName "record")+_EliminationVariant_union = (Core.Name "union") -_EliminationVariant_union = (Core.FieldName "union")+_EliminationVariant_wrap = (Core.Name "wrap") -- | The identifier of a function constructor data FunctionVariant = - FunctionVariantCompareTo | FunctionVariantElimination | FunctionVariantLambda | FunctionVariantPrimitive @@ -72,28 +53,11 @@ _FunctionVariant = (Core.Name "hydra/mantle.FunctionVariant") -_FunctionVariant_compareTo = (Core.FieldName "compareTo")--_FunctionVariant_elimination = (Core.FieldName "elimination")--_FunctionVariant_lambda = (Core.FieldName "lambda")--_FunctionVariant_primitive = (Core.FieldName "primitive")---- | A graph, or set of named terms, together with its schema graph-data Graph m = - Graph {- -- | All of the elements in the graph- graphElements :: (Map Core.Name (Element m)),- -- | The schema graph to this graph. If omitted, the graph is its own schema graph.- graphSchema :: (Maybe (Graph m))}- deriving (Eq, Ord, Read, Show)--_Graph = (Core.Name "hydra/mantle.Graph")+_FunctionVariant_elimination = (Core.Name "elimination") -_Graph_elements = (Core.FieldName "elements")+_FunctionVariant_lambda = (Core.Name "lambda") -_Graph_schema = (Core.FieldName "schema")+_FunctionVariant_primitive = (Core.Name "primitive") -- | The identifier of a literal constructor data LiteralVariant = @@ -106,15 +70,15 @@ _LiteralVariant = (Core.Name "hydra/mantle.LiteralVariant") -_LiteralVariant_binary = (Core.FieldName "binary")+_LiteralVariant_binary = (Core.Name "binary") -_LiteralVariant_boolean = (Core.FieldName "boolean")+_LiteralVariant_boolean = (Core.Name "boolean") -_LiteralVariant_float = (Core.FieldName "float")+_LiteralVariant_float = (Core.Name "float") -_LiteralVariant_integer = (Core.FieldName "integer")+_LiteralVariant_integer = (Core.Name "integer") -_LiteralVariant_string = (Core.FieldName "string")+_LiteralVariant_string = (Core.Name "string") -- | Numeric precision: arbitrary precision, or precision to a specified number of bits data Precision = @@ -124,146 +88,111 @@ _Precision = (Core.Name "hydra/mantle.Precision") -_Precision_arbitrary = (Core.FieldName "arbitrary")+_Precision_arbitrary = (Core.Name "arbitrary") -_Precision_bits = (Core.FieldName "bits")+_Precision_bits = (Core.Name "bits") -- | The identifier of a term expression constructor data TermVariant = TermVariantAnnotated | TermVariantApplication |- TermVariantElement | TermVariantFunction | TermVariantLet | TermVariantList | TermVariantLiteral | TermVariantMap |- TermVariantNominal | TermVariantOptional | TermVariantProduct | TermVariantRecord | TermVariantSet |- TermVariantStream | TermVariantSum |+ TermVariantTyped | TermVariantUnion |- TermVariantVariable + TermVariantVariable |+ TermVariantWrap deriving (Eq, Ord, Read, Show) _TermVariant = (Core.Name "hydra/mantle.TermVariant") -_TermVariant_annotated = (Core.FieldName "annotated")--_TermVariant_application = (Core.FieldName "application")--_TermVariant_element = (Core.FieldName "element")--_TermVariant_function = (Core.FieldName "function")--_TermVariant_let = (Core.FieldName "let")--_TermVariant_list = (Core.FieldName "list")+_TermVariant_annotated = (Core.Name "annotated") -_TermVariant_literal = (Core.FieldName "literal")+_TermVariant_application = (Core.Name "application") -_TermVariant_map = (Core.FieldName "map")+_TermVariant_function = (Core.Name "function") -_TermVariant_nominal = (Core.FieldName "nominal")+_TermVariant_let = (Core.Name "let") -_TermVariant_optional = (Core.FieldName "optional")+_TermVariant_list = (Core.Name "list") -_TermVariant_product = (Core.FieldName "product")+_TermVariant_literal = (Core.Name "literal") -_TermVariant_record = (Core.FieldName "record")+_TermVariant_map = (Core.Name "map") -_TermVariant_set = (Core.FieldName "set")+_TermVariant_optional = (Core.Name "optional") -_TermVariant_stream = (Core.FieldName "stream")+_TermVariant_product = (Core.Name "product") -_TermVariant_sum = (Core.FieldName "sum")+_TermVariant_record = (Core.Name "record") -_TermVariant_union = (Core.FieldName "union")+_TermVariant_set = (Core.Name "set") -_TermVariant_variable = (Core.FieldName "variable")+_TermVariant_sum = (Core.Name "sum") --- | A type expression together with free type variables occurring in the expression-data TypeScheme m = - TypeScheme {- typeSchemeVariables :: [Core.VariableType],- typeSchemeType :: (Core.Type m)}- deriving (Eq, Ord, Read, Show)+_TermVariant_typed = (Core.Name "typed") -_TypeScheme = (Core.Name "hydra/mantle.TypeScheme")+_TermVariant_union = (Core.Name "union") -_TypeScheme_variables = (Core.FieldName "variables")+_TermVariant_variable = (Core.Name "variable") -_TypeScheme_type = (Core.FieldName "type")+_TermVariant_wrap = (Core.Name "wrap") -- | The identifier of a type constructor data TypeVariant = TypeVariantAnnotated | TypeVariantApplication |- TypeVariantElement | TypeVariantFunction | TypeVariantLambda | TypeVariantList | TypeVariantLiteral | TypeVariantMap |- TypeVariantNominal | TypeVariantOptional | TypeVariantProduct | TypeVariantRecord | TypeVariantSet |- TypeVariantStream | TypeVariantSum | TypeVariantUnion |- TypeVariantVariable + TypeVariantVariable |+ TypeVariantWrap deriving (Eq, Ord, Read, Show) _TypeVariant = (Core.Name "hydra/mantle.TypeVariant") -_TypeVariant_annotated = (Core.FieldName "annotated")--_TypeVariant_application = (Core.FieldName "application")--_TypeVariant_element = (Core.FieldName "element")--_TypeVariant_function = (Core.FieldName "function")--_TypeVariant_lambda = (Core.FieldName "lambda")--_TypeVariant_list = (Core.FieldName "list")--_TypeVariant_literal = (Core.FieldName "literal")+_TypeVariant_annotated = (Core.Name "annotated") -_TypeVariant_map = (Core.FieldName "map")+_TypeVariant_application = (Core.Name "application") -_TypeVariant_nominal = (Core.FieldName "nominal")+_TypeVariant_function = (Core.Name "function") -_TypeVariant_optional = (Core.FieldName "optional")+_TypeVariant_lambda = (Core.Name "lambda") -_TypeVariant_product = (Core.FieldName "product")+_TypeVariant_list = (Core.Name "list") -_TypeVariant_record = (Core.FieldName "record")+_TypeVariant_literal = (Core.Name "literal") -_TypeVariant_set = (Core.FieldName "set")+_TypeVariant_map = (Core.Name "map") -_TypeVariant_stream = (Core.FieldName "stream")+_TypeVariant_optional = (Core.Name "optional") -_TypeVariant_sum = (Core.FieldName "sum")+_TypeVariant_product = (Core.Name "product") -_TypeVariant_union = (Core.FieldName "union")+_TypeVariant_record = (Core.Name "record") -_TypeVariant_variable = (Core.FieldName "variable")+_TypeVariant_set = (Core.Name "set") --- | A type together with an instance of the type-data TypedTerm m = - TypedTerm {- typedTermType :: (Core.Type m),- typedTermTerm :: (Core.Term m)}- deriving (Eq, Ord, Read, Show)+_TypeVariant_sum = (Core.Name "sum") -_TypedTerm = (Core.Name "hydra/mantle.TypedTerm")+_TypeVariant_union = (Core.Name "union") -_TypedTerm_type = (Core.FieldName "type")+_TypeVariant_variable = (Core.Name "variable") -_TypedTerm_term = (Core.FieldName "term")+_TypeVariant_wrap = (Core.Name "wrap")
+ src/gen-main/haskell/Hydra/Messages.hs view
@@ -0,0 +1,11 @@+-- | A collection of standard error and warning messages++module Hydra.Messages where++import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++warningAutoGeneratedFile :: String+warningAutoGeneratedFile = "Note: this is an automatically generated file. Do not edit."
src/gen-main/haskell/Hydra/Module.hs view
@@ -3,10 +3,11 @@ module Hydra.Module where import qualified Hydra.Core as Core-import qualified Hydra.Mantle as Mantle-import Data.List-import Data.Map-import Data.Set+import qualified Hydra.Graph as Graph+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S newtype FileExtension = FileExtension {@@ -16,33 +17,49 @@ _FileExtension = (Core.Name "hydra/module.FileExtension") -- | A logical collection of elements in the same namespace, having dependencies on zero or more other modules-data Module m = +data Module = Module { -- | A common prefix for all element names in the module moduleNamespace :: Namespace, -- | The elements defined in this module- moduleElements :: [Mantle.Element m],- -- | Any additional modules this one has a direct dependency upon- moduleDependencies :: [Module m],+ moduleElements :: [Graph.Element],+ -- | Any modules which the term expressions of this module directly depend upon+ moduleTermDependencies :: [Module],+ -- | Any modules which the type expressions of this module directly depend upon+ moduleTypeDependencies :: [Module], -- | An optional human-readable description of the module moduleDescription :: (Maybe String)} deriving (Eq, Ord, Read, Show) _Module = (Core.Name "hydra/module.Module") -_Module_namespace = (Core.FieldName "namespace")+_Module_namespace = (Core.Name "namespace") -_Module_elements = (Core.FieldName "elements")+_Module_elements = (Core.Name "elements") -_Module_dependencies = (Core.FieldName "dependencies")+_Module_termDependencies = (Core.Name "termDependencies") -_Module_description = (Core.FieldName "description")+_Module_typeDependencies = (Core.Name "typeDependencies") +_Module_description = (Core.Name "description")+ -- | A prefix for element names newtype Namespace = Namespace {- -- | A prefix for element names unNamespace :: String} deriving (Eq, Ord, Read, Show) _Namespace = (Core.Name "hydra/module.Namespace")++-- | A qualified name consisting of an optional namespace together with a mandatory local name+data QualifiedName = + QualifiedName {+ qualifiedNameNamespace :: (Maybe Namespace),+ qualifiedNameLocal :: String}+ deriving (Eq, Ord, Read, Show)++_QualifiedName = (Core.Name "hydra/module.QualifiedName")++_QualifiedName_namespace = (Core.Name "namespace")++_QualifiedName_local = (Core.Name "local")
src/gen-main/haskell/Hydra/Phantoms.hs view
@@ -2,16 +2,16 @@ module Hydra.Phantoms where -import qualified Hydra.Compute as Compute import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set+import Data.Int+import Data.List as L+import Data.Map as M+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.FieldName}+ unCase :: Core.Name} deriving (Eq, Ord, Read, Show) _Case = (Core.Name "hydra/phantoms.Case")@@ -19,7 +19,7 @@ -- | An association of a term with a phantom type newtype Datum a = Datum {- unDatum :: (Core.Term Compute.Meta)}+ unDatum :: Core.Term} deriving (Eq, Ord, Read, Show) _Datum = (Core.Name "hydra/phantoms.Datum")@@ -33,14 +33,14 @@ _Definition = (Core.Name "hydra/phantoms.Definition") -_Definition_name = (Core.FieldName "name")+_Definition_name = (Core.Name "name") -_Definition_datum = (Core.FieldName "datum")+_Definition_datum = (Core.Name "datum") -- | An association with a term-level field with a phantom type newtype Fld a = Fld {- unFld :: (Core.Field Compute.Meta)}+ unFld :: Core.Field} deriving (Eq, Ord, Read, Show) _Fld = (Core.Name "hydra/phantoms.Fld")
+ src/gen-main/haskell/Hydra/Printing.hs view
@@ -0,0 +1,83 @@+-- | Utilities for use in transformations++module Hydra.Printing where++import qualified Hydra.Basics as Basics+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Literals as Literals+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Mantle as Mantle+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | Display a floating-point type as a string+describeFloatType :: (Core.FloatType -> String)+describeFloatType t = (Strings.cat [+ (\x -> describePrecision (Basics.floatTypePrecision x)) t,+ " floating-point numbers"])++-- | Display an integer type as a string+describeIntegerType :: (Core.IntegerType -> String)+describeIntegerType t = (Strings.cat [+ (\x -> describePrecision (Basics.integerTypePrecision x)) t,+ " integers"])++-- | Display a literal type as a string+describeLiteralType :: (Core.LiteralType -> String)+describeLiteralType x = case x of+ Core.LiteralTypeBinary -> "binary strings"+ Core.LiteralTypeBoolean -> "boolean values"+ Core.LiteralTypeFloat v246 -> (describeFloatType v246)+ Core.LiteralTypeInteger v247 -> (describeIntegerType v247)+ 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,+ "-bit"])++-- | Display a type as a string+describeType :: (Core.Type -> String)+describeType x = case x of+ Core.TypeAnnotated v251 -> (Strings.cat [+ "annotated ",+ (describeType (Core.annotatedTypeSubject v251))])+ Core.TypeApplication _ -> "instances of an application type"+ Core.TypeLiteral v253 -> (describeLiteralType v253)+ Core.TypeFunction v254 -> (Strings.cat [+ Strings.cat [+ Strings.cat [+ "functions from ",+ (describeType (Core.functionTypeDomain v254))],+ " to "],+ (describeType (Core.functionTypeCodomain v254))])+ Core.TypeLambda _ -> "polymorphic terms"+ Core.TypeList v256 -> (Strings.cat [+ "lists of ",+ (describeType v256)])+ Core.TypeMap v257 -> (Strings.cat [+ Strings.cat [+ Strings.cat [+ "maps from ",+ (describeType (Core.mapTypeKeys v257))],+ " to "],+ (describeType (Core.mapTypeValues v257))])+ Core.TypeOptional v258 -> (Strings.cat [+ "optional ",+ (describeType v258)])+ Core.TypeProduct _ -> "tuples"+ Core.TypeRecord _ -> "records"+ Core.TypeSet v261 -> (Strings.cat [+ "sets of ",+ (describeType v261)])+ Core.TypeSum _ -> "variant tuples"+ Core.TypeUnion _ -> "unions"+ Core.TypeVariable _ -> "instances of a named type"+ Core.TypeWrap v265 -> (Strings.cat [+ "wrapper for ",+ (describeType (Core.wrappedTypeObject v265))])
+ src/gen-main/haskell/Hydra/Query.hs view
@@ -0,0 +1,246 @@+-- | A model for language-agnostic graph pattern queries++module Hydra.Query 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++-- | One of several comparison operators+data ComparisonConstraint = + ComparisonConstraintEqual |+ ComparisonConstraintNotEqual |+ ComparisonConstraintLessThan |+ ComparisonConstraintGreaterThan |+ ComparisonConstraintLessThanOrEqual |+ ComparisonConstraintGreaterThanOrEqual + deriving (Eq, Ord, Read, Show)++_ComparisonConstraint = (Core.Name "hydra/query.ComparisonConstraint")++_ComparisonConstraint_equal = (Core.Name "equal")++_ComparisonConstraint_notEqual = (Core.Name "notEqual")++_ComparisonConstraint_lessThan = (Core.Name "lessThan")++_ComparisonConstraint_greaterThan = (Core.Name "greaterThan")++_ComparisonConstraint_lessThanOrEqual = (Core.Name "lessThanOrEqual")++_ComparisonConstraint_greaterThanOrEqual = (Core.Name "greaterThanOrEqual")++-- | An abstract edge based on a record type+data Edge = + Edge {+ -- | The name of a record type, for which the edge also specifies an out- and an in- projection+ edgeType :: Core.Name,+ -- | The field representing the out-projection of the edge. Defaults to 'out'.+ edgeOut :: (Maybe Core.Name),+ -- | The field representing the in-projection of the edge. Defaults to 'in'.+ edgeIn :: (Maybe Core.Name)}+ deriving (Eq, Ord, Read, Show)++_Edge = (Core.Name "hydra/query.Edge")++_Edge_type = (Core.Name "type")++_Edge_out = (Core.Name "out")++_Edge_in = (Core.Name "in")++-- | A query pattern which matches within a designated component subgraph+data GraphPattern = + GraphPattern {+ -- | The name of the component graph+ graphPatternGraph :: Core.Name,+ -- | The patterns to match within the subgraph+ graphPatternPatterns :: [Pattern]}+ deriving (Eq, Ord, Read, Show)++_GraphPattern = (Core.Name "hydra/query.GraphPattern")++_GraphPattern_graph = (Core.Name "graph")++_GraphPattern_patterns = (Core.Name "patterns")++-- | A node in a query expression; it may be a term, a variable, or a wildcard+data Node = + -- | A graph term; an expression which is valid in the graph being matched+ NodeTerm Core.Term |+ -- | A query variable, not to be confused with a variable term+ NodeVariable Variable |+ -- | An anonymous variable which we do not care to join across patterns+ NodeWildcard + deriving (Eq, Ord, Read, Show)++_Node = (Core.Name "hydra/query.Node")++_Node_term = (Core.Name "term")++_Node_variable = (Core.Name "variable")++_Node_wildcard = (Core.Name "wildcard")++-- | A query path+data Path = + -- | A path given by a single step+ PathStep Step |+ -- | A path given by a regular expression quantifier applied to another path+ PathRegex RegexSequence |+ -- | A path given by the inverse of another path+ PathInverse Path+ deriving (Eq, Ord, Read, Show)++_Path = (Core.Name "hydra/query.Path")++_Path_step = (Core.Name "step")++_Path_regex = (Core.Name "regex")++_Path_inverse = (Core.Name "inverse")++-- | A query pattern+data Pattern = + -- | A subject/predicate/object pattern+ PatternTriple TriplePattern |+ -- | The negation of another pattern+ PatternNegation Pattern |+ -- | The conjunction ('and') of several other patterns+ PatternConjunction [Pattern] |+ -- | The disjunction (inclusive 'or') of several other patterns+ PatternDisjunction [Pattern] |+ -- | A pattern which matches within a named subgraph+ PatternGraph GraphPattern+ deriving (Eq, Ord, Read, Show)++_Pattern = (Core.Name "hydra/query.Pattern")++_Pattern_triple = (Core.Name "triple")++_Pattern_negation = (Core.Name "negation")++_Pattern_conjunction = (Core.Name "conjunction")++_Pattern_disjunction = (Core.Name "disjunction")++_Pattern_graph = (Core.Name "graph")++-- | A SELECT-style graph pattern matching query+data Query = + Query {+ -- | The variables selected by the query+ queryVariables :: [Variable],+ -- | The patterns to be matched+ queryPatterns :: [Pattern]}+ deriving (Eq, Ord, Read, Show)++_Query = (Core.Name "hydra/query.Query")++_Query_variables = (Core.Name "variables")++_Query_patterns = (Core.Name "patterns")++-- | A range from min to max, inclusive+data Range = + Range {+ rangeMin :: Int,+ rangeMax :: Int}+ deriving (Eq, Ord, Read, Show)++_Range = (Core.Name "hydra/query.Range")++_Range_min = (Core.Name "min")++_Range_max = (Core.Name "max")++-- | A regular expression quantifier+data RegexQuantifier = + -- | No quantifier; matches a single occurrence+ RegexQuantifierOne |+ -- | The ? quanifier; matches zero or one occurrence+ RegexQuantifierZeroOrOne |+ -- | The * quantifier; matches any number of occurrences+ RegexQuantifierZeroOrMore |+ -- | The + quantifier; matches one or more occurrences+ RegexQuantifierOneOrMore |+ -- | The {n} quantifier; matches exactly n occurrences+ RegexQuantifierExactly Int |+ -- | The {n,} quantifier; matches at least n occurrences+ RegexQuantifierAtLeast Int |+ -- | The {n, m} quantifier; matches between n and m (inclusive) occurrences+ RegexQuantifierRange Range+ deriving (Eq, Ord, Read, Show)++_RegexQuantifier = (Core.Name "hydra/query.RegexQuantifier")++_RegexQuantifier_one = (Core.Name "one")++_RegexQuantifier_zeroOrOne = (Core.Name "zeroOrOne")++_RegexQuantifier_zeroOrMore = (Core.Name "zeroOrMore")++_RegexQuantifier_oneOrMore = (Core.Name "oneOrMore")++_RegexQuantifier_exactly = (Core.Name "exactly")++_RegexQuantifier_atLeast = (Core.Name "atLeast")++_RegexQuantifier_range = (Core.Name "range")++-- | A path with a regex quantifier+data RegexSequence = + RegexSequence {+ regexSequencePath :: Path,+ regexSequenceQuantifier :: RegexQuantifier}+ deriving (Eq, Ord, Read, Show)++_RegexSequence = (Core.Name "hydra/query.RegexSequence")++_RegexSequence_path = (Core.Name "path")++_RegexSequence_quantifier = (Core.Name "quantifier")++-- | An atomic function as part of a query. When applied to a graph, steps are typed by function types.+data Step = + -- | An out-to-in traversal of an abstract edge+ StepEdge Edge |+ -- | A projection from a record through one of its fields+ StepProject Core.Projection |+ -- | A comparison of two terms+ StepCompare ComparisonConstraint+ deriving (Eq, Ord, Read, Show)++_Step = (Core.Name "hydra/query.Step")++_Step_edge = (Core.Name "edge")++_Step_project = (Core.Name "project")++_Step_compare = (Core.Name "compare")++-- | A subject/predicate/object pattern+data TriplePattern = + TriplePattern {+ triplePatternSubject :: Node,+ triplePatternPredicate :: Path,+ triplePatternObject :: Node}+ deriving (Eq, Ord, Read, Show)++_TriplePattern = (Core.Name "hydra/query.TriplePattern")++_TriplePattern_subject = (Core.Name "subject")++_TriplePattern_predicate = (Core.Name "predicate")++_TriplePattern_object = (Core.Name "object")++-- | A query variable+newtype Variable = + Variable {+ unVariable :: String}+ deriving (Eq, Ord, Read, Show)++_Variable = (Core.Name "hydra/query.Variable")
+ src/gen-main/haskell/Hydra/Strip.hs view
@@ -0,0 +1,34 @@+-- | Several functions for stripping annotations from types and terms.++module Hydra.Strip 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++-- | 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))+ _ -> 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))+ _ -> 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))+ _ -> 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))+ _ -> t) (stripType t))
+ src/gen-main/haskell/Hydra/Testing.hs view
@@ -0,0 +1,59 @@+-- | A model for unit testing++module Hydra.Testing 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++-- | One of two evaluation styles: eager or lazy+data EvaluationStyle = + EvaluationStyleEager |+ EvaluationStyleLazy + deriving (Eq, Ord, Read, Show)++_EvaluationStyle = (Core.Name "hydra/testing.EvaluationStyle")++_EvaluationStyle_eager = (Core.Name "eager")++_EvaluationStyle_lazy = (Core.Name "lazy")++-- | A simple test case with an input and an expected output+data TestCase = + TestCase {+ testCaseDescription :: (Maybe String),+ testCaseEvaluationStyle :: EvaluationStyle,+ testCaseInput :: Core.Term,+ testCaseOutput :: Core.Term}+ deriving (Eq, Ord, Read, Show)++_TestCase = (Core.Name "hydra/testing.TestCase")++_TestCase_description = (Core.Name "description")++_TestCase_evaluationStyle = (Core.Name "evaluationStyle")++_TestCase_input = (Core.Name "input")++_TestCase_output = (Core.Name "output")++-- | A collection of test cases with a name and optional description+data TestGroup = + TestGroup {+ testGroupName :: String,+ testGroupDescription :: (Maybe String),+ testGroupSubgroups :: [TestGroup],+ testGroupCases :: [TestCase]}+ deriving (Eq, Ord, Read, Show)++_TestGroup = (Core.Name "hydra/testing.TestGroup")++_TestGroup_name = (Core.Name "name")++_TestGroup_description = (Core.Name "description")++_TestGroup_subgroups = (Core.Name "subgroups")++_TestGroup_cases = (Core.Name "cases")
+ src/gen-main/haskell/Hydra/Tier1.hs view
@@ -0,0 +1,269 @@+-- | A module for miscellaneous tier-1 functions and constants.++module Hydra.Tier1 where++import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Constants as Constants+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Literals as Literals+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.Sets as Sets+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Module as Module+import qualified Hydra.Strip as Strip+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | 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)++-- | 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)++-- | 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.FunctionLambda _ -> True+ _ -> False) v89)+ Core.TermLet v91 -> (isLambda (Core.letEnvironment v91))+ _ -> False) (Strip.fullyStripTerm term))++-- | Convert a qualified name to a dot-separated name+unqualifyName :: (Module.QualifiedName -> Core.Name)+unqualifyName qname = + let prefix = ((\x -> case x of+ Nothing -> ""+ Just v92 -> (Strings.cat [+ Module.unNamespace v92,+ "."])) (Module.qualifiedNameNamespace qname))+ in (Core.Name (Strings.cat [+ prefix,+ (Module.qualifiedNameLocal qname)]))++-- | Fold over a term, traversing its subterms in the specified order+foldOverTerm :: (Coders.TraversalOrder -> (x -> Core.Term -> x) -> x -> Core.Term -> x)+foldOverTerm order fld b0 term = ((\x -> case x of+ Coders.TraversalOrderPre -> (Lists.foldl (foldOverTerm order fld) (fld b0 term) (subterms term))+ Coders.TraversalOrderPost -> (fld (Lists.foldl (foldOverTerm order fld) b0 (subterms term)) term)) order)++-- | Fold over a type, traversing its subtypes in the specified order+foldOverType :: (Coders.TraversalOrder -> (x -> Core.Type -> x) -> x -> Core.Type -> x)+foldOverType order fld b0 typ = ((\x -> case x of+ Coders.TraversalOrderPre -> (Lists.foldl (foldOverType order fld) (fld b0 typ) (subtypes typ))+ Coders.TraversalOrderPost -> (fld (Lists.foldl (foldOverType order fld) b0 (subtypes typ)) typ)) order)++-- | Find the free variables (i.e. variables not bound by a lambda or let) in a term+freeVariablesInTerm :: (Core.Term -> Set Core.Name)+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)+ _ -> dfltVars) term)++-- | Find the free variables (i.e. variables not bound by a lambda or let) in a type+freeVariablesInType :: (Core.Type -> Set Core.Name)+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)+ _ -> 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+ 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+ Core.TermLiteral _ -> []+ Core.TermMap v114 -> (Lists.concat (Lists.map (\p -> [+ fst p,+ (snd p)]) (Maps.toList v114)))+ Core.TermOptional v115 -> ((\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)]+ Core.TermVariable _ -> []+ Core.TermWrap v124 -> [+ Core.wrappedTermObject v124]++-- | 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.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.TypeVariable _ -> []+ Core.TypeWrap v139 -> [+ Core.wrappedTypeObject v139]++emptyTrace :: Compute.Trace+emptyTrace = Compute.Trace {+ Compute.traceStack = [],+ Compute.traceMessages = [],+ Compute.traceOther = Maps.empty}++-- | Check whether a flow succeeds+flowSucceeds :: (s -> Compute.Flow s a -> Bool)+flowSucceeds cx f = (Optionals.isJust (Compute.flowStateValue (Compute.unFlow f cx emptyTrace)))++-- | Get the value of a flow, or a default value if the flow fails+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)))++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 -> + let forLeft = (\msg -> Compute.FlowState {+ Compute.flowStateValue = Nothing,+ Compute.flowStateState = s0,+ Compute.flowStateTrace = (pushError msg t0)}) + forRight = (\t1 -> + let f2 = (Compute.unFlow f s0 t1)+ in Compute.FlowState {+ Compute.flowStateValue = (Compute.flowStateValue f2),+ 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))))++-- | Push an error message+pushError :: (String -> Compute.Trace -> Compute.Trace)+pushError msg t = + let errorMsg = (Strings.cat [+ "Error: ",+ msg,+ " (",+ Strings.intercalate " > " (Lists.reverse (Compute.traceStack t)),+ ")"])+ in Compute.Trace {+ Compute.traceStack = (Compute.traceStack t),+ Compute.traceMessages = (Lists.cons errorMsg (Compute.traceMessages t)),+ Compute.traceOther = (Compute.traceOther t)}++-- | Continue the current flow after adding a warning message+warn :: (String -> Compute.Flow s a -> Compute.Flow s a)+warn msg b = (Compute.Flow (\s0 -> \t0 -> + let f1 = (Compute.unFlow b s0 t0) + addMessage = (\t -> Compute.Trace {+ Compute.traceStack = (Compute.traceStack t),+ Compute.traceMessages = (Lists.cons (Strings.cat [+ "Warning: ",+ msg]) (Compute.traceMessages t)),+ Compute.traceOther = (Compute.traceOther t)})+ in Compute.FlowState {+ Compute.flowStateValue = (Compute.flowStateValue f1),+ Compute.flowStateState = (Compute.flowStateState f1),+ 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 flag = + let mutate = (\t -> Mantle.EitherRight (Compute.Trace {+ Compute.traceStack = (Compute.traceStack t),+ Compute.traceMessages = (Compute.traceMessages t),+ Compute.traceOther = (Maps.insert flag (Core.TermLiteral (Core.LiteralBoolean True)) (Compute.traceOther t))})) + restore = (\ignored -> \t1 -> Compute.Trace {+ Compute.traceStack = (Compute.traceStack t1),+ Compute.traceMessages = (Compute.traceMessages t1),+ Compute.traceOther = (Maps.remove flag (Compute.traceOther t1))})+ in (mutateTrace mutate restore)++-- | Continue a flow using a given state+withState :: (s1 -> Compute.Flow s1 a -> Compute.Flow s2 a)+withState cx0 f = (Compute.Flow (\cx1 -> \t1 -> + let f1 = (Compute.unFlow f cx0 t1)+ in Compute.FlowState {+ Compute.flowStateValue = (Compute.flowStateValue f1),+ Compute.flowStateState = cx1,+ Compute.flowStateTrace = (Compute.flowStateTrace f1)}))++-- | Continue the current flow after augmenting the trace+withTrace :: (String -> Compute.Flow s a -> Compute.Flow s a)+withTrace msg = + let mutate = (\t -> Logic.ifElse (Mantle.EitherLeft "maximum trace depth exceeded. This may indicate an infinite loop") (Mantle.EitherRight (Compute.Trace {+ Compute.traceStack = (Lists.cons msg (Compute.traceStack t)),+ Compute.traceMessages = (Compute.traceMessages t),+ Compute.traceOther = (Compute.traceOther t)})) (Equality.gteInt32 (Lists.length (Compute.traceStack t)) Constants.maxTraceDepth)) + restore = (\t0 -> \t1 -> Compute.Trace {+ Compute.traceStack = (Compute.traceStack t0),+ Compute.traceMessages = (Compute.traceMessages t1),+ Compute.traceOther = (Compute.traceOther t1)})+ in (mutateTrace mutate restore)
+ src/gen-main/haskell/Hydra/Tier2.hs view
@@ -0,0 +1,71 @@+-- | A module for miscellaneous tier-2 functions and constants.++module Hydra.Tier2 where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Flows as Flows+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++-- | Get the state of the current flow+getState :: (Compute.Flow s s)+getState = (Compute.Flow (\s0 -> \t0 -> + let fs1 = (Compute.unFlow (Flows.pure ()) s0 t0)+ in ((\v -> \s -> \t -> (\x -> case x of+ Nothing -> Compute.FlowState {+ Compute.flowStateValue = Nothing,+ Compute.flowStateState = s,+ Compute.flowStateTrace = t}+ Just _ -> Compute.FlowState {+ Compute.flowStateValue = (Just s),+ Compute.flowStateState = s,+ Compute.flowStateTrace = t}) v) (Compute.flowStateValue fs1) (Compute.flowStateState fs1) (Compute.flowStateTrace fs1))))++-- | 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))+ _ -> Nothing++-- | Set the state of a flow+putState :: (s -> Compute.Flow s ())+putState cx = (Compute.Flow (\s0 -> \t0 -> + let f1 = (Compute.unFlow (Flows.pure ()) s0 t0)+ in Compute.FlowState {+ Compute.flowStateValue = (Compute.flowStateValue f1),+ Compute.flowStateState = cx,+ Compute.flowStateTrace = (Compute.flowStateTrace f1)}))++-- | Get the annotated type of a given element, or fail if it is missing+requireElementType :: (Graph.Element -> Compute.Flow Graph.Graph Core.Type)+requireElementType el = + let withType = (\x -> case x of+ Nothing -> (Flows.fail (Strings.cat [+ "missing type annotation for element ",+ (Core.unName (Graph.elementName el))]))+ Just v274 -> (Flows.pure v274))+ in (withType (getTermType (Graph.elementData el)))++-- | Get the annotated type of a given term, or fail if it is missing+requireTermType :: (Core.Term -> Compute.Flow Graph.Graph Core.Type)+requireTermType x = (withType (getTermType x)) + where + withType = (\x -> case x of+ Nothing -> (Flows.fail "missing type annotation")+ Just v275 -> (Flows.pure v275))++-- | Fail if an actual value does not match an expected value+unexpected :: (String -> String -> Compute.Flow s x)+unexpected expected actual = (Flows.fail (Strings.cat [+ Strings.cat [+ Strings.cat [+ "expected ",+ expected],+ " but found: "],+ actual]))
+ src/gen-main/haskell/Hydra/Tier3.hs view
@@ -0,0 +1,28 @@+-- | A module for miscellaneous tier-3 functions and constants.++module Hydra.Tier3 where++import qualified Hydra.Compute as Compute+import qualified Hydra.Lib.Io as Io+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.Strings as Strings+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | Summarize a trace as a string+traceSummary :: (Compute.Trace -> String)+traceSummary t = + let messageLines = (Lists.nub (Compute.traceMessages t)) + keyvalLines = (Logic.ifElse [] (Lists.cons "key/value pairs: " (Lists.map toLine (Maps.toList (Compute.traceOther t)))) (Maps.isEmpty (Compute.traceOther t)))+ toLine = (\pair -> Strings.cat [+ Strings.cat [+ Strings.cat [+ "\t",+ (fst pair)],+ ": "],+ (Io.showTerm (snd pair))])+ in (Strings.intercalate "\n" (Lists.concat2 messageLines keyvalLines))
− src/gen-main/haskell/Hydra/Util/Codetree/Ast.hs
@@ -1,173 +0,0 @@--- | A model which provides a common syntax tree for Hydra serializers--module Hydra.Util.Codetree.Ast where--import qualified Hydra.Core as Core-import Data.List-import Data.Map-import Data.Set---- | Operator associativity-data Associativity = - AssociativityNone |- AssociativityLeft |- AssociativityRight |- AssociativityBoth - deriving (Eq, Ord, Read, Show)--_Associativity = (Core.Name "hydra/util/codetree/ast.Associativity")--_Associativity_none = (Core.FieldName "none")--_Associativity_left = (Core.FieldName "left")--_Associativity_right = (Core.FieldName "right")--_Associativity_both = (Core.FieldName "both")---- | Formatting option for code blocks-data BlockStyle = - BlockStyle {- blockStyleIndent :: Bool,- blockStyleNewlineBeforeContent :: Bool,- blockStyleNewlineAfterContent :: Bool}- deriving (Eq, Ord, Read, Show)--_BlockStyle = (Core.Name "hydra/util/codetree/ast.BlockStyle")--_BlockStyle_indent = (Core.FieldName "indent")--_BlockStyle_newlineBeforeContent = (Core.FieldName "newlineBeforeContent")--_BlockStyle_newlineAfterContent = (Core.FieldName "newlineAfterContent")---- | An expression enclosed by brackets-data BracketExpr = - BracketExpr {- bracketExprBrackets :: Brackets,- bracketExprEnclosed :: Expr,- bracketExprStyle :: BlockStyle}- deriving (Eq, Ord, Read, Show)--_BracketExpr = (Core.Name "hydra/util/codetree/ast.BracketExpr")--_BracketExpr_brackets = (Core.FieldName "brackets")--_BracketExpr_enclosed = (Core.FieldName "enclosed")--_BracketExpr_style = (Core.FieldName "style")---- | Matching open and close bracket symbols-data Brackets = - Brackets {- bracketsOpen :: Symbol,- bracketsClose :: Symbol}- deriving (Eq, Ord, Read, Show)--_Brackets = (Core.Name "hydra/util/codetree/ast.Brackets")--_Brackets_open = (Core.FieldName "open")--_Brackets_close = (Core.FieldName "close")---- | An abstract expression-data Expr = - ExprConst Symbol |- ExprOp OpExpr |- ExprBrackets BracketExpr- deriving (Eq, Ord, Read, Show)--_Expr = (Core.Name "hydra/util/codetree/ast.Expr")--_Expr_const = (Core.FieldName "const")--_Expr_op = (Core.FieldName "op")--_Expr_brackets = (Core.FieldName "brackets")---- | An operator symbol-data Op = - Op {- opSymbol :: Symbol,- opPadding :: Padding,- opPrecedence :: Precedence,- opAssociativity :: Associativity}- deriving (Eq, Ord, Read, Show)--_Op = (Core.Name "hydra/util/codetree/ast.Op")--_Op_symbol = (Core.FieldName "symbol")--_Op_padding = (Core.FieldName "padding")--_Op_precedence = (Core.FieldName "precedence")--_Op_associativity = (Core.FieldName "associativity")---- | An operator expression-data OpExpr = - OpExpr {- opExprOp :: Op,- opExprLhs :: Expr,- opExprRhs :: Expr}- deriving (Eq, Ord, Read, Show)--_OpExpr = (Core.Name "hydra/util/codetree/ast.OpExpr")--_OpExpr_op = (Core.FieldName "op")--_OpExpr_lhs = (Core.FieldName "lhs")--_OpExpr_rhs = (Core.FieldName "rhs")---- | Left and right padding for an operator-data Padding = - Padding {- paddingLeft :: Ws,- paddingRight :: Ws}- deriving (Eq, Ord, Read, Show)--_Padding = (Core.Name "hydra/util/codetree/ast.Padding")--_Padding_left = (Core.FieldName "left")--_Padding_right = (Core.FieldName "right")---- | Operator precedence-newtype Precedence = - Precedence {- -- | Operator precedence- unPrecedence :: Int}- deriving (Eq, Ord, Read, Show)--_Precedence = (Core.Name "hydra/util/codetree/ast.Precedence")---- | Any symbol-newtype Symbol = - Symbol {- -- | Any symbol- unSymbol :: String}- deriving (Eq, Ord, Read, Show)--_Symbol = (Core.Name "hydra/util/codetree/ast.Symbol")---- | One of several classes of whitespace-data Ws = - WsNone |- WsSpace |- WsBreak |- WsBreakAndIndent |- WsDoubleBreak - deriving (Eq, Ord, Read, Show)--_Ws = (Core.Name "hydra/util/codetree/ast.Ws")--_Ws_none = (Core.FieldName "none")--_Ws_space = (Core.FieldName "space")--_Ws_break = (Core.FieldName "break")--_Ws_breakAndIndent = (Core.FieldName "breakAndIndent")--_Ws_doubleBreak = (Core.FieldName "doubleBreak")
+ src/gen-main/haskell/Hydra/Workflow.hs view
@@ -0,0 +1,86 @@+-- | A model for Hydra transformation workflows++module Hydra.Workflow where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Module as Module+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++-- | The specification of a Hydra schema, provided as a set of modules and a distinguished type+data HydraSchemaSpec = + HydraSchemaSpec {+ -- | The modules to include in the schema graph+ hydraSchemaSpecModules :: [Module.Module],+ -- | The name of the top-level type; all data which passes through the workflow will be instances of this type+ hydraSchemaSpecTypeName :: Core.Name}+ deriving (Eq, Ord, Read, Show)++_HydraSchemaSpec = (Core.Name "hydra/workflow.HydraSchemaSpec")++_HydraSchemaSpec_modules = (Core.Name "modules")++_HydraSchemaSpec_typeName = (Core.Name "typeName")++-- | The last mile of a transformation, which encodes and serializes terms to a file+data LastMile s a = + LastMile {+ -- | An encoder for terms to a list of output objects+ lastMileEncoder :: (Core.Type -> Compute.Flow s (Core.Term -> Graph.Graph -> Compute.Flow s [a])),+ -- | A function which serializes a list of output objects to a string representation+ lastMileSerializer :: ([a] -> Compute.Flow s String),+ -- | A file extension for the generated file(s)+ lastMileFileExtension :: String}++_LastMile = (Core.Name "hydra/workflow.LastMile")++_LastMile_encoder = (Core.Name "encoder")++_LastMile_serializer = (Core.Name "serializer")++_LastMile_fileExtension = (Core.Name "fileExtension")++-- | The specification of a schema at the source end of a workflow+data SchemaSpec = + -- | A native Hydra schema+ SchemaSpecHydra HydraSchemaSpec |+ -- | A schema provided as a file, available at the given file path+ SchemaSpecFile String |+ -- | A schema which will be provided within the workflow+ SchemaSpecProvided + deriving (Eq, Ord, Read, Show)++_SchemaSpec = (Core.Name "hydra/workflow.SchemaSpec")++_SchemaSpec_hydra = (Core.Name "hydra")++_SchemaSpec_file = (Core.Name "file")++_SchemaSpec_provided = (Core.Name "provided")++-- | The specification of a workflow which takes a schema specification, reads data from a directory, and writes data to another directory+data TransformWorkflow = + TransformWorkflow {+ -- | A descriptive name for the workflow+ transformWorkflowName :: String,+ -- | The schema specification+ transformWorkflowSchemaSpec :: SchemaSpec,+ -- | The source directory+ transformWorkflowSrcDir :: String,+ -- | The destination directory+ transformWorkflowDestDir :: String}+ deriving (Eq, Ord, Read, Show)++_TransformWorkflow = (Core.Name "hydra/workflow.TransformWorkflow")++_TransformWorkflow_name = (Core.Name "name")++_TransformWorkflow_schemaSpec = (Core.Name "schemaSpec")++_TransformWorkflow_srcDir = (Core.Name "srcDir")++_TransformWorkflow_destDir = (Core.Name "destDir")
+ src/gen-test/haskell/Hydra/Test/TestSuite.hs view
@@ -0,0 +1,468 @@+-- | Test cases for primitive functions++module Hydra.Test.TestSuite where++import qualified Hydra.Core as Core+import qualified Hydra.Testing as Testing+import Data.Int+import Data.List as L+import Data.Map as M+import Data.Set as S++allTests :: Testing.TestGroup+allTests = Testing.TestGroup {+ Testing.testGroupName = "All tests",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [+ Testing.TestGroup {+ Testing.testGroupName = "hydra/lib/lists primitives",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [+ Testing.TestGroup {+ Testing.testGroupName = "apply",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.apply"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper")),+ (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toLower")))])})),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "One"),+ Core.TermLiteral (Core.LiteralString "Two"),+ (Core.TermLiteral (Core.LiteralString "Three"))])})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "ONE"),+ Core.TermLiteral (Core.LiteralString "TWO"),+ Core.TermLiteral (Core.LiteralString "THREE"),+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "two"),+ (Core.TermLiteral (Core.LiteralString "three"))])}]},+ Testing.TestGroup {+ Testing.testGroupName = "bind",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.bind"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+ Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+ Core.lambdaParameter = (Core.Name "x"),+ Core.lambdaBody = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.pure"))),+ Core.applicationArgument = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/math.neg"))),+ Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-4))))])}]},+ Testing.TestGroup {+ Testing.testGroupName = "concat",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.concat"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],+ Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],+ (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])])})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])}]},+ Testing.TestGroup {+ Testing.testGroupName = "head",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.head"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}]},+ Testing.TestGroup {+ Testing.testGroupName = "intercalate",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.intercalate"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))])})),+ Core.applicationArgument = (Core.TermList [+ Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],+ Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],+ (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])])})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])}]},+ Testing.TestGroup {+ Testing.testGroupName = "intersperse",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.intersperse"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "and"))})),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "two"),+ (Core.TermLiteral (Core.LiteralString "three"))])})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "and"),+ Core.TermLiteral (Core.LiteralString "two"),+ Core.TermLiteral (Core.LiteralString "and"),+ (Core.TermLiteral (Core.LiteralString "three"))])}]},+ Testing.TestGroup {+ Testing.testGroupName = "last",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.last"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))}]},+ Testing.TestGroup {+ Testing.testGroupName = "length",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.length"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+ Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+ (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))}]},+ Testing.TestGroup {+ Testing.testGroupName = "map",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.map"))),+ Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper")))})),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "one"),+ (Core.TermLiteral (Core.LiteralString "two"))])})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "ONE"),+ (Core.TermLiteral (Core.LiteralString "TWO"))])}]},+ Testing.TestGroup {+ Testing.testGroupName = "pure",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.pure"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "one")])}]}],+ Testing.testGroupCases = []},+ Testing.TestGroup {+ Testing.testGroupName = "hydra/lib/strings primitives",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [+ Testing.TestGroup {+ Testing.testGroupName = "cat",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.cat"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "two"),+ (Core.TermLiteral (Core.LiteralString "three"))])})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "onetwothree"))},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.cat"))),+ Core.applicationArgument = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString ""),+ (Core.TermLiteral (Core.LiteralString ""))])})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "one"))},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.cat"))),+ Core.applicationArgument = (Core.TermList [])})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString ""))}]},+ Testing.TestGroup {+ Testing.testGroupName = "length",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.length"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.length"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.length"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one"))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))}]},+ Testing.TestGroup {+ Testing.testGroupName = "splitOn",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "ss"))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "Mi"),+ Core.TermLiteral (Core.LiteralString "i"),+ (Core.TermLiteral (Core.LiteralString "ippi"))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ (Core.TermLiteral (Core.LiteralString ""))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one two three"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "two"),+ (Core.TermLiteral (Core.LiteralString "three"))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " one two three "))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "two"),+ Core.TermLiteral (Core.LiteralString "three"),+ (Core.TermLiteral (Core.LiteralString ""))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " one two three"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ Core.TermLiteral (Core.LiteralString ""),+ Core.TermLiteral (Core.LiteralString "one"),+ Core.TermLiteral (Core.LiteralString "two"),+ (Core.TermLiteral (Core.LiteralString "three"))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " one two three"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ (Core.TermLiteral (Core.LiteralString "one two three"))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "aa"))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "aaa"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ (Core.TermLiteral (Core.LiteralString "a"))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "")])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "abc"))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString ""),+ Core.TermLiteral (Core.LiteralString "a"),+ Core.TermLiteral (Core.LiteralString "b"),+ (Core.TermLiteral (Core.LiteralString "c"))])},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+ Testing.testCaseOutput = (Core.TermList [+ Core.TermLiteral (Core.LiteralString "")])}]},+ Testing.TestGroup {+ Testing.testGroupName = "toLower",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toLower"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "One TWO threE"))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "one two three"))},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toLower"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Abc123"))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "abc123"))}]},+ Testing.TestGroup {+ Testing.testGroupName = "toUpper",+ Testing.testGroupDescription = Nothing,+ Testing.testGroupSubgroups = [],+ Testing.testGroupCases = [+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "One TWO threE"))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "ONE TWO THREE"))},+ Testing.TestCase {+ Testing.testCaseDescription = Nothing,+ Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,+ Testing.testCaseInput = (Core.TermApplication (Core.Application {+ Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper"))),+ Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Abc123"))})),+ Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "ABC123"))}]}],+ Testing.testGroupCases = []}],+ Testing.testGroupCases = []}
+ src/main/haskell/Hydra/AdapterUtils.hs view
@@ -0,0 +1,131 @@+-- | Additional adapter utilities, above and beyond the generated ones++module Hydra.AdapterUtils (+ module Hydra.AdapterUtils,+ module Hydra.Printing,+) where++import Hydra.Coders+import Hydra.Compute+import Hydra.Core+import Hydra.Basics+import Hydra.Module+import Hydra.Printing+import Hydra.Mantle+import Hydra.Annotations+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Dsl.Expect as Expect+import qualified Hydra.Dsl.Terms as Terms++import qualified Data.List as L+import qualified Data.Set as S+import qualified Data.Maybe as Y+import Control.Monad+++type SymmetricAdapter s t v = Adapter s s t t v v++type TypeAdapter = Type -> Flow AdapterContext (SymmetricAdapter AdapterContext Type Term)++bidirectional :: (CoderDirection -> b -> Flow s b) -> Coder s s b b+bidirectional f = Coder (f CoderDirectionEncode) (f CoderDirectionDecode)++chooseAdapter :: (Eq t, Ord t, Show t) =>+ (t -> [Flow so (SymmetricAdapter si t v)])+ -> (t -> Bool)+ -> (t -> String)+ -> t+ -> Flow so (SymmetricAdapter si t v)+chooseAdapter alts supported describe typ = if supported typ+ then pure $ Adapter False typ typ idCoder+ else do+ -- Uncomment to debug adapter cycles+ -- debugCheckType typ++ raw <- sequence (alts typ)+ let candidates = L.filter (supported . adapterTarget) raw+ if L.null candidates+ then fail $ "no adapters found for " ++ describe typ+ ++ (if L.null raw+ then ""+ else " (discarded " ++ show (L.length raw) ++ " unsupported candidate types: " ++ show (adapterTarget <$> raw) ++ ")")+ ++ ". Original type: " ++ show typ+ else do+ -- Uncomment to debug adapter cycles+ -- debugRemoveType typ++ return $ L.head candidates++composeCoders :: Coder s s a b -> Coder s s b c -> Coder s s a c+composeCoders c1 c2 = Coder {+ coderEncode = coderEncode c1 >=> coderEncode c2,+ coderDecode = coderDecode c2 >=> coderDecode c1}++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+ 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))+ 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+ let types' = S.delete s types+ putAttr "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+ CoderDirectionEncode -> coderEncode+ CoderDirectionDecode -> coderDecode++floatTypeIsSupported :: LanguageConstraints -> FloatType -> Bool+floatTypeIsSupported constraints ft = S.member ft $ languageConstraintsFloatTypes constraints++idAdapter :: t -> SymmetricAdapter s t v+idAdapter t = Adapter False t t idCoder++idCoder :: Coder s s a a+idCoder = Coder pure pure++integerTypeIsSupported :: LanguageConstraints -> IntegerType -> Bool+integerTypeIsSupported constraints it = S.member it $ languageConstraintsIntegerTypes constraints++literalTypeIsSupported :: LanguageConstraints -> LiteralType -> Bool+literalTypeIsSupported constraints at = S.member (literalTypeVariant at) (languageConstraintsLiteralVariants constraints)+ && case at of+ LiteralTypeFloat ft -> floatTypeIsSupported constraints ft+ LiteralTypeInteger it -> integerTypeIsSupported constraints it+ _ -> True++nameToFilePath :: Bool -> FileExtension -> Name -> FilePath+nameToFilePath caps ext name = namespaceToFilePath caps ext $ Namespace $ prefix ++ local+ where+ QualifiedName ns local = qualifyNameEager name+ 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+ TypeLiteral at -> literalTypeIsSupported constraints at+ TypeFunction (FunctionType dom cod) -> typeIsSupported constraints dom && typeIsSupported constraints cod+ TypeList lt -> typeIsSupported constraints lt+ TypeMap (MapType kt vt) -> typeIsSupported constraints kt && typeIsSupported constraints vt+ TypeWrap _ -> True -- TODO: dereference the type+ TypeOptional t -> typeIsSupported constraints t+ TypeRecord rt -> and $ typeIsSupported constraints . fieldTypeType <$> rowTypeFields rt+ TypeSet st -> typeIsSupported constraints st+ TypeUnion rt -> and $ typeIsSupported constraints . fieldTypeType <$> rowTypeFields rt+ _ -> True+ where+ isSupportedVariant v = v == TypeVariantVariable || S.member v (languageConstraintsTypeVariants constraints)++unidirectionalCoder :: (a -> Flow s b) -> Coder s s a b+unidirectionalCoder m = Coder {+ coderEncode = m,+ coderDecode = \_ -> fail "inbound mapping is unsupported"}
+ src/main/haskell/Hydra/Adapters.hs view
@@ -0,0 +1,90 @@+-- | Entry point for Hydra's adapter (type/term rewriting) framework.+-- An adapter takes a type expression which is supported in a source language, and rewrites it to a type which is supported by a target language.+-- In parallel, terms conforming to the original type are rewritten. Both levels of the transformation are bidirectional.++module Hydra.Adapters where++import Hydra.TermAdapters+import Hydra.Printing+import Hydra.Coders+import Hydra.Compute+import Hydra.Core+import Hydra.CoreDecoding+import Hydra.CoreLanguage+import Hydra.Graph+import Hydra.Lexical+import Hydra.Mantle+import Hydra.Module+import Hydra.Strip+import Hydra.TermAdapters+import Hydra.AdapterUtils+import Hydra.Reduction+import Hydra.Tier1+import Hydra.Tier2++import qualified Control.Monad as CM+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+++adaptAndEncodeType :: Language -> (Type -> Flow Graph t) -> Type -> Flow Graph t+adaptAndEncodeType lang enc typ = case stripType typ of+ TypeVariable _ -> enc typ+ _ -> adaptType lang typ >>= enc++-- | Given a target language and a source type, find the target type to which the latter will be adapted.+adaptType :: Language -> Type -> Flow Graph Type+adaptType lang typ = adapterTarget <$> languageAdapter lang typ++-- | Given a target language, a unidirectional last-mile encoding, and a source type,+-- construct a unidirectional adapting coder for terms of that type. Terms will be rewritten according to the type and+-- according to the constraints of the target language, then carried by the last mile into the final representation+constructCoder :: Language+ -> (Term -> Flow Graph c)+ -> Type+ -> Flow Graph (Coder Graph Graph Term c)+constructCoder lang encodeTerm typ = withTrace ("coder for " ++ describeType typ) $ do+ adapter <- languageAdapter lang typ+ return $ composeCoders (adapterCoder adapter) (unidirectionalCoder encodeTerm)++-- | Given a target language and a source type, produce an adapter,+-- which rewrites the type and its terms according to the language's constraints+languageAdapter :: Language -> Type -> Flow Graph (SymmetricAdapter Graph Type Term)+languageAdapter lang typ0 = do+ -- TODO: rather than beta-reducing types all at once, we should incrementally extend the environment when application types are adapted+ -- typ <- betaReduceType typ0+ let typ = typ0++ g <- getState+ -- Provide an initial adapter context+ let cx0 = AdapterContext g lang M.empty+ -- Construct the term adapter, and capture the populated adapter context+ (adapter, cx) <- withState cx0 $ do+ ad <- termAdapter typ+ cx <- getState -- The state has been mutated to hold adapters for type elements+ return (ad, cx)+ -- Wrap terms in the adapter context as they pass through the adapter coder+ let ac = Coder encode decode+ where+ encode = withState cx . coderEncode (adapterCoder adapter)+ decode = withState cx . coderDecode (adapterCoder adapter)+ return $ adapter {adapterCoder = ac}++-- | Given a target language, a unidirectional last mile encoding, and an intermediate helper function,+-- transform a given module into a target representation+transformModule :: Language+ -> (Term -> Flow Graph e)+ -> (Module -> M.Map Type (Coder Graph Graph Term e) -> [(Element, TypedTerm)] -> Flow Graph d)+ -> Module -> Flow Graph d+transformModule lang encodeTerm createModule mod = withTrace ("transform module " ++ unNamespace (moduleNamespace mod)) $ do+ tterms <- withSchemaContext $ CM.mapM elementAsTypedTerm els+ let types = L.nub (typedTermType <$> tterms)+ coders <- codersFor types+ createModule mod coders $ L.zip els tterms+ where+ els = moduleElements mod++ codersFor types = do+ cdrs <- CM.mapM (constructCoder lang encodeTerm) types+ return $ M.fromList $ L.zip types cdrs
− src/main/haskell/Hydra/Adapters/Coders.hs
@@ -1,49 +0,0 @@--- | Entry point for Hydra's adapter (type/term rewriting) framework.--- An adapter takes a type expression which is supported in a source language, and rewrites it to a type which is supported by a target language.--- In parallel, terms conforming to the original type are rewritten. Both levels of the transformation are bidirectional.--module Hydra.Adapters.Coders where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Adapters.Term-import Hydra.Adapters.UtilsEtc--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S---adaptType :: (Ord m, Read m, Show m) => Language m -> Type m -> GraphFlow m (Type m)-adaptType targetLang t = do- cx <- getState- let acx = AdapterContext cx hydraCoreLanguage targetLang- ad <- withState acx $ termAdapter t- return $ adapterTarget ad--transformModule :: (Ord m, Read m, Show m)- => Language m- -> (Term m -> GraphFlow m e)- -> (Module m -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) e) -> [(Element m, TypedTerm m)] -> GraphFlow m d)- -> Module m -> GraphFlow m d-transformModule lang encodeTerm createModule mod = do- pairs <- withSchemaContext $ CM.mapM elementAsTypedTerm els- let types = L.nub (typedTermType <$> pairs)- coders <- codersFor types- createModule mod coders $ L.zip els pairs- where- els = moduleElements mod-- codersFor types = do- cdrs <- CM.mapM constructCoder types- return $ M.fromList $ L.zip types cdrs-- constructCoder typ = withTrace ("coder for " ++ describeType typ) $ do- cx <- getState- let acx = AdapterContext cx hydraCoreLanguage lang- adapter <- withState acx $ termAdapter typ- coder <- termCoder $ adapterTarget adapter- return $ composeCoders (adapterCoder adapter) coder- where- termCoder _ = pure $ unidirectionalCoder encodeTerm
− src/main/haskell/Hydra/Adapters/Literal.hs
@@ -1,144 +0,0 @@--- | Adapter framework for literal types and terms--module Hydra.Adapters.Literal (- literalAdapter,- floatAdapter,- integerAdapter,-) where--import Hydra.Kernel-import Hydra.Adapters.UtilsEtc--import qualified Data.List as L-import qualified Data.Set as S---literalAdapter :: LiteralType -> Flow (AdapterContext m) (SymmetricAdapter (Context m) LiteralType Literal)-literalAdapter lt = do- acx <- getState- chooseAdapter (alts acx) (supported acx) describeLiteralType lt- where- supported acx = literalTypeIsSupported (constraints acx)- constraints acx = languageConstraints $ adapterContextTarget acx-- alts acx t = case t of- LiteralTypeBinary -> pure $ fallbackAdapter t- LiteralTypeBoolean -> pure $ if noIntegerVars- then fallbackAdapter t- else do- adapter <- integerAdapter IntegerTypeUint8- let step' = adapterCoder adapter- let step = Coder encode decode- where- encode (LiteralBoolean bv) = LiteralInteger <$> coderEncode step' (toInt bv)- where- toInt bv = IntegerValueUint8 $ if bv then 1 else 0- decode (LiteralInteger iv) = LiteralBoolean <$> do- (IntegerValueUint8 v) <- coderDecode step' iv- return $ v == 1- return $ Adapter False t (LiteralTypeInteger $ adapterTarget adapter) step- LiteralTypeFloat ft -> pure $ if noFloatVars- then fallbackAdapter t- else do- adapter <- floatAdapter ft- let step = bidirectional- $ \dir l -> case l of- LiteralFloat fv -> LiteralFloat <$> encodeDecode dir (adapterCoder adapter) fv- _ -> unexpected "floating-point literal" (show l)- return $ Adapter (adapterIsLossy adapter) t (LiteralTypeFloat $ adapterTarget adapter) step- LiteralTypeInteger it -> pure $ if noIntegerVars- then fallbackAdapter t- else do- adapter <- integerAdapter it- let step = bidirectional- $ \dir (LiteralInteger iv) -> LiteralInteger- <$> encodeDecode dir (adapterCoder adapter) iv- return $ Adapter (adapterIsLossy adapter) t (LiteralTypeInteger $ adapterTarget adapter) step- LiteralTypeString -> pure $ fail "no substitute for the literal string type"- where- noFloatVars = not (S.member LiteralVariantFloat $ languageConstraintsLiteralVariants $ constraints acx)- || S.null (languageConstraintsFloatTypes $ constraints acx)- noIntegerVars = not (S.member LiteralVariantInteger $ languageConstraintsLiteralVariants $ constraints acx)- || S.null (languageConstraintsIntegerTypes $ constraints acx)- noStrings = not $ supported acx LiteralTypeString-- fallbackAdapter t = if noStrings- then fail "cannot serialize unsupported type; strings are unsupported"- else withWarning msg $ Adapter False t LiteralTypeString step- where- msg = disclaimer False (describeLiteralType t) (describeLiteralType LiteralTypeString)- step = Coder encode decode- where- -- TODO: this format is tied to Haskell- encode av = pure $ LiteralString $ case av of- LiteralBinary s -> s- LiteralBoolean b -> if b then "true" else "false"- _ -> show av- decode (LiteralString s) = pure $ case t of- LiteralTypeBinary -> LiteralBinary s- LiteralTypeBoolean -> LiteralBoolean $ s == "true"- _ -> read s--comparePrecision :: Precision -> Precision -> Ordering-comparePrecision p1 p2 = if p1 == p2 then EQ else case (p1, p2) of- (PrecisionArbitrary, _) -> GT- (_, PrecisionArbitrary) -> LT- (PrecisionBits b1, PrecisionBits b2) -> compare b1 b2--disclaimer :: Bool -> String -> String -> String-disclaimer lossy source target = "replace " ++ source ++ " with " ++ target- ++ if lossy then " (lossy)" else ""--floatAdapter :: FloatType -> Flow (AdapterContext m) (SymmetricAdapter (Context m) FloatType FloatValue)-floatAdapter ft = do- acx <- getState- let supported = floatTypeIsSupported $ languageConstraints $ adapterContextTarget acx- chooseAdapter alts supported describeFloatType ft- where- alts t = makeAdapter t <$> case t of- FloatTypeBigfloat -> [FloatTypeFloat64, FloatTypeFloat32]- FloatTypeFloat32 -> [FloatTypeFloat64, FloatTypeBigfloat]- FloatTypeFloat64 -> [FloatTypeBigfloat, FloatTypeFloat32]- where- makeAdapter source target = withWarning msg $ Adapter lossy source target step- where- lossy = comparePrecision (floatTypePrecision source) (floatTypePrecision target) == GT- step = Coder (pure . convertFloatValue target) (pure . convertFloatValue source)- msg = disclaimer lossy (describeFloatType source) (describeFloatType target)--integerAdapter :: IntegerType -> Flow (AdapterContext m) (SymmetricAdapter (Context m) IntegerType IntegerValue)-integerAdapter it = do- acx <- getState- let supported = integerTypeIsSupported $ languageConstraints $ adapterContextTarget acx- chooseAdapter alts supported describeIntegerType it- where- alts t = makeAdapter t <$> case t of- IntegerTypeBigint -> L.reverse unsignedPref- IntegerTypeInt8 -> signed 1- IntegerTypeInt16 -> signed 2- IntegerTypeInt32 -> signed 3- IntegerTypeInt64 -> signed 4- IntegerTypeUint8 -> unsigned 1- IntegerTypeUint16 -> unsigned 2- IntegerTypeUint32 -> unsigned 3- IntegerTypeUint64 -> unsigned 4- where- signed i = L.drop (i*2) signedPref ++ [IntegerTypeBigint] ++ L.drop (8-(i*2)+1) signedNonPref- unsigned i = L.drop (i*2) unsignedPref ++ [IntegerTypeBigint] ++ L.drop (8-(i*2)+1) unsignedNonPref- signedPref = interleave signedOrdered unsignedOrdered- unsignedPref = interleave unsignedOrdered signedOrdered- signedNonPref = L.reverse unsignedPref- unsignedNonPref = L.reverse signedPref-- interleave xs ys = L.concat (L.transpose [xs, ys])-- signedOrdered = L.filter- (\v -> integerTypeIsSigned v && integerTypePrecision v /= PrecisionArbitrary) integerTypes- unsignedOrdered = L.filter- (\v -> not (integerTypeIsSigned v) && integerTypePrecision v /= PrecisionArbitrary) integerTypes-- makeAdapter source target = withWarning msg $ Adapter lossy source target step- where- lossy = comparePrecision (integerTypePrecision source) (integerTypePrecision target) /= LT- step = Coder (pure . convertIntegerValue target) (pure . convertIntegerValue source)- msg = disclaimer lossy (describeIntegerType source) (describeIntegerType target)
− src/main/haskell/Hydra/Adapters/Term.hs
@@ -1,366 +0,0 @@--- | Adapter framework for types and terms--module Hydra.Adapters.Term (- fieldAdapter,- functionProxyName,- functionProxyType,- termAdapter,-) where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Reduction-import Hydra.Adapters.Literal-import Hydra.Adapters.UtilsEtc-import Hydra.Impl.Haskell.Dsl.Terms-import qualified Hydra.Impl.Haskell.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 Text.Read as TR-import qualified Data.Maybe as Y---type TypeAdapter m = Type m -> Flow (AdapterContext m) (SymmetricAdapter (Context m) (Type m) (Term m))--_context :: FieldName-_context = FieldName "context"--_record :: FieldName-_record = FieldName "record"--dereferenceNominal :: (Ord m, Read m, Show m) => TypeAdapter m-dereferenceNominal t@(TypeNominal name) = do- typ <- withEvaluationContext $ do- -- Note: we just assume the schema term is a reference to hydra/core.Type- withTrace ("dereference nominal type " ++ unName name) $ do- el <- withSchemaContext $ requireElement name- decodeType $ elementData el- ad <- termAdapter typ- return ad { adapterSource = t }--dropAnnotation :: (Ord m, Read m, Show m) => TypeAdapter m-dropAnnotation t@(TypeAnnotated (Annotated t' _)) = do- ad <- termAdapter t'- return $ Adapter False t (adapterTarget ad) $ Coder pure pure--elementToString :: TypeAdapter m-elementToString t@(TypeElement _) = pure $ Adapter False t Types.string $ Coder encode decode- where- encode (TermElement (Name name)) = pure $ string name- decode (TermLiteral (LiteralString name)) = pure $ TermElement $ Name name--fieldAdapter :: (Ord m, Read m, Show m) => FieldType m -> Flow (AdapterContext m) (SymmetricAdapter (Context m) (FieldType m) (Field m))-fieldAdapter ftyp = do- ad <- termAdapter $ fieldTypeType ftyp- return $ Adapter (adapterIsLossy ad) ftyp (ftyp { fieldTypeType = adapterTarget ad })- $ bidirectional $ \dir (Field name term) -> Field name <$> encodeDecode dir (adapterCoder ad) term--functionProxyName :: Name-functionProxyName = Name "hydra/core.FunctionProxy"--functionProxyType :: Type m -> Type m-functionProxyType dom = TypeUnion $ RowType functionProxyName Nothing [- FieldType _Elimination_element Types.unit,- FieldType _Elimination_nominal Types.string,- FieldType _Elimination_optional Types.string,- FieldType _Elimination_record Types.string,- FieldType _Elimination_union Types.string, -- TODO (TypeRecord cases)- FieldType _Function_compareTo dom,- FieldType _Function_lambda Types.string, -- TODO (TypeRecord [FieldType _Lambda_parameter Types.string, FieldType _Lambda_body cod]),- FieldType _Function_primitive Types.string,- FieldType _Term_variable Types.string]--functionToUnion :: (Ord m, Read m, Show m) => TypeAdapter m-functionToUnion t@(TypeFunction (FunctionType dom _)) = do- ut <- unionType- ad <- termAdapter ut- return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder (encode ad) (decode ad)- where- encode ad term = coderEncode (adapterCoder ad) $ case stripTerm term of- TermFunction f -> case f of- FunctionCompareTo other -> variant functionProxyName _Function_compareTo other- FunctionElimination e -> case e of- EliminationElement -> unitVariant functionProxyName _Elimination_element- EliminationNominal (Name name) -> variant functionProxyName _Elimination_nominal $ string name- EliminationOptional _ -> variant functionProxyName _Elimination_optional $ string $ show term -- TODO- EliminationRecord _ -> variant functionProxyName _Elimination_record $ string $ show term -- TODO- EliminationUnion _ -> variant functionProxyName _Elimination_union $ string $ show term -- TODO- FunctionLambda _ -> variant functionProxyName _Function_lambda $ string $ show term -- TODO- FunctionPrimitive (Name name) -> variant functionProxyName _Function_primitive $ string name- TermVariable (Variable var) -> variant functionProxyName _Term_variable $ string var- decode ad term = do- (Field fname fterm) <- coderDecode (adapterCoder ad) term >>= expectUnion- Y.fromMaybe (notFound fname) $ M.lookup fname $ M.fromList [- (_Elimination_element, forTerm fterm),- (_Elimination_nominal, forNominal fterm),- (_Elimination_optional, forOptionalCases fterm),- (_Elimination_record, forProjection fterm),- (_Elimination_union, forCases fterm),- (_Function_compareTo, forCompareTo fterm),- (_Function_lambda, forLambda fterm),- (_Function_primitive, forPrimitive fterm),- (_Term_variable, forVariable fterm)]- where- notFound fname = fail $ "unexpected field: " ++ unFieldName fname- forCases fterm = read <$> expectString fterm -- TODO- forCompareTo fterm = pure $ compareTo fterm- forTerm _ = pure delta- forLambda fterm = read <$> expectString fterm -- TODO- forNominal fterm = eliminateNominal . Name <$> expectString fterm- forOptionalCases fterm = read <$> expectString fterm -- TODO- forPrimitive fterm = primitive . Name <$> expectString fterm- forProjection fterm = read <$> expectString fterm -- TODO- forVariable fterm = variable <$> expectString fterm-- unionType = do- domAd <- termAdapter dom- return $ TypeUnion $ RowType functionProxyName Nothing [- FieldType _Elimination_element Types.unit,- FieldType _Elimination_nominal Types.string,- FieldType _Elimination_optional Types.string,- FieldType _Elimination_record Types.string,- FieldType _Elimination_union Types.string, -- TODO (TypeRecord cases)- FieldType _Function_compareTo (adapterTarget domAd),- FieldType _Function_lambda Types.string, -- TODO (TypeRecord [FieldType _Lambda_parameter Types.string, FieldType _Lambda_body cod]),- FieldType _Function_primitive Types.string,- FieldType _Term_variable Types.string]--lambdaToMonotype :: (Ord m, Read m, Show m) => TypeAdapter m-lambdaToMonotype t@(TypeLambda (LambdaType _ body)) = do- ad <- termAdapter body- return ad {adapterSource = t}--listToSet :: (Ord m, Read m, Show m) => TypeAdapter m-listToSet t@(TypeSet st) = do- ad <- termAdapter $ Types.list st- return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder (encode ad) (decode ad)- where- encode ad (TermSet s) = coderEncode (adapterCoder ad) $ TermList $ S.toList s- decode ad term = TermSet . S.fromList . (\(TermList l') -> l') <$> coderDecode (adapterCoder ad) term--optionalToList :: (Ord m, Read m, Show m) => TypeAdapter m-optionalToList t@(TypeOptional ot) = do- ad <- termAdapter ot- return $ Adapter False t (Types.list $ adapterTarget ad) $ Coder {- coderEncode = \(TermOptional m) -> Y.maybe- (pure $ list [])- (fmap (\ r -> list [r]) . coderEncode (adapterCoder ad)) m,- coderDecode = \(TermList l) -> optional <$> if L.null l then- pure Nothing- else Just <$> coderDecode (adapterCoder ad) (L.head l)}--passAnnotated :: (Ord m, Read m, Show m) => Type m -> Flow (AdapterContext m) (SymmetricAdapter (Context m) (Type m) v)-passAnnotated t@(TypeAnnotated (Annotated at ann)) = do- ad <- termAdapter at- return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ bidirectional $ \dir term -> pure term---- TODO: only tested for type mappings; not yet for types+terms-passApplication :: (Ord m, Read m, Show m) => TypeAdapter m-passApplication t = do- reduced <- withEvaluationContext $ betaReduceType t- ad <- termAdapter reduced- return $ Adapter (adapterIsLossy ad) t reduced $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term--passFunction :: (Ord m, Read m, Show m) => TypeAdapter m-passFunction t@(TypeFunction (FunctionType dom cod)) = do- domAd <- termAdapter dom- codAd <- termAdapter cod- caseAds <- case stripType dom of- TypeUnion rt -> M.fromList . L.zip (fieldTypeName <$> rowTypeFields rt)- <$> CM.mapM fieldAdapter (rowTypeFields rt)- _ -> pure M.empty- optionAd <- case stripType dom of- TypeOptional ot -> Just <$> termAdapter (Types.function ot cod)- _ -> pure Nothing- let lossy = adapterIsLossy codAd || or (adapterIsLossy . snd <$> M.toList caseAds)- let dom' = adapterTarget domAd- let cod' = adapterTarget codAd- return $ Adapter lossy t (Types.function dom' cod')- $ bidirectional $ \dir term -> case stripTerm term of- TermFunction f -> TermFunction <$> case f of- FunctionCompareTo other -> FunctionCompareTo <$> encodeDecode dir (adapterCoder codAd) other- FunctionElimination e -> FunctionElimination <$> case e of- EliminationOptional (OptionalCases nothing just) -> EliminationOptional <$> (- OptionalCases- <$> encodeDecode dir (adapterCoder codAd) nothing- <*> (encodeDecode dir (adapterCoder $ Y.fromJust optionAd) just))- EliminationUnion (CaseStatement n cases) -> EliminationUnion . CaseStatement n <$>- CM.mapM (\f -> encodeDecode dir (getCoder $ fieldName f) f) cases- where- -- Note: this causes unrecognized cases to simply be passed through;- -- it is not the job of this adapter to catch validation issues.- getCoder fname = Y.maybe idCoder adapterCoder $ M.lookup fname caseAds- FunctionLambda (Lambda var body) -> FunctionLambda <$> (Lambda var <$> encodeDecode dir (adapterCoder codAd) body)- _ -> unexpected "function term" $ show term--passLambda :: (Ord m, Read m, Show m) => TypeAdapter m-passLambda t@(TypeLambda (LambdaType (VariableType v) body)) = do- ad <- termAdapter body- return $ Adapter (adapterIsLossy ad) t (Types.lambda v $ adapterTarget ad)- $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term--passLiteral :: TypeAdapter m-passLiteral (TypeLiteral at) = do- ad <- literalAdapter at- let step = bidirectional $ \dir (TermLiteral av) -> literal <$> encodeDecode dir (adapterCoder ad) av- return $ Adapter (adapterIsLossy ad) (Types.literal $ adapterSource ad) (Types.literal $ adapterTarget ad) step--passList :: (Ord m, Read m, Show m) => TypeAdapter m-passList t@(TypeList lt) = do- ad <- termAdapter lt- return $ Adapter (adapterIsLossy ad) t (Types.list $ adapterTarget ad)- $ bidirectional $ \dir (TermList terms) -> list <$> CM.mapM (encodeDecode dir $ adapterCoder ad) terms--passMap :: (Ord m, Read m, Show m) => TypeAdapter m-passMap t@(TypeMap (MapType kt vt)) = do- kad <- termAdapter kt- vad <- termAdapter vt- return $ Adapter (adapterIsLossy kad || adapterIsLossy vad)- t (Types.map (adapterTarget kad) (adapterTarget vad))- $ bidirectional $ \dir (TermMap m) -> TermMap . M.fromList- <$> CM.mapM (\(k, v) -> (,) <$> encodeDecode dir (adapterCoder kad) k <*> encodeDecode dir (adapterCoder vad) v)- (M.toList m)--passOptional :: (Ord m, Read m, Show m) => TypeAdapter m-passOptional t@(TypeOptional ot) = do- ad <- termAdapter ot- return $ Adapter (adapterIsLossy ad) t (Types.optional $ adapterTarget ad) $- bidirectional $ \dir term -> case term of- (TermOptional m) -> TermOptional <$> case m of- Nothing -> pure Nothing- Just term' -> Just <$> encodeDecode dir (adapterCoder ad) term'- _ -> fail $ "expected optional term, found: " ++ show term--passProduct :: (Ord m, Read m, Show m) => TypeAdapter m-passProduct t@(TypeProduct types) = do- ads <- CM.mapM termAdapter types- let lossy = L.foldl (\b ad -> b || adapterIsLossy ad) False ads- return $ Adapter lossy t (Types.product (adapterTarget <$> ads))- $ bidirectional $ \dir (TermProduct tuple) -> TermProduct <$> (CM.zipWithM (\term ad -> encodeDecode dir (adapterCoder ad) term) tuple ads)--passRecord :: (Ord m, Read m, Show m) => TypeAdapter m-passRecord t@(TypeRecord rt) = do- adapters <- CM.mapM fieldAdapter (rowTypeFields rt)- let lossy = or $ adapterIsLossy <$> adapters- let sfields' = adapterTarget <$> adapters- return $ Adapter lossy t (TypeRecord $ rt {rowTypeFields = sfields'}) $ bidirectional- $ \dir (TermRecord (Record _ dfields)) -> record (rowTypeTypeName rt) <$> CM.zipWithM (encodeDecode dir . adapterCoder) adapters dfields--passSet :: (Ord m, Read m, Show m) => TypeAdapter m-passSet t@(TypeSet st) = do- ad <- termAdapter st- return $ Adapter (adapterIsLossy ad) t (Types.set $ adapterTarget ad)- $ bidirectional $ \dir (TermSet terms) -> set . S.fromList- <$> CM.mapM (encodeDecode dir (adapterCoder ad)) (S.toList terms)--passSum :: (Ord m, Read m, Show m) => TypeAdapter m-passSum t@(TypeSum types) = do- ads <- CM.mapM termAdapter types- let lossy = L.foldl (\b ad -> b || adapterIsLossy ad) False ads- return $ Adapter lossy t (Types.sum (adapterTarget <$> ads))- $ bidirectional $ \dir (TermSum (Sum i n term)) -> TermSum . Sum i n <$> encodeDecode dir (adapterCoder $ ads !! i) term--passUnion :: (Ord m, Read m, Show m) => TypeAdapter m-passUnion t@(TypeUnion rt) = do- adapters <- M.fromList <$> CM.mapM (\f -> pure ((,) (fieldTypeName f)) <*> fieldAdapter f) sfields- let lossy = or $ adapterIsLossy <$> adapters- let sfields' = adapterTarget . snd <$> M.toList adapters- return $ Adapter lossy t (TypeUnion $ rt {rowTypeFields = sfields'})- $ bidirectional $ \dir term -> do- dfield <- expectUnion term- ad <- getAdapter adapters dfield- TermUnion . Union nm <$> encodeDecode dir (adapterCoder ad) dfield- where- getAdapter adapters f = Y.maybe (fail $ "no such field: " ++ unFieldName (fieldName f)) pure $ M.lookup (fieldName f) adapters- sfields = rowTypeFields rt- nm = rowTypeTypeName rt--simplifyApplication :: (Ord m, Read m, Show m) => TypeAdapter m-simplifyApplication t@(TypeApplication (ApplicationType lhs _)) = do- ad <- termAdapter lhs- return $ Adapter False t (adapterTarget ad) $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term---- Note: those constructors which cannot be mapped meaningfully at this time are simply--- preserved as strings using Haskell's derived show/read format.-termAdapter :: (Ord m, Read m, Show m) => TypeAdapter m-termAdapter typ = do- acx <- getState- chooseAdapter (alts acx) (supported acx) describeType typ- where- alts acx t = (\c -> c t) <$> if variantIsSupported acx t- then case typeVariant t of- TypeVariantAnnotated -> [passAnnotated]- TypeVariantApplication -> [passApplication]- TypeVariantFunction -> [passFunction]- TypeVariantLambda -> [passLambda]- TypeVariantList -> [passList]- TypeVariantLiteral -> [passLiteral]- TypeVariantMap -> [passMap]- TypeVariantOptional -> [passOptional, optionalToList]- TypeVariantProduct -> [passProduct]- TypeVariantRecord -> [passRecord]- TypeVariantSet -> [passSet]- TypeVariantSum -> [passSum]- TypeVariantUnion -> [passUnion]- _ -> []- else case typeVariant t of- TypeVariantAnnotated -> [dropAnnotation]- TypeVariantApplication -> [simplifyApplication]- TypeVariantElement -> [elementToString]- TypeVariantFunction -> [functionToUnion]- TypeVariantLambda -> [lambdaToMonotype]- TypeVariantNominal -> [dereferenceNominal]- TypeVariantOptional -> [optionalToList]- TypeVariantSet -> [listToSet]- TypeVariantUnion -> [unionToRecord]- _ -> [unsupportedToString]-- constraints acx = languageConstraints $ adapterContextTarget acx- supported acx = typeIsSupported (constraints acx)- variantIsSupported acx t = S.member (typeVariant t) $ languageConstraintsTypeVariants (constraints acx)------ Caution: possibility of an infinite loop if neither unions, optionals, nor lists are supported-unionToRecord :: (Ord m, Read m, Show m) => TypeAdapter m-unionToRecord t@(TypeUnion rt) = do- let target = TypeRecord $ rt {rowTypeFields = makeOptional <$> sfields}- ad <- termAdapter target- return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder {- coderEncode = \(TermUnion (Union _ (Field fn term))) -> coderEncode (adapterCoder ad)- $ record nm (toRecordField term fn <$> sfields),- coderDecode = \term -> do- TermRecord (Record _ fields) <- coderDecode (adapterCoder ad) term- union nm <$> fromRecordFields term (TermRecord (Record nm fields)) (adapterTarget ad) fields}- where- nm = rowTypeTypeName rt- sfields = rowTypeFields rt-- makeOptional (FieldType fn ft) = FieldType fn $ Types.optional ft-- toRecordField term fn (FieldType fn' _) = Field fn' $- TermOptional $ if fn' == fn then Just term else Nothing-- fromRecordFields term term' t' fields = if L.null matches- then fail $ "cannot convert term back to union: " ++ show term ++ " -- becomes " ++ show term'- ++ " where type = " ++ show t ++ " and target type = " ++ show t'- else pure $ L.head matches- where- matches = Y.mapMaybe (\(Field fn (TermOptional opt)) -> (Just . Field fn) =<< opt) fields--unsupportedToString :: (Ord m, Read m, Show m) => TypeAdapter m-unsupportedToString t = pure $ Adapter False t Types.string $ Coder encode decode- where- -- TODO: use JSON for encoding and decoding unsupported terms, rather than Haskell's read/show- encode = pure . string . show- decode term = do- s <- expectString term- case TR.readEither s of- Left msg -> fail $ "could not decode unsupported term: " ++ s- Right t -> pure t--withEvaluationContext :: GraphFlow m a -> Flow (AdapterContext m) a-withEvaluationContext f = do- acx <- getState- withState (adapterContextEvaluation acx) f
− src/main/haskell/Hydra/Adapters/UtilsEtc.hs
@@ -1,127 +0,0 @@--- | Additional adapter utilities, above and beyond the generated ones--module Hydra.Adapters.UtilsEtc (- module Hydra.Adapters.UtilsEtc,- module Hydra.Adapters.Utils,- module Hydra.Common,-) where--import Hydra.Common-import Hydra.Core-import Hydra.Basics-import Hydra.Module-import Hydra.Monads-import Hydra.Compute-import Hydra.Adapters.Utils-import qualified Hydra.Lib.Strings as Strings-import Hydra.Util.Formatting-import Hydra.Rewriting-import Hydra.Meta-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms--import qualified Data.List as L-import qualified Data.Set as S-import Control.Monad---type SymmetricAdapter s t v = Adapter s s t t v v--bidirectional :: (CoderDirection -> b -> Flow s b) -> Coder s s b b-bidirectional f = Coder (f CoderDirectionEncode) (f CoderDirectionDecode)--chooseAdapter :: (Eq t, Ord t, Show t) =>- (t -> [Flow so (SymmetricAdapter si t v)])- -> (t -> Bool)- -> (t -> String)- -> t- -> Flow so (SymmetricAdapter si t v)-chooseAdapter alts supported describe typ = if supported typ- then pure $ Adapter False typ typ idCoder- else do- -- Uncomment to debug adapter cycles- --debugCheckType typ-- raw <- sequence (alts typ)- let candidates = L.filter (supported . adapterTarget) raw- if L.null candidates- then fail $ "no adapters found for " ++ describe typ- ++ (if L.null raw- then ""- else " (discarded " ++ show (L.length raw) ++ " unsupported candidate types: " ++ show (adapterTarget <$> raw) ++ ")")- ++ ". Original type: " ++ show typ- else do- -- Uncomment to debug adapter cycles- --debugRemoveType typ-- return $ L.head candidates--composeCoders :: Coder s s a b -> Coder s s b c -> Coder s s a c-composeCoders c1 c2 = Coder {- coderEncode = coderEncode c1 >=> coderEncode c2,- coderDecode = coderDecode c2 >=> coderDecode c1}--debugCheckType :: (Eq t, Ord t, Show t) => t -> Flow s ()-debugCheckType typ = do- let s = show typ- types <- getAttrWithDefault "types" (Terms.set S.empty) >>= Terms.expectSet Terms.expectString- 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))- 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) >>= Terms.expectSet Terms.expectString- let types' = S.delete s types- putAttr "types" $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types'))--encodeDecode :: CoderDirection -> Coder s s a a -> a -> Flow s a-encodeDecode dir = case dir of- CoderDirectionEncode -> coderEncode- CoderDirectionDecode -> coderDecode--floatTypeIsSupported :: LanguageConstraints m -> FloatType -> Bool-floatTypeIsSupported constraints ft = S.member ft $ languageConstraintsFloatTypes constraints--idAdapter :: t -> SymmetricAdapter s t v-idAdapter t = Adapter False t t idCoder--idCoder :: Coder s s a a-idCoder = Coder pure pure--integerTypeIsSupported :: LanguageConstraints m -> IntegerType -> Bool-integerTypeIsSupported constraints it = S.member it $ languageConstraintsIntegerTypes constraints--literalTypeIsSupported :: LanguageConstraints m -> LiteralType -> Bool-literalTypeIsSupported constraints at = S.member (literalTypeVariant at) (languageConstraintsLiteralVariants constraints)- && case at of- LiteralTypeFloat ft -> floatTypeIsSupported constraints ft- LiteralTypeInteger it -> integerTypeIsSupported constraints it- _ -> True--nameToFilePath :: Bool -> FileExtension -> Name -> FilePath-nameToFilePath caps ext name = namespaceToFilePath caps ext $ Namespace $ gname ++ "/" ++ local- where- (Namespace gname, local) = toQnameEager name--typeIsSupported :: LanguageConstraints m -> Type m -> Bool-typeIsSupported constraints t = languageConstraintsTypes constraints t -- these are *additional* type constraints- && S.member (typeVariant t) (languageConstraintsTypeVariants constraints)- && case t of- TypeAnnotated (Annotated at _) -> typeIsSupported constraints at- TypeLiteral at -> literalTypeIsSupported constraints at- TypeFunction (FunctionType dom cod) -> typeIsSupported constraints dom && typeIsSupported constraints cod- TypeList lt -> typeIsSupported constraints lt- TypeMap (MapType kt vt) -> typeIsSupported constraints kt && typeIsSupported constraints vt- TypeNominal _ -> True -- TODO: dereference the type- TypeOptional t -> typeIsSupported constraints t- TypeRecord rt -> and $ typeIsSupported constraints . fieldTypeType <$> rowTypeFields rt- TypeSet st -> typeIsSupported constraints st- TypeUnion rt -> and $ typeIsSupported constraints . fieldTypeType <$> rowTypeFields rt- _ -> True--unidirectionalCoder :: (a -> Flow s b) -> Coder s s a b-unidirectionalCoder m = Coder {- coderEncode = m,- coderDecode = \_ -> fail "inbound mapping is unsupported"}
+ src/main/haskell/Hydra/Annotations.hs view
@@ -0,0 +1,216 @@+-- | Functions for working with term and type annotations++module Hydra.Annotations where++import Hydra.Basics+import Hydra.Strip+import Hydra.Core+import Hydra.Compute+import Hydra.Extras+import Hydra.Graph+import Hydra.CoreDecoding+import Hydra.CoreEncoding+import Hydra.Mantle+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 Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+++key_classes = "classes" :: String+key_description = "description"+key_type = "type"+++aggregateAnnotations :: (x -> Maybe y) -> (y -> x) -> (y -> M.Map String Term) -> x -> M.Map String 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 flag msg = do+ val <- hasFlag flag+ if val+ then fail msg+ else pure ()++getAttr :: String -> 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 key def = Y.fromMaybe def <$> getAttr key++getDescription :: M.Map String 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 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 anns = case getAnnotation key_type anns of+ Nothing -> pure Nothing+ Just dat -> Just <$> coreDecodeType dat++getTypeAnnotation :: String -> Type -> Y.Maybe Term+getTypeAnnotation key = getAnnotation key . typeAnnotationInternal++getTypeClasses :: Type -> Flow Graph (M.Map Name (S.Set TypeClass))+getTypeClasses typ = case getTypeAnnotation key_classes typ of+ Nothing -> pure M.empty+ Just term -> Expect.map coreDecodeName (Expect.set decodeClass) term+ where+ decodeClass term = Expect.unitVariant _TypeClass term >>= \fn -> Y.maybe+ (unexpected "type class" $ show term) pure $ M.lookup fn byName+ byName = M.fromList [(_TypeClass_equality, TypeClassEquality), (_TypeClass_ordering, TypeClassOrdering)]++getTypeDescription :: Type -> Flow Graph (Y.Maybe String)+getTypeDescription = getDescription . typeAnnotationInternal++hasFlag :: String -> 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 attrName = do+ count <- getAttrWithDefault attrName (Terms.int32 0) >>= Expect.int32+ putAttr attrName (Terms.int32 $ count + 1)+ return count++resetCount :: String -> Flow s ()+resetCount attrName = do+ putAttr attrName (Terms.int32 0)+ return ()++normalizeTermAnnotations :: Term -> Term+normalizeTermAnnotations term = if M.null anns+ then stripped+ else TermAnnotated $ AnnotatedTerm stripped anns+ where+ anns = termAnnotationInternal term+ stripped = stripTerm term++normalizeTypeAnnotations :: Type -> Type+normalizeTypeAnnotations typ = if M.null anns+ then stripped+ else TypeAnnotated $ AnnotatedType stripped anns+ where+ anns = typeAnnotationInternal typ+ stripped = stripType typ++putAttr :: String -> 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 key val m = M.alter (const val) key m++setDescription :: Y.Maybe String -> M.Map String Term -> M.Map String Term+setDescription d = setAnnotation key_description (Terms.string <$> d)++setTermAnnotation :: String -> Y.Maybe Term -> Term -> Term+setTermAnnotation key val term = if anns == M.empty+ then term'+ else TermAnnotated $ AnnotatedTerm term' anns+ where+ term' = stripTerm term+ anns = setAnnotation key val $ termAnnotationInternal term++setTermDescription :: Y.Maybe String -> Term -> Term+setTermDescription d = setTermAnnotation key_description (Terms.string <$> d)++-- TODO: temporary. Move this function out of Annotations+setTermType :: Y.Maybe Type -> Term -> Term+setTermType mtyp term = case mtyp of+ Nothing -> withoutType term+ Just typ -> TermTyped $ TypedTerm (withoutType term) typ+ where+ withoutType term = case term of+ TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated $ AnnotatedTerm (withoutType term1) ann+ TermTyped (TypedTerm term1 _) -> term1+ _ -> term++setType mt = setAnnotation key_type (coreEncodeType <$> mt)++setTypeAnnotation :: String -> Y.Maybe Term -> Type -> Type+setTypeAnnotation key val typ = if anns == M.empty+ then typ'+ else TypeAnnotated $ AnnotatedType typ' anns+ where+ typ' = stripType typ+ anns = setAnnotation key val $ typeAnnotationInternal typ++setTypeClasses :: M.Map Name (S.Set TypeClass) -> Type -> Type+setTypeClasses m = setTypeAnnotation key_classes encoded+ where+ encoded = if M.null m+ then Nothing+ else Just $ Terms.map $ M.fromList (encodePair <$> M.toList m)+ encodePair (name, classes) = (coreEncodeName name, Terms.set $ S.fromList (encodeClass <$> (S.toList classes)))+ encodeClass tc = Terms.unitVariant _TypeClass $ case tc of+ TypeClassEquality -> _TypeClass_equality+ TypeClassOrdering -> _TypeClass_ordering++setTypeDescription :: Y.Maybe String -> Type -> Type+setTypeDescription d = setTypeAnnotation key_description (Terms.string <$> d)++termAnnotationInternal :: Term -> M.Map String Term+termAnnotationInternal = aggregateAnnotations getAnn annotatedTermSubject annotatedTermAnnotation+ where+ getAnn t = case t of+ TermAnnotated a -> Just a+ TermTyped (TypedTerm t1 _) -> getAnn t1+ _ -> Nothing++typeAnnotationInternal :: Type -> M.Map String 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 flag fthen felse = do+ b <- hasFlag flag+ if b+ then fthen+ else felse++-- 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+ 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+ 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'+ else do+ putState (S.insert v reserved, subst)+ body' <- recurse body+ return $ TermFunction $ FunctionLambda $ Lambda v body'+ _ -> recurse term+ freshName = (\n -> Name $ "s" ++ show n) <$> nextCount "unshadow"
+ src/main/haskell/Hydra/Codegen.hs view
@@ -0,0 +1,107 @@+-- | Entry point for Hydra code generation utilities++module Hydra.Codegen (+ modulesToGraph,+ writeGraphql,+ writeHaskell,+ writeJava,+ writePdl,+ writeProtobuf,+ writeScala,+ writeYaml,+ module Hydra.Sources.Tier4.All+) where++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.Sources.Libraries+import Hydra.Sources.Tier4.All++import qualified Control.Monad as CM+import qualified System.FilePath as FP+import qualified Data.List as L+import qualified Data.Map as M+import qualified System.Directory as SD+import qualified Data.Maybe as Y+++generateSources :: (Module -> Flow (Graph) (M.Map FilePath String)) -> FilePath -> [Module] -> IO ()+generateSources printModule basePath mods = do+ mfiles <- runFlow bootstrapGraph generateFiles+ case mfiles of+ Nothing -> fail "Transformation failed"+ Just files -> mapM_ writePair files+ where+ generateFiles = do+ withTrace "generate files" $ do+ withState (modulesToGraph mods) $ do+ g' <- inferGraphTypes+ withState g' $ do+ maps <- CM.mapM forModule $ refreshModule (graphElements g') <$> mods+ return $ L.concat (M.toList <$> maps)+ where+ refreshModule els mod = mod {+ moduleElements = Y.catMaybes ((\e -> M.lookup (elementName e) els) <$> moduleElements mod)}++ writePair (path, s) = do+ let fullPath = FP.combine basePath path+ SD.createDirectoryIfMissing True $ FP.takeDirectory fullPath+ writeFile fullPath s++ forModule mod = withTrace ("module " ++ unNamespace (moduleNamespace mod)) $ printModule mod++modulesToGraph :: [Module] -> Graph+modulesToGraph mods = elementsToGraph parent (Just schemaGraph) dataElements+ where+ parent = bootstrapGraph+ dataElements = L.concat (moduleElements <$> (L.concat (close <$> mods)))+ schemaElements = L.concat (moduleElements <$> (L.concat (close <$> (L.nub $ L.concat (moduleTypeDependencies <$> mods)))))+ schemaGraph = elementsToGraph bootstrapGraph Nothing schemaElements+ close mod = mod:(L.concat (close <$> moduleTermDependencies mod))++printTrace :: Bool -> Trace -> IO ()+printTrace isError t = do+ CM.unless (L.null $ traceMessages t) $ do+ putStrLn $ if isError then "Flow failed. Messages:" else "Messages:"+ putStrLn $ indentLines $ traceSummary t++runFlow :: s -> Flow s a -> IO (Maybe a)+runFlow cx f = do+ printTrace (Y.isNothing v) t+ return v+ where+ FlowState v _ t = unFlow f cx emptyTrace++writeGraphql :: FP.FilePath -> [Module] -> IO ()+writeGraphql = generateSources moduleToGraphql++writeHaskell :: FilePath -> [Module] -> IO ()+writeHaskell = generateSources moduleToHaskell++writeJava :: FP.FilePath -> [Module] -> IO ()+writeJava = generateSources moduleToJava++-- writeJson :: FP.FilePath -> [Module] -> IO ()+-- writeJson = generateSources Json.printModule++writePdl :: FP.FilePath -> [Module] -> IO ()+writePdl = generateSources moduleToPdl++writeProtobuf :: FP.FilePath -> [Module] -> IO ()+writeProtobuf = generateSources moduleToProtobuf++writeScala :: FP.FilePath -> [Module] -> IO ()+writeScala = generateSources moduleToScala++writeYaml :: FP.FilePath -> [Module] -> IO ()+writeYaml = generateSources moduleToYaml
− src/main/haskell/Hydra/Common.hs
@@ -1,130 +0,0 @@--- | Common functions for working with terms, types, and names--module Hydra.Common where--import Hydra.Core-import Hydra.Compute-import Hydra.Mantle-import Hydra.Module-import qualified Hydra.Lib.Strings as Strings-import Hydra.Util.Formatting--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S---debug :: Bool-debug = True--convertFloatValue :: FloatType -> FloatValue -> FloatValue-convertFloatValue target = encoder . decoder- where- decoder fv = case fv of- FloatValueBigfloat d -> d- FloatValueFloat32 f -> realToFrac f- FloatValueFloat64 d -> d- encoder d = case target of- FloatTypeBigfloat -> FloatValueBigfloat d- FloatTypeFloat32 -> FloatValueFloat32 $ realToFrac d- FloatTypeFloat64 -> FloatValueFloat64 d--convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue-convertIntegerValue target = encoder . decoder- where- decoder iv = case iv of- IntegerValueBigint v -> v- IntegerValueInt8 v -> fromIntegral v- IntegerValueInt16 v -> fromIntegral v- IntegerValueInt32 v -> fromIntegral v- IntegerValueInt64 v -> fromIntegral v- IntegerValueUint8 v -> fromIntegral v- IntegerValueUint16 v -> fromIntegral v- IntegerValueUint32 v -> fromIntegral v- IntegerValueUint64 v -> fromIntegral v- encoder d = case target of- IntegerTypeBigint -> IntegerValueBigint d- IntegerTypeInt8 -> IntegerValueInt8 $ fromIntegral d- IntegerTypeInt16 -> IntegerValueInt16 $ fromIntegral d- IntegerTypeInt32 -> IntegerValueInt32 $ fromIntegral d- IntegerTypeInt64 -> IntegerValueInt64 $ fromIntegral d- IntegerTypeUint8 -> IntegerValueUint8 $ fromIntegral d- IntegerTypeUint16 -> IntegerValueUint16 $ fromIntegral d- IntegerTypeUint32 -> IntegerValueUint32 $ fromIntegral d- IntegerTypeUint64 -> IntegerValueUint64 $ fromIntegral d--elementsToGraph :: Maybe (Graph m) -> [Element m] -> Graph m-elementsToGraph msg els = Graph elementMap msg- where- elementMap = M.fromList (toPair <$> els)- where- toPair el = (elementName el, el)--fromQname :: Namespace -> String -> Name-fromQname ns local = Name $ unNamespace ns ++ "." ++ local--namespaceToFilePath :: Bool -> FileExtension -> Namespace -> FilePath-namespaceToFilePath caps (FileExtension ext) (Namespace name) = L.intercalate "/" parts ++ "." ++ ext- where- parts = (if caps then capitalize else id) <$> Strings.splitOn "/" name--isEncodedType :: Eq m => Context m -> Term m -> Bool-isEncodedType cx term = stripTerm term == TermElement _Type--isType :: Eq m => Context m -> Type m -> Bool-isType cx typ = case stripType typ of- TypeNominal _Type -> True- TypeUnion (RowType _Type _ _) -> True- TypeApplication (ApplicationType lhs _) -> isType cx lhs- _ -> False--localNameOfLazy :: Name -> String-localNameOfLazy = snd . toQnameLazy--localNameOfEager :: Name -> String-localNameOfEager = snd . toQnameEager--namespaceOfLazy :: Name -> Namespace-namespaceOfLazy = fst . toQnameLazy--namespaceOfEager :: Name -> Namespace-namespaceOfEager = fst . toQnameEager--placeholderName :: Name-placeholderName = Name "Placeholder"--skipAnnotations :: (a -> Maybe (Annotated a m)) -> a -> a-skipAnnotations getAnn t = skip t- where- skip t = case getAnn t of- Nothing -> t- Just (Annotated t' _) -> skip t'--stripTerm :: Term m -> Term m-stripTerm = skipAnnotations $ \t -> case t of- TermAnnotated a -> Just a- _ -> Nothing--stripType :: Type m -> Type m-stripType = skipAnnotations $ \t -> case t of- TypeAnnotated a -> Just a- _ -> Nothing--termMeta :: Context m -> Term m -> m-termMeta cx = annotationClassTermMeta $ contextAnnotations cx--toQnameLazy :: Name -> (Namespace, String)-toQnameLazy (Name name) = case L.reverse $ Strings.splitOn "." name of- (local:rest) -> (Namespace $ L.intercalate "." $ L.reverse rest, local)- _ -> (Namespace "UNKNOWN", name)--toQnameEager :: Name -> (Namespace, String)-toQnameEager (Name name) = case Strings.splitOn "." name of- (ns:rest) -> (Namespace ns, L.intercalate "." rest)- _ -> (Namespace "UNKNOWN", name)--typeMeta :: Context m -> Type m -> m-typeMeta cx = annotationClassTypeMeta $ contextAnnotations cx--unitTypeName :: Name-unitTypeName = Name "hydra/core.UnitType"
src/main/haskell/Hydra/CoreDecoding.hs view
@@ -1,74 +1,83 @@--- | Decoding of encoded types (as terms) back to types+-- | Decoding of encoded types (as terms) back to types according to LambdaGraph's epsilon encoding module Hydra.CoreDecoding (- decodeLiteralType,- decodeFieldType,- decodeFieldTypes,- decodeFloatType,- decodeFunctionType,- decodeIntegerType,- decodeMapType,- decodeRowType,- decodeString,- decodeType,- decodeLambdaType,+ coreDecodeFieldType,+ coreDecodeFieldTypes,+ coreDecodeFloatType,+ coreDecodeFunctionType,+ coreDecodeIntegerType,+ coreDecodeLambdaType,+ coreDecodeLiteralType,+ coreDecodeMapType,+ coreDecodeName,+ coreDecodeRowType,+ coreDecodeString,+ coreDecodeType,+ dereferenceType, elementAsTypedTerm, fieldTypes,+ fullyStripTerm,+ isSerializable,+ moduleDependencyNamespaces, requireRecordType, requireType, requireUnionType,+ requireWrappedType,+ resolveType, typeDependencies, typeDependencyNames, ) where -import Hydra.Common+import Hydra.Basics+import Hydra.Strip+import Hydra.Coders+import Hydra.Compute import Hydra.Core+import Hydra.Graph import Hydra.Mantle import Hydra.Module import Hydra.Lexical-import Hydra.Monads import Hydra.Rewriting-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms+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 -decodeApplicationType :: Show m => Term m -> GraphFlow m (ApplicationType m)-decodeApplicationType = matchRecord $ \m -> ApplicationType- <$> getField m _ApplicationType_function decodeType- <*> getField m _ApplicationType_argument decodeType--decodeElement :: Show m => Term m -> GraphFlow m Name-decodeElement term = case stripTerm term of- TermElement name -> pure name- _ -> unexpected "element" term+coreDecodeApplicationType :: Term -> Flow Graph (ApplicationType)+coreDecodeApplicationType = matchRecord $ \m -> ApplicationType+ <$> getField m _ApplicationType_function coreDecodeType+ <*> getField m _ApplicationType_argument coreDecodeType -decodeFieldType :: Show m => Term m -> GraphFlow m (FieldType m)-decodeFieldType = matchRecord $ \m -> FieldType- <$> (FieldName <$> getField m _FieldType_name decodeString)- <*> getField m _FieldType_type decodeType+coreDecodeFieldType :: Term -> Flow Graph (FieldType)+coreDecodeFieldType = matchRecord $ \m -> FieldType+ <$> getField m _FieldType_name coreDecodeName+ <*> getField m _FieldType_type coreDecodeType -decodeFieldTypes :: Show m => Term m -> GraphFlow m [FieldType m]-decodeFieldTypes term = case stripTerm term of- TermList els -> CM.mapM decodeFieldType els- _ -> unexpected "list" term+coreDecodeFieldTypes :: Term -> Flow Graph [FieldType]+coreDecodeFieldTypes term = case fullyStripTerm term of+ TermList els -> CM.mapM coreDecodeFieldType els+ _ -> unexpected "list" $ show term -decodeFloatType :: Show m => Term m -> GraphFlow m FloatType-decodeFloatType = matchEnum [+coreDecodeFloatType :: Term -> Flow Graph FloatType+coreDecodeFloatType = matchEnum _FloatType [ (_FloatType_bigfloat, FloatTypeBigfloat), (_FloatType_float32, FloatTypeFloat32), (_FloatType_float64, FloatTypeFloat64)] -decodeFunctionType :: Show m => Term m -> GraphFlow m (FunctionType m)-decodeFunctionType = matchRecord $ \m -> FunctionType- <$> getField m _FunctionType_domain decodeType- <*> getField m _FunctionType_codomain decodeType+coreDecodeFunctionType :: Term -> Flow Graph (FunctionType)+coreDecodeFunctionType = matchRecord $ \m -> FunctionType+ <$> getField m _FunctionType_domain coreDecodeType+ <*> getField m _FunctionType_codomain coreDecodeType -decodeIntegerType :: Show m => Term m -> GraphFlow m IntegerType-decodeIntegerType = matchEnum [+coreDecodeIntegerType :: Term -> Flow Graph IntegerType+coreDecodeIntegerType = matchEnum _IntegerType [ (_IntegerType_bigint, IntegerTypeBigint), (_IntegerType_int8, IntegerTypeInt8), (_IntegerType_int16, IntegerTypeInt16),@@ -79,110 +88,158 @@ (_IntegerType_uint32, IntegerTypeUint32), (_IntegerType_uint64, IntegerTypeUint64)] -decodeLambdaType :: Show m => Term m -> GraphFlow m (LambdaType m)-decodeLambdaType = matchRecord $ \m -> LambdaType- <$> (VariableType <$> getField m _LambdaType_parameter decodeString)- <*> getField m _LambdaType_body decodeType+coreDecodeLambdaType :: Term -> Flow Graph (LambdaType)+coreDecodeLambdaType = matchRecord $ \m -> LambdaType+ <$> (getField m _LambdaType_parameter coreDecodeName)+ <*> getField m _LambdaType_body coreDecodeType -decodeLiteralType :: Show m => Term m -> GraphFlow m LiteralType-decodeLiteralType = matchUnion [+coreDecodeLiteralType :: Term -> Flow Graph LiteralType+coreDecodeLiteralType = matchUnion _LiteralType [ matchUnitField _LiteralType_binary LiteralTypeBinary, matchUnitField _LiteralType_boolean LiteralTypeBoolean,- (_LiteralType_float, fmap LiteralTypeFloat . decodeFloatType),- (_LiteralType_integer, fmap LiteralTypeInteger . decodeIntegerType),+ (_LiteralType_float, fmap LiteralTypeFloat . coreDecodeFloatType),+ (_LiteralType_integer, fmap LiteralTypeInteger . coreDecodeIntegerType), matchUnitField _LiteralType_string LiteralTypeString] -decodeMapType :: Show m => Term m -> GraphFlow m (MapType m)-decodeMapType = matchRecord $ \m -> MapType- <$> getField m _MapType_keys decodeType- <*> getField m _MapType_values decodeType+coreDecodeMapType :: Term -> Flow Graph (MapType)+coreDecodeMapType = matchRecord $ \m -> MapType+ <$> getField m _MapType_keys coreDecodeType+ <*> getField m _MapType_values coreDecodeType -decodeRowType :: Show m => Term m -> GraphFlow m (RowType m)-decodeRowType = matchRecord $ \m -> RowType- <$> (Name <$> getField m _RowType_typeName decodeString)- <*> getField m _RowType_extends (Terms.expectOptional (\term -> Name <$> Terms.expectString term))- <*> getField m _RowType_fields decodeFieldTypes+coreDecodeName :: Term -> Flow Graph Name+coreDecodeName term = Name <$> (Expect.wrap _Name term >>= Expect.string) -decodeString :: Show m => Term m -> GraphFlow m String-decodeString = Terms.expectString . stripTerm+coreDecodeWrappedType :: Term -> Flow Graph WrappedType+coreDecodeWrappedType term = do+ fields <- Expect.recordWithName _WrappedType term+ name <- Expect.field _WrappedType_typeName coreDecodeName fields+ obj <- Expect.field _WrappedType_object coreDecodeType fields+ pure $ WrappedType name obj -decodeType :: Show m => Term m -> GraphFlow m (Type m)-decodeType dat = case dat of- TermElement name -> pure $ TypeNominal name- TermAnnotated (Annotated term ann) -> (\t -> TypeAnnotated $ Annotated t ann) <$> decodeType term- _ -> matchUnion [--- (_Type_annotated, fmap TypeAnnotated . decodeAnnotated),- (_Type_application, fmap TypeApplication . decodeApplicationType),- (_Type_element, fmap TypeElement . decodeType),- (_Type_function, fmap TypeFunction . decodeFunctionType),- (_Type_lambda, fmap TypeLambda . decodeLambdaType),- (_Type_list, fmap TypeList . decodeType),- (_Type_literal, fmap TypeLiteral . decodeLiteralType),- (_Type_map, fmap TypeMap . decodeMapType),- (_Type_nominal, fmap TypeNominal . decodeElement),- (_Type_optional, fmap TypeOptional . decodeType),- (_Type_product, \(TermList types) -> TypeProduct <$> (CM.mapM decodeType types)),- (_Type_record, fmap TypeRecord . decodeRowType),- (_Type_set, fmap TypeSet . decodeType),- (_Type_sum, \(TermList types) -> TypeSum <$> (CM.mapM decodeType types)),- (_Type_union, fmap TypeUnion . decodeRowType),- (_Type_variable, fmap (TypeVariable . VariableType) . decodeString)] dat+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 -elementAsTypedTerm :: (Show m) => Element m -> GraphFlow m (TypedTerm m)-elementAsTypedTerm el = TypedTerm <$> decodeType (elementSchema el) <*> pure (elementData el)+coreDecodeString :: Term -> Flow Graph String+coreDecodeString = Expect.string . fullyStripTerm -fieldTypes :: Show m => Type m -> GraphFlow m (M.Map FieldName (Type m))+coreDecodeType :: Term -> Flow Graph Type+coreDecodeType dat = case dat of+ TermAnnotated (AnnotatedTerm term ann) -> (\t -> TypeAnnotated $ AnnotatedType t ann) <$> coreDecodeType term+ _ -> matchUnion _Type [+-- (_Type_annotated, fmap TypeAnnotated . coreDecodeAnnotated),+ (_Type_application, fmap TypeApplication . coreDecodeApplicationType),+ (_Type_function, fmap TypeFunction . coreDecodeFunctionType),+ (_Type_lambda, fmap TypeLambda . coreDecodeLambdaType),+ (_Type_list, fmap TypeList . coreDecodeType),+ (_Type_literal, fmap TypeLiteral . coreDecodeLiteralType),+ (_Type_map, fmap TypeMap . coreDecodeMapType),+ (_Type_optional, fmap TypeOptional . coreDecodeType),+ (_Type_product, \l -> do+ types <- Expect.list pure l+ TypeProduct <$> (CM.mapM coreDecodeType types)),+ (_Type_record, fmap TypeRecord . coreDecodeRowType),+ (_Type_set, fmap TypeSet . coreDecodeType),+ (_Type_sum, \(TermList types) -> TypeSum <$> (CM.mapM coreDecodeType types)),+ (_Type_union, fmap TypeUnion . coreDecodeRowType),+ (_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- TypeElement et -> fieldTypes et- TypeNominal name -> do+ TypeVariable name -> do withTrace ("field types of " ++ unName name) $ do el <- requireElement name- decodeType (elementData el) >>= fieldTypes- TypeLambda (LambdaType _ body) -> fieldTypes body- _ -> unexpected "record or union type" t+ 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 FieldName (Term m) -> FieldName -> (Term m -> GraphFlow m b) -> GraphFlow m b+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 -matchEnum :: Show m => [(FieldName, b)] -> Term m -> GraphFlow m b-matchEnum = matchUnion . fmap (uncurry matchUnitField)+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 -matchRecord :: Show m => (M.Map FieldName (Term m) -> GraphFlow m b) -> Term m -> GraphFlow m b-matchRecord decode term = do- term1 <- deref term- case stripTerm term1 of- TermRecord (Record _ fields) -> decode $ M.fromList $ fmap (\(Field fname val) -> (fname, val)) fields- _ -> unexpected "record" term1+matchEnum :: Name -> [(Name, b)] -> Term -> Flow Graph b+matchEnum tname = matchUnion tname . fmap (uncurry matchUnitField) -matchUnion :: Show m => [(FieldName, Term m -> GraphFlow m b)] -> Term m -> GraphFlow m b-matchUnion pairs term = do- term1 <- deref term- case stripTerm term1 of- TermUnion (Union _ (Field fname val)) -> case M.lookup fname mapping of+matchRecord :: (M.Map Name (Term) -> Flow Graph b) -> Term -> Flow Graph b+matchRecord decode term = case fullyStripTerm term of+ TermRecord (Record _ fields) -> decode $ M.fromList $ fmap (\(Field fname val) -> (fname, val)) fields+ _ -> unexpected "record" $ show term++matchUnion :: Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b+matchUnion tname pairs term = case fullyStripTerm term of+ TermVariable name -> do+ el <- requireElement name+ matchUnion tname pairs (elementData el)+ TermUnion (Injection tname' (Field fname val)) -> if tname' == tname+ then case M.lookup fname mapping of Nothing -> fail $ "no matching case for field " ++ show fname Just f -> f val- _ -> unexpected ("union with one of {" ++ L.intercalate ", " (unFieldName . fst <$> pairs) ++ "}") term+ else unexpected ("injection for type " ++ show tname) $ show term+ t -> unexpected ("union with one of {" ++ L.intercalate ", " (unName . fst <$> pairs) ++ "}") $ show t where mapping = M.fromList pairs -matchUnitField :: FieldName -> b -> (FieldName, a -> GraphFlow m b)+matchUnitField :: Name -> y -> (Name, x -> Flow Graph y) matchUnitField fname x = (fname, \_ -> pure x) -requireRecordType :: Show m => Bool -> Name -> GraphFlow m (RowType m)-requireRecordType infer = requireRowType "record" infer $ \t -> case t of+-- | 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 :: Show m => String -> Bool -> (Type m -> Maybe (RowType m)) -> Name -> GraphFlow m (RowType m)+requireRowType :: String -> Bool -> (Type -> Maybe (RowType)) -> Name -> Flow Graph (RowType) requireRowType label infer getter name = do- t <- withSchemaContext $ requireType name+ t <- requireType name case getter (rawType t) of Just rt -> if infer then case rowTypeExtends rt of@@ -194,21 +251,37 @@ Nothing -> fail $ show name ++ " does not resolve to a " ++ label ++ " type: " ++ show t where rawType t = case t of- TypeAnnotated (Annotated t' _) -> rawType t'+ TypeAnnotated (AnnotatedType t' _) -> rawType t' TypeLambda (LambdaType _ body) -> rawType body -- Note: throwing away quantification here _ -> t -requireType :: Show m => Name -> GraphFlow m (Type m)-requireType name = withTrace "require type" $ do- el <- requireElement name- decodeType $ elementData el+requireType :: Name -> Flow Graph Type+requireType name = withTrace ("require type " ++ unName name) $+ (withSchemaContext $ requireElement name) >>= (coreDecodeType . elementData) -requireUnionType :: Show m => Bool -> Name -> GraphFlow m (RowType m)+requireUnionType :: Bool -> Name -> Flow Graph (RowType) requireUnionType infer = requireRowType "union" infer $ \t -> case t of TypeUnion rt -> Just rt _ -> Nothing -typeDependencies :: Show m => Name -> GraphFlow m (M.Map Name (Type m))+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@@ -228,11 +301,4 @@ requireType name = do withTrace ("type dependencies of " ++ unName name) $ do el <- requireElement name- decodeType (elementData el)--typeDependencyNames :: Type m -> S.Set Name-typeDependencyNames = foldOverType TraversalOrderPre addNames S.empty- where- addNames names typ = case typ of- TypeNominal name -> S.insert name names- _ -> names+ coreDecodeType (elementData el)
− src/main/haskell/Hydra/CoreEncoding.hs
@@ -1,195 +0,0 @@--- | Encoding of types as terms--module Hydra.CoreEncoding where--import Hydra.Core-import Hydra.Compute-import Hydra.Mantle-import Hydra.Monads-import Hydra.Impl.Haskell.Dsl.Terms--import Prelude hiding (map)-import qualified Data.Map as M-import qualified Data.Set as S---encodeApplication :: Ord m => Application m -> Term m-encodeApplication (Application lhs rhs) = record _Application [- Field _Application_function $ encodeTerm lhs,- Field _Application_argument $ encodeTerm rhs]--encodeApplicationType :: ApplicationType m -> Term m-encodeApplicationType (ApplicationType lhs rhs) = record _ApplicationType [- Field _ApplicationType_function $ encodeType lhs,- Field _ApplicationType_argument $ encodeType rhs]--encodeCaseStatement :: Ord m => CaseStatement m -> Term m-encodeCaseStatement (CaseStatement name cases) = record _CaseStatement [- Field _CaseStatement_typeName $ string (unName name),- Field _CaseStatement_cases $ list $ encodeField <$> cases]--encodeElimination :: Ord m => Elimination m -> Term m-encodeElimination e = case e of- EliminationElement -> unitVariant _Elimination _Elimination_element- EliminationList f -> variant _Elimination _Elimination_list $ encodeTerm f- EliminationNominal (Name name) -> variant _Elimination _Elimination_nominal $ string name- EliminationOptional cases -> variant _Elimination _Elimination_optional $ encodeOptionalCases cases- EliminationRecord p -> variant _Elimination _Elimination_record $ encodeProjection p- EliminationUnion c -> variant _Elimination _Elimination_union $ encodeCaseStatement c--encodeField :: Ord m => Field m -> Term m-encodeField (Field (FieldName name) term) = record _Field [- Field _Field_name $ string name,- Field _Field_term $ encodeTerm term]--encodeFieldType :: FieldType m -> Term m-encodeFieldType (FieldType (FieldName fname) t) = record _FieldType [- Field _FieldType_name $ string fname,- Field _FieldType_type $ encodeType t]--encodeFloatType :: FloatType -> Term m-encodeFloatType ft = unitVariant _FloatType $ case ft of- FloatTypeBigfloat -> _FloatType_bigfloat- FloatTypeFloat32 -> _FloatType_float32- FloatTypeFloat64 -> _FloatType_float64--encodeFunction :: Ord m => Function m -> Term m-encodeFunction f = case f of- FunctionCompareTo other -> variant _Function _Function_compareTo $ encodeTerm other- FunctionElimination e -> variant _Function _Function_compareTo $ encodeElimination e- FunctionLambda l -> variant _Function _Function_lambda $ encodeLambda l- FunctionPrimitive (Name name) -> variant _Function _Function_primitive $ string name--encodeFunctionType :: FunctionType m -> Term m-encodeFunctionType (FunctionType dom cod) = record _FunctionType [- Field _FunctionType_domain $ encodeType dom,- Field _FunctionType_codomain $ encodeType cod]--encodeIntegerType :: IntegerType -> Term m-encodeIntegerType it = unitVariant _IntegerType $ case it of- IntegerTypeBigint -> _IntegerType_bigint- IntegerTypeInt8 -> _IntegerType_int8- IntegerTypeInt16 -> _IntegerType_int16- IntegerTypeInt32 -> _IntegerType_int32- IntegerTypeInt64 -> _IntegerType_int64- IntegerTypeUint8 -> _IntegerType_uint8- IntegerTypeUint16 -> _IntegerType_uint16- IntegerTypeUint32 -> _IntegerType_uint32- IntegerTypeUint64 -> _IntegerType_uint64--encodeLambda :: Ord m => Lambda m -> Term m-encodeLambda (Lambda (Variable v) b) = record _Lambda [- Field _Lambda_parameter $ string v,- Field _Lambda_body $ encodeTerm b]--encodeLambdaType :: LambdaType m -> Term m-encodeLambdaType (LambdaType (VariableType var) body) = record _LambdaType [- Field _LambdaType_parameter $ string var,- Field _LambdaType_body $ encodeType body]--encodeLiteralType :: LiteralType -> Term m-encodeLiteralType at = case at of- LiteralTypeBinary -> unitVariant _LiteralType _LiteralType_binary- LiteralTypeBoolean -> unitVariant _LiteralType _LiteralType_boolean- LiteralTypeFloat ft -> variant _LiteralType _LiteralType_float $ encodeFloatType ft- LiteralTypeInteger it -> variant _LiteralType _LiteralType_integer $ encodeIntegerType it- LiteralTypeString -> unitVariant _LiteralType _LiteralType_string--encodeLiteral :: Literal -> Term m-encodeLiteral = literal--encodeLiteralVariant :: LiteralVariant -> Term m-encodeLiteralVariant av = unitVariant _LiteralVariant $ case av of- LiteralVariantBinary -> _LiteralVariant_binary- LiteralVariantBoolean -> _LiteralVariant_boolean- LiteralVariantFloat -> _LiteralVariant_float- LiteralVariantInteger -> _LiteralVariant_integer- LiteralVariantString -> _LiteralVariant_string--encodeMapType :: MapType m -> Term m-encodeMapType (MapType kt vt) = record _MapType [- Field _MapType_keys $ encodeType kt,- Field _MapType_values $ encodeType vt]--encodeNamed :: Ord m => Named m -> Term m-encodeNamed (Named (Name name) term) = record _Named [- Field _Named_typeName $ string name,- Field _Named_term $ encodeTerm term]--encodeOptionalCases :: Ord m => OptionalCases m -> Term m-encodeOptionalCases (OptionalCases nothing just) = record _OptionalCases [- Field _OptionalCases_nothing $ encodeTerm nothing,- Field _OptionalCases_just $ encodeTerm just]--encodeProjection :: Projection -> Term m-encodeProjection (Projection name fname) = record _Projection [- Field _Projection_typeName $ string (unName name),- Field _Projection_field $ string (unFieldName fname)]--encodeRowType :: RowType m -> Term m-encodeRowType (RowType name extends fields) = record _RowType [- Field _RowType_typeName $ string (unName name),- Field _RowType_extends $ optional (string . unName <$> extends),- Field _RowType_fields $ list $ encodeFieldType <$> fields]--encodeSum :: Ord m => Sum m -> Term m-encodeSum (Sum i l term) = record _Sum [- Field _Sum_index $ int32 i,- Field _Sum_size $ int32 l,- Field _Sum_term $ encodeTerm term]--encodeTerm :: Ord m => Term m -> Term m-encodeTerm term = case term of- TermAnnotated (Annotated t ann) -> variant _Term _Term_annotated $ TermAnnotated $ Annotated (encodeTerm t) ann- TermApplication a -> variant _Term _Term_application $ encodeApplication a- TermLiteral av -> variant _Term _Term_literal $ encodeLiteral av- TermElement (Name name) -> variant _Term _Term_element $ string name- TermFunction f -> variant _Term _Term_function $ encodeFunction f- TermList terms -> variant _Term _Term_list $ list $ encodeTerm <$> terms- TermMap m -> variant _Term _Term_map $ map $ M.fromList $ encodePair <$> M.toList m- where encodePair (k, v) = (encodeTerm k, encodeTerm v)- TermNominal ntt -> variant _Term _Term_nominal $ encodeNamed ntt- TermOptional m -> variant _Term _Term_optional $ optional $ encodeTerm <$> m- TermProduct terms -> variant _Term _Term_product $ list (encodeTerm <$> terms)- TermRecord (Record _ fields) -> variant _Term _Term_record $ list $ encodeField <$> fields- TermSet terms -> variant _Term _Term_set $ set $ S.fromList $ encodeTerm <$> S.toList terms- TermSum s -> variant _Term _Term_sum $ encodeSum s- TermUnion (Union _ field) -> variant _Term _Term_union $ encodeField field- TermVariable (Variable var) -> variant _Term _Term_variable $ string var--encodeType :: Type m -> Term m-encodeType typ = case typ of- TypeAnnotated (Annotated t ann) -> TermAnnotated (Annotated (encodeType t) ann)- TypeApplication a -> variant _Type _Type_application $ encodeApplicationType a- TypeElement t -> variant _Type _Type_element $ encodeType t- TypeFunction ft -> variant _Type _Type_function $ encodeFunctionType ft- TypeLambda ut -> variant _Type _Type_lambda $ encodeLambdaType ut- TypeList t -> variant _Type _Type_list $ encodeType t- TypeLiteral at -> variant _Type _Type_literal $ encodeLiteralType at- TypeMap mt -> variant _Type _Type_map $ encodeMapType mt- TypeNominal name -> variant _Type _Type_nominal $ element name- TypeOptional t -> variant _Type _Type_optional $ encodeType t- TypeProduct types -> variant _Type _Type_product $ list (encodeType <$> types)- TypeRecord rt -> variant _Type _Type_record $ encodeRowType rt- TypeSet t -> variant _Type _Type_set $ encodeType t- TypeSum types -> variant _Type _Type_sum $ list (encodeType <$> types)- TypeUnion rt -> variant _Type _Type_union $ encodeRowType rt- TypeVariable (VariableType var) -> variant _Type _Type_variable $ string var--encodeTypeVariant :: TypeVariant -> Term m-encodeTypeVariant tv = unitVariant _TypeVariant $ case tv of- TypeVariantAnnotated -> _TypeVariant_annotated- TypeVariantLiteral -> _TypeVariant_literal- TypeVariantElement -> _TypeVariant_element- TypeVariantFunction -> _TypeVariant_function- TypeVariantList -> _TypeVariant_list- TypeVariantMap -> _TypeVariant_map- TypeVariantNominal -> _TypeVariant_nominal- TypeVariantOptional -> _TypeVariant_optional- TypeVariantProduct -> _TypeVariant_product- TypeVariantRecord -> _TypeVariant_record- TypeVariantSet -> _TypeVariant_set- TypeVariantSum -> _TypeVariant_sum- TypeVariantUnion -> _TypeVariant_union- TypeVariantLambda -> _TypeVariant_lambda- TypeVariantVariable -> _TypeVariant_variable
− src/main/haskell/Hydra/CoreLanguage.hs
@@ -1,20 +0,0 @@--- | Core language constraints of Hydra. These constraints are trivial; all types and all terms are supported.--module Hydra.CoreLanguage where--import Hydra.Compute-import Hydra.Basics--import qualified Data.Set as S---hydraCoreLanguage :: Language m-hydraCoreLanguage = Language (LanguageName "hydra/core") $ LanguageConstraints {- languageConstraintsEliminationVariants = S.fromList eliminationVariants,- languageConstraintsLiteralVariants = S.fromList literalVariants,- languageConstraintsFloatTypes = S.fromList floatTypes,- languageConstraintsFunctionVariants = S.fromList functionVariants,- languageConstraintsIntegerTypes = S.fromList integerTypes,- languageConstraintsTermVariants = S.fromList termVariants,- languageConstraintsTypeVariants = S.fromList typeVariants,- languageConstraintsTypes = const True }
+ src/main/haskell/Hydra/Dsl/Annotations.hs view
@@ -0,0 +1,79 @@+-- | A DSL which is used as a basis for some of the other DSLs++module Hydra.Dsl.Annotations where++import Hydra.Core+import Hydra.Compute+import Hydra.Annotations+import Hydra.Tools.Formatting+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types++import qualified Data.Map as M+import qualified Data.Maybe as Y+++key_deprecated = "_deprecated"+key_maxLength = "_maxLength"+key_minLength = "_minLength"+key_preserveFieldName = "_preserveFieldName"++annotateTerm :: String -> Y.Maybe (Term) -> Term -> Term+annotateTerm = setTermAnnotation++annotateType :: String -> Y.Maybe (Term) -> Type -> Type+annotateType = setTypeAnnotation++bounded :: Maybe Int -> Maybe Int -> Type -> Type+bounded min max = annotMin . annotMax+ where+ annotMax t = Y.maybe t (`setMaxLength` t) max+ annotMin t = Y.maybe t (`setMinLength` t) max++boundedList :: Maybe Int -> Maybe Int -> Type -> Type+boundedList min max et = bounded min max $ Types.list et++boundedSet :: Maybe Int -> Maybe Int -> Type -> Type+boundedSet min max et = bounded min max $ Types.set et++boundedString :: Maybe Int -> Maybe Int -> Type+boundedString min max = bounded min max Types.string++deprecated :: Type -> Type+deprecated = setTypeAnnotation key_deprecated (Just $ Terms.boolean True)++doc :: String -> Type -> Type+doc s = setTypeDescription (Just s)++doc70 :: String -> Type -> Type+doc70 = doc . wrapLine 70++doc80 :: String -> Type -> Type+doc80 = doc . wrapLine 80++dataDoc :: String -> Term -> Term+dataDoc s = setTermDescription (Just s)++minLengthList :: Int -> Type -> Type+minLengthList len = boundedList (Just len) Nothing++nonemptyList :: Type -> Type+nonemptyList = minLengthList 1++note :: String -> Type -> Type+note s = doc $ "Note: " ++ s++preserveFieldName :: Type -> Type+preserveFieldName = setTypeAnnotation key_preserveFieldName (Just $ Terms.boolean True)++see :: String -> Type -> Type+see s = doc $ "See " ++ s++setMaxLength :: Int -> Type -> Type+setMaxLength m = setTypeAnnotation key_maxLength (Just $ Terms.int32 m)++setMinLength :: Int -> Type -> Type+setMinLength m = setTypeAnnotation key_minLength (Just $ Terms.int32 m)++twoOrMoreList :: Type -> Type+twoOrMoreList = boundedList (Just 2) Nothing
+ src/main/haskell/Hydra/Dsl/Base.hs view
@@ -0,0 +1,224 @@+-- | Base DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions.++module Hydra.Dsl.Base (+ module Hydra.Dsl.Base,+ module Hydra.Dsl.PhantomLiterals,+ module Hydra.Dsl.ShorthandTypes,+ hydraCore,+) where++import Hydra.Coders+import Hydra.Core+import Hydra.Compute+import Hydra.Graph+import Hydra.Annotations+import Hydra.Phantoms+import Hydra.Module+import qualified Hydra.Tier1 as Tier1+import Hydra.Dsl.PhantomLiterals+import Hydra.Dsl.ShorthandTypes+import Hydra.Sources.Core+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import qualified Hydra.Dsl.Lib.Lists as Lists+import Hydra.Sources.Libraries++import Prelude hiding ((++))+import Data.String(IsString(..))++import qualified Data.Map as M+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++infixr 0 >:+(>:) :: String -> Datum a -> Field+n >: d = Field (Name n) (unDatum d)++infixr 0 >>:+(>>:) :: Name -> Datum a -> Field+fname >>: d = Field fname (unDatum d)++(<.>) :: Datum (b -> c) -> Datum (a -> b) -> Datum (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+f @@ x = apply f x++infixr 0 @->+(@->) :: a -> b -> (a, b)+x @-> y = (x, y)++infixr 0 -->+(-->) :: Case a -> Datum (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++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++caseField :: Case a -> Datum (a -> b) -> Field+caseField (Case fname) (Datum f) = Field fname f++compose :: Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)+compose (Datum f) (Datum g) = Datum $ Terms.compose f g++constant :: Datum a -> Datum (b -> a)+constant (Datum term) = Datum $ Terms.constant term++definitionInModule :: Module -> String -> Datum a -> Definition a+definitionInModule mod lname = Definition $ Tier1.unqualifyName $ QualifiedName (Just $ moduleNamespace mod) lname++doc :: String -> Datum a -> Datum a+doc s (Datum term) = Datum $ setTermDescription (Just s) term++doc70 :: String -> Datum a -> Datum a+doc70 = doc . wrapLine 70++doc80 :: String -> Datum a -> Datum a+doc80 = doc . wrapLine 80++field :: Name -> Datum a -> Field+field fname (Datum val) = Field fname val++first :: Datum ((a, b) -> a)+first = Datum $ Terms.untuple 2 0++fld :: Name -> Datum a -> Fld a+fld fname (Datum val) = Fld $ Field fname val++fold :: Datum (b -> a -> b) -> Datum (b -> [a] -> b)+fold f = Lists.foldl @@ f++function :: Type -> Type -> Datum a -> Datum a+function dom cod = typed (Types.function dom cod)++functionN :: [Type] -> Datum a -> Datum a+functionN ts = typed $ Types.functionN ts++functionNWithClasses :: [Type] -> M.Map Name (S.Set TypeClass) -> Datum a -> Datum a+functionNWithClasses ts classes = typed $ setTypeClasses classes (Types.functionN ts)++functionWithClasses :: Type -> Type -> M.Map Name (S.Set TypeClass) -> Datum a -> Datum 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 $+ 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 m n j = matchOpt n j @@ m++identity :: Datum (a -> a)+identity = Datum Terms.identity++inject :: Name -> Name -> Datum a -> Datum b+inject name fname (Datum term) = Datum $ Terms.inject name (Field fname term)++inject2 :: Name -> Name -> Datum (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++lambda :: String -> Datum x -> Datum (a -> b)+lambda v (Datum body) = Datum $ 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++list :: [Datum a] -> Datum [a]+list els = Datum $ Terms.list (unDatum <$> els)++map :: M.Map (Datum a) (Datum b) -> Datum (M.Map a b)+map = Datum . Terms.map . M.fromList . fmap fromDatum . M.toList+ where+ fromDatum (Datum k, Datum v) = (k, v)++match :: Name -> Maybe (Datum b) -> [Field] -> Datum (u -> b)+match name dflt fields = Datum $ Terms.match name (unDatum <$> 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)+ where+ toField (fname, Datum term) = Field fname term++matchOpt :: Datum b -> Datum (a -> b) -> Datum (Maybe a -> b)+matchOpt (Datum n) (Datum j) = Datum $ Terms.matchOpt n j++matchToEnum :: Name -> Name -> Maybe (Datum b) -> [(Name, Name)] -> Datum (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 domName codName dflt pairs = matchData domName dflt (toCase <$> pairs)+ where+ toCase (fromName, fld) = (fromName, constant $ Datum $ 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++nothing :: Datum x+nothing = Datum Terms.nothing++opt :: Maybe (Datum a) -> Datum (Maybe a)+opt mc = Datum $ Terms.optional (unDatum <$> mc)++pair :: (Datum a, Datum b) -> Datum (a, b)+pair (Datum l, Datum r) = Datum $ Terms.pair l r++primitive :: Name -> Datum a+primitive = Datum . Terms.primitive++project :: Name -> Name -> Datum (a -> b)+project name fname = Datum $ Terms.project name fname++record :: Name -> [Field] -> Datum a+record name fields = Datum $ Terms.record name fields++ref :: Definition a -> Datum a+ref (Definition name _) = Datum (TermVariable name)++second :: Datum ((a, b) -> b)+second = Datum $ Terms.untuple 2 1++set :: S.Set (Datum a) -> Datum (S.Set a)+set = Datum . Terms.set . S.fromList . fmap unDatum . S.toList++typed :: Type -> Datum a -> Datum a+typed typ (Datum term) = Datum $ setTermType (Just typ) term++unit :: Datum a+unit = Datum Terms.unit++unitVariant :: Name -> Name -> Datum a+unitVariant name fname = Datum $ Terms.inject name $ Field fname Terms.unit++unwrap :: Name -> Datum (a -> b)+unwrap = Datum . Terms.unwrap++var :: String -> Datum a+var v = Datum $ Terms.var v++variant :: Name -> Name -> Datum a -> Datum b+variant name fname (Datum term) = Datum $ Terms.inject name $ Field fname term++with :: Datum a -> [Field] -> Datum a+(Datum env) `with` fields = Datum $ 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
+ src/main/haskell/Hydra/Dsl/Bootstrap.hs view
@@ -0,0 +1,65 @@+-- | A bootstrapping DSL, used for Hydra's inner core models++module Hydra.Dsl.Bootstrap where++import Hydra.Compute+import Hydra.Constants+import Hydra.Core+import Hydra.CoreEncoding+import Hydra.Graph+import Hydra.Annotations+import Hydra.Module+import Hydra.Rewriting+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Tools.Debug++import qualified Data.Map as M+import qualified Data.Set as S+++-- | An empty graph (no elements, no primitives, but an annotation class) which is used for bootstrapping Hydra Core+bootstrapGraph :: Graph+bootstrapGraph = Graph {+ graphElements = M.empty,+ graphEnvironment = M.empty,+ graphTypes = M.empty,+ graphBody = Terms.list [], -- Note: the bootstrap body is arbitrary+ graphPrimitives = M.fromList $ fmap (\p -> (primitiveName p, p)) standardPrimitives,+ graphSchema = Nothing}++datatype :: Namespace -> String -> Type -> Element+datatype gname lname typ = typeElement elName $ rewriteType replacePlaceholders id 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)+ else rect+ TypeUnion (RowType tname e fields) -> if tname == placeholderName+ then TypeUnion (RowType elName e fields)+ else rect+ TypeWrap (WrappedType tname t) -> if tname == placeholderName+ then TypeWrap (WrappedType elName t)+ else rect+ _ -> rect+ where+ rect = rec t++typeref :: Namespace -> String -> Type+typeref ns = TypeVariable . qualify ns . Name++qualify :: Namespace -> Name -> Name+qualify (Namespace gname) (Name lname) = Name $ gname ++ "." ++ lname++typeElement :: Name -> Type -> Element+typeElement name typ = Element {+ elementName = name,+ elementData = dataTerm}+ where+ -- These type annotations allow type inference to proceed despite cyclic type definitions, e.g. in Hydra Core+ dataTerm = normalizeTermAnnotations $ TermAnnotated $ AnnotatedTerm (coreEncodeType typ) $ M.fromList [(key_type, schemaTerm)]+ schemaTerm = TermVariable _Type
+ src/main/haskell/Hydra/Dsl/Core.hs view
@@ -0,0 +1,274 @@+module Hydra.Dsl.Core where++import Hydra.Kernel+import Hydra.Dsl.Base as Base++import qualified Data.Map as M+import qualified Data.Maybe as Y+++annotatedTerm :: Datum Term -> Datum (M.Map String Term) -> Datum AnnotatedTerm+annotatedTerm subject annotation = Base.record _AnnotatedTerm [+ _AnnotatedTerm_subject>>: subject,+ _AnnotatedTerm_annotation>>: annotation]++annotatedTermSubject :: Datum (AnnotatedTerm -> Term)+annotatedTermSubject = project _AnnotatedTerm _AnnotatedTerm_subject++annotatedTermAnnotation :: Datum (AnnotatedTerm -> M.Map String Term)+annotatedTermAnnotation = project _AnnotatedTerm _AnnotatedTerm_annotation++annotatedType :: Datum Type -> Datum (M.Map String Term) -> Datum AnnotatedType+annotatedType subject annotation = Base.record _AnnotatedType [+ _AnnotatedType_subject>>: subject,+ _AnnotatedType_annotation>>: annotation]++annotatedTypeSubject :: Datum (AnnotatedType -> Type)+annotatedTypeSubject = project _AnnotatedType _AnnotatedType_subject++annotatedTypeAnnotation :: Datum (AnnotatedType -> M.Map String Term)+annotatedTypeAnnotation = project _AnnotatedType _AnnotatedType_annotation++application :: Datum Term -> Datum Term -> Datum (Application)+application function argument = Base.record _Application [+ _Application_function>>: function,+ _Application_argument>>: argument]++applicationFunction :: Datum (Application -> Term)+applicationFunction = project _Application _Application_function++applicationArgument :: Datum (Application -> Term)+applicationArgument = project _Application _Application_argument++applicationType :: Datum Type -> Datum Type -> Datum (ApplicationType)+applicationType function argument = Base.record _ApplicationType [+ _ApplicationType_function>>: function,+ _ApplicationType_argument>>: argument]++applicationTypeFunction :: Datum (ApplicationType -> Type)+applicationTypeFunction = project _ApplicationType _ApplicationType_function++applicationTypeArgument :: Datum (ApplicationType -> Type)+applicationTypeArgument = project _ApplicationType _ApplicationType_argument++caseStatement :: Datum Name -> Datum (Maybe Term) -> Datum [Field] -> Datum (CaseStatement)+caseStatement typeName defaultTerm cases = Base.record _CaseStatement [+ _CaseStatement_typeName>>: typeName,+ _CaseStatement_default>>: defaultTerm,+ _CaseStatement_cases>>: cases]++caseStatementTypeName :: Datum (CaseStatement -> Name)+caseStatementTypeName = project _CaseStatement _CaseStatement_typeName++caseStatementDefault :: Datum (CaseStatement -> Maybe Term)+caseStatementDefault = project _CaseStatement _CaseStatement_default++caseStatementCases :: Datum (CaseStatement -> [Field])+caseStatementCases = project _CaseStatement _CaseStatement_cases++field :: Datum Name -> Datum Term -> Datum Field+field name term = Base.record _Field [+ _Field_name>>: name,+ _Field_term>>: term]++fieldName :: Datum (Field -> Name)+fieldName = project _Field _Field_name++fieldTerm :: Datum (Field -> Term)+fieldTerm = project _Field _Field_term++fieldType :: Datum Name -> Datum Type -> Datum (FieldType)+fieldType name typ = Base.record _FieldType [+ _FieldType_name>>: name,+ _FieldType_type>>: typ]++fieldTypeName :: Datum (FieldType -> Name)+fieldTypeName = project _FieldType _FieldType_name++fieldTypeType :: Datum (FieldType -> Type)+fieldTypeType = project _FieldType _FieldType_type++functionType :: Datum Type -> Datum Type -> Datum (FunctionType)+functionType domain codomain = Base.record _FunctionType [+ _FunctionType_domain>>: domain,+ _FunctionType_codomain>>: codomain]++functionTypeDomain :: Datum (FunctionType -> Type)+functionTypeDomain = project _FunctionType _FunctionType_domain++functionTypeCodomain :: Datum (FunctionType -> Type)+functionTypeCodomain = project _FunctionType _FunctionType_codomain++injection :: Datum Name -> Datum Field -> Datum Injection+injection typeName field = Base.record _Injection [+ _Injection_typeName>>: typeName,+ _Injection_field>>: field]++injectionTypeName :: Datum (Injection -> Name)+injectionTypeName = project _Injection _Injection_typeName++injectionField :: Datum (Injection -> Field)+injectionField = project _Injection _Injection_field++lambda :: Datum Name -> Datum Term -> Datum Lambda+lambda parameter body = Base.record _Lambda [+ _Lambda_parameter>>: parameter,+ _Lambda_body>>: body]++lambdaParameter :: Datum (Lambda -> Name)+lambdaParameter = project _Lambda _Lambda_parameter++lambdaBody :: Datum (Lambda -> Term)+lambdaBody = project _Lambda _Lambda_body++lambdaType :: Datum Name -> Datum Type -> Datum LambdaType+lambdaType parameter body = Base.record _LambdaType [+ _LambdaType_parameter>>: parameter,+ _LambdaType_body>>: body]++lambdaTypeParameter :: Datum (LambdaType -> Name)+lambdaTypeParameter = project _LambdaType _LambdaType_parameter++lambdaTypeBody :: Datum (LambdaType -> Type)+lambdaTypeBody = project _LambdaType _LambdaType_body++letExpression :: Datum [LetBinding] -> Datum Term -> Datum Let+letExpression bindings environment = Base.record _Let [+ _Let_bindings>>: bindings,+ _Let_environment>>: environment]++letBindings :: Datum (Let -> [LetBinding])+letBindings = project _Let _Let_bindings++letBindingName :: Datum (LetBinding -> Name)+letBindingName = project _LetBinding _LetBinding_name++letBindingTerm :: Datum (LetBinding -> Term)+letBindingTerm = project _LetBinding _LetBinding_term++letBindingType :: Datum (LetBinding -> Y.Maybe TypeScheme)+letBindingType = project _LetBinding _LetBinding_type++letEnvironment :: Datum (Let -> Term)+letEnvironment = project _Let _Let_environment++literalBinary :: Datum String -> Datum Literal+literalBinary = variant _Literal _Literal_binary++literalBoolean :: Datum Bool -> Datum Literal+literalBoolean = variant _Literal _Literal_boolean++literalFloat :: Datum FloatValue -> Datum Literal+literalFloat = variant _Literal _Literal_float++literalInteger :: Datum IntegerValue -> Datum Literal+literalInteger = variant _Literal _Literal_integer++mapType :: Datum Type -> Datum Type -> Datum MapType+mapType keys values = Base.record _MapType [+ _MapType_keys>>: keys,+ _MapType_values>>: values]++mapTypeKeys :: Datum (MapType -> Type)+mapTypeKeys = project _MapType _MapType_keys++mapTypeValues :: Datum (MapType -> Type)+mapTypeValues = project _MapType _MapType_values++optionalCases :: Datum Term -> Datum Term -> Datum OptionalCases+optionalCases nothing just = Base.record _OptionalCases [+ _OptionalCases_nothing>>: nothing,+ _OptionalCases_just>>: just]++optionalCasesNothing :: Datum (OptionalCases -> Term)+optionalCasesNothing = project _OptionalCases _OptionalCases_nothing++optionalCasesJust :: Datum (OptionalCases -> Term)+optionalCasesJust = project _OptionalCases _OptionalCases_just++projectionTypeName :: Datum (Projection -> Name)+projectionTypeName = project _Projection _Projection_typeName++projectionField :: Datum (Projection -> Name)+projectionField = project _Projection _Projection_field++record :: Datum Name -> Datum [Field] -> Datum Record+record typeName fields = Base.record _Record [+ _Record_typeName>>: typeName,+ _Record_fields>>: fields]++recordTypeName :: Datum (Record -> Name)+recordTypeName = project _Record _Record_typeName++recordFields :: Datum (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_typeName>>: typeName,+ _RowType_extends>>: extends,+ _RowType_fields>>: fields]++rowTypeTypeName :: Datum (RowType -> Name)+rowTypeTypeName = project _RowType _RowType_typeName++rowTypeExtends :: Datum (RowType -> Maybe Name)+rowTypeExtends = project _RowType _RowType_extends++rowTypeFields :: Datum (RowType -> [FieldType])+rowTypeFields = project _RowType _RowType_fields++sum :: Datum Int -> Datum Int -> Datum Term -> Datum Sum+sum index size term = Base.record _Sum [+ _Sum_index>>: index,+ _Sum_size>>: size,+ _Sum_term>>: term]++sumIndex :: Datum (Sum -> Int)+sumIndex = project _Sum _Sum_index++sumSize :: Datum (Sum -> Int)+sumSize = project _Sum _Sum_size++sumTerm :: Datum (Sum -> Term)+sumTerm = project _Sum _Sum_term++termAnnotated :: Datum AnnotatedTerm -> Datum Term+termAnnotated = variant _Term _Term_annotated++tupleProjectionArity :: Datum (TupleProjection -> Int)+tupleProjectionArity = project _TupleProjection _TupleProjection_arity++tupleProjectionIndex :: Datum (TupleProjection -> Int)+tupleProjectionIndex = project _TupleProjection _TupleProjection_index++typeSchemeVariables :: Datum (TypeScheme -> [Name])+typeSchemeVariables = project _TypeScheme _TypeScheme_variables++typeSchemeType :: Datum (TypeScheme -> Type)+typeSchemeType = project _TypeScheme _TypeScheme_type++typedTermTerm :: Datum (TypedTerm -> Term)+typedTermTerm = project _TypedTerm _TypedTerm_term++wrappedTerm :: Datum Name -> Datum Term -> Datum WrappedTerm+wrappedTerm typeName object = Base.record _WrappedTerm [+ _WrappedTerm_typeName>>: typeName,+ _WrappedTerm_object>>: object]++wrappedTermTypeName :: Datum (WrappedTerm -> Name)+wrappedTermTypeName = project _WrappedTerm _WrappedTerm_typeName++wrappedTermObject :: Datum (WrappedTerm -> Term)+wrappedTermObject = project _WrappedTerm _WrappedTerm_object++wrappedType :: Datum Name -> Datum Type -> Datum WrappedType+wrappedType typeName object = Base.record _WrappedType [+ _WrappedType_typeName>>: typeName,+ _WrappedType_object>>: object]++wrappedTypeTypeName :: Datum (WrappedType -> Name)+wrappedTypeTypeName = project _WrappedType _WrappedType_typeName++wrappedTypeObject :: Datum (WrappedType -> Type)+wrappedTypeObject = project _WrappedType _WrappedType_object
+ src/main/haskell/Hydra/Dsl/Expect.hs view
@@ -0,0 +1,321 @@+-- | A DSL for constructing Hydra terms++module Hydra.Dsl.Expect where++import Hydra.Compute+import Hydra.Core+import Hydra.Graph+import Hydra.Strip+import Hydra.Tier1+import Hydra.Tier2+import qualified Hydra.Lib.Flows as Flows++import Prelude hiding (map)+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 qualified Control.Monad as CM+import Data.Int+++bigfloat :: Term -> Flow s Double+bigfloat t = literal t >>= floatLiteral >>= bigfloatValue++bigfloatValue :: FloatValue -> Flow s Double+bigfloatValue v = case v of+ FloatValueBigfloat f -> pure f+ _ -> unexpected "bigfloat" $ show v++bigint :: Term -> Flow s Integer+bigint t = literal t >>= integerLiteral >>= bigintValue++bigintValue :: IntegerValue -> Flow s Integer+bigintValue v = case v of+ IntegerValueBigint i -> pure i+ _ -> unexpected "bigint" $ show v++binary :: Term -> Flow s String+binary t = literal t >>= binaryLiteral++binaryLiteral :: Literal -> Flow s String+binaryLiteral v = case v of+ LiteralBinary b -> pure b+ _ -> unexpected "binary" $ show v++boolean :: Term -> Flow s Bool+boolean t = literal t >>= booleanLiteral++booleanLiteral :: Literal -> Flow s Bool+booleanLiteral v = case v of+ LiteralBoolean b -> pure b+ _ -> unexpected "boolean" $ show v++cases :: Name -> Term -> Flow s (CaseStatement)+cases name term = case strip term of+ TermFunction (FunctionElimination (EliminationUnion cs)) -> if caseStatementTypeName cs == name+ then pure cs+ else unexpected ("case statement for type " ++ unName name) $ show term+ _ -> unexpected "case statement" $ show term++casesCase :: Name -> String -> Term -> Flow s (Field)+casesCase name n term = do+ cs <- cases name term+ let matching = L.filter (\f -> fieldName f == Name n) $ caseStatementCases cs+ if L.null matching+ then fail $ "not enough cases"+ else pure $ L.head matching++field :: Name -> (Term -> Flow s x) -> [Field] -> Flow s x+field fname mapping fields = case L.filter (\f -> fieldName f == fname) fields of+ [] -> fail $ "field " ++ unName fname ++ " not found"+ [f] -> mapping $ fieldTerm f+ _ -> fail $ "multiple fields named " ++ unName fname++float32 :: Term -> Flow s Float+float32 t = literal t >>= floatLiteral >>= float32Value++float32Value :: FloatValue -> Flow s Float+float32Value v = case v of+ FloatValueFloat32 f -> pure f+ _ -> unexpected "float32" $ show v++float64 :: Term -> Flow s Double+float64 t = literal t >>= floatLiteral >>= float64Value++float64Value :: FloatValue -> Flow s Double+float64Value v = case v of+ FloatValueFloat64 f -> pure f+ _ -> unexpected "float64" $ show v++floatLiteral :: Literal -> Flow s FloatValue+floatLiteral lit = case lit of+ LiteralFloat v -> pure v+ _ -> unexpected "floating-point value" $ show lit++inject :: Name -> Term -> Flow s (Field)+inject name term = case strip term of+ TermUnion (Injection name' field) -> if name' == name+ then pure field+ else unexpected ("injection of type " ++ unName name) (unName name')+ _ -> unexpected "injection" $ show term++injection :: Term -> Flow s (Field)+injection term = case strip term of+ TermUnion (Injection _ field) -> pure field+ _ -> unexpected "injection" $ show term++injectionWithName :: Name -> Term -> Flow s (Field)+injectionWithName expected term = case strip term of+ TermUnion (Injection actual field) -> if actual == expected+ then pure field+ else unexpected ("injection of type " ++ unName expected) (unName actual)+ _ -> unexpected "injection" $ show term++int8 :: Term -> Flow s Int8+int8 t = literal t >>= integerLiteral >>= int8Value++int8Value :: IntegerValue -> Flow s Int8+int8Value v = case v of+ IntegerValueInt8 i -> pure i+ _ -> unexpected "int8" $ show v++int16 :: Term -> Flow s Int16+int16 t = literal t >>= integerLiteral >>= int16Value++int16Value :: IntegerValue -> Flow s Int16+int16Value v = case v of+ IntegerValueInt16 i -> pure i+ _ -> unexpected "int16" $ show v++int32 :: Term -> Flow s Int+int32 t = literal t >>= integerLiteral >>= int32Value++int32Value :: IntegerValue -> Flow s Int+int32Value v = case v of+ IntegerValueInt32 i -> pure i+ _ -> unexpected "int32" $ show v++int64 :: Term -> Flow s Int64+int64 t = literal t >>= integerLiteral >>= int64Value++int64Value :: IntegerValue -> Flow s Int64+int64Value v = case v of+ IntegerValueInt64 i -> pure i+ _ -> unexpected "int64" $ show v++integerLiteral :: Literal -> Flow s IntegerValue+integerLiteral lit = case lit of+ LiteralInteger v -> pure v+ _ -> unexpected "integer value" $ show lit++lambda :: Term -> Flow s (Lambda)+lambda term = case strip term of+ TermFunction (FunctionLambda l) -> pure l+ _ -> unexpected "lambda" $ show term++letBinding :: String -> Term -> Flow s (Term)+letBinding n term = do+ bindings <- letBindings <$> letTerm term+ case L.filter (\b -> letBindingName b == Name n) bindings of+ [] -> fail $ "no such binding: " ++ n+ [b] -> pure $ letBindingTerm b+ _ -> fail $ "multiple bindings named " ++ n++lambdaBody :: Term -> Flow s (Term)+lambdaBody term = Hydra.Core.lambdaBody <$> lambda term++letTerm :: Term -> Flow s (Let)+letTerm term = case strip term of+ TermLet lt -> pure lt+ _ -> unexpected "let term" $ show term++list :: (Term -> Flow s x) -> Term -> Flow s [x]+list f term = case strip term of+ TermList l -> CM.mapM f l+ _ -> unexpected "list" $ show term++listHead :: Term -> Flow s (Term)+listHead term = do+ l <- list pure term+ if L.null l+ then fail "empty list"+ else pure $ L.head l++literal :: Term -> Flow s Literal+literal term = case strip term of+ TermLiteral lit -> pure lit+ _ -> unexpected "literal" $ show term++map :: Ord k => (Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (M.Map k v)+map fk fv term = case strip term of+ TermMap m -> M.fromList <$> CM.mapM pair (M.toList m)+ where+ pair (kterm, vterm) = do+ kval <- fk kterm+ vval <- fv vterm+ return (kval, vval)+ _ -> unexpected "map" $ show term++nArgs :: Int -> [Term] -> Flow s ()+nArgs n args = if L.length args /= n+ then unexpected (show n ++ " arguments") $ show (L.length args)+ else pure ()++optCases :: Term -> Flow s (OptionalCases)+optCases term = case strip term of+ TermFunction (FunctionElimination (EliminationOptional cs)) -> pure cs+ _ -> unexpected "optional cases" $ show term++optCasesJust :: Term -> Flow s (Term)+optCasesJust term = optionalCasesJust <$> optCases term++optCasesNothing :: Term -> Flow s (Term)+optCasesNothing term = optionalCasesNothing <$> optCases term++optional :: (Term -> Flow s x) -> Term -> Flow s (Y.Maybe x)+optional f term = case strip term of+ TermOptional mt -> case mt of+ Nothing -> pure Nothing+ Just t -> Just <$> f t+ _ -> unexpected "optional value" $ show term++pair :: (Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (k, v)+pair kf vf term = case strip term of+ TermProduct terms -> case terms of+ [kTerm, vTerm] -> do+ kVal <- kf kTerm+ vVal <- vf vTerm+ return (kVal, vVal)+ _ -> unexpected "pair" $ show term+ _ -> unexpected "product" $ show term++record :: Term -> Flow s [Field]+record term = case strip term of+ TermRecord (Record _ fields) -> pure fields+ _ -> unexpected "record" $ show term++recordWithName :: Name -> Term -> Flow s [Field]+recordWithName expected term = case strip term of+ TermRecord (Record actual fields) -> if actual == expected+ then pure fields+ else unexpected ("record of type " ++ unName expected) (unName actual)+ _ -> unexpected "record" $ show term++set :: Ord x => (Term -> Flow s x) -> Term -> Flow s (S.Set x)+set f term = case strip term of+ TermSet s -> S.fromList <$> CM.mapM f (S.toList s)+ _ -> unexpected "set" $ show term++string :: Term -> Flow s String+string t = literal t >>= stringLiteral++stringLiteral :: Literal -> Flow s String+stringLiteral v = case v of+ LiteralString s -> pure s+ _ -> unexpected "string" $ show v++strip :: Term -> Term+strip term = case stripTerm term of+ TermTyped (TypedTerm term1 _) -> strip term1+ t -> t++uint8 :: Term -> Flow s Int16+uint8 t = literal t >>= integerLiteral >>= uint8Value++uint8Value :: IntegerValue -> Flow s Int16+uint8Value v = case v of+ IntegerValueUint8 i -> pure i+ _ -> unexpected "uint8" $ show v++uint16 :: Term -> Flow s Int+uint16 t = literal t >>= integerLiteral >>= uint16Value++uint16Value :: IntegerValue -> Flow s Int+uint16Value v = case v of+ IntegerValueUint16 i -> pure i+ _ -> unexpected "uint16" $ show v++uint32 :: Term -> Flow s Int64+uint32 t = literal t >>= integerLiteral >>= uint32Value++uint32Value :: IntegerValue -> Flow s Int64+uint32Value v = case v of+ IntegerValueUint32 i -> pure i+ _ -> unexpected "uint32" $ show v++uint64 :: Term -> Flow s Integer+uint64 t = literal t >>= integerLiteral >>= uint64Value++uint64Value :: IntegerValue -> Flow s Integer+uint64Value v = case v of+ IntegerValueUint64 i -> pure i+ _ -> unexpected "uint64" $ show v++unit :: Term -> Flow s ()+unit term = do+ fields <- recordWithName _Unit term+ if L.null fields+ then pure ()+ else unexpected "unit" $ show term++unitVariant :: Name -> Term -> Flow s Name+unitVariant tname term = do+ field <- variant tname term+ unit $ fieldTerm field+ pure $ fieldName field++variable :: Term -> Flow s Name+variable term = case strip term of+ TermVariable name -> pure name+ _ -> unexpected "variable" $ show term++variant :: Name -> Term -> Flow s (Field)+variant = injectionWithName++wrap :: Name -> Term -> Flow s (Term)+wrap expected term = case strip term of+ TermWrap (WrappedTerm actual term) -> if actual == expected+ then pure term+ else unexpected ("wrapper of type " ++ unName expected) (unName actual)+ _ -> unexpected ("wrap(" ++ unName expected ++ ")") $ show term
+ src/main/haskell/Hydra/Dsl/Grammars.hs view
@@ -0,0 +1,59 @@+-- | A DSL for building BNF grammars++module Hydra.Dsl.Grammars where++import qualified Hydra.Grammar as G++import Data.String(IsString(..))+++instance IsString G.Pattern where fromString = symbol++infixr 0 >:+(>:) :: String -> G.Pattern -> G.Pattern+l >: p = G.PatternLabeled $ G.LabeledPattern (G.Label l) p++alts :: [G.Pattern] -> G.Pattern+alts = G.PatternAlternatives++define :: String -> [G.Pattern] -> G.Production+define s pats = G.Production (G.Symbol s) pat+ where+ pat = case pats of+ [p] -> p+ _ -> alts pats++ignored :: G.Pattern -> G.Pattern+ignored = G.PatternIgnored++list :: [G.Pattern] -> G.Pattern+list = G.PatternSequence++nil :: G.Pattern+nil = G.PatternNil++opt :: G.Pattern -> G.Pattern+opt = G.PatternOption++plus :: G.Pattern -> G.Pattern+plus = G.PatternPlus++regex :: String -> G.Pattern+regex = G.PatternRegex . G.Regex++-- | A helper which matches patterns like "foo.bar.quux" or "one; two; three; four"+sep :: G.Pattern -> G.Pattern -> G.Pattern+sep separator pat = list[pat, star(list[separator, pat])]++-- | A helper which matches patterns like "foo.bar.quux" or "foo.bar.quux." (i.e. trailing separators are allowed)+sepp :: G.Pattern -> G.Pattern -> G.Pattern+sepp separator pat = list[pat, star(list[separator, pat]), opt(separator)]++star :: G.Pattern -> G.Pattern+star = G.PatternStar++symbol :: String -> G.Pattern+symbol = G.PatternNonterminal . G.Symbol++terminal :: String -> G.Pattern+terminal = G.PatternConstant . G.Constant
+ src/main/haskell/Hydra/Dsl/Graph.hs view
@@ -0,0 +1,40 @@+module Hydra.Dsl.Graph where++import Hydra.Kernel+import Hydra.Dsl.Base as Base++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+graph elements environment types body primitives schema = record _Graph [+ _Graph_elements>>: elements,+ _Graph_environment>>: environment,+ _Graph_types>>: types,+ _Graph_body>>: body,+ _Graph_primitives>>: primitives,+ _Graph_schema>>: schema]++graphElements :: Datum (Graph -> M.Map Name Element)+graphElements = project _Graph _Graph_elements++graphEnvironment :: Datum (Graph -> M.Map Name (Maybe Term))+graphEnvironment = project _Graph _Graph_environment++graphTypes :: Datum (Graph -> M.Map Name Type)+graphTypes = project _Graph _Graph_types++graphBody :: Datum (Graph -> Term)+graphBody = project _Graph _Graph_body++graphPrimitives :: Datum (Graph -> M.Map Name Primitive)+graphPrimitives = project _Graph _Graph_primitives++graphSchema :: Datum (Graph -> Maybe Graph)+graphSchema = project _Graph _Graph_schema
+ src/main/haskell/Hydra/Dsl/Lib/Equality.hs view
@@ -0,0 +1,75 @@+module Hydra.Dsl.Lib.Equality where++import Hydra.Core+import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms++import Data.Int+++equalBinary :: Datum (String -> String -> Bool)+equalBinary = Datum $ Terms.primitive _equality_equalBinary++equalBoolean :: Datum (Bool -> Bool -> Bool)+equalBoolean = Datum $ Terms.primitive _equality_equalBoolean++equalBigfloat :: Datum (Double -> Double -> Bool)+equalBigfloat = Datum $ Terms.primitive _equality_equalBigfloat++equalFloat32 :: Datum (Float -> Float -> Bool)+equalFloat32 = Datum $ Terms.primitive _equality_equalFloat32++equalFloat64 :: Datum (Double -> Double -> Bool)+equalFloat64 = Datum $ Terms.primitive _equality_equalFloat64++equalBigint :: Datum (Integer -> Integer -> Bool)+equalBigint = Datum $ Terms.primitive _equality_equalBigint++equalInt8 :: Datum (Int8 -> Int8 -> Bool)+equalInt8 = Datum $ Terms.primitive _equality_equalInt8++equalInt16 :: Datum (Int16 -> Int16 -> Bool)+equalInt16 = Datum $ Terms.primitive _equality_equalInt16++equalInt32 :: Datum (Int -> Int -> Bool)+equalInt32 = Datum $ Terms.primitive _equality_equalInt32++equalInt64 :: Datum (Int64 -> Int64 -> Bool)+equalInt64 = Datum $ Terms.primitive _equality_equalInt64++equalString :: Datum (String -> String -> Bool)+equalString = Datum $ Terms.primitive _equality_equalString++equalTerm :: Datum (Term -> Term -> Bool)+equalTerm = Datum $ Terms.primitive _equality_equalTerm++equalType :: Datum (Type -> Type -> Bool)+equalType = Datum $ Terms.primitive _equality_equalType++equalUint8 :: Datum (Int16 -> Int16 -> Bool)+equalUint8 = Datum $ Terms.primitive _equality_equalUint8++equalUint16 :: Datum (Int -> Int -> Bool)+equalUint16 = Datum $ Terms.primitive _equality_equalUint16++equalUint32 :: Datum (Int64 -> Int64 -> Bool)+equalUint32 = Datum $ Terms.primitive _equality_equalUint32++equalUint64 :: Datum (Integer -> Integer -> Bool)+equalUint64 = Datum $ Terms.primitive _equality_equalUint64++identity :: Datum (x -> x)+identity = Datum $ Terms.primitive _equality_identity++gtInt32 :: Datum (Int -> Int -> Bool)+gtInt32 = Datum $ Terms.primitive _equality_gtInt32++gteInt32 :: Datum (Int -> Int -> Bool)+gteInt32 = Datum $ Terms.primitive _equality_gteInt32++ltInt32 :: Datum (Int -> Int -> Bool)+ltInt32 = Datum $ Terms.primitive _equality_ltInt32++lteInt32 :: Datum (Int -> Int -> Bool)+lteInt32 = Datum $ Terms.primitive _equality_lteInt32
+ src/main/haskell/Hydra/Dsl/Lib/Flows.hs view
@@ -0,0 +1,67 @@+module Hydra.Dsl.Lib.Flows where++import Hydra.Dsl.Base+import Hydra.Core+import Hydra.Compute+import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types++import qualified Data.Map as M+++-- Primitives++apply :: Datum (Flow s (x -> y) -> Flow s x -> Flow s y)+apply = Datum $ Terms.primitive _flows_apply++bind :: Datum (Flow s x -> (x -> Flow s y) -> Flow s y)+bind = Datum $ Terms.primitive _flows_bind++fail :: Datum (String -> Flow s x)+fail = Datum $ Terms.primitive _flows_fail++map :: Datum ((x -> y) -> Flow s x -> Flow s y)+map = Datum $ Terms.primitive _flows_map++mapList :: Datum ((x -> Flow s y) -> [x] -> Flow s [y])+mapList = Datum $ Terms.primitive _flows_mapList++pure :: Datum (x -> Flow s x)+pure = Datum $ Terms.primitive _flows_pure++-- Accessors++flowState :: Datum (Maybe x) -> Datum s -> Datum Trace -> Datum (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 = project _FlowState _FlowState_state++flowStateTrace :: Datum (FlowState s x -> Trace)+flowStateTrace = project _FlowState _FlowState_trace++flowStateValue :: Datum (FlowState s x -> Maybe x)+flowStateValue = project _FlowState _FlowState_value++trace :: Datum [String] -> Datum [String] -> Datum (M.Map String (Term)) -> Datum Trace+trace stack messages other = record _Trace [+ _Trace_stack>>: stack,+ _Trace_messages>>: messages,+ _Trace_other>>: other]+ +traceStack :: Datum (Trace -> [String])+traceStack = project _Trace _Trace_stack++traceMessages :: Datum (Trace -> [String])+traceMessages = project _Trace _Trace_messages++traceOther :: Datum (Trace -> M.Map String (Term))+traceOther = project _Trace _Trace_other++unFlow :: Datum (Flow s x -> s -> Trace -> FlowState s x)+unFlow = unwrap _Flow
+ src/main/haskell/Hydra/Dsl/Lib/Io.hs view
@@ -0,0 +1,13 @@+module Hydra.Dsl.Lib.Io where++import Hydra.Core+import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++showTerm :: Datum (Term -> String)+showTerm = Datum $ Terms.primitive _io_showTerm++showType :: Datum (Type -> String)+showType = Datum $ Terms.primitive _io_showType
+ src/main/haskell/Hydra/Dsl/Lib/Lists.hs view
@@ -0,0 +1,54 @@+module Hydra.Dsl.Lib.Lists where++import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++concat :: Datum ([[a]] -> [a])+concat = Datum $ Terms.primitive _lists_concat++concat2 :: Datum ([a] -> [a] -> [a])+concat2 = Datum $ Terms.primitive _lists_concat2++cons :: Datum (a -> [a] -> [a])+cons = Datum $ Terms.primitive _lists_cons++foldl :: Datum ((b -> a -> b) -> b -> [a] -> b)+foldl = Datum $ Terms.primitive _lists_foldl++head :: Datum ([a] -> a)+head = Datum $ Terms.primitive _lists_head++intercalate :: Datum ([a] -> [[a]] -> [a])+intercalate = Datum $ Terms.primitive _lists_intercalate++intersperse :: Datum ([a] -> a -> [a])+intersperse = Datum $ Terms.primitive _lists_intersperse++last :: Datum ([a] -> a)+last = Datum $ Terms.primitive _lists_last++length :: Datum ([a] -> Int)+length = Datum $ Terms.primitive _lists_length++map :: Datum ((a -> b) -> [a] -> [b])+map = Datum $ Terms.primitive _lists_map++nub :: Eq a => Datum ([a] -> [a])+nub = Datum $ Terms.primitive _lists_nub++null :: Datum ([a] -> Bool)+null = Datum $ Terms.primitive _lists_null++pure :: Datum (a -> [a])+pure = Datum $ Terms.primitive _lists_pure++reverse :: Datum ([a] -> [a])+reverse = Datum $ Terms.primitive _lists_reverse++safeHead :: Datum ([a] -> Maybe a)+safeHead = Datum $ Terms.primitive _lists_safeHead++tail :: Datum ([a] -> [a])+tail = Datum $ Terms.primitive _lists_tail
+ src/main/haskell/Hydra/Dsl/Lib/Literals.hs view
@@ -0,0 +1,80 @@+module Hydra.Dsl.Lib.Literals where++import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms++import Data.Int+++bigfloatToBigint :: Datum (Double -> Double)+bigfloatToBigint = Datum $ Terms.primitive _literals_bigfloatToBigint++bigfloatToFloat32 :: Datum (Double -> Float)+bigfloatToFloat32 = Datum $ Terms.primitive _literals_bigfloatToFloat32++bigfloatToFloat64 :: Datum (Double -> Double)+bigfloatToFloat64 = Datum $ Terms.primitive _literals_bigfloatToFloat64++bigintToBigfloat :: Datum (Integer -> Double)+bigintToBigfloat = Datum $ Terms.primitive _literals_bigintToBigfloat++bigintToInt8 :: Datum (Integer -> Int8)+bigintToInt8 = Datum $ Terms.primitive _literals_bigintToInt8++bigintToInt16 :: Datum (Integer -> Int16)+bigintToInt16 = Datum $ Terms.primitive _literals_bigintToInt16++bigintToInt32 :: Datum (Integer -> Int)+bigintToInt32 = Datum $ Terms.primitive _literals_bigintToInt32++bigintToInt64 :: Datum (Integer -> Int64)+bigintToInt64 = Datum $ Terms.primitive _literals_bigintToInt64++bigintToUint8 :: Datum (Integer -> Int16)+bigintToUint8 = Datum $ Terms.primitive _literals_bigintToUint8++bigintToUint16 :: Datum (Integer -> Int)+bigintToUint16 = Datum $ Terms.primitive _literals_bigintToUint16++bigintToUint32 :: Datum (Integer -> Int64)+bigintToUint32 = Datum $ Terms.primitive _literals_bigintToUint32++bigintToUint64 :: Datum (Integer -> Integer)+bigintToUint64 = Datum $ Terms.primitive _literals_bigintToUint64++float32ToBigfloat :: Datum (Float -> Double)+float32ToBigfloat = Datum $ Terms.primitive _literals_float32ToBigfloat++float64ToBigfloat :: Datum (Double -> Double)+float64ToBigfloat = Datum $ Terms.primitive _literals_float64ToBigfloat++int8ToBigint :: Datum (Int8 -> Integer)+int8ToBigint = Datum $ Terms.primitive _literals_int8ToBigint++int16ToBigint :: Datum (Int16 -> Integer)+int16ToBigint = Datum $ Terms.primitive _literals_int16ToBigint++int32ToBigint :: Datum (Int -> Integer)+int32ToBigint = Datum $ Terms.primitive _literals_int32ToBigint++int64ToBigint :: Datum (Int64 -> Integer)+int64ToBigint = Datum $ Terms.primitive _literals_int64ToBigint++showInt32 :: Datum (Int -> String)+showInt32 = Datum $ Terms.primitive _literals_showInt32++showString :: Datum (String -> String)+showString = Datum $ Terms.primitive _literals_showString++uint8ToBigint :: Datum (Int16 -> Integer)+uint8ToBigint = Datum $ Terms.primitive _literals_uint8ToBigint++uint16ToBigint :: Datum (Int -> Integer)+uint16ToBigint = Datum $ Terms.primitive _literals_uint16ToBigint++uint32ToBigint :: Datum (Int64 -> Integer)+uint32ToBigint = Datum $ Terms.primitive _literals_uint32ToBigint++uint64ToBigint :: Datum (Integer -> Integer)+uint64ToBigint = Datum $ Terms.primitive _literals_uint64ToBigint
+ src/main/haskell/Hydra/Dsl/Lib/Logic.hs view
@@ -0,0 +1,19 @@+module Hydra.Dsl.Lib.Logic where++import Hydra.Core+import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++and :: Datum (Bool -> Bool -> Bool)+and = Datum $ Terms.primitive _logic_and++ifElse :: Datum (a -> a -> Bool -> a)+ifElse = Datum $ Terms.primitive _logic_ifElse++not :: Datum (Bool -> Bool)+not = Datum $ Terms.primitive _logic_not++or :: Datum (Bool -> Bool -> Bool)+or = Datum $ Terms.primitive _logic_or
+ src/main/haskell/Hydra/Dsl/Lib/Maps.hs view
@@ -0,0 +1,47 @@+module Hydra.Dsl.Lib.Maps where++import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms++import Data.Map+++empty :: Datum (Map k v)+empty = Datum $ Terms.primitive _maps_empty++fromList :: Datum ([(k, v)] -> Map k v)+fromList = Datum $ Terms.primitive _maps_fromList++insert :: Datum (k -> v -> Map k v -> Map k v)+insert = Datum $ Terms.primitive _maps_insert++isEmpty :: Datum (Map k v -> Bool)+isEmpty = Datum $ Terms.primitive _maps_isEmpty++keys :: Datum (Map k v -> [k])+keys = Datum $ Terms.primitive _maps_keys++lookup :: Datum (k -> Map k v -> Maybe v)+lookup = Datum $ Terms.primitive _maps_lookup++map :: Datum ((v1 -> v2) -> Map k v1 -> Map k v2)+map = Datum $ Terms.primitive _maps_map++mapKeys :: Datum ((k1 -> k2) -> Map k1 v -> Map k2 v)+mapKeys = Datum $ Terms.primitive _maps_mapKeys++remove :: Datum (k -> Map k v -> Map k v)+remove = Datum $ Terms.primitive _maps_remove++singleton :: Datum (k -> v -> Map k v)+singleton = Datum $ Terms.primitive _maps_singleton++size :: Datum (Map k v -> Int)+size = Datum $ Terms.primitive _maps_size++toList :: Datum (Map k v -> [(k, v)])+toList = Datum $ Terms.primitive _maps_toList++values :: Datum (Map k v -> [v])+values = Datum $ Terms.primitive _maps_values
+ src/main/haskell/Hydra/Dsl/Lib/Math.hs view
@@ -0,0 +1,27 @@+module Hydra.Dsl.Lib.Math where++import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++add :: Datum (Int -> Int -> Int)+add = Datum $ Terms.primitive _math_add++div :: Datum (Int -> Int -> Int)+div = Datum $ Terms.primitive _math_div++mod :: Datum (Int -> Int -> Int)+mod = Datum $ Terms.primitive _math_mod++mul :: Datum (Int -> Int -> Int)+mul = Datum $ Terms.primitive _math_mul++neg :: Datum (Int -> Int)+neg = Datum $ Terms.primitive _math_neg++rem :: Datum (Int -> Int -> Int)+rem = Datum $ Terms.primitive _math_rem++sub :: Datum (Int -> Int -> Int)+sub = Datum $ Terms.primitive _math_sub
+ src/main/haskell/Hydra/Dsl/Lib/Optionals.hs view
@@ -0,0 +1,33 @@+module Hydra.Dsl.Lib.Optionals where++import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++apply :: Datum (Maybe (a -> b) -> Maybe a -> Maybe b)+apply = Datum $ Terms.primitive _optionals_apply++bind :: Datum (Maybe a -> (a -> Maybe b) -> Maybe b)+bind = Datum $ Terms.primitive _optionals_bind++cat :: Datum ([Maybe a] -> [a])+cat = Datum $ Terms.primitive _optionals_cat++fromMaybe :: Datum (a -> Maybe a -> a)+fromMaybe = Datum $ Terms.primitive _optionals_fromMaybe++isJust :: Datum (Maybe a -> Bool)+isJust = Datum $ Terms.primitive _optionals_isJust++isNothing :: Datum (Maybe a -> Bool)+isNothing = Datum $ Terms.primitive _optionals_isNothing++map :: Datum ((a -> b) -> Maybe a -> Maybe b)+map = Datum $ Terms.primitive _optionals_map++maybe :: Datum (b -> (a -> b) -> Maybe a -> b)+maybe = Datum $ Terms.primitive _optionals_maybe++pure :: Datum (a -> Maybe a)+pure = Datum $ Terms.primitive _optionals_pure
+ src/main/haskell/Hydra/Dsl/Lib/Sets.hs view
@@ -0,0 +1,47 @@+module Hydra.Dsl.Lib.Sets where++import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms++import Data.Set+++contains :: Datum (a -> Set a -> Bool)+contains = Datum $ Terms.primitive _sets_contains++difference :: Datum (Set a -> Set a -> Set a)+difference = Datum $ Terms.primitive _sets_difference++empty :: Datum (Set a)+empty = Datum $ Terms.primitive _sets_empty++fromList :: Datum ([a] -> Set a)+fromList = Datum $ Terms.primitive _sets_fromList++insert :: Datum (a -> Set a -> Set a)+insert = Datum $ Terms.primitive _sets_insert++intersection :: Datum (Set a -> Set a -> Set a)+intersection = Datum $ Terms.primitive _sets_intersection++isEmpty :: Datum (Set a -> Bool)+isEmpty = Datum $ Terms.primitive _sets_isEmpty++map :: Datum ((a -> b) -> Set a -> Set b)+map = Datum $ Terms.primitive _sets_map++remove :: Datum (a -> Set a -> Set a)+remove = Datum $ Terms.primitive _sets_remove++singleton :: Datum (a -> Set a)+singleton = Datum $ Terms.primitive _sets_singleton++size :: Datum (Set a -> Int)+size = Datum $ Terms.primitive _sets_size++toList :: Datum (Set a -> [a])+toList = Datum $ Terms.primitive _sets_toList++union :: Datum (Set a -> Set a -> Set a)+union = Datum $ Terms.primitive _sets_union
+ src/main/haskell/Hydra/Dsl/Lib/Strings.hs view
@@ -0,0 +1,45 @@+module Hydra.Dsl.Lib.Strings where++import Hydra.Dsl.Base+import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++(++) :: Datum String -> Datum String -> Datum String+l ++ r = (Datum $ Terms.primitive _strings_cat) @@ (list [l, r])++cat :: Datum ([String] -> String)+cat = Datum $ Terms.primitive _strings_cat++cat2 :: Datum (String -> String -> String)+cat2 = Datum $ Terms.primitive _strings_cat2++fromList :: Datum ([Int] -> String)+fromList = Datum $ Terms.primitive _strings_fromList++intercalate :: Datum (String -> [String] -> String)+intercalate = Datum $ Terms.primitive _strings_intercalate++isEmpty :: Datum (String -> Bool)+isEmpty = Datum $ Terms.primitive _strings_isEmpty++length :: Datum (String -> Int)+length = Datum $ Terms.primitive _strings_length++splitOn :: Datum (String -> String -> [String])+splitOn = Datum $ Terms.primitive _strings_splitOn++toList :: Datum (String -> [Int])+toList = Datum $ Terms.primitive _strings_toList++toLower :: Datum (String -> String)+toLower = Datum $ Terms.primitive _strings_toLower++toUpper :: Datum (String -> String)+toUpper = Datum $ Terms.primitive _strings_toUpper++-- Helpers++concat :: [Datum String] -> Datum String+concat strings = (Datum $ Terms.primitive _strings_cat) @@ list strings
+ src/main/haskell/Hydra/Dsl/Literals.hs view
@@ -0,0 +1,59 @@+-- | A DSL for constructing literal values++module Hydra.Dsl.Literals where++import Hydra.Core++import Data.Int+++bigfloat :: Double -> Literal+bigfloat = float . FloatValueBigfloat++bigint :: Integer -> Literal+bigint = integer . IntegerValueBigint . fromIntegral++binary :: String -> Literal+binary = LiteralBinary++boolean :: Bool -> Literal+boolean = LiteralBoolean++float32 :: Float -> Literal+float32 = float . FloatValueFloat32++float64 :: Double -> Literal+float64 = float . FloatValueFloat64++float :: FloatValue -> Literal+float = LiteralFloat++int16 :: Int16 -> Literal+int16 = integer . IntegerValueInt16 . fromIntegral++int32 :: Int -> Literal+int32 = integer . IntegerValueInt32++int64 :: Int64 -> Literal+int64 = integer . IntegerValueInt64 . fromIntegral++int8 :: Int8 -> Literal+int8 = integer . IntegerValueInt8 . fromIntegral++integer :: IntegerValue -> Literal+integer = LiteralInteger++string :: String -> Literal+string = LiteralString++uint16 :: Int -> Literal+uint16 = integer . IntegerValueUint16 . fromIntegral++uint32 :: Int64 -> Literal+uint32 = integer . IntegerValueUint32 . fromIntegral++uint64 :: Integer -> Literal+uint64 = integer . IntegerValueUint64 . fromIntegral++uint8 :: Int16 -> Literal+uint8 = integer . IntegerValueUint8 . fromIntegral
+ src/main/haskell/Hydra/Dsl/Module.hs view
@@ -0,0 +1,16 @@+module Hydra.Dsl.Module where++import Hydra.Kernel+import Hydra.Dsl.Base as Base+++qualifiedName :: Datum (Maybe Namespace) -> Datum String -> Datum QualifiedName+qualifiedName ns local = record _QualifiedName [+ _QualifiedName_namespace>>: ns,+ _QualifiedName_local>>: local]++qualifiedNameLocal :: Datum (QualifiedName -> String)+qualifiedNameLocal = project _QualifiedName _QualifiedName_local++qualifiedNameNamespace :: Datum (QualifiedName -> Maybe Namespace)+qualifiedNameNamespace = project _QualifiedName _QualifiedName_namespace
+ src/main/haskell/Hydra/Dsl/PhantomLiterals.hs view
@@ -0,0 +1,78 @@+-- | A DSL for constructing literal terms using Haskell's built-in datatypes++module Hydra.Dsl.PhantomLiterals where++import Hydra.Phantoms+import qualified Hydra.Dsl.Terms as Terms++import Data.Int+++-- Note: does not yet properly capture arbitrary-precision floating-point numbers,+-- because code generation does not.+type Bigfloat = Double++-- Note: does not distinguish Binary from String, because code generation does not.+type Binary = String++bigfloat :: Bigfloat -> Datum Bigfloat+bigfloat = Datum . Terms.bigfloat++bigint :: Integer -> Datum Integer+bigint = Datum . Terms.bigint++binary :: Binary -> Datum Binary+binary = Datum . Terms.binary++bool :: Bool -> Datum Bool+bool = Datum . Terms.boolean++boolean :: Bool -> Datum Bool+boolean = bool++double :: Double -> Datum Double+double = float64++false :: Datum Bool+false = bool False++float :: Float -> Datum Float+float = float32++float32 :: Float -> Datum Float+float32 = Datum . Terms.float32++float64 :: Double -> Datum Double+float64 = Datum . Terms.float64++int :: Int -> Datum Int+int = int32++int8 :: Int8 -> Datum Int8+int8 = Datum . Terms.int8++int16 :: Int16 -> Datum Int16+int16 = Datum . Terms.int16++int32 :: Int -> Datum Int+int32 = Datum . Terms.int32++int64 :: Int64 -> Datum Int64+int64 = Datum . Terms.int64++string :: String -> Datum String+string = Datum . Terms.string++true :: Datum 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+uint16 :: Int16 -> Datum Int16+uint16 = int16+uint32 :: Int -> Datum Int+uint32 = int+uint64 :: Int64 -> Datum Int64+uint64 = int64
+ src/main/haskell/Hydra/Dsl/Prims.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE FlexibleInstances #-} -- for IsString with nontrivial parameters++-- | A DSL for constructing primitive function definitions+module Hydra.Dsl.Prims where++import Hydra.Compute+import Hydra.Core+import Hydra.Graph+import Hydra.CoreDecoding+import Hydra.CoreEncoding+import qualified Hydra.Dsl.Expect as Expect+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types++import Data.Int+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 (removeTermAnnotations)+import Data.String(IsString(..))++instance IsString (TermCoder (Term)) where fromString = variable++bigfloat :: TermCoder Double+bigfloat = TermCoder Types.bigfloat $ Coder encode decode+ where+ encode = Expect.bigfloat+ decode = pure . Terms.bigfloat++bigint :: TermCoder Integer+bigint = TermCoder Types.bigint $ Coder encode decode+ where+ encode = Expect.bigint+ decode = pure . Terms.bigint++binary :: TermCoder String+binary = TermCoder Types.binary $ Coder encode decode+ where+ encode = Expect.binary+ decode = pure . Terms.binary++boolean :: TermCoder Bool+boolean = TermCoder Types.boolean $ Coder encode decode+ where+ encode = Expect.boolean+ decode = pure . Terms.boolean++float32 :: TermCoder Float+float32 = TermCoder Types.float32 $ Coder encode decode+ where+ encode = Expect.float32+ decode = pure . Terms.float32++float64 :: TermCoder Double+float64 = TermCoder Types.float64 $ Coder encode decode+ where+ encode = Expect.float64+ decode = pure . Terms.float64++flow :: TermCoder s -> TermCoder x -> TermCoder (Flow s x)+flow states values = TermCoder (TypeVariable _Flow Types.@@ (termCoderType states) Types.@@ (termCoderType values)) $+ Coder encode decode+ where+ encode _ = fail $ "cannot currently encode flows from terms"+ decode _ = fail $ "cannot decode flows to terms"++function :: TermCoder x -> TermCoder y -> TermCoder (x -> y)+function dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) $ Coder encode decode+ where+ encode term = fail $ "cannot encode terms to functions"+ decode _ = fail $ "cannot decode functions to terms"++int8 :: TermCoder Int8+int8 = TermCoder Types.int8 $ Coder encode decode+ where+ encode = Expect.int8+ decode = pure . Terms.int8++int16 :: TermCoder Int16+int16 = TermCoder Types.int16 $ Coder encode decode+ where+ encode = Expect.int16+ decode = pure . Terms.int16++int32 :: TermCoder Int+int32 = TermCoder Types.int32 $ Coder encode decode+ where+ encode = Expect.int32+ decode = pure . Terms.int32++int64 :: TermCoder Int64+int64 = TermCoder Types.int64 $ Coder encode decode+ where+ encode = Expect.int64+ decode = pure . Terms.int64++list :: TermCoder x -> TermCoder [x]+list els = TermCoder (Types.list $ termCoderType els) $ Coder encode decode+ where+ encode = Expect.list (coderEncode $ termCoderCoder els)+ decode l = Terms.list <$> mapM (coderDecode $ termCoderCoder els) l++map :: Ord k => TermCoder k -> TermCoder v -> TermCoder (M.Map k v)+map keys values = TermCoder (Types.map (termCoderType keys) (termCoderType values)) $ Coder encode decode+ where+ encode = Expect.map (coderEncode $ termCoderCoder keys) (coderEncode $ termCoderCoder values)+ decode m = Terms.map . M.fromList <$> mapM decodePair (M.toList m)+ where+ decodePair (k, v) = do+ ke <- (coderDecode $ termCoderCoder keys) k+ ve <- (coderDecode $ termCoderCoder values) v+ return (ke, ve)++optional :: TermCoder x -> TermCoder (Y.Maybe x)+optional mel = TermCoder (Types.optional $ termCoderType mel) $ Coder encode decode+ where+ encode = Expect.optional (coderEncode $ termCoderCoder mel)+ decode mv = Terms.optional <$> case mv of+ Nothing -> pure Nothing+ Just v -> Just <$> (coderDecode $ termCoderCoder mel) v++pair :: TermCoder k -> TermCoder v -> TermCoder (k, v)+pair kCoder vCoder = TermCoder (Types.product [termCoderType kCoder, termCoderType vCoder]) $ Coder encode decode+ where+ encode = Expect.pair (coderEncode $ termCoderCoder kCoder) (coderEncode $ termCoderCoder vCoder)+ decode (k, v) = do+ kTerm <- coderDecode (termCoderCoder kCoder) k+ 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+ where+ impl _ = coderDecode (termCoderCoder output) value++prim1 :: Name -> TermCoder x -> TermCoder y -> (x -> y) -> Primitive+prim1 name input1 output compute = Primitive name ft impl+ where+ ft = 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+ where+ ft = 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+ where+ ft = 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+ where+ ft = 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)+ arg2 <- coderEncode (termCoderCoder input2) (args !! 1)+ arg3 <- coderEncode (termCoderCoder input3) (args !! 2)+ coderDecode (termCoderCoder output) $ compute arg1 arg2 arg3++set :: Ord x => TermCoder x -> TermCoder (S.Set x)+set els = TermCoder (Types.set $ termCoderType els) $ Coder encode decode+ where+ encode = Expect.set (coderEncode $ termCoderCoder els)+ decode s = Terms.set . S.fromList <$> mapM (coderDecode $ termCoderCoder els) (S.toList s)++string :: TermCoder String+string = TermCoder Types.string $ Coder encode decode+ where+ encode = Expect.string+ decode = pure . Terms.string++term :: TermCoder (Term)+term = TermCoder (Types.apply (TypeVariable _Term) (Types.var "a")) $ Coder encode decode+ where+ encode = pure+ decode = pure++type_ :: TermCoder (Type)+type_ = TermCoder (Types.apply (TypeVariable _Type) (Types.var "a")) $ Coder encode decode+ where+ encode = coreDecodeType+ decode = pure . coreEncodeType++uint8 :: TermCoder Int16+uint8 = TermCoder Types.uint8 $ Coder encode decode+ where+ encode = Expect.uint8+ decode = pure . Terms.uint8++uint16 :: TermCoder Int+uint16 = TermCoder Types.uint16 $ Coder encode decode+ where+ encode = Expect.uint16+ decode = pure . Terms.uint16++uint32 :: TermCoder Int64+uint32 = TermCoder Types.uint32 $ Coder encode decode+ where+ encode = Expect.uint32+ decode = pure . Terms.uint32++uint64 :: TermCoder Integer+uint64 = TermCoder Types.uint64 $ Coder encode decode+ where+ encode = Expect.uint64+ decode = pure . Terms.uint64++variable :: String -> TermCoder (Term)+variable v = TermCoder (Types.var v) $ Coder encode decode+ where+ encode = pure+ decode = pure
+ src/main/haskell/Hydra/Dsl/ShorthandTypes.hs view
@@ -0,0 +1,86 @@+module Hydra.Dsl.ShorthandTypes where++import Hydra.Coders+import Hydra.Core+import Hydra.Compute+import Hydra.Graph+import Hydra.Mantle+import Hydra.Module+import qualified Hydra.Dsl.Types as Types++import qualified Data.Map as M+import qualified Data.Set as S+++eqA = (M.fromList [(Name "a", S.fromList [TypeClassEquality])])+ordA = (M.fromList [(Name "a", S.fromList [TypeClassOrdering])])++aT = Types.var "a" :: Type+annotatedTermT = TypeVariable _AnnotatedTerm :: Type+annotatedTypeT = TypeVariable _AnnotatedType :: Type+applicationT = TypeVariable _Application :: Type+applicationTypeT = TypeVariable _ApplicationType :: Type+booleanT = Types.boolean+caseStatementT = TypeVariable _CaseStatement :: Type+elementT = TypeVariable _Element :: Type+eliminationT = TypeVariable _Elimination :: Type+eliminationVariantT = TypeVariable _EliminationVariant :: Type+fieldT = TypeVariable _Field :: Type+fieldNameT = TypeVariable _Name :: Type+fieldTypeT = TypeVariable _FieldType :: Type+fileExtensionT = TypeVariable _FileExtension :: Type+floatTypeT = TypeVariable _FloatType :: Type+floatValueT = TypeVariable _FloatValue :: Type+flowS1AT = flowT (Types.var "s1") aT :: Type+flowS2AT = flowT (Types.var "s2") aT :: Type+flowSAT = flowT sT aT :: Type+flowSST = flowT sT sT :: Type+flowStateT s x = Types.apply (Types.apply (TypeVariable _FlowState) s) x+flowT s x = Types.apply (Types.apply (TypeVariable _Flow) s) x+funT = Types.function+functionT = TypeVariable _Function :: Type+functionTypeT = TypeVariable _FunctionType :: Type+functionVariantT = TypeVariable _FunctionVariant :: Type+graphT = TypeVariable _Graph :: Type+injectionT = TypeVariable _Injection :: Type+int32T = Types.int32+integerTypeT = TypeVariable _IntegerType :: Type+integerValueT = TypeVariable _IntegerValue :: Type+kvT = mapT stringT termT :: Type+lambdaT = TypeVariable _Lambda :: Type+lambdaTypeT = TypeVariable _LambdaType :: Type+languageT = TypeVariable _Language :: Type+letT = TypeVariable _Let :: Type+letBindingT = TypeVariable _LetBinding :: Type+listT = Types.list+literalT = TypeVariable _Literal :: Type+literalTypeT = TypeVariable _LiteralType :: Type+literalVariantT = TypeVariable _LiteralVariant :: Type+mapT = Types.map+mapTypeT = TypeVariable _MapType :: Type+nameT = TypeVariable _Name+namespaceT = TypeVariable _Namespace+optionalT = Types.optional+optionalCasesT = TypeVariable _OptionalCases :: Type+pairT = Types.pair+precisionT = TypeVariable _Precision :: Type+primitiveT = TypeVariable _Primitive :: Type+projectionT = TypeVariable _Projection :: Type+qualifiedNameT = TypeVariable _QualifiedName+recordT = TypeVariable _Record :: Type+rowTypeT = TypeVariable _RowType :: Type+sT = Types.var "s" :: Type+setT = TypeSet+stringT = Types.string :: Type+sumT = TypeVariable _Sum :: Type+termT = TypeVariable _Term :: Type+termVariantT = TypeVariable _TermVariant :: Type+traceT = TypeVariable _Trace+tupleProjectionT = TypeVariable _TupleProjection :: Type+typeT = TypeVariable _Type :: Type+typeSchemeT = TypeVariable _TypeScheme :: Type+typeVariantT = TypeVariable _TypeVariant :: Type+unitT = Types.unit :: Type+wrappedTermT = TypeVariable _WrappedTerm :: Type+wrappedTypeT = TypeVariable _WrappedType :: Type+xT = Types.var "x" :: Type
+ src/main/haskell/Hydra/Dsl/Terms.hs view
@@ -0,0 +1,211 @@+-- | A DSL for constructing Hydra terms++{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for IsString Term+module Hydra.Dsl.Terms where++import Hydra.Compute+import Hydra.Constants+import Hydra.Core+import Hydra.Graph+import qualified Hydra.Dsl.Literals as Literals++import Prelude hiding (map)+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 qualified Control.Monad as CM+import Data.Int+import Data.String(IsString(..))+++instance IsString Term where fromString = string++(@@) :: Term -> Term -> Term+f @@ x = apply f x++(<.>) :: Term -> Term -> Term+f <.> g = compose f g++infixr 0 >:+(>:) :: String -> Term -> Field+n >: t = field n t++annot :: M.Map String Term -> Term -> Term+annot ann t = TermAnnotated $ AnnotatedTerm t ann++apply :: Term -> Term -> Term+apply func arg = TermApplication $ Application func arg++bigfloat :: Double -> Term+bigfloat = literal . Literals.bigfloat++bigint :: Integer -> Term+bigint = literal . Literals.bigint++binary :: String -> Term+binary = literal . Literals.binary++boolean :: Bool -> Term+boolean = literal . Literals.boolean++compose :: Term -> Term -> Term+compose f g = lambda "x" $ apply f (apply g $ var "x")++constant :: Term -> Term+constant = lambda ignoredVariable++elimination :: Elimination -> Term+elimination = TermFunction . FunctionElimination++false :: Term+false = boolean False++field :: String -> Term -> Field+field n = Field (Name n)++fieldsToMap :: [Field] -> M.Map Name Term+fieldsToMap fields = M.fromList $ (\(Field name term) -> (name, term)) <$> fields++float32 :: Float -> Term+float32 = literal . Literals.float32++float64 :: Double -> Term+float64 = literal . Literals.float64++float :: FloatValue -> Term+float = literal . Literals.float++fold :: Term -> Term+fold = TermFunction . FunctionElimination . EliminationList++identity :: Term+identity = lambda "x" $ var "x"++inject :: Name -> Field -> Term+inject tname = TermUnion . Injection tname++int16 :: Int16 -> Term+int16 = literal . Literals.int16++int32 :: Int -> Term+int32 = literal . Literals.int32++int64 :: Int64 -> Term+int64 = literal . Literals.int64++int8 :: Int8 -> Term+int8 = literal . Literals.int8++integer :: IntegerValue -> Term+integer = literal . Literals.integer++just :: Term -> Term+just = optional . Just++lambda :: String -> Term -> Term+lambda param body = TermFunction $ FunctionLambda $ Lambda (Name param) body++-- Construct a 'let' term with a single binding+letTerm :: Name -> Term -> Term -> Term+letTerm v t1 t2 = TermLet $ Let [LetBinding v t1 Nothing] t2++list :: [Term] -> Term+list = TermList++literal :: Literal -> Term+literal = TermLiteral++map :: M.Map Term Term -> Term+map = TermMap++mapTerm :: M.Map Term Term -> Term+mapTerm = TermMap++match :: Name -> Maybe Term -> [Field] -> Term+match tname def fields = TermFunction $ FunctionElimination $ EliminationUnion $ CaseStatement tname def fields++matchOpt :: Term -> Term -> Term+matchOpt n j = TermFunction $ FunctionElimination $ EliminationOptional $ OptionalCases n j++matchWithVariants :: Name -> Maybe Term -> [(Name, Name)] -> Term+matchWithVariants tname def pairs = match tname def (toField <$> pairs)+ where+ toField (from, to) = Field from $ constant $ unitVariant tname to++nothing :: Term+nothing = optional Nothing++optional :: Y.Maybe Term -> Term+optional = TermOptional++pair :: Term -> Term -> Term+pair a b = TermProduct [a, b]++primitive :: Name -> Term+primitive = TermFunction . FunctionPrimitive++product :: [Term] -> Term+product = TermProduct++project :: Name -> Name -> Term+project tname fname = TermFunction $ FunctionElimination $ EliminationRecord $ Projection tname fname++record :: Name -> [Field] -> Term+record tname fields = TermRecord $ Record tname fields++set :: S.Set Term -> Term+set = TermSet++string :: String -> Term+string = TermLiteral . LiteralString++sum :: Int -> Int -> Term -> Term+sum i s term = TermSum $ Sum i s term++true :: Term+true = boolean True++typed :: Type -> Term -> Term+typed typ term = TermTyped $ TypedTerm term typ++uint16 :: Int -> Term+uint16 = literal . Literals.uint16++uint32 :: Int64 -> Term+uint32 = literal . Literals.uint32++uint64 :: Integer -> Term+uint64 = literal . Literals.uint64++uint8 :: Int16 -> Term+uint8 = literal . Literals.uint8++unit :: Term+unit = TermRecord $ Record _Unit []++unitVariant :: Name -> Name -> Term+unitVariant tname fname = variant tname fname unit++untuple :: Int -> Int -> Term+untuple arity idx = TermFunction $ FunctionElimination $ EliminationProduct $ TupleProjection arity idx++unwrap :: Name -> Term+unwrap = TermFunction . FunctionElimination . EliminationWrap++var :: String -> Term+var = TermVariable . Name++variant :: Name -> Name -> Term -> Term+variant tname fname term = TermUnion $ Injection tname $ Field fname term++with :: Term -> [Field] -> Term+env `with` bindings = TermLet $ Let (toBinding <$> bindings) env+ where+ toBinding (Field name value) = LetBinding name value Nothing++withVariant :: Name -> Name -> Term+withVariant tname = constant . unitVariant tname++wrap :: Name -> Term -> Term+wrap name term = TermWrap $ WrappedTerm name term
+ src/main/haskell/Hydra/Dsl/Tests.hs view
@@ -0,0 +1,34 @@+module Hydra.Dsl.Tests (+ module Hydra.Testing,+ module Hydra.Sources.Libraries,+ module Hydra.Dsl.Terms,+ module Hydra.Dsl.Tests,+) where++import Hydra.Core+import Hydra.Testing+import Hydra.Sources.Libraries+import Hydra.Dsl.Terms++import qualified Data.List as L+import qualified Data.Set as S+++intList :: [Int] -> Term+intList els = list (int32 <$> els)++intListList :: [[Int]] -> Term+intListList lists = list (intList <$> lists)++primCase :: Name -> [Term] -> Term -> TestCase+primCase name args output = TestCase Nothing EvaluationStyleEager input output+ where+ input = L.foldl (\a arg -> a @@ arg) (primitive name) args++stringList :: [String] -> Term+stringList els = list (string <$> els)++stringSet :: S.Set String -> Term+stringSet strings = set $ S.fromList $ string <$> S.toList strings++testCase = TestCase Nothing
+ src/main/haskell/Hydra/Dsl/Types.hs view
@@ -0,0 +1,150 @@+-- | A DSL for constructing Hydra types++{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for IsString (Type)+module Hydra.Dsl.Types where++import Hydra.Constants+import Hydra.Core++import qualified Data.List as L+import qualified Data.Map as M+import Data.String(IsString(..))+++instance IsString (Type) where fromString = var++infixr 0 >:+(>:) :: String -> Type -> FieldType+n >: t = field n t++infixr 0 -->+(-->) :: Type -> Type -> Type+a --> b = function a b++(@@) :: Type -> Type -> Type+f @@ x = apply f x++annot :: M.Map String Term -> Type -> Type+annot ann t = TypeAnnotated $ AnnotatedType t ann++apply :: Type -> Type -> Type+apply lhs rhs = TypeApplication (ApplicationType lhs rhs)++applyN :: [Type] -> Type+applyN ts = foldl apply (L.head ts) (L.tail ts)++bigfloat :: Type+bigfloat = float FloatTypeBigfloat++bigint :: Type+bigint = integer IntegerTypeBigint++binary :: Type+binary = literal LiteralTypeBinary++boolean :: Type+boolean = literal LiteralTypeBoolean++enum :: [String] -> Type+enum names = union $ (`field` unit) <$> names++field :: String -> Type -> FieldType+field fn = FieldType (Name fn)++fieldsToMap :: [FieldType] -> M.Map Name (Type)+fieldsToMap fields = M.fromList $ (\(FieldType name typ) -> (name, typ)) <$> fields++float32 :: Type+float32 = float FloatTypeFloat32++float64 :: Type+float64 = float FloatTypeFloat64++float :: FloatType -> Type+float = literal . LiteralTypeFloat++function :: Type -> Type -> Type+function dom cod = TypeFunction $ FunctionType dom cod++functionN :: [Type] -> Type+functionN ts = L.foldl (\cod dom -> function dom cod) (L.head r) (L.tail r)+ where+ r = L.reverse ts++int16 :: Type+int16 = integer IntegerTypeInt16++int32 :: Type+int32 = integer IntegerTypeInt32++int64 :: Type+int64 = integer IntegerTypeInt64++int8 :: Type+int8 = integer IntegerTypeInt8++integer :: IntegerType -> Type+integer = literal . LiteralTypeInteger++lambda :: String -> Type -> Type+lambda v body = TypeLambda $ LambdaType (Name v) body++lambdas :: [String] -> Type -> Type+lambdas vs body = L.foldr lambda body vs++list :: Type -> Type+list = TypeList++literal :: LiteralType -> Type+literal = TypeLiteral++map :: Type -> Type -> Type+map kt vt = TypeMap $ MapType kt vt++optional :: Type -> Type+optional = TypeOptional++pair :: Type -> Type -> Type+pair a b = TypeProduct [a, b]++product :: [Type] -> Type+product = TypeProduct++record :: [FieldType] -> Type+record fields = TypeRecord $ RowType placeholderName Nothing fields++set :: Type -> Type+set = TypeSet++string :: Type+string = literal LiteralTypeString++sum :: [Type] -> Type+sum = TypeSum++uint16 :: Type+uint16 = integer IntegerTypeUint16++uint32 :: Type+uint32 = integer IntegerTypeUint32++uint64 :: Type+uint64 = integer IntegerTypeUint64++uint8 :: Type+uint8 = integer IntegerTypeUint8++union :: [FieldType] -> Type+union fields = TypeUnion $ RowType placeholderName Nothing fields++unit :: Type+unit = TypeRecord $ RowType (Name "hydra/core.Unit") Nothing []++var :: String -> Type+var = TypeVariable . Name++wrap :: Type -> Type+wrap = wrapWithName placeholderName++wrapWithName :: Name -> Type -> Type+wrapWithName name t = TypeWrap $ WrappedType name t
− src/main/haskell/Hydra/Ext/Avro/Coder.hs
@@ -1,352 +0,0 @@-module Hydra.Ext.Avro.Coder where--import Hydra.Kernel-import Hydra.Adapters.Coders-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Util.Codetree.Script-import Hydra.Adapters.UtilsEtc-import qualified Hydra.Ext.Avro.Schema as Avro-import qualified Hydra.Ext.Json.Model as Json-import Hydra.Ext.Json.Eliminate-import Hydra.CoreEncoding--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 qualified Text.Read as TR---data AvroEnvironment m = AvroEnvironment {- avroEnvironmentNamedAdapters :: M.Map AvroQualifiedName (AvroHydraAdapter m),- avroEnvironmentNamespace :: Maybe String,- avroEnvironmentElements :: M.Map Name (Element m)} -- note: only used in the term coders--type AvroHydraAdapter m = Adapter (AvroEnvironment m) (AvroEnvironment m) Avro.Schema (Type m) Json.Value (Term m)--data AvroQualifiedName = AvroQualifiedName (Maybe String) String deriving (Eq, Ord, Show)--data ForeignKey = ForeignKey Name (String -> Name)--data PrimaryKey = PrimaryKey FieldName (String -> Name)--emptyEnvironment = AvroEnvironment M.empty Nothing M.empty--avro_foreignKey = "@foreignKey"-avro_primaryKey = "@primaryKey"--avroHydraAdapter :: (Ord m, Show m) => Avro.Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)-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 <$> Terms.expectMap Terms.expectString (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 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 (FieldName s) Types.unit- encode (Json.ValueString s) = pure $ TermUnion (Union hydraName $ Field (FieldName s) Terms.unit)- -- Note: we simply trust that data coming from the Hydra side is correct- decode (TermUnion (Union _ (Field fn _))) = return $ Json.ValueString $ unFieldName fn- Avro.NamedTypeFixed (Avro.Fixed size) -> simpleAdapter Types.binary encode decode- where- encode (Json.ValueString s) = pure $ Terms.binary s- decode term = Json.ValueString <$> Terms.expectBinary 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 (FieldName k) v'- let decodeField (Field (FieldName 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 (FieldName $ Avro.fieldName f) $ adapterTarget ad- env <- getState- putState $ putAvroHydraAdapter qname ad env- return 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 (encodeType typ) term- env <- getState- putState $ env {avroEnvironmentElements = M.insert name el (avroEnvironmentElements env)}- return ()- _ -> fail $ "multiple fields named " ++ unFieldName 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- ad <- case fk of- Nothing -> avroHydraAdapter $ Avro.fieldType f- Just (ForeignKey name constr) -> do- ad <- avroHydraAdapter $ Avro.fieldType f- let decodeTerm = \(TermElement 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 $ TermElement $ 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 = Types.element $ Types.nominal name- return (Avro.fieldName f, (f, 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 <$> Terms.expectString term- Avro.PrimitiveBoolean -> simpleAdapter Types.boolean encode decode- where- encode (Json.ValueBoolean b) = pure $ Terms.boolean b- decode term = Json.ValueBoolean <$> Terms.expectBoolean term- Avro.PrimitiveInt -> simpleAdapter Types.int32 encode decode- where- encode (Json.ValueNumber d) = pure $ Terms.int32 $ doubleToInt d- decode term = Json.ValueNumber . fromIntegral <$> Terms.expectInt32 term- Avro.PrimitiveLong -> simpleAdapter Types.int64 encode decode- where- encode (Json.ValueNumber d) = pure $ Terms.int64 $ doubleToInt d- decode term = Json.ValueNumber . fromIntegral <$> Terms.expectInt64 term- Avro.PrimitiveFloat -> simpleAdapter Types.float32 encode decode- where- encode (Json.ValueNumber d) = pure $ Terms.float32 $ realToFrac d- decode term = Json.ValueNumber . realToFrac <$> Terms.expectFloat32 term- Avro.PrimitiveDouble -> simpleAdapter Types.float64 encode decode- where- encode (Json.ValueNumber d) = pure $ Terms.float64 d- decode term = Json.ValueNumber <$> Terms.expectFloat64 term- Avro.PrimitiveBytes -> simpleAdapter Types.binary encode decode- where- encode (Json.ValueString s) = pure $ Terms.binary s- decode term = Json.ValueString <$> Terms.expectBinary term- Avro.PrimitiveString -> simpleAdapter Types.string encode decode- where- encode (Json.ValueString s) = pure $ Terms.string s- decode term = Json.ValueString <$> Terms.expectString 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--avroNameToHydraName :: AvroQualifiedName -> Name-avroNameToHydraName (AvroQualifiedName mns local) = fromQname (Namespace $ Y.fromMaybe "DEFAULT" mns) local--getAvroHydraAdapter :: AvroQualifiedName -> AvroEnvironment m -> Y.Maybe (AvroHydraAdapter m)-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 (FieldName $ 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 m -> AvroEnvironment m -> AvroEnvironment m-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" v--showQname :: AvroQualifiedName -> String-showQname (AvroQualifiedName mns local) = (Y.maybe "" (\ns -> ns ++ ".") mns) ++ local--stringToTerm :: Show m => Type m -> String -> Flow s (Term m)-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" lt- where- doRead s = case TR.readEither s of- Left msg -> fail $ "failed to read value: " ++ msg- Right term -> pure term--termToString :: Show m => Term m -> 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" l- TermOptional (Just term') -> termToString term'- _ -> unexpected "literal value" term
− src/main/haskell/Hydra/Ext/Avro/Language.hs
@@ -1,32 +0,0 @@-module Hydra.Ext.Avro.Language where--import Hydra.Kernel--import qualified Data.Set as S---avroLanguage :: Language m-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,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantRecord],- languageConstraintsTypes = \typ -> case stripType typ of- TypeOptional (TypeOptional _) -> False- _ -> True }
− src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs
@@ -1,165 +0,0 @@-module Hydra.Ext.Avro.SchemaJson where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Ext.Json.Serde-import qualified Hydra.Ext.Avro.Schema as Avro-import qualified Hydra.Ext.Json.Model as Json-import Hydra.Ext.Json.Eliminate--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 -> valueToString <$> coderEncode avroSchemaJsonCoder schema,- coderDecode = \s -> do- json <- case stringToValue 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" 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" 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\"" 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" v--getAnnotations :: M.Map String Json.Value -> M.Map String Json.Value-getAnnotations = M.fromList . L.filter isAnnotation . M.toList- where- isAnnotation (k, _) = L.take 1 k == "@"
− src/main/haskell/Hydra/Ext/Graphql/Coder.hs
@@ -1,176 +0,0 @@-module Hydra.Ext.Graphql.Coder where -- (printGraph) where--import Hydra.Kernel---import Hydra.Adapter---import Hydra.Adapters.Term---import Hydra.CoreDecoding---import Hydra.CoreLanguage---import Hydra.Adapters.Coders---import Hydra.Ext.Graphql.Language---import Hydra.Ext.Graphql.Serde---import qualified Hydra.Ext.Graphql.Syntax as G---import qualified Hydra.Impl.Haskell.Dsl.Types as Types---import Hydra.Util.Codetree.Script--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y-----printGraph :: (Ord m, Read m, Show m) => Graph m -> GraphFlow m (M.Map FilePath String)---printGraph g = do--- sf <- moduleToGraphqlSchema g--- let s = printExpr $ parenthesize $ exprDocument sf--- return $ M.fromList [(graphNameToFilePath False (FileExtension "graphql") $ graphName g, s)]--- ---constructModule :: (Ord m, Read m, Show m)--- => Graph m--- -> M.Map (Type m) (Coder (Context m) (Term m) ())--- -> [(Element m, TypedTerm m)]--- -> GraphFlow m G.Document---constructModule g coders pairs = do--- fail "TODO"----- let ns = pdlNameForGraph g----- let pkg = Nothing----- let imports = [] -- TODO----- sortedPairs <- case (topologicalSortElements $ fst <$> pairs) of----- Nothing -> fail $ "types form a cycle (unsupported in PDL)"----- Just sorted -> pure $ Y.catMaybes $ fmap (\n -> M.lookup n pairByName) sorted----- schemas <- CM.mapM toSchema sortedPairs----- return $ PDL.SchemaFile ns pkg imports schemas----- where----- pairByName = L.foldl (\m p@(el, tt) -> M.insert (elementName el) p m) M.empty pairs----- aliases = importAliasesForGraph g----- toSchema (el, TypedTerm typ term) = if stripType typ == TypeNominal _Type----- then decodeType term >>= typeToSchema el----- else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ show typ----- typeToSchema el typ = do----- let qname = pdlNameForElement aliases False $ elementName el----- res <- encodeAdaptedType aliases typ----- let ptype = case res of----- Left schema -> PDL.NamedSchema_TypeTyperef schema----- Right t -> t----- cx <- getState----- r <- annotationClassTermDescription (contextAnnotations cx) $ elementTerm el----- let anns = doc r----- return $ PDL.NamedSchema qname ptype anns------moduleToGraphqlSchema :: (Ord m, Read m, Show m) => Graph m -> GraphFlow m G.Document---moduleToGraphqlSchema g = graphToExternalModule language (encodeTerm aliases) constructModule g--- where--- aliases = importAliasesForGraph g--------doc :: Y.Maybe String -> PDL.Annotations-----doc s = PDL.Annotations s False----------encodeAdaptedType :: (Ord m, Read m, Show m)----- => M.Map GraphName String -> Type m----- -> GraphFlow m (Either PDL.Schema PDL.NamedSchema_Type)-----encodeAdaptedType aliases typ = do----- cx <- getState----- let acx = AdapterContext cx hydraCoreLanguage language----- ad <- withState acx $ termAdapter typ----- encodeType aliases $ adapterTarget ad------encodeTerm :: (Eq m, Ord m, Read m, Show m) => M.Map GraphName String -> Term m -> GraphFlow m ()---encodeTerm aliases term = fail "term encoding is not yet implemented"--------encodeType :: (Eq m, Show m) => M.Map GraphName String -> Type m -> GraphFlow m (Either PDL.Schema PDL.NamedSchema_Type)-----encodeType aliases typ = case stripType typ of----- 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----- _ -> fail $ "unexpected floating-point type: " ++ show ft----- LiteralTypeInteger it -> case it of----- IntegerTypeInt32 -> pure PDL.PrimitiveTypeInt----- IntegerTypeInt64 -> pure PDL.PrimitiveTypeLong----- _ -> fail $ "unexpected integer type: " ++ show it----- LiteralTypeString -> pure PDL.PrimitiveTypeString----- TypeMap (MapType kt vt) -> Left . PDL.SchemaMap <$> encode vt -- note: we simply assume string as a key type----- TypeNominal name -> pure $ Left $ PDL.SchemaNamed $ pdlNameForElement aliases True name----- TypeOptional ot -> fail $ "optionals unexpected at top level"----- TypeRecord (RowType _ fields) -> do----- let includes = []----- rfields <- CM.mapM encodeRecordField fields----- return $ Right $ PDL.NamedSchema_TypeRecord $ PDL.RecordSchema rfields includes----- TypeUnion (RowType _ fields) -> if isEnum----- then do----- fs <- CM.mapM encodeEnumField fields----- return $ Right $ PDL.NamedSchema_TypeEnum $ PDL.EnumSchema fs----- else Left . PDL.SchemaUnion . PDL.UnionSchema <$> CM.mapM encodeUnionField fields----- where----- isEnum = L.foldl (\b t -> b && stripType t == Types.unit) True $ fmap fieldTypeType fields----- _ -> fail $ "unexpected 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 (FieldName 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 (FieldName 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 (FieldName name) typ) = do----- anns <- getAnns typ----- return PDL.EnumField {----- PDL.enumFieldName = PDL.EnumFieldName $ convertCase CaseCamel CaseUpperSnake 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----- cx <- getState----- r <- annotationClassTypeDescription (contextAnnotations cx) typ----- return $ doc r------importAliasesForGraph g = M.empty -- TODO--------noAnnotations :: PDL.Annotations-----noAnnotations = PDL.Annotations Nothing False----------pdlNameForElement :: M.Map GraphName String -> Bool -> Name -> PDL.QualifiedName-----pdlNameForElement aliases withNs name = PDL.QualifiedName (PDL.Name local)----- $ if withNs----- then PDL.Namespace . slashesToDots <$> alias----- else Nothing----- where----- (ns, local) = toQname name----- alias = M.lookup ns aliases----------pdlNameForGraph :: Graph m -> PDL.Namespace-----pdlNameForGraph = PDL.Namespace . slashesToDots . h . graphName----- where----- h (GraphName 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)
− src/main/haskell/Hydra/Ext/Graphql/Language.hs
@@ -1,38 +0,0 @@-module Hydra.Ext.Graphql.Language where--import Hydra.Kernel--import qualified Data.Set as S---graphqlLanguage :: Language m-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,- LiteralVariantFloat,- LiteralVariantInteger,- LiteralVariantString],- languageConstraintsFloatTypes = S.fromList [- FloatTypeBigfloat],- languageConstraintsFunctionVariants = S.empty,- languageConstraintsIntegerTypes = S.fromList [- IntegerTypeBigint],- languageConstraintsTermVariants = S.fromList [- TermVariantList,- TermVariantLiteral,- TermVariantOptional,- TermVariantRecord,- TermVariantUnion],- languageConstraintsTypeVariants = S.fromList [- TypeVariantApplication,- TypeVariantLambda,- TypeVariantList,- TypeVariantLiteral,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantRecord,- TypeVariantUnion,- TypeVariantVariable],- languageConstraintsTypes = const True }
− src/main/haskell/Hydra/Ext/Graphql/Serde.hs
@@ -1,13 +0,0 @@-module Hydra.Ext.Graphql.Serde where--import Hydra.Util.Codetree.Script-import Hydra.Util.Formatting-import qualified Hydra.Util.Codetree.Ast as CT-import qualified Hydra.Ext.Graphql.Syntax as G--import qualified Data.List as L-import qualified Data.Maybe as Y---exprDocument :: G.Document -> CT.Expr-exprDocument d = cst "TODO"
− src/main/haskell/Hydra/Ext/Haskell/Coder.hs
@@ -1,327 +0,0 @@-module Hydra.Ext.Haskell.Coder (printModule) where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Adapters.Coders-import Hydra.Ext.Haskell.Language-import Hydra.Ext.Haskell.Utils-import qualified Hydra.Ext.Haskell.Ast as H-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Terms-import Hydra.Util.Codetree.Script-import Hydra.Ext.Haskell.Serde-import Hydra.Ext.Haskell.Settings--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---constantDecls :: Context m -> Namespaces -> Name -> Type m -> [H.DeclarationWithComments]-constantDecls cx namespaces name@(Name nm) typ = if useCoreImport- then toDecl (Name "hydra/core.Name") nameDecl:(toDecl (Name "hydra/core.FieldName") <$> 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 = H.PatternApplication $ H.Pattern_Application (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 cx typ)- toConstant (FieldType (FieldName fname) _) = ("_" ++ lname ++ "_" ++ fname, fname)--constructModule :: (Ord m, Read m, Show m)- => Module m- -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) H.Expression)- -> [(Element m, TypedTerm m)] -> GraphFlow m H.Module-constructModule mod coders pairs = do- cx <- getState- decls <- L.concat <$> CM.mapM (createDeclarations cx) pairs- let mc = moduleDescription mod- return $ H.Module (Just $ H.ModuleHead mc (importName $ h $ moduleNamespace mod) []) imports decls- where- h (Namespace name) = name-- createDeclarations cx pair@(el, TypedTerm typ term) = if isType cx typ- then toTypeDeclarations namespaces el term- else toDataDeclarations coders namespaces pair-- namespaces = namespacesForModule mod- 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 . H.ModuleName <$> Y.catMaybes [- Just "Data.List",- Just "Data.Map",- Just "Data.Set"{-,- if useCoreImport && moduleNamespace g /= Namespace "hydra/core"- then Just "Hydra.Core"- else Nothing-}]- where- toImport name = H.Import False name Nothing Nothing--encodeAdaptedType :: (Ord m, Read m, Show m) => Namespaces -> Type m -> GraphFlow m H.Type-encodeAdaptedType namespaces typ = adaptType haskellLanguage typ >>= encodeType namespaces--encodeFunction :: (Eq m, Ord m, Read m, Show m) => Namespaces -> Function m -> GraphFlow m H.Expression-encodeFunction namespaces fun = case fun of- FunctionElimination e -> case e of- EliminationElement -> pure $ hsvar "id"- EliminationList fun -> do- let lhs = hsvar "foldl"- rhs <- encodeTerm namespaces fun- return $ hsapp lhs rhs- EliminationNominal name -> pure $ H.ExpressionVariable $ elementReference namespaces $- qname (namespaceOfEager name) $ newtypeAccessorName name- EliminationOptional (OptionalCases nothing just) -> do- nothingRhs <- H.CaseRhs <$> encodeTerm namespaces nothing- let nothingAlt = H.Alternative (H.PatternName $ simpleName "Nothing") nothingRhs Nothing- justAlt <- do- -- Note: some of the following could be brought together with FunctionCases- let v0 = "v"- let rhsTerm = simplifyTerm $ apply just (variable v0)- let v1 = if S.member (Variable v0) $ freeVariablesInTerm rhsTerm then v0 else "_"- let lhs = H.PatternApplication $ H.Pattern_Application (rawName "Just") [H.PatternName $ rawName v1]- rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm- return $ H.Alternative lhs rhs Nothing- return $ H.ExpressionCase $ H.Expression_Case (hsvar "x") [nothingAlt, justAlt]- EliminationRecord (Projection dn fname) -> return $ H.ExpressionVariable $ recordFieldReference namespaces dn fname- EliminationUnion (CaseStatement dn 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- H.ExpressionCase <$> (H.Expression_Case (hsvar "x") <$> CM.mapM (toAlt fieldMap) fields)- toAlt fieldMap (Field fn fun') = do- let v0 = "v"- let raw = apply fun' (variable v0)- let rhsTerm = simplifyTerm raw- let v1 = if isFreeIn (Variable v0) rhsTerm then "_" 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 = H.PatternApplication $ H.Pattern_Application hname args- rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm- return $ H.Alternative lhs rhs Nothing- FunctionLambda (Lambda (Variable v) body) -> hslambda v <$> encodeTerm namespaces body- FunctionPrimitive name -> pure $ H.ExpressionVariable $ hsPrimitiveReference name- _ -> fail $ "unexpected function: " ++ show fun--encodeLiteral :: Literal -> GraphFlow m 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" fv- LiteralInteger iv -> case iv of- IntegerValueBigint i -> pure $ hslit $ H.LiteralInteger i- IntegerValueInt32 i -> pure $ hslit $ H.LiteralInt i- _ -> unexpected "integer" iv- LiteralString s -> pure $ hslit $ H.LiteralString s- _ -> unexpected "literal value" av--encodeTerm :: (Eq m, Ord m, Read m, Show m) => Namespaces -> Term m -> GraphFlow m H.Expression-encodeTerm namespaces term = do- case stripTerm term of- TermApplication (Application fun arg) -> case stripTerm fun of- TermFunction (FunctionElimination EliminationElement) -> encode arg- _ -> hsapp <$> encode fun <*> encode arg- TermElement name -> pure $ H.ExpressionVariable $ elementReference namespaces name- TermFunction f -> encodeFunction namespaces f- TermList els -> H.ExpressionList <$> CM.mapM encode els- TermLiteral v -> encodeLiteral v- TermNominal (Named 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 = typeNameForRecord sname- updates <- CM.mapM toFieldUpdate fields- return $ H.ExpressionConstructRecord $ H.Expression_ConstructRecord (rawName typeName) updates- where- toFieldUpdate (Field fn ft) = H.FieldUpdate (recordFieldReference namespaces sname fn) <$> encode ft- TermUnion (Union sname (Field fn ft)) -> do- let lhs = H.ExpressionVariable $ unionFieldReference namespaces sname fn- case stripTerm ft of- TermRecord (Record _ []) -> pure lhs- _ -> hsapp lhs <$> encode ft- TermVariable (Variable v) -> pure $ hsvar v- _ -> fail $ "unexpected term: " ++ show term- where- encode = encodeTerm namespaces--encodeType :: Show m => Namespaces -> Type m -> GraphFlow m H.Type-encodeType namespaces typ = case stripType typ of- TypeApplication (ApplicationType lhs rhs) -> toTypeApplication <$>- CM.sequence [encode lhs, encode rhs]- TypeElement et -> encode et- TypeFunction (FunctionType dom cod) -> H.TypeFunction <$> (H.Type_Function <$> encode dom <*> encode cod)- TypeLambda (LambdaType (VariableType 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"- _ -> fail $ "unexpected floating-point type: " ++ show ft- LiteralTypeInteger it -> case it of- IntegerTypeBigint -> pure "Integer"- IntegerTypeInt32 -> pure "Int"- _ -> 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]- TypeNominal name -> nominal name- 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- _ -> nominal $ rowTypeTypeName rt- TypeSet st -> toTypeApplication <$> CM.sequence [- pure $ H.TypeVariable $ rawName "Set",- encode st]- TypeUnion rt -> nominal $ rowTypeTypeName rt- TypeVariable (VariableType v) -> pure $ H.TypeVariable $ simpleName v- _ -> fail $ "unexpected type: " ++ show typ- where- encode = encodeType namespaces- nominal name = pure $ H.TypeVariable $ elementReference namespaces name--moduleToHaskellModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m H.Module-moduleToHaskellModule mod = transformModule haskellLanguage (encodeTerm namespaces) constructModule mod- where- namespaces = namespacesForModule mod--printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)-printModule mod = do- hsmod <- moduleToHaskellModule mod- let s = printExpr $ parenthesize $ toTree hsmod- return $ M.fromList [(namespaceToFilePath True (FileExtension "hs") $ moduleNamespace mod, s)]--toDataDeclarations :: (Ord m, Show m)- => M.Map (Type m) (Coder (Context m) (Context m) (Term m) H.Expression) -> Namespaces- -> (Element m, TypedTerm m) -> GraphFlow m [H.DeclarationWithComments]-toDataDeclarations coders namespaces (el, TypedTerm typ term) = do- let coder = Y.fromJust $ M.lookup typ coders- rhs <- H.RightHandSide <$> coderEncode coder term- let hname = simpleName $ localNameOfEager $ elementName el- let pat = H.PatternApplication $ H.Pattern_Application hname []- htype <- encodeType namespaces typ- let decl = H.DeclarationTypedBinding $ H.TypedBinding- (H.TypeSignature hname htype)- (H.ValueBindingSimple $ rewriteValueBinding $ H.ValueBinding_Simple pat rhs Nothing)- cx <- getState- comments <- annotationClassTermDescription (contextAnnotations cx) term- return [H.DeclarationWithComments decl comments]- where- rewriteValueBinding vb = case vb of- 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.ValueBinding_Simple- (H.PatternApplication (H.Pattern_Application name (args ++ vars))) (H.RightHandSide body) bindings- _ -> vb--toTypeDeclarations :: (Ord m, Read m, Show m)- => Namespaces -> Element m -> Term m -> GraphFlow m [H.DeclarationWithComments]-toTypeDeclarations namespaces el term = do- cx <- getState- let lname = localNameOfEager $ elementName el- let hname = simpleName lname- t <- decodeType term- isSer <- isSerializable- let deriv = H.Deriving $ if isSer- then rawName <$> ["Eq", "Ord", "Read", "Show"]- else []- let (vars, t') = unpackLambdaType cx 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]- _ -> if newtypesNotTypedefs- then do- cons <- newtypeCons el t'- return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv]- else do- htype <- encodeAdaptedType namespaces t- return $ H.DeclarationType (H.TypeDeclaration hd htype)- comments <- annotationClassTermDescription (contextAnnotations cx) term- return $ [H.DeclarationWithComments decl comments] ++ constantDecls cx namespaces (elementName el) t- where- isSerializable = 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-- declHead name vars = case vars of- [] -> H.DeclarationHeadSimple name- ((VariableType h):rest) -> H.DeclarationHeadApplication $- H.DeclarationHead_Application (declHead name rest) (H.Variable $ simpleName h)-- newtypeCons el typ = do- cx <- getState- let hname = simpleName $ newtypeAccessorName $ elementName el- htype <- encodeAdaptedType namespaces typ- comments <- annotationClassTypeDescription (contextAnnotations cx) 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 (FieldName fname) ftype) = do- let hname = simpleName $ decapitalize lname ++ capitalize fname- htype <- encodeAdaptedType namespaces ftype- cx <- getState- comments <- annotationClassTypeDescription (contextAnnotations cx) ftype- return $ H.FieldWithComments (H.Field hname htype) comments-- unionCons lname (FieldType (FieldName fname) ftype) = do- cx <- getState- comments <- annotationClassTypeDescription (contextAnnotations cx) ftype- let nm = capitalize lname ++ capitalize fname- typeList <- if stripType ftype == Types.unit- then pure []- else do- htype <- encodeAdaptedType namespaces ftype- return [htype]- return $ H.ConstructorWithComments (H.ConstructorOrdinary $ H.Constructor_Ordinary (simpleName nm) typeList) comments
− src/main/haskell/Hydra/Ext/Haskell/Language.hs
@@ -1,70 +0,0 @@-module Hydra.Ext.Haskell.Language where--import Hydra.Kernel--import qualified Data.Set as S---haskellLanguage :: Language m-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,- FloatTypeFloat64],- languageConstraintsFunctionVariants = S.fromList functionVariants,- languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint, IntegerTypeInt32],- languageConstraintsTermVariants = S.fromList [- TermVariantApplication,- TermVariantElement,- TermVariantFunction,- TermVariantList,- TermVariantLiteral,- TermVariantMap,- TermVariantNominal,- TermVariantOptional,- TermVariantProduct,- TermVariantRecord,- TermVariantSet,- TermVariantUnion,- TermVariantVariable],- languageConstraintsTypeVariants = S.fromList [- TypeVariantAnnotated,- TypeVariantApplication,- TypeVariantElement,- TypeVariantFunction,- TypeVariantLambda,- TypeVariantList,- TypeVariantLiteral,- TypeVariantMap,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantProduct,- TypeVariantRecord,- TypeVariantSet,- TypeVariantUnion,- TypeVariantVariable],- 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"]
− src/main/haskell/Hydra/Ext/Haskell/Operators.hs
@@ -1,110 +0,0 @@-module Hydra.Ext.Haskell.Operators where--import Hydra.Util.Codetree.Ast-import Hydra.Util.Codetree.Script---andOp :: Op-andOp = op "&&" 3 AssociativityRight--apOp :: Op-apOp = op "<*>" 4 AssociativityLeft--appOp :: Op-appOp = Op (Symbol "") (Padding WsNone WsSpace) (Precedence 0) AssociativityLeft -- No source--applyOp :: Op-applyOp = op "$" 0 AssociativityRight--arrowOp :: Op-arrowOp = op "->" (negate 1) AssociativityRight----assignOp = op "<-"--bindOp :: Op-bindOp = op ">>=" 1 AssociativityLeft--caseOp :: Op-caseOp = op "->" 0 AssociativityNone -- No source--composeOp :: Op-composeOp = op "." 9 AssociativityLeft--concatOp :: Op-concatOp = op "++" 5 AssociativityRight--consOp :: Op-consOp = op ":" 5 AssociativityRight--defineOp :: Op-defineOp = op "=" 0 AssociativityNone -- No source--diamondOp :: Op-diamondOp = op "<>" 6 AssociativityRight--divOp :: Op-divOp = op "`div`" 7 AssociativityLeft--divideOp :: Op-divideOp = op "/" 7 AssociativityLeft--elemOp :: Op-elemOp = op "`elem`" 4 AssociativityNone--equalOp :: Op-equalOp = op "==" 4 AssociativityNone--fmapOp :: Op-fmapOp = op "<$>" 4 AssociativityLeft--gtOp :: Op-gtOp = op ">" 4 AssociativityNone--gteOp :: Op-gteOp = op ">=" 4 AssociativityNone--indexOp :: Op-indexOp = op "!!" 9 AssociativityLeft--lambdaOp :: Op-lambdaOp = op "->" (negate 1) AssociativityRight -- No source--ltOp :: Op-ltOp = op "<" 4 AssociativityNone--lteOp :: Op-lteOp = op ">=" 4 AssociativityNone--minusOp :: Op-minusOp = op "-" 6 AssociativityBoth -- Originally: AssociativityLeft--modOp :: Op-modOp = op "`mod`" 7 AssociativityLeft--multOp :: Op-multOp = op "*" 7 AssociativityBoth -- Originally: AssociativityLeft--neqOp :: Op-neqOp = op "/=" 4 AssociativityNone--notElemOp :: Op-notElemOp = op "`notElem`" 4 AssociativityNone--orOp :: Op-orOp = op "||" 2 AssociativityRight--plusOp :: Op-plusOp = op "+" 6 AssociativityBoth -- Originally: AssociativityLeft--quotOp :: Op-quotOp = op "`quot`" 7 AssociativityLeft--remOp :: Op-remOp = op "`rem`" 7 AssociativityLeft----suchThatOp = op "|"----thenOp = op "=>"--typeOp :: Op-typeOp = op "::" 0 AssociativityNone -- No source
− src/main/haskell/Hydra/Ext/Haskell/Serde.hs
@@ -1,213 +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.Ext.Haskell.Serde where--import Hydra.Util.Codetree.Script-import qualified Hydra.Util.Codetree.Ast as CT-import qualified Hydra.Ext.Haskell.Ast as H-import Hydra.Ext.Haskell.Operators--import qualified Data.Char as C-import qualified Data.List as L-import qualified Data.Maybe as Y---class ToTree a where- toTree :: a -> CT.Expr--instance ToTree H.Alternative where- toTree (H.Alternative pat rhs _) = ifx caseOp (toTree pat) (toTree rhs)--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 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- H.ExpressionLambda lam -> toTree lam- -- H.ExpressionLeftSection Term_Section- -- H.ExpressionLet Term_Let- 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 = CT.Op (CT.Symbol "of") (CT.Padding CT.WsSpace CT.WsBreakAndIndent) (CT.Precedence 0) CT.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 = CT.Op (CT.Symbol "") (CT.Padding CT.WsNone CT.WsBreakAndIndent) (CT.Precedence 0) CT.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 -> show d- H.LiteralFloat f -> show f- H.LiteralInt i -> show i- H.LiteralInteger i -> show i- H.LiteralString s -> show s--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.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.ValueBinding where- toTree vb = case vb of- H.ValueBindingSimple (H.ValueBinding_Simple pat rhs _) -> 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
− src/main/haskell/Hydra/Ext/Haskell/Settings.hs
@@ -1,7 +0,0 @@-module Hydra.Ext.Haskell.Settings where--newtypesNotTypedefs :: Bool-newtypesNotTypedefs = True--useCoreImport :: Bool-useCoreImport = True
− src/main/haskell/Hydra/Ext/Haskell/Utils.hs
@@ -1,96 +0,0 @@-module Hydra.Ext.Haskell.Utils where--import Hydra.Kernel-import Hydra.Adapters.Coders-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}--elementReference :: Namespaces -> Name -> H.Name-elementReference (Namespaces (gname, H.ModuleName gmod) namespaces) name = case alias of- Nothing -> simpleName local- Just (H.ModuleName a) -> if ns == gname- then simpleName escLocal- else rawName $ a ++ "." ++ escLocal- where- (ns, local) = toQnameEager name- alias = M.lookup ns namespaces- escLocal = sanitizeHaskellName local--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- (Namespace ns, local) = toQnameEager name- prefix = H.NamePart $ capitalize $ L.last $ Strings.splitOn "/" ns--hsvar :: String -> H.Expression-hsvar s = H.ExpressionVariable $ rawName s--namespacesForModule :: Module m -> Namespaces-namespacesForModule mod = Namespaces focusPair mapping- where- ns = moduleNamespace mod- focusPair = toPair ns- mapping = fst $ L.foldl addPair (M.empty, S.empty) (toPair <$> S.toList (moduleDependencyNamespaces True True True mod))- 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 -> FieldName -> H.Name-recordFieldReference namespaces sname (FieldName fname) = elementReference namespaces $ fromQname (fst $ toQnameEager sname) nm- where- nm = decapitalize (typeNameForRecord sname) ++ capitalize fname--sanitizeHaskellName :: String -> String-sanitizeHaskellName = sanitizeWithUnderscores reservedWords--simpleName :: String -> H.Name-simpleName = rawName . sanitizeHaskellName--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 -> FieldName -> H.Name-unionFieldReference namespaces sname (FieldName fname) = elementReference namespaces $ fromQname (fst $ toQnameEager sname) nm- where- nm = capitalize (typeNameForRecord sname) ++ capitalize fname--unpackLambdaType :: Context m -> Type m -> ([VariableType], Type m)-unpackLambdaType cx t = case stripType t of- TypeLambda (LambdaType v tbody) -> (v:vars, t')- where- (vars, t') = unpackLambdaType cx tbody- _ -> ([], t)
− src/main/haskell/Hydra/Ext/Java/Coder.hs
@@ -1,710 +0,0 @@-module Hydra.Ext.Java.Coder (printModule) where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Reduction-import Hydra.Ext.Java.Utils-import Hydra.Ext.Java.Language-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import qualified Hydra.Ext.Java.Syntax as Java-import Hydra.Adapters.Coders-import Hydra.Util.Codetree.Script-import Hydra.Ext.Java.Serde-import Hydra.Ext.Java.Settings-import Hydra.Adapters.UtilsEtc-import Hydra.Types.Inference-import Hydra.Meta--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---type Aliases = M.Map Namespace Java.PackageName--printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)-printModule mod = do- withTrace "encode in Java" $ do- units <- moduleToJavaCompilationUnit mod- return $ M.fromList $ forPair <$> M.toList units- where- forPair (name, unit) = (- elementNameToFilePath name,- printExpr $ parenthesize $ writeCompilationUnit unit)--boundTypeVariables :: Type m -> [VariableType]-boundTypeVariables typ = case typ of- TypeAnnotated (Annotated typ1 _) -> boundTypeVariables typ1- TypeLambda (LambdaType v body) -> v:(boundTypeVariables body)- _ -> []--commentsFromElement :: Element m -> GraphFlow m (Maybe String)-commentsFromElement el = do- cx <- getState- annotationClassTermDescription (contextAnnotations cx) (elementData el)--commentsFromFieldType :: FieldType m -> GraphFlow m (Maybe String)-commentsFromFieldType (FieldType _ t) = do- cx <- getState- annotationClassTypeDescription (contextAnnotations cx) t--addComment :: Java.ClassBodyDeclaration -> FieldType m -> GraphFlow m Java.ClassBodyDeclarationWithComments-addComment decl field = Java.ClassBodyDeclarationWithComments decl <$> commentsFromFieldType field--noComment :: Java.ClassBodyDeclaration -> Java.ClassBodyDeclarationWithComments-noComment decl = Java.ClassBodyDeclarationWithComments decl Nothing--elementNameToFilePath :: Name -> FilePath-elementNameToFilePath name = nameToFilePath False (FileExtension "java") $ fromQname ns (sanitizeJavaName local)- where- (ns, local) = toQnameEager name--moduleToJavaCompilationUnit :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map Name Java.CompilationUnit)-moduleToJavaCompilationUnit mod = transformModule javaLanguage encode constructModule mod- where- aliases = importAliasesForModule mod- encode = encodeTerm aliases Nothing . contractTerm--classModsPublic :: [Java.ClassModifier]-classModsPublic = [Java.ClassModifierPublic]--constructModule :: (Ord m, Read m, Show m)- => Module m -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) Java.Expression) -> [(Element m, TypedTerm m)]- -> GraphFlow m (M.Map Name Java.CompilationUnit)-constructModule mod coders pairs = do- cx <- getState- let isTypePair = isType cx . 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- let imports = []- decl <- declarationForType aliases pair- return (elementName el,- Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) imports [decl])-- termToInterfaceMember coders pair = do- withTrace ("element " ++ unName (elementName el)) $ do- expanded <- contractTerm <$> (expandLambdas $ typedTermTerm $ snd pair) >>= annotateTermWithTypes- if isLambda expanded- then termToMethod coders el (typedTermType $ snd pair) expanded- else termToConstant coders el (typedTermType $ snd pair) expanded- where- el = fst pair- isLambda t = case stripTerm t of- TermFunction (FunctionLambda _) -> True- _ -> False-- termToConstant coders el typ term = do- jtype <- Java.UnannType <$> encodeType 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]-- -- Lambdas cannot (in general) be turned into top-level constants, as there is no way of declaring type parameters for constants- termToMethod coders el typ term = case stripType typ of- TypeFunction (FunctionType dom cod) -> case stripTerm term of- TermFunction (FunctionLambda (Lambda v body)) -> do- jdom <- encodeType aliases dom- jcod <- encodeType aliases cod- let mods = [Java.InterfaceMethodModifierStatic]- let anns = []- let mname = sanitizeJavaName $ decapitalize $ localNameOfEager $ elementName el- let param = javaTypeToJavaFormalParameter jdom (FieldName $ unVariable v)- let result = javaTypeToJavaResult jcod- jbody <- encodeTerm aliases (Just cod) body- let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody- let tparams = javaTypeParametersForType typ- return $ interfaceMethodDeclaration mods tparams mname [param] result (Just [returnSt])- _ -> unexpected "function term" term- _ -> unexpected "function type" typ--constructElementsInterface :: Module m -> [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 = fromQname (moduleNamespace mod) className- body = Java.InterfaceBody members- itf = Java.TypeDeclarationInterface $ Java.InterfaceDeclarationNormalInterface $- Java.NormalInterfaceDeclaration mods (javaTypeIdentifier className) [] [] body- decl = Java.TypeDeclarationWithComments itf $ moduleDescription mod--declarationForLambdaType :: (Eq m, Ord m, Read m, Show m) => Aliases- -> [Java.TypeParameter] -> Name -> LambdaType m -> GraphFlow m Java.ClassDeclaration-declarationForLambdaType aliases tparams elName (LambdaType (VariableType v) body) =- toClassDecl False aliases (tparams ++ [param]) elName body- where- param = javaTypeParameter $ capitalize v--declarationForRecordType :: (Ord m, Read m, Show m) => Bool -> Aliases -> [Java.TypeParameter] -> Name- -> [FieldType m] -> GraphFlow m Java.ClassDeclaration-declarationForRecordType isInner aliases tparams elName fields = do- memberVars <- CM.mapM toMemberVar fields- cx <- getState- 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 bodyDecls- where- constructor = do- params <- CM.mapM (fieldTypeToFormalParam aliases) fields- let stmts = Java.BlockStatementStatement . toAssignStmt . fieldTypeName <$> fields- return $ makeConstructor aliases elName False params stmts-- fieldArgs = fieldNameToJavaExpression . fieldTypeName <$> fields-- toMemberVar (FieldType fname ft) = do- let mods = [Java.FieldModifierPublic, Java.FieldModifierFinal]- jt <- encodeType aliases ft- let var = fieldNameToJavaVariableDeclarator fname- return $ javaMemberField mods jt var-- toWithMethod field = do- let mods = [Java.MethodModifierPublic]- let methodName = "with" ++ capitalize (unFieldName $ fieldTypeName field)- param <- fieldTypeToFormalParam aliases field- let anns = [] -- TODO- let result = referenceTypeToResult $ nameToJavaReferenceType aliases False elName Nothing- let consId = Java.Identifier $ sanitizeJavaName $ localNameOfEager elName- let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just $- javaConstructorCall (javaConstructorName consId Nothing) fieldArgs Nothing- return $ methodDeclaration mods [] anns methodName [param] result (Just [returnStmt])-- equalsMethod = methodDeclaration mods [] anns "equals" [param] result $- Just [instanceOfStmt,- castStmt,- returnAllFieldsEqual]- where- anns = [overrideAnnotation]- mods = [Java.MethodModifierPublic]- param = javaTypeToJavaFormalParameter (javaRefType [] Nothing "Object") (FieldName otherName)- result = javaTypeToJavaResult javaBooleanType- otherName = "other"- 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 otherName- parent = nameToJavaReferenceType aliases False elName Nothing-- returnFalse = javaReturnStatement $ Just $ javaBooleanExpression False-- castStmt = variableDeclarationStatement aliases elName id rhs- where- id = javaIdentifier tmpName- rhs = javaCastExpressionToJavaExpression $ javaCastExpression aliases rt var- var = javaIdentifierToJavaUnaryExpression $ Java.Identifier $ sanitizeJavaName otherName- 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 (FieldName 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 "equals")- var = Java.MethodInvocation_VariantExpression $ Java.ExpressionName Nothing $ Java.Identifier $- sanitizeJavaName fname-- hashCodeMethod = methodDeclaration mods [] anns "hashCode" [] 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 -> FieldName -> Java.MultiplicativeExpression- multPair i (FieldName fname) = Java.MultiplicativeExpressionTimes $- Java.MultiplicativeExpression_Binary lhs rhs- where- lhs = Java.MultiplicativeExpressionUnary $ javaPrimaryToJavaUnaryExpression $- javaLiteralToPrimary $ javaInt i- rhs = javaPostfixExpressionToJavaUnaryExpression $- javaMethodInvocationToJavaPostfixExpression $- methodInvocationStatic (javaIdentifier fname) (Java.Identifier "hashCode") []-- 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 :: (Ord m, Read m, Show m)- => Aliases -> (Element m, TypedTerm m) -> GraphFlow m Java.TypeDeclarationWithComments-declarationForType aliases (el, TypedTerm _ term) = do- t <- decodeType term >>= adaptType javaLanguage- cd <- toClassDecl False aliases [] (elementName el) t- cx <- getState- comments <- commentsFromElement el- return $ Java.TypeDeclarationWithComments (Java.TypeDeclarationClass cd) comments--declarationForUnionType :: (Eq m, Ord m, Read m, Show m)- => Aliases- -> [Java.TypeParameter] -> Name -> [FieldType m] -> GraphFlow m Java.ClassDeclaration-declarationForUnionType aliases tparams elName fields = do- variantClasses <- CM.mapM (fmap augmentVariantClass . unionFieldClass) fields- let variantDecls = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationClass <$> variantClasses- cx <- getState- variantDecls' <- CM.zipWithM addComment variantDecls fields- let otherDecls = noComment <$> [privateConstructor, toAcceptMethod True, visitor, partialVisitor]- tn <- typeNameDecl aliases elName- let bodyDecls = [tn] ++ otherDecls ++ variantDecls'- let mods = classModsPublic ++ [Java.ClassModifierAbstract]- return $ javaClassDeclaration aliases tparams elName mods Nothing bodyDecls- where- privateConstructor = makeConstructor aliases elName True [] []- unionFieldClass (FieldType fname ftype) = do- let rtype = Types.record $ if Types.isUnit ftype then [] else [FieldType (FieldName valueFieldName) ftype]- toClassDecl True 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]- args = typeParameterToTypeArgument <$> tparams-- visitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $- Java.NormalInterfaceDeclaration mods ti tparams extends body- where- mods = [Java.InterfaceModifierPublic]- ti = Java.TypeIdentifier $ Java.Identifier visitorName- tparams = [javaTypeParameter "R"]- 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 = [javaTypeParameter "R"],- Java.normalInterfaceDeclarationExtends =- [Java.InterfaceType $ javaClassType [visitorTypeVariable] Nothing visitorName],- Java.normalInterfaceDeclarationBody = Java.InterfaceBody $ otherwise:(toVisitMethod . fieldTypeName <$> fields)}- where- otherwise = interfaceMethodDeclaration defaultMod [] "otherwise" [mainInstanceParam] resultR $ Just [throw]- where- throw = Java.BlockStatementStatement $ Java.StatementWithoutTrailing $- Java.StatementWithoutTrailingSubstatementThrow $ Java.ThrowStatement $- javaConstructorCall (javaConstructorName (Java.Identifier "IllegalStateException") Nothing) args Nothing- 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 "otherwise") [javaIdentifierToJavaExpression $ Java.Identifier "instance"]-- defaultMod = [Java.InterfaceMethodModifierDefault]-- resultR = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable-- mainInstanceParam = javaTypeToJavaFormalParameter classRef $ FieldName instanceName- where- classRef = javaClassTypeToJavaType $- nameToJavaClassType aliases False [] elName Nothing-- variantInstanceParam fname = javaTypeToJavaFormalParameter classRef $ FieldName instanceName- where- classRef = javaClassTypeToJavaType $- nameToJavaClassType aliases False [] (variantClassName False elName fname) Nothing--elementJavaIdentifier :: Aliases -> Name -> Java.Identifier-elementJavaIdentifier aliases name = Java.Identifier $ jname ++ "." ++ local- where- (gname, local) = toQnameEager name- Java.Identifier jname = nameToJavaName aliases $ fromQname gname $ elementsClassName gname--elementsClassName :: Namespace -> String-elementsClassName (Namespace ns) = capitalize $ L.last $ LS.splitOn "/" ns--encodeElimination :: (Eq m, Ord m, Read m, Show m)- => Aliases -> Maybe Java.Expression -> Type m -> Type m -> Elimination m -> GraphFlow m Java.Expression-encodeElimination aliases marg dom cod elm = case elm of- EliminationElement -> case marg of- Nothing -> encodeFunction aliases dom cod $ FunctionLambda $ Lambda var $ TermVariable var- where- var = Variable "v"- Just jarg -> pure jarg- EliminationNominal name -> case marg of- Nothing -> pure $ javaLambda var jbody- where- var = Variable "v"- 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--- EliminationOptional (OptionalCases nothing just) ->- EliminationRecord (Projection _ fname) -> do- jdomr <- encodeType aliases dom >>= javaTypeToJavaReferenceType- jexp <- case marg of- Nothing -> pure $ javaLambda var jbody- where- var = Variable "v"- jbody = javaExpressionNameToJavaExpression $- fieldExpression (variableToJavaIdentifier var) (javaIdentifier $ unFieldName fname)- Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier $ unFieldName fname)- where- qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg- return $ javaCastExpressionToJavaExpression $ javaCastExpression aliases jdomr $ javaExpressionToJavaUnaryExpression jexp- EliminationUnion (CaseStatement tname fields) -> case marg of- Nothing -> do- cx <- getState- let anns = contextAnnotations cx- let lhs = annotationClassSetTermType anns cx (Just $ Types.function (Types.nominal tname) cod) $ Terms.elimination elm- encodeTerm aliases Nothing $ Terms.lambda "v" $ Terms.apply lhs (Terms.variable "v")- Just jarg -> applyElimination jarg- where- applyElimination jarg = do- let prim = javaExpressionToJavaPrimary jarg- let consId = innerClassRef aliases tname visitorName- jcod <- encodeType aliases cod- let targs = Java.TypeArgumentsOrDiamondArguments [javaTypeToJavaTypeArgument jcod]- body <- Java.ClassBody <$> CM.mapM (bodyDecl jcod) fields- let visitor = javaConstructorCall (javaConstructorName consId $ Just targs) [] (Just body)- return $ javaMethodInvocationToJavaExpression $- methodInvocation (Just $ Right prim) (Java.Identifier "accept") [visitor]- where- bodyDecl jcod field = do- let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True tname (Just $ capitalize $ unFieldName $ fieldName field)- let mods = [Java.MethodModifierPublic]- let anns = [overrideAnnotation]- let param = javaTypeToJavaFormalParameter jdom $ FieldName 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.variable ("$" ++ instanceName ++ "." ++ valueFieldName)- jret <- encodeTerm aliases (Just cod) $ contractTerm $ Terms.apply (fieldTerm field) value- let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret-- return $ noComment $ methodDeclaration mods [] anns visitMethodName [param] result (Just [returnStmt])- _ -> pure $ encodeLiteral $ LiteralString $- "Unimplemented elimination variant: " ++ show (eliminationVariant elm) -- TODO: temporary--encodeFunction :: (Eq m, Ord m, Read m, Show m)- => Aliases -> Type m -> Type m -> Function m -> GraphFlow m Java.Expression-encodeFunction aliases dom cod fun = case fun of--- FunctionCompareTo other ->- FunctionElimination elm -> encodeElimination aliases Nothing dom cod elm- FunctionLambda (Lambda var body) -> do- jbody <- encodeTerm aliases Nothing body- return $ javaLambda var jbody--- FunctionPrimitive name ->- _ -> pure $ encodeLiteral $ LiteralString $- "Unimplemented function variant: " ++ show (functionVariant fun) -- TODO: temporary--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 -> int v -- short- IntegerValueInt32 v -> int v -- int- IntegerValueInt64 v -> integer v -- long- IntegerValueUint8 v -> int v -- byte- IntegerValueUint16 v -> Java.LiteralCharacter $ fromIntegral v -- char- where- integer = Java.LiteralInteger . Java.IntegerLiteral- int = integer . fromIntegral- 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 -> GraphFlow m Java.Type-encodeLiteralType lt = case lt of- LiteralTypeBoolean -> simple "Boolean"- LiteralTypeFloat ft -> case ft of- FloatTypeFloat32 -> simple "Float"- FloatTypeFloat64 -> simple "Double"- _ -> 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--encodeTerm :: (Eq m, Ord m, Read m, Show m)- => Aliases -> Maybe (Type m) -> Term m -> GraphFlow m Java.Expression-encodeTerm aliases mtype term = case term of- -- Note: we are currently only reading the type from the annotation, leaving any documentation etc. behind- TermAnnotated (Annotated term' ann) -> case mtype of- Just t -> encodeTerm aliases mtype term'- Nothing -> do- cx <- getState- mt <- annotationClassTypeOf (contextAnnotations cx) ann- encodeTerm aliases mt term'-- TermApplication a -> case stripTerm fun of- TermFunction f -> case f of- FunctionPrimitive name -> forNamedFunction name args- FunctionElimination EliminationElement -> if L.length args > 0- then case stripTerm (L.head args) of- TermElement name -> do- forNamedFunction name (L.tail args)- _ -> fallback- else fallback- _ -> fallback- _ -> fallback- where- forNamedFunction name args = do- jargs <- CM.mapM encode args- let header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $ elementJavaIdentifier aliases name- return $ javaMethodInvocationToJavaExpression $ Java.MethodInvocation header jargs-- (fun, args) = uncurry [] term- where- uncurry args term = case term of- TermAnnotated (Annotated body _) -> uncurry args body- TermApplication (Application lhs rhs) -> uncurry (rhs:args) lhs- _ -> (term, args)-- fallback = forApplication a- forApplication (Application lhs rhs) = do- cx <- getState- mt <- annotationClassTermType (contextAnnotations cx) lhs- t <- case mt of- Just t' -> pure t'- Nothing -> fail $ "expected a type annotation on function " ++ show lhs- (dom, cod) <- case stripType t of- TypeFunction (FunctionType dom cod) -> pure (dom, cod)- _ -> fail $ "expected a function type on function " ++ show lhs- case stripTerm lhs of- TermFunction f -> case f of- FunctionElimination e -> case e of- EliminationElement -> encodeTerm aliases Nothing rhs- _ -> do- jarg <- encode rhs- encodeElimination aliases (Just jarg) dom cod e- _ -> defaultExpression dom cod- _ -> defaultExpression dom cod- where- defaultExpression dom cod = do- -- Note: the domain type will not be used, so we just substitute the unit type- jfun <- encodeTerm aliases (Just $ Types.function dom cod) lhs- jarg <- encodeTerm aliases (Just dom) rhs- let prim = javaExpressionToJavaPrimary jfun- return $ javaMethodInvocationToJavaExpression $ methodInvocation (Just $ Right prim) (Java.Identifier "apply") [jarg]-- TermElement name -> pure $ javaIdentifierToJavaExpression $ elementJavaIdentifier aliases name-- TermFunction f -> case mtype of- Just t -> case stripType t of- TypeFunction (FunctionType dom cod) -> encodeFunction aliases dom cod f- _ -> unexpected "function type" $ t- Nothing -> failAsLiteral $ "unannotated function: " ++ show f-- 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-- -- TermMap (Map (Term m) (Term m))-- TermNominal (Named name arg) -> do- jarg <- encode arg- return $ javaConstructorCall (javaConstructorName (nameToJavaName aliases name) Nothing) [jarg] Nothing-- TermOptional mt -> case mt of- Nothing -> pure $ javaMethodInvocationToJavaExpression $- methodInvocationStatic (javaIdentifier "java.util.Optional") (Java.Identifier "empty") []- Just term1 -> do- expr <- encode term1- return $ javaMethodInvocationToJavaExpression $- methodInvocationStatic (javaIdentifier "java.util.Optional") (Java.Identifier "of") [expr]-- 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 (javaIdentifier "java.util.stream.Collectors") (Java.Identifier "toSet") []- return $ javaMethodInvocationToJavaExpression $- methodInvocation (Just $ Right prim) (Java.Identifier "collect") [coll]-- TermUnion (Union name (Field (FieldName fname) v)) -> do- let (Java.Identifier typeId) = nameToJavaName aliases name- let consId = Java.Identifier $ typeId ++ "." ++ sanitizeJavaName (capitalize fname)- args <- if Terms.isUnit v- then return []- else do- ex <- encode v- return [ex]- return $ javaConstructorCall (javaConstructorName consId Nothing) args Nothing-- TermVariable (Variable v) -> pure $ javaIdentifierToJavaExpression $ javaIdentifier v-- _ -> failAsLiteral $ "Unimplemented term variant: " ++ show (termVariant term)- where- encode = encodeTerm aliases Nothing-- failAsLiteral msg = pure $ encodeLiteral $ LiteralString msg--encodeType :: Show m => Aliases -> Type m -> GraphFlow m Java.Type-encodeType aliases t = case stripType t of- TypeApplication (ApplicationType lhs rhs) -> do- jlhs <- encode lhs- jrhs <- encode rhs >>= javaTypeToJavaReferenceType- addJavaTypeParameter jrhs jlhs- TypeElement et -> encode et -- Elements are simply unboxed- TypeFunction (FunctionType dom cod) -> do- jdom <- encode dom >>= javaTypeToJavaReferenceType- jcod <- encode cod >>= javaTypeToJavaReferenceType- return $ javaRefType [jdom, jcod] javaUtilFunctionPackageName "Function"- TypeLambda (LambdaType (VariableType 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"- TypeNominal name -> pure $ Java.TypeReference $ nameToJavaReferenceType aliases True name Nothing- TypeRecord (RowType _UnitType _ []) -> return $ javaRefType [] javaLangPackageName "Void"- TypeRecord (RowType name _ _) -> pure $ Java.TypeReference $ nameToJavaReferenceType aliases True name Nothing- TypeOptional ot -> do- jot <- encode ot >>= javaTypeToJavaReferenceType- return $ javaRefType [jot] javaUtilPackageName "Optional"- TypeSet st -> do- jst <- encode st >>= javaTypeToJavaReferenceType- return $ javaRefType [jst] javaUtilPackageName "Set"- TypeUnion (RowType name _ _) -> pure $ Java.TypeReference $ nameToJavaReferenceType aliases True name Nothing- TypeVariable (VariableType v) -> pure $ Java.TypeReference $ javaTypeVariable v- _ -> fail $ "can't encode unsupported type in Java: " ++ show t- where- encode = encodeType aliases--fieldTypeToFormalParam aliases (FieldType fname ft) = do- jt <- encodeType aliases ft- return $ javaTypeToJavaFormalParameter jt fname--getCodomain :: Show m => m -> GraphFlow m (Type m)-getCodomain ann = functionTypeCodomain <$> getFunctionType ann--getFunctionType :: Show m => m -> GraphFlow m (FunctionType m)-getFunctionType ann = do- cx <- getState- mt <- annotationClassTypeOf (contextAnnotations cx) 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" t--innerClassRef :: Aliases -> Name -> String -> Java.Identifier-innerClassRef aliases name local = Java.Identifier $ id ++ "." ++ local- where- Java.Identifier id = nameToJavaName aliases name--instanceName = "instance"--javaTypeParametersForType :: Type m -> [Java.TypeParameter]-javaTypeParametersForType typ = toParam <$> vars- where- toParam (VariableType v) = Java.TypeParameter [] (javaTypeIdentifier $ capitalize v) Nothing--- vars = boundTypeVariables typ- vars = S.toList $ freeVariablesInType typ -- TODO: the fact that the variables are free is a bug, not a feature--partialVisitorName :: String-partialVisitorName = "PartialVisitor"--toClassDecl :: (Eq m, Ord m, Read m, Show m) => Bool -> Aliases -> [Java.TypeParameter]- -> Name -> Type m -> GraphFlow m Java.ClassDeclaration-toClassDecl isInner aliases tparams elName t = case stripType t of- TypeRecord rt -> declarationForRecordType isInner aliases tparams elName $ rowTypeFields rt- TypeUnion rt -> declarationForUnionType aliases tparams elName $ rowTypeFields rt- TypeLambda ut -> declarationForLambdaType aliases tparams elName ut- -- 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 aliases tparams elName [Types.field valueFieldName t']--toDataDeclaration :: Aliases -> (a, TypedTerm m) -> GraphFlow m a-toDataDeclaration aliases (el, TypedTerm typ term) = do- fail "not implemented" -- TODO--typeNameDecl :: (Ord m, Read m, Show m) => Aliases -> Name -> GraphFlow m Java.ClassBodyDeclarationWithComments-typeNameDecl aliases name = do- jt <- encodeType aliases $ Types.nominal _Name- arg <- encodeTerm aliases Nothing $ 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--valueFieldName :: String-valueFieldName = "value"--visitMethodName :: String-visitMethodName = "visit"--visitorName :: String-visitorName = "Visitor"
− src/main/haskell/Hydra/Ext/Java/Language.hs
@@ -1,96 +0,0 @@-module Hydra.Ext.Java.Language where--import Hydra.Kernel--import qualified Data.Set as S---javaLanguage :: Language m-javaLanguage = Language (LanguageName "hydra/ext/java") $ LanguageConstraints {- languageConstraintsEliminationVariants = S.fromList eliminationVariants,-- languageConstraintsLiteralVariants = S.fromList [- LiteralVariantBoolean, -- boolean- LiteralVariantFloat, -- (see float types)- LiteralVariantInteger, -- (see integer types)- LiteralVariantString], -- string- languageConstraintsFloatTypes = S.fromList [- -- Bigfloat (e.g. as Java's BigDecimal) is excluded for now- FloatTypeFloat32, -- float- FloatTypeFloat64], -- double- languageConstraintsFunctionVariants = S.fromList functionVariants,- languageConstraintsIntegerTypes = S.fromList [- IntegerTypeBigint, -- BigInteger- IntegerTypeInt16, -- short- IntegerTypeInt32, -- int- IntegerTypeInt64, -- long- IntegerTypeUint8, -- byte- IntegerTypeUint16], -- char- languageConstraintsTermVariants = S.fromList [- TermVariantApplication,- TermVariantElement,- TermVariantFunction,- -- Note: "let" is excluded for now- TermVariantList,- TermVariantLiteral,- TermVariantMap,- TermVariantNominal,- TermVariantOptional,- TermVariantRecord,- TermVariantSet,- TermVariantUnion,- TermVariantVariable],- languageConstraintsTypeVariants = S.fromList [- TypeVariantAnnotated,- TypeVariantApplication,- TypeVariantElement,- TypeVariantFunction,- TypeVariantLambda,- TypeVariantList,- TypeVariantLiteral,- TypeVariantMap,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantRecord,- TypeVariantSet,- TypeVariantUnion,- TypeVariantVariable],- languageConstraintsTypes = const True }--reservedWords :: S.Set String-reservedWords = S.fromList $ specialNames ++ classNames ++ keywords ++ literals- where- -- Special names reserved for use by Hydra- specialNames = ["Elements"]-- -- java.lang classes as of JDK 7- -- See: https://docs.oracle.com/javase/7/docs/api/java/lang/package-summary.html- 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 and literals are taken from Oracle's Java Tutorials on 2022-05-27; said to be complete for Java 1.8 only- -- See: https://docs.oracle.com/javase/tutorial/java/nutsandbolts/_keywords.html- 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"]
− src/main/haskell/Hydra/Ext/Java/Serde.hs
@@ -1,918 +0,0 @@-module Hydra.Ext.Java.Serde where--import Hydra.Util.Codetree.Script-import qualified Hydra.Util.Codetree.Ast as CT-import qualified Hydra.Ext.Java.Syntax as Java--import qualified Data.List as L-import qualified Data.Maybe as Y---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- sanitizeJavaComment s = L.concat (fromChar <$> s)- where- fromChar c = case c of- '<' -> "<"- '>' -> ">"- _ -> [c]--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- [pkgSec, importsSec, typesSec]- where- 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 d -> cst "TODO:ImportDeclarationSingleType"- 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 $ writeLocalVariableType t,- Just $ commaSep inlineStyle (writeVariableDeclarator <$> decls)]--writeLocalVariableDeclarationStatement :: Java.LocalVariableDeclarationStatement -> CT.Expr-writeLocalVariableDeclarationStatement (Java.LocalVariableDeclarationStatement d) = suffixSemi $ writeLocalVariableDeclaration d--writeLocalVariableType :: Java.LocalVariableType -> CT.Expr-writeLocalVariableType 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 -> writeVariableType 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--writeVariableType :: Java.TypeVariable -> CT.Expr-writeVariableType (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]
− src/main/haskell/Hydra/Ext/Java/Settings.hs
@@ -1,4 +0,0 @@-module Hydra.Ext.Java.Settings where--listsAsArrays :: Bool-listsAsArrays = False
− src/main/haskell/Hydra/Ext/Java/Utils.hs
@@ -1,495 +0,0 @@-module Hydra.Ext.Java.Utils where--import Hydra.Kernel-import qualified Hydra.Ext.Java.Syntax as Java-import qualified Hydra.Lib.Strings as Strings-import Hydra.Adapters.Coders-import Hydra.Ext.Java.Language--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---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 -> GraphFlow m Java.Type-addJavaTypeParameter rt t = case t of- Java.TypeReference (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- _ -> fail $ "expected a Java class or interface type. Found: " ++ show t--fieldExpression :: Java.Identifier -> Java.Identifier -> Java.ExpressionName-fieldExpression varId fieldId = Java.ExpressionName (Just $ Java.AmbiguousName [varId]) fieldId--fieldNameToJavaExpression :: FieldName -> Java.Expression-fieldNameToJavaExpression fname = javaPostfixExpressionToJavaExpression $- Java.PostfixExpressionName $ Java.ExpressionName Nothing (fieldNameToJavaIdentifier fname)--fieldNameToJavaIdentifier :: FieldName -> Java.Identifier-fieldNameToJavaIdentifier (FieldName name) = javaIdentifier name--fieldNameToJavaVariableDeclarator :: FieldName -> Java.VariableDeclarator-fieldNameToJavaVariableDeclarator (FieldName n) = javaVariableDeclarator (javaIdentifier n) Nothing--fieldNameToJavaVariableDeclaratorId :: FieldName -> Java.VariableDeclaratorId-fieldNameToJavaVariableDeclaratorId (FieldName n) = javaVariableDeclaratorId $ javaIdentifier n--importAliasesForModule :: Module m -> M.Map Namespace Java.PackageName-importAliasesForModule mod = addName (L.foldl addName M.empty $ S.toList deps) $ moduleNamespace mod- where- deps = moduleDependencyNamespaces True True True mod- addName m name = M.insert name (moduleNamespaceToPackageName name) m- moduleNamespaceToPackageName (Namespace n) = javaPackageName $ Strings.splitOn "/" n--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--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 . javaLiteralToPrimary . javaBoolean--javaBooleanType :: Java.Type-javaBooleanType = javaPrimitiveTypeToJavaType Java.PrimitiveTypeBoolean--javaCastExpression :: M.Map Namespace Java.PackageName -> Java.ReferenceType -> Java.UnaryExpression -> Java.CastExpression-javaCastExpression aliases 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 :: M.Map Namespace Java.PackageName -> [Java.TypeParameter] -> Name -> [Java.ClassModifier]- -> Maybe Name -> [Java.ClassBodyDeclarationWithComments] -> Java.ClassDeclaration-javaClassDeclaration aliases tparams elName mods supname 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 = [],- 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--javaEqualityExpressionToJavaInclusiveOrExpression :: Java.EqualityExpression -> Java.InclusiveOrExpression-javaEqualityExpressionToJavaInclusiveOrExpression eq = Java.InclusiveOrExpression [- Java.ExclusiveOrExpression [Java.AndExpression [eq]]]--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--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 . javaLiteralToPrimary . 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 :: Variable -> Java.Expression -> Java.Expression-javaLambda var jbody = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyExpression jbody)- where- params = Java.LambdaParametersSingle $ variableToJavaIdentifier var--javaLangPackageName :: Maybe Java.PackageName-javaLangPackageName = Just $ javaPackageName ["java", "lang"]--javaLiteralToJavaExpression = javaRelationalExpressionToJavaExpression .- javaMultiplicativeExpressionToJavaRelationalExpression .- javaLiteralToJavaMultiplicativeExpression--javaLiteralToJavaMultiplicativeExpression = Java.MultiplicativeExpressionUnary . javaPrimaryToJavaUnaryExpression .- javaLiteralToPrimary--javaLiteralToPrimary :: Java.Literal -> Java.Primary-javaLiteralToPrimary = 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--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)--javaPackageName :: [String] -> Java.PackageName-javaPackageName parts = Java.PackageName (Java.Identifier <$> parts)--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--javaRelationalExpressionToJavaExpression :: Java.RelationalExpression -> Java.Expression-javaRelationalExpressionToJavaExpression relEx = javaConditionalAndExpressionToJavaExpression $- Java.ConditionalAndExpression [javaEqualityExpressionToJavaInclusiveOrExpression $ Java.EqualityExpressionUnary relEx]--javaRelationalExpressionToJavaUnaryExpression :: Java.RelationalExpression -> Java.UnaryExpression-javaRelationalExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression .- Java.PrimaryNoNewArray .- Java.PrimaryNoNewArrayParens .- javaRelationalExpressionToJavaExpression--javaReturnStatement :: Y.Maybe Java.Expression -> Java.Statement-javaReturnStatement mex = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementReturn $- Java.ReturnStatement mex--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--javaThis :: Java.Expression-javaThis = javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis--javaTypeIdentifier :: String -> Java.TypeIdentifier-javaTypeIdentifier = Java.TypeIdentifier . Java.Identifier--javaTypeName :: Java.Identifier -> Java.TypeName-javaTypeName id = Java.TypeName (Java.TypeIdentifier id) Nothing--javaTypeParameter :: String -> Java.TypeParameter-javaTypeParameter v = Java.TypeParameter [] (javaTypeIdentifier v) Nothing--javaTypeVariable :: String -> Java.ReferenceType-javaTypeVariable v = Java.ReferenceTypeVariable $ Java.TypeVariable [] $ javaTypeIdentifier $ capitalize v--javaTypeVariableToType :: Java.TypeVariable -> Java.Type-javaTypeVariableToType = Java.TypeReference . Java.ReferenceTypeVariable--javaUtilFunctionPackageName :: Maybe Java.PackageName-javaUtilFunctionPackageName = Just $ javaPackageName ["java", "util", "function"]--javaUtilPackageName :: Maybe Java.PackageName-javaUtilPackageName = Just $ javaPackageName ["java", "util"]--javaTypeToJavaFormalParameter :: Java.Type -> FieldName -> Java.FormalParameter-javaTypeToJavaFormalParameter jt fname = Java.FormalParameterSimple $ Java.FormalParameter_Simple [] argType argId- where- argType = Java.UnannType jt- argId = fieldNameToJavaVariableDeclaratorId fname--javaTypeToJavaReferenceType :: Java.Type -> GraphFlow m 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--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)--javaAdditiveExpressionToJavaExpression :: Java.AdditiveExpression -> Java.Expression-javaAdditiveExpressionToJavaExpression = javaRelationalExpressionToJavaExpression .- Java.RelationalExpressionSimple . Java.ShiftExpressionUnary--javaVariableDeclaratorId :: Java.Identifier -> Java.VariableDeclaratorId-javaVariableDeclaratorId id = Java.VariableDeclaratorId id Nothing--javaVariableName :: Name -> Java.Identifier-javaVariableName = javaIdentifier . localNameOfEager--makeConstructor :: M.Map Namespace Java.PackageName -> 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 :: M.Map Namespace Java.PackageName -> 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 :: M.Map Namespace Java.PackageName -> Bool -> Name -> Maybe String- -> (Java.TypeIdentifier, Java.ClassTypeQualifier)-nameToQualifiedJavaName aliases qualify name mlocal = (jid, pkg)- where- (gname, local) = toQnameEager name- pkg = if qualify- then Y.maybe none Java.ClassTypeQualifierPackage $ M.lookup gname aliases- else none- none = Java.ClassTypeQualifierNone- jid = javaTypeIdentifier $ case mlocal of- Nothing -> sanitizeJavaName local- Just l -> sanitizeJavaName local ++ "." ++ sanitizeJavaName l--nameToJavaName :: M.Map Namespace Java.PackageName -> Name -> Java.Identifier-nameToJavaName aliases name = Java.Identifier $ case M.lookup gname aliases of- Nothing -> local- Just (Java.PackageName parts) -> L.intercalate "." $ (Java.unIdentifier <$> parts) ++ [sanitizeJavaName local]- where- (gname, local) = toQnameEager name--nameToJavaReferenceType :: M.Map Namespace Java.PackageName -> Bool -> Name -> Maybe String -> Java.ReferenceType-nameToJavaReferenceType aliases qualify name mlocal = Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $- nameToJavaClassType aliases qualify [] name mlocal--nameToJavaTypeIdentifier :: M.Map Namespace Java.PackageName -> 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 L.head name == '$'- -- The '$' prefix allows names to be excluded from sanitization- then L.tail name- else sanitizeWithUnderscores reservedWords name--toAcceptMethod :: Bool -> Java.ClassBodyDeclaration-toAcceptMethod abstract = methodDeclaration mods tparams anns "accept" [param] result body- where- mods = [Java.MethodModifierPublic] ++ if abstract then [Java.MethodModifierAbstract] else []- tparams = [javaTypeParameter "R"]- anns = if abstract- then []- else [overrideAnnotation]- param = javaTypeToJavaFormalParameter ref (FieldName varName)- where- ref = javaClassTypeToJavaType $- Java.ClassType- []- Java.ClassTypeQualifierNone- (javaTypeIdentifier "Visitor")- [Java.TypeArgumentReference visitorTypeVariable]- result = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable- varName = "visitor"- visitMethodName = Java.Identifier "visit"- body = if abstract- then Nothing- else Just [Java.BlockStatementStatement $ javaReturnStatement $ Just returnExpr]- returnExpr = javaMethodInvocationToJavaExpression $- methodInvocationStatic (Java.Identifier varName) visitMethodName [javaThis]--toAssignStmt :: FieldName -> 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 -> GraphFlow m 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 _ id _) = Java.TypeArgumentReference $- Java.ReferenceTypeVariable $ Java.TypeVariable [] id--variableDeclarationStatement :: M.Map Namespace Java.PackageName -> Name -> Java.Identifier -> Java.Expression -> Java.BlockStatement-variableDeclarationStatement aliases elName id rhs = Java.BlockStatementLocalVariableDeclaration $- Java.LocalVariableDeclarationStatement $- Java.LocalVariableDeclaration [] t [vdec]- where- t = Java.LocalVariableTypeType $ Java.UnannType $ javaTypeVariableToType $ Java.TypeVariable [] $- nameToJavaTypeIdentifier aliases False elName- vdec = javaVariableDeclarator id (Just init)- where- init = Java.VariableInitializerExpression rhs--variableToJavaIdentifier :: Variable -> Java.Identifier-variableToJavaIdentifier (Variable var) = Java.Identifier var -- TODO: escape--variantClassName :: Bool -> Name -> FieldName -> Name-variantClassName qualify elName (FieldName fname) = fromQname gname local1- where- (gname, local) = toQnameEager elName- flocal = capitalize fname- local1 = if qualify- then local ++ "." ++ flocal- else if flocal == local then flocal ++ "_" else flocal--visitorTypeVariable :: Java.ReferenceType-visitorTypeVariable = javaTypeVariable "r"
− src/main/haskell/Hydra/Ext/Json/Coder.hs
@@ -1,113 +0,0 @@-module Hydra.Ext.Json.Coder (jsonCoder) where--import Hydra.Kernel-import Hydra.Adapters.Term-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Ext.Json.Language-import qualified Hydra.Ext.Json.Model as Json-import Hydra.Lib.Literals-import Hydra.Adapters.UtilsEtc--import qualified Control.Monad as CM-import qualified Data.Map as M-import qualified Data.Maybe as Y---jsonCoder :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) Json.Value)-jsonCoder typ = do- cx <- getState- let acx = AdapterContext cx hydraCoreLanguage jsonLanguage- adapter <- withState acx $ termAdapter typ- coder <- termCoder $ adapterTarget adapter- return $ composeCoders (adapterCoder adapter) coder--literalCoder :: LiteralType -> GraphFlow m (Coder (Context m) (Context m) Literal Json.Value)-literalCoder 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" 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" 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" s}- LiteralTypeString -> Coder {- coderEncode = \(LiteralString s) -> pure $ Json.ValueString s,- coderDecode = \s -> case s of- Json.ValueString s' -> pure $ LiteralString s'- _ -> unexpected "string" s}--recordCoder :: (Eq m, Ord m, Read m, Show m) => RowType m -> GraphFlow m (Coder (Context m) (Context m) (Term m) 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 (unFieldName fname) <*> coderEncode coder fv)- _ -> unexpected "record" 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 m (FieldType fname _, coder) = do- v <- coderDecode coder $ Y.fromMaybe Json.ValueNull $ M.lookup (unFieldName fname) m- return $ Field fname v- _ -> unexpected "mapping" n- getCoder coders fname = Y.maybe error pure $ M.lookup fname coders- where- error = fail $ "no such field: " ++ fname--termCoder :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) Json.Value)-termCoder typ = case stripType typ of- TypeLiteral at -> do- ac <- literalCoder 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" 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" 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" 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
− src/main/haskell/Hydra/Ext/Json/Eliminate.hs
@@ -1,54 +0,0 @@-module Hydra.Ext.Json.Eliminate where--import Hydra.Kernel-import qualified Hydra.Ext.Json.Model 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" value--expectNumber :: Json.Value -> Flow s Double-expectNumber value = case value of- Json.ValueNumber d -> pure d- _ -> unexpected "JSON number" value--expectObject :: Json.Value -> Flow s (M.Map String Json.Value)-expectObject value = case value of- Json.ValueObject m -> pure m- _ -> unexpected "JSON object" value--expectString :: Json.Value -> Flow s String-expectString value = case value of- Json.ValueString s -> pure s- _ -> unexpected "JSON string" 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
− src/main/haskell/Hydra/Ext/Json/Language.hs
@@ -1,30 +0,0 @@-module Hydra.Ext.Json.Language where--import Hydra.Kernel--import qualified Data.Set as S---jsonLanguage :: Language m-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 }
− src/main/haskell/Hydra/Ext/Pegasus/Coder.hs
@@ -1,182 +0,0 @@-module Hydra.Ext.Pegasus.Coder (printModule) where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Adapters.Term-import Hydra.Adapters.Coders-import Hydra.Ext.Pegasus.Language-import qualified Hydra.Ext.Pegasus.Pdl as PDL-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Util.Codetree.Script-import Hydra.Ext.Pegasus.Serde--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y---printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)-printModule mod = do- files <- moduleToPegasusSchemas mod- return $ M.fromList (mapPair <$> M.toList files)- where- mapPair (path, sf) = (path, printExpr $ parenthesize $ exprSchemaFile sf)--constructModule :: (Ord m, Read m, Show m)- => Module m- -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) ())- -> [(Element m, TypedTerm m)]- -> GraphFlow m (M.Map FilePath PDL.SchemaFile)-constructModule mod coders pairs = do- sortedPairs <- case (topologicalSortElements $ fst <$> pairs) of- Nothing -> fail $ "types form a cycle (unsupported in PDL)"- Just 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- imports = [] -- TODO- toPair schema = (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- aliases = importAliasesForModule mod- toSchema (el, TypedTerm typ term) = do- cx <- getState- if isType cx typ- then decodeType term >>= typeToSchema el- else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el)- typeToSchema el typ = do- let qname = pdlNameForElement aliases False $ elementName el- res <- encodeAdaptedType aliases typ- let ptype = case res of- Left schema -> PDL.NamedSchema_TypeTyperef schema- Right t -> t- cx <- getState- r <- annotationClassTermDescription (contextAnnotations cx) $ elementData el- let anns = doc r- return $ PDL.NamedSchema qname ptype anns--moduleToPegasusSchemas :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath PDL.SchemaFile)-moduleToPegasusSchemas mod = transformModule pdlLanguage (encodeTerm aliases) constructModule mod- where- aliases = importAliasesForModule mod--doc :: Y.Maybe String -> PDL.Annotations-doc s = PDL.Annotations s False--encodeAdaptedType :: (Ord m, Read m, Show m)- => M.Map Namespace String -> Type m- -> GraphFlow m (Either PDL.Schema PDL.NamedSchema_Type)-encodeAdaptedType aliases typ = do- cx <- getState- let acx = AdapterContext cx hydraCoreLanguage pdlLanguage- ad <- withState acx $ termAdapter typ- encodeType aliases $ adapterTarget ad--encodeTerm :: (Eq m, Ord m, Read m, Show m) => M.Map Namespace String -> Term m -> GraphFlow m ()-encodeTerm aliases term = fail "not yet implemented"--encodeType :: (Eq m, Show m) => M.Map Namespace String -> Type m -> GraphFlow m (Either PDL.Schema PDL.NamedSchema_Type)-encodeType aliases typ = case typ of- TypeAnnotated (Annotated typ' _) -> encodeType aliases typ'- TypeElement et -> pure $ Left $ PDL.SchemaPrimitive PDL.PrimitiveTypeString- 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" ft- LiteralTypeInteger it -> case it of- IntegerTypeInt32 -> pure PDL.PrimitiveTypeInt- IntegerTypeInt64 -> pure PDL.PrimitiveTypeLong- _ -> unexpected "int32 or int64" it- LiteralTypeString -> pure PDL.PrimitiveTypeString- TypeMap (MapType kt vt) -> Left . PDL.SchemaMap <$> encode vt -- note: we simply assume string as a key type- TypeNominal 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" 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 (FieldName 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 (FieldName 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 (FieldName 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- cx <- getState- r <- annotationClassTypeDescription (contextAnnotations cx) typ- return $ doc r--importAliasesForModule g = M.empty -- TODO--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 . slashesToDots <$> alias- else Nothing- where- (ns, local) = toQnameEager name- alias = M.lookup ns aliases--pdlNameForModule :: Module m -> 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)
− src/main/haskell/Hydra/Ext/Pegasus/Language.hs
@@ -1,42 +0,0 @@-module Hydra.Ext.Pegasus.Language where--import Hydra.Kernel--import qualified Data.Set as S---pdlLanguage :: Language m-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,- TermVariantNominal,- TermVariantOptional,- TermVariantRecord,- TermVariantUnion],- languageConstraintsTypeVariants = S.fromList [- TypeVariantAnnotated,- TypeVariantElement,- TypeVariantList,- TypeVariantLiteral,- TypeVariantMap,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantRecord,- TypeVariantUnion],- languageConstraintsTypes = const True }
− src/main/haskell/Hydra/Ext/Pegasus/Serde.hs
@@ -1,81 +0,0 @@-module Hydra.Ext.Pegasus.Serde where--import Hydra.Util.Codetree.Script-import Hydra.Util.Formatting-import qualified Hydra.Util.Codetree.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 fullBlockStyle (exprRecordField <$> fields)]- PDL.NamedSchema_TypeEnum (PDL.EnumSchema fields) -> spaceSep [cst "enum", exprQualifiedName qn,- curlyBracesList 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]
− src/main/haskell/Hydra/Ext/Rdf/Serde.hs
@@ -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.Ext.Rdf.Serde (- rdfGraphToString,-) where--import qualified Hydra.Ext.Rdf.Syntax as Rdf-import Hydra.Util.Codetree.Script-import qualified Hydra.Util.Codetree.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]--rdfGraphToString :: Rdf.Graph -> String-rdfGraphToString = 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 "."]
− src/main/haskell/Hydra/Ext/Scala/Coder.hs
@@ -1,232 +0,0 @@-module Hydra.Ext.Scala.Coder (printModule) where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Impl.Haskell.Dsl.Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import qualified Hydra.Ext.Scala.Meta as Scala-import qualified Hydra.Lib.Strings as Strings-import Hydra.Ext.Scala.Language-import Hydra.Ext.Scala.Utils-import Hydra.Adapters.Coders-import Hydra.Types.Inference-import Hydra.Types.Substitution-import Hydra.Util.Codetree.Script-import Hydra.Ext.Scala.Serde--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---printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)-printModule mod = do- pkg <- moduleToScalaPackage mod- let s = printExpr $ parenthesize $ writePkg pkg- return $ M.fromList [(namespaceToFilePath False (FileExtension "scala") $ moduleNamespace mod, s)]--moduleToScalaPackage :: (Ord m, Read m, Show m) => Module m -> GraphFlow m Scala.Pkg-moduleToScalaPackage = transformModule scalaLanguage encodeUntypedTerm constructModule--constructModule :: (Ord m, Show m) => Module m -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) Scala.Data) -> [(Element m, TypedTerm m)]- -> GraphFlow m Scala.Pkg-constructModule mod coders pairs = do- defs <- CM.mapM toDef pairs- let pname = toScalaName $ h $ moduleNamespace mod- let pref = Scala.Data_RefName pname- return $ Scala.Pkg pname pref (imports ++ defs)- where- h (Namespace n) = n- imports = (toElImport <$> S.toList (moduleDependencyNamespaces True False True mod))- ++ (toPrimImport <$> S.toList (moduleDependencyNamespaces False True False mod))- 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 typ term) = 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 :: (Eq m, Ord m, Read m, Show m) => m -> Function m -> Y.Maybe (Term m) -> GraphFlow m Scala.Data-encodeFunction meta fun arg = case fun of- FunctionLambda (Lambda (Variable v) body) -> slambda v <$> encodeTerm body <*> findSdom- FunctionPrimitive name -> pure $ sprim name- FunctionElimination e -> case e of- EliminationElement -> pure $ sname "DATA" -- TODO- EliminationNominal 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 _ 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- 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 = Variable "y"- applyVar fterm var@(Variable v) = case stripTerm fterm of- TermFunction (FunctionLambda (Lambda v1 body)) -> if isFreeIn v1 body- then body- else substituteVariable v1 var body- _ -> apply fterm (variable v)- _ -> fail $ "unexpected function: " ++ show fun- where- findSdom = Just <$> (findDomain >>= encodeType)- findDomain = do- cx <- getState- r <- annotationClassTypeOf (contextAnnotations cx) 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- TypeElement et -> domainOf et- _ -> fail $ "expected a function type, but found " ++ show t--encodeLiteral :: Literal -> GraphFlow m 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" 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" iv- LiteralString s -> pure $ Scala.LitString s- _ -> unexpected "literal value" av--encodeTerm :: (Eq m, Ord m, Read m, Show m) => Term m -> GraphFlow m 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- EliminationElement -> encodeTerm arg- EliminationNominal name -> fallback- EliminationOptional c -> fallback- EliminationRecord (Projection _ (FieldName 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 (termMeta cx fun) f (Just arg)- _ -> fallback- _ -> fallback- where- fallback = sapply <$> encodeTerm fun <*> ((: []) <$> encodeTerm arg)- TermElement name -> pure $ sname $ localNameOfEager name- TermFunction f -> do- cx <- getState- encodeFunction (termMeta cx 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- TermNominal (Named _ 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 (Union 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 (Variable v) -> pure $ sname v- _ -> fail $ "unexpected term: " ++ show term---encodeType :: Show m => Type m -> GraphFlow m Scala.Type-encodeType t = case stripType t of--- TypeElement et ->- 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- TypeNominal name -> pure $ stref $ scalaTypeName True name- 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 (VariableType v) -> pure $ Scala.TypeVar $ Scala.Type_Var $ Scala.Type_Name v- _ -> fail $ "can't encode unsupported type in Scala: " ++ show t--encodeUntypedTerm :: (Eq m, Ord m, Read m, Show m) => Term m -> GraphFlow m Scala.Data-encodeUntypedTerm term = annotateTermWithTypes term >>= encodeTerm
− src/main/haskell/Hydra/Ext/Scala/Language.hs
@@ -1,73 +0,0 @@-module Hydra.Ext.Scala.Language where--import Hydra.Kernel--import qualified Data.Set as S---scalaLanguage :: Language m-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,- TermVariantElement,- TermVariantFunction,- TermVariantList,- TermVariantLiteral,- TermVariantMap,- TermVariantNominal,- TermVariantOptional,- TermVariantRecord,- TermVariantSet,- TermVariantUnion,- TermVariantVariable],- languageConstraintsTypeVariants = S.fromList [- TypeVariantAnnotated,- TypeVariantElement,- TypeVariantFunction,- TypeVariantList,- TypeVariantLiteral,- TypeVariantMap,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantRecord,- TypeVariantSet,- TypeVariantUnion,- TypeVariantLambda,- TypeVariantVariable],- 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"]
− src/main/haskell/Hydra/Ext/Scala/Prepare.hs
@@ -1,65 +0,0 @@-module Hydra.Ext.Scala.Prepare (- prepareType,-) where--import Hydra.Kernel-import qualified Hydra.Impl.Haskell.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 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 v- _ -> same it--prepareType :: Context m -> Type m -> (Type m, Term m -> Term m, 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--- TypeElement et ->--- TypeFunction (FunctionType dom cod) ->--- TypeList lt ->--- TypeMap (MapType kt vt) ->--- TypeNominal 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])
− src/main/haskell/Hydra/Ext/Scala/Serde.hs
@@ -1,140 +0,0 @@-module Hydra.Ext.Scala.Serde where--import Hydra.Util.Codetree.Ast-import Hydra.Util.Codetree.Script-import qualified Hydra.Lib.Literals as Literals-import qualified Hydra.Util.Codetree.Ast as CT-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 -> CT.Expr-writeCase (Scala.Case pat _ term) = spaceSep [cst "case", writePat pat, cst "=>", writeTerm term]--writeDefn :: Scala.Defn -> CT.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 -> CT.Expr-writeImportExportStat ie = case ie of- Scala.ImportExportStatImport (Scala.Import importers) -> newlineSep (writeImporter <$> importers)--- Scala.ImportExportStatExport exp ->--writeImporter :: Scala.Importer -> CT.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 inlineStyle (forImportee <$> its)]-writeLit :: Scala.Lit -> CT.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 -> CT.Expr-writeName name = case name of- Scala.NameValue s -> cst s--writePat :: Scala.Pat -> CT.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 -> CT.Expr-writePkg (Scala.Pkg name _ stats) = doubleNewlineSep $ package:(writeStat <$> stats)- where- package = spaceSep [cst "package", writeData_Name name]--writeStat :: Scala.Stat -> CT.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 -> CT.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 -> CT.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 -> CT.Expr-writeData_Name (Scala.Data_Name (Scala.PredefString name)) = cst name--writeData_Param :: Scala.Data_Param -> CT.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 -> CT.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 -> CT.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 -> CT.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 -> CT.Expr-writeType_Name (Scala.Type_Name name) = cst name--writeType_Param :: Scala.Type_Param -> CT.Expr-writeType_Param (Scala.Type_Param [] n [] [] [] []) = writeName n
− src/main/haskell/Hydra/Ext/Scala/Utils.hs
@@ -1,68 +0,0 @@-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 :: Context m -> Type m -> Y.Maybe Name-nameOfType cx t = case stripType t of- TypeNominal name -> Just name- TypeLambda (LambdaType _ body) -> nameOfType cx body- _ -> Nothing--qualifyUnionFieldName :: String -> Y.Maybe Name -> FieldName -> String-qualifyUnionFieldName dlft sname (FieldName 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) = toQnameLazy 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 ++ "." ++ local- where- (Namespace ns, local) = toQnameLazy name- prefix = L.last $ Strings.splitOn "/" ns--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 :: VariableType -> Scala.Type_Param-stparam (VariableType v) = Scala.Type_Param [] (Scala.NameValue v) [] [] [] []--stref :: String -> Scala.Type-stref = Scala.TypeRef . Scala.Type_RefName . Scala.Type_Name--svar :: Variable -> Scala.Pat-svar (Variable v) = (Scala.PatVar . Scala.Pat_Var . Scala.Data_Name . Scala.PredefString) v
− src/main/haskell/Hydra/Ext/Shacl/Coder.hs
@@ -1,273 +0,0 @@-module Hydra.Ext.Shacl.Coder where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.Meta-import qualified Hydra.Ext.Rdf.Syntax as Rdf-import qualified Hydra.Ext.Shacl.Model as Shacl-import qualified Hydra.Impl.Haskell.Dsl.Literals as Literals-import qualified Hydra.Impl.Haskell.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 :: (Eq m, Show m) => Module m -> GraphFlow m (Shacl.ShapesGraph, Graph m -> GraphFlow m Rdf.Graph)-shaclCoder mod = do- cx <- getState- let typeEls = L.filter (isEncodedType cx . elementSchema) $ 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- toShape el = do- typ <- decodeType $ 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}--descriptionsToGraph :: [Rdf.Description] -> Rdf.Graph-descriptionsToGraph ds = Rdf.Graph $ S.fromList $ triplesOf ds--elementIri :: Element m -> Rdf.Iri-elementIri = nameToIri . elementName--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--encodeField :: Show m => Name -> Rdf.Resource -> Field m -> GraphFlow m [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 :: Show m => Name -> Maybe Integer -> FieldType m -> GraphFlow m (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}--encodeLiteral :: Literal -> GraphFlow m Rdf.Node-encodeLiteral lit = Rdf.NodeLiteral <$> 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--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 :: Show m => Rdf.Resource -> Term m -> GraphFlow m [Rdf.Description]-encodeTerm subject term = case term of- TermAnnotated (Annotated inner ann) -> encodeTerm subject inner -- TODO: extract an rdfs:comment- TermElement name -> pure [emptyDescription $ Rdf.NodeIri $ nameToIri name]- 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 <- 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 <- Terms.expectString $ 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- TermNominal (Named 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 (Union rname field) -> do- triples <- encodeField rname subject field- return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList triples)]- _ -> unexpected "RDF-compatible term" term--encodeType :: Show m => Type m -> GraphFlow m Shacl.CommonProperties-encodeType typ = case stripType typ of- TypeElement et -> encodeType et- TypeList _ -> any- TypeLiteral lt -> pure $ encodeLiteralType lt- TypeMap _ -> any- TypeNominal 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" 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 []--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 :: Show m => GraphFlow m Rdf.Resource-nextBlankNode = do- count <- nextCount "shaclBlankNodeCounter"- return $ Rdf.ResourceBnode $ Rdf.BlankNode $ "b" ++ show count--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}---- Note: these are not "proper" URNs, as they do not use an established URN scheme-propertyIri :: Name -> FieldName -> Rdf.Iri-propertyIri rname fname = Rdf.Iri $ "urn:" ++ unNamespace gname ++ "#" ++ decapitalize local ++ capitalize (unFieldName fname)- where- (gname, local) = toQnameLazy 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)--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)--xmlSchemaDatatypeIri :: String -> Rdf.Iri-xmlSchemaDatatypeIri = iri "http://www.w3.org/2001/XMLSchema#"
− src/main/haskell/Hydra/Ext/Shacl/Language.hs
@@ -1,36 +0,0 @@-module Hydra.Ext.Shacl.Language where--import Hydra.Kernel--import qualified Data.Set as S---shaclLanguage :: Language m-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 [- TermVariantElement,- TermVariantList,- TermVariantLiteral,- TermVariantMap,- TermVariantNominal,- TermVariantOptional,- TermVariantRecord,- TermVariantSet,- TermVariantUnion],- languageConstraintsTypeVariants = S.fromList [- TypeVariantAnnotated,- TypeVariantElement,- TypeVariantList,- TypeVariantLiteral,- TypeVariantMap,- TypeVariantNominal,- TypeVariantOptional,- TypeVariantRecord,- TypeVariantSet,- TypeVariantUnion],- languageConstraintsTypes = const True }
− src/main/haskell/Hydra/Ext/Tinkerpop/Language.hs
@@ -1,100 +0,0 @@-module Hydra.Ext.Tinkerpop.Language where--import Hydra.Kernel-import Hydra.Ext.Tinkerpop.Features--import qualified Data.Set as S-import qualified Data.Maybe as Y----- Populate language constraints based on TinkerPop Graph.Features.--- Note: although Graph.Features is phrased such that it defaults to supporting features not explicitly mentioned,--- for Hydra we cannot support a term or type pattern unless it is provably safe in the target environment.--- Otherwise, generated expressions could cause failure during runtime operations.--- Also note that extra features are required on top of Graph.Features, again for reasons of completeness.-tinkerpopLanguage :: LanguageName -> Features -> ExtraFeatures m -> Language m-tinkerpopLanguage 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 [- Just TermVariantElement, -- Note: subject to the APG taxonomy- 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 [- Just TypeVariantElement,- cond TypeVariantList supportsLists,- cond TypeVariantLiteral supportsLiterals,- cond TypeVariantMap supportsMaps,- Just TypeVariantOptional,- Just TypeVariantNominal],-- languageConstraintsTypes = \typ -> case stripType typ of- TypeElement et -> True- -- 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- TypeNominal _ -> True- TypeOptional ot -> case stripType ot of- TypeElement _ -> True -- Note: subject to the APG taxonomy- 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
− src/main/haskell/Hydra/Ext/Yaml/Coder.hs
@@ -1,117 +0,0 @@-module Hydra.Ext.Yaml.Coder (yamlCoder) where--import Hydra.Kernel-import Hydra.Adapters.Term-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Ext.Yaml.Language-import qualified Hydra.Ext.Yaml.Model as YM-import Hydra.Adapters.UtilsEtc--import qualified Control.Monad as CM-import qualified Data.Map as M-import qualified Data.Maybe as Y---literalCoder :: LiteralType -> GraphFlow m (Coder (Context m) (Context m) 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" 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" 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" s}- LiteralTypeString -> Coder {- coderEncode = \(LiteralString s) -> pure $ YM.ScalarStr s,- coderDecode = \s -> case s of- YM.ScalarStr s' -> pure $ LiteralString s'- _ -> unexpected "string" s}--recordCoder :: (Eq m, Ord m, Read m, Show m) => RowType m -> GraphFlow m (Coder (Context m) (Context m) (Term m) 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 (FieldName fn) fv) = case (fieldTypeType ft, fv) of- (TypeOptional _, TermOptional Nothing) -> pure Nothing- _ -> Just <$> ((,) <$> pure (yamlString fn) <*> coderEncode coder fv)- _ -> unexpected "record" 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 m (FieldType fname@(FieldName fn) ft, coder) = do- v <- coderDecode coder $ Y.fromMaybe yamlNull $ M.lookup (yamlString fn) m- return $ Field fname v- _ -> unexpected "mapping" n- getCoder coders fname = Y.maybe error pure $ M.lookup fname coders- where- error = fail $ "no such field: " ++ fname--termCoder :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) 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" t,- coderDecode = \n -> case n of- YM.NodeScalar s -> Terms.literal <$> coderDecode ac s- _ -> unexpected "scalar node" 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" t,- coderDecode = \n -> case n of- YM.NodeSequence nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes- _ -> unexpected "sequence" 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" 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" t,- coderDecode = \n -> case n of- YM.NodeMapping m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m)- _ -> unexpected "mapping" n}- TypeRecord rt -> recordCoder rt--yamlCoder :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) YM.Node)-yamlCoder typ = do- cx <- getState- let acx = AdapterContext cx hydraCoreLanguage yamlLanguage- adapter <- withState acx $ termAdapter 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
− src/main/haskell/Hydra/Ext/Yaml/Language.hs
@@ -1,26 +0,0 @@-module Hydra.Ext.Yaml.Language where--import Hydra.Kernel--import qualified Data.Set as S---yamlLanguage :: Language m-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 }
− src/main/haskell/Hydra/Ext/Yaml/Modules.hs
@@ -1,40 +0,0 @@-module Hydra.Ext.Yaml.Modules (printModule) where--import Hydra.Kernel-import Hydra.Adapters.Coders-import Hydra.Impl.Haskell.Ext.Yaml.Serde-import Hydra.Ext.Yaml.Coder-import Hydra.Ext.Yaml.Language-import qualified Hydra.Ext.Yaml.Model as YM-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M---constructModule :: (Ord m, Read m, Show m)- => Module m- -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) YM.Node)- -> [(Element m, TypedTerm m)]- -> GraphFlow m 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 typ term)) = 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--printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)-printModule 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"
+ src/main/haskell/Hydra/Flows.hs view
@@ -0,0 +1,16 @@+-- | Functions and type class implementations for working with Hydra's built-in Flow monad++module Hydra.Flows where++import Hydra.Kernel++import qualified Control.Monad as CM+import qualified System.IO as IO+++fromFlowIo :: s -> Flow s a -> IO.IO a+fromFlowIo cx f = case mv of+ Just v -> return v+ Nothing -> CM.fail $ traceSummary trace+ where+ FlowState mv _ trace = unFlow f cx emptyTrace
− src/main/haskell/Hydra/Impl/Haskell/Codegen.hs
@@ -1,173 +0,0 @@--- | Entry point for Hydra code generation utilities--module Hydra.Impl.Haskell.Codegen where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.CoreEncoding-import Hydra.Types.Inference--import qualified Hydra.Ext.Haskell.Coder as Haskell-import qualified Hydra.Ext.Java.Coder as Java-import qualified Hydra.Ext.Pegasus.Coder as PDL-import qualified Hydra.Ext.Scala.Coder as Scala-import qualified Hydra.Ext.Yaml.Modules as Yaml--import Hydra.Impl.Haskell.Sources.Adapters.Utils-import Hydra.Impl.Haskell.Sources.Basics-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Sources.Compute-import Hydra.Impl.Haskell.Sources.Grammar-import Hydra.Impl.Haskell.Sources.Libraries-import Hydra.Impl.Haskell.Sources.Mantle-import Hydra.Impl.Haskell.Sources.Module-import Hydra.Impl.Haskell.Sources.Phantoms--import Hydra.Impl.Haskell.Sources.Util.Codetree.Ast-import Hydra.Impl.Haskell.Sources.Ext.Avro.Schema-import Hydra.Impl.Haskell.Sources.Ext.Graphql.Syntax-import Hydra.Impl.Haskell.Sources.Ext.Haskell.Ast-import Hydra.Impl.Haskell.Sources.Ext.Java.Syntax-import Hydra.Impl.Haskell.Sources.Ext.Json.Model-import Hydra.Impl.Haskell.Sources.Ext.Pegasus.Pdl-import Hydra.Impl.Haskell.Sources.Ext.Owl.Syntax-import Hydra.Impl.Haskell.Sources.Ext.Scala.Meta-import Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Features-import Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Typed-import Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.V3-import Hydra.Impl.Haskell.Sources.Ext.Xml.Schema-import Hydra.Impl.Haskell.Sources.Ext.Yaml.Model-import Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax-import Hydra.Impl.Haskell.Sources.Ext.Shacl.Model-import Hydra.Impl.Haskell.Sources.Ext.Shex.Syntax--import qualified Control.Monad as CM-import qualified System.FilePath as FP-import qualified Data.List as L-import qualified Data.Map as M-import qualified System.Directory as SD-import qualified Data.Maybe as Y---addDeepTypeAnnotations :: (Ord m, Show m) => Module m -> GraphFlow m (Module m)-addDeepTypeAnnotations mod = do- els <- CM.mapM annotateElementWithTypes $ moduleElements mod- return $ mod {moduleElements = els}--allModules :: [Module Meta]-allModules = coreModules ++ utilModules ++ extModules--assignSchemas :: (Ord m, Show m) => Bool -> Module m -> GraphFlow m (Module m)-assignSchemas doInfer mod = do- cx <- getState- els <- CM.mapM (annotate cx) $ moduleElements mod- return $ mod {moduleElements = els}- where- annotate cx el = do- typ <- findType cx (elementData el)- case typ of- Nothing -> if doInfer- then do- t <- typeSchemeType . snd <$> inferType (elementData el)- return el {elementSchema = encodeType t}- else return el- Just typ -> return el {elementSchema = encodeType typ}--coreModules :: [Module Meta]-coreModules = [- codetreeAstModule,- haskellAstModule,- hydraCoreModule,- hydraComputeModule,- hydraMantleModule,- hydraModuleModule,- hydraGrammarModule,--- hydraMonadsModule,- hydraPhantomsModule,- jsonModelModule]--utilModules = [- adapterUtilsModule,- hydraBasicsModule]--extModules :: [Module Meta]-extModules = [- avroSchemaModule,- graphqlSyntaxModule,- javaSyntaxModule,- pegasusPdlModule,- owlSyntaxModule,- rdfSyntaxModule,- scalaMetaModule,- shaclModelModule,- shexSyntaxModule,- tinkerpopFeaturesModule,- tinkerpopTypedModule,- tinkerpopV3Module,- xmlSchemaModule,- yamlModelModule]--findType :: Context m -> Term m -> GraphFlow m (Maybe (Type m))-findType cx term = annotationClassTermType (contextAnnotations cx) term--generateSources :: (Module Meta -> GraphFlow Meta (M.Map FilePath String)) -> [Module Meta] -> FilePath -> IO ()-generateSources printModule mods0 basePath = do- mfiles <- runFlow kernelContext generateFiles- case mfiles of- Nothing -> fail "Transformation failed"- Just files -> mapM_ writePair files- where- generateFiles = do- withTrace "generate files" $ do- mods1 <- CM.mapM (assignSchemas False) mods0- withState (modulesToContext mods1) $ do- mods2 <- CM.mapM addDeepTypeAnnotations mods1- maps <- CM.mapM printModule mods2- return $ L.concat (M.toList <$> maps)-- writePair (path, s) = do- let fullPath = FP.combine basePath path- SD.createDirectoryIfMissing True $ FP.takeDirectory fullPath- writeFile fullPath s--hydraKernel :: Graph Meta-hydraKernel = elementsToGraph Nothing $ L.concat (moduleElements <$> [hydraCoreModule, hydraMantleModule, hydraModuleModule])--kernelContext = graphContext hydraKernel--modulesToContext :: [Module Meta] -> Context Meta-modulesToContext mods = kernelContext {contextGraph = elementsToGraph (Just hydraKernel) elements}- where- elements = L.concat (moduleElements <$> allModules)- allModules = L.concat (close <$> mods)- where- close mod = mod:(L.concat (close <$> moduleDependencies mod))--printTrace :: Bool -> Trace -> IO ()-printTrace isError t = do- if not (L.null $ traceMessages t)- then do- putStrLn $ if isError then "Flow failed. Messages:" else "Messages:"- putStrLn $ indentLines $ traceSummary t- else pure ()--runFlow :: s -> Flow s a -> IO (Maybe a)-runFlow cx f = do- let FlowState v _ t = unFlow f cx emptyTrace- printTrace (Y.isNothing v) t- return v--writeHaskell :: [Module Meta] -> FilePath -> IO ()-writeHaskell = generateSources Haskell.printModule--writeJava :: [Module Meta] -> FP.FilePath -> IO ()-writeJava = generateSources Java.printModule--writePdl :: [Module Meta] -> FP.FilePath -> IO ()-writePdl = generateSources PDL.printModule--writeScala :: [Module Meta] -> FP.FilePath -> IO ()-writeScala = generateSources Scala.printModule--writeYaml :: [Module Meta] -> FP.FilePath -> IO ()-writeYaml = generateSources Yaml.printModule
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Base.hs
@@ -1,170 +0,0 @@--- | Base DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions.--module Hydra.Impl.Haskell.Dsl.Base (- module Hydra.Impl.Haskell.Dsl.Base,- module Hydra.Impl.Haskell.Dsl.PhantomLiterals,- Standard.coreContext,-) where--import Hydra.Kernel-import Hydra.Meta-import Hydra.CoreEncoding-import Hydra.Impl.Haskell.Dsl.PhantomLiterals-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Types.Inference-import qualified Hydra.Impl.Haskell.Dsl.Lib.Strings as Strings--import Prelude hiding ((++))--import qualified Data.Map as M-import qualified Data.Set as S---el :: Definition a -> Element Meta-el (Definition name (Datum term)) = Element name (encodeType dummyType) term- where- dummyType = TypeRecord (RowType (Name "PreInferencePlaceholder") Nothing [])--infixr 0 >:-(>:) :: String -> Datum a -> Fld a-n >: d = Fld $ Field (FieldName n) (unDatum d)--(<.>) :: Datum (b -> c) -> Datum (a -> b) -> Datum (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-f @@ x = apply f x--infixr 0 @->-(@->) :: a -> b -> (a, b)-x @-> y = (x, y)--infixr 0 -->-(-->) :: Case a -> Datum (a -> b) -> Field Meta-c --> t = caseField c t--(++) :: Datum String -> Datum String -> Datum String-l ++ r = Strings.cat @@ list [l, r]--apply :: Datum (a -> b) -> Datum a -> Datum b-apply (Datum lhs) (Datum rhs) = Datum $ 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--caseField :: Case a -> Datum (a -> b) -> Field Meta-caseField (Case fname) (Datum f) = Field fname f--compareTo :: Datum a -> Datum (a -> Bool)-compareTo (Datum term) = Datum $ Terms.compareTo term--compose :: Datum (b -> c) -> Datum (a -> b) -> Datum (a -> c)-compose (Datum f) (Datum g) = Datum $ Terms.lambda "x1" $ Terms.apply f (Terms.apply g $ Terms.variable "x1")--constant :: Datum a -> Datum (b -> a)-constant (Datum term) = Datum $ Terms.lambda "_" term--denom :: Name -> Datum (a -> b)-denom = Datum . Terms.eliminateNominal--delta :: Datum (Reference a -> a)-delta = Datum Terms.delta--doc :: String -> Datum a -> Datum a-doc s (Datum term) = Datum $ setTermDescription Standard.coreContext (Just s) term--element :: Definition a -> Datum (Reference a)-element (Definition name _) = Datum $ Terms.element name--field :: FieldName -> Datum a -> Field Meta-field fname (Datum val) = Field fname val--function :: Type Meta -> Type Meta -> Datum a -> Datum a-function dom cod = typed (Types.function dom cod)--functionN :: [Type Meta] -> Type Meta -> Datum a -> Datum a-functionN doms cod = typed $ Types.functionN doms cod--lambda :: String -> Datum x -> Datum (a -> b)-lambda v (Datum body) = Datum $ Terms.lambda v body----letTerm :: Var a -> Datum a -> Datum b -> Datum b---letTerm (Var k) (Datum v) (Datum env) = Datum $ Terms.letTerm (Variable k) v env--list :: [Datum a] -> Datum [a]-list els = Datum $ Terms.list (unDatum <$> els)--map :: M.Map (Datum a) (Datum b) -> Datum (M.Map a b)-map = Datum . Terms.map . M.fromList . fmap fromDatum . M.toList- where- fromDatum (Datum k, Datum v) = (k, v)--matchData :: Name -> [(FieldName, Datum (x -> b))] -> Datum (a -> b)-matchData name pairs = Datum $ Terms.cases name (toField <$> pairs)- where- toField (fname, Datum term) = Field fname term--matchOpt :: Datum b -> Datum (a -> b) -> Datum (Maybe a -> b)-matchOpt (Datum n) (Datum j) = Datum $ Terms.matchOptional n j--match :: Name -> Type Meta -> [Field Meta] -> Datum (u -> b)-match name cod fields = function (Types.nominal name) cod $ Datum $ Terms.cases name fields--matchToEnum :: Name -> Name -> [(FieldName, FieldName)] -> Datum (a -> b)-matchToEnum domName codName pairs = matchData domName (toCase <$> pairs)- where- toCase (fromName, toName) = (fromName, constant $ unitVariant codName toName)--matchToUnion :: Name -> Name -> [(FieldName, Field Meta)] -> Datum (a -> b)-matchToUnion domName codName pairs = matchData domName (toCase <$> pairs)- where- toCase (fromName, fld) = (fromName, constant $ Datum $ Terms.union 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.nominal name term--opt :: Maybe (Datum a) -> Datum (Maybe a)-opt mc = Datum $ Terms.optional (unDatum <$> mc)--primitive :: Name -> Datum a-primitive = Datum . Terms.primitive--project :: Name -> Type Meta -> FieldName -> Datum (a -> b)-project name cod fname = Datum $ Terms.projection name fname--record :: Name -> [Fld a] -> Datum a-record name fields = Datum $ Terms.record name (unFld <$> fields)--ref :: Definition a -> Datum a-ref (Definition name _) = Datum (Terms.apply Terms.delta $ Terms.element name) --set :: S.Set (Datum a) -> Datum (S.Set a)-set = Datum . Terms.set . S.fromList . fmap unDatum . S.toList--typed :: Type Meta -> Datum a -> Datum a-typed t (Datum term) = Datum $ setTermType Standard.coreContext (Just t) term--union :: Name -> FieldName -> Datum a -> Datum b-union name fname (Datum term) = Datum $ Terms.union name (Field fname term)--union2 :: Name -> FieldName -> Datum (a -> b)-union2 name fname = lambda "x2" $ typed (Types.nominal name) $ union name fname $ var "x2"--unit :: Datum a-unit = Datum Terms.unit--unitVariant :: Name -> FieldName -> Datum a-unitVariant name fname = typed (Types.nominal name) $ Datum $ Terms.union name $ Field fname Terms.unit--var :: String -> Datum a-var v = Datum $ Terms.variable v--variant :: Name -> FieldName -> Datum a -> Datum b-variant name fname (Datum term) = typed (Types.nominal name) $ Datum $ Terms.union name $ Field fname term
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Bootstrap.hs
@@ -1,56 +0,0 @@--- | A bootstrapping DSL, used for Hydra's inner core models--module Hydra.Impl.Haskell.Dsl.Bootstrap where--import Hydra.Kernel-import Hydra.Meta-import Hydra.CoreEncoding-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import qualified Data.Map as M-import qualified Data.Set as S---datatype :: Namespace -> String -> Type m -> Element m-datatype gname lname typ = typeElement elName $ rewriteType replacePlaceholders id 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 t' of- TypeRecord (RowType n e fields) -> if n == placeholderName- then TypeRecord (RowType elName e fields)- else t'- TypeUnion (RowType n e fields) -> if n == placeholderName- then TypeUnion (RowType elName e fields)- else t'- _ -> t'- where- t' = rec t--bootstrapContext :: Context Meta-bootstrapContext = cx- where- cx = Context {- contextGraph = Graph M.empty Nothing,- contextFunctions = M.empty,- contextStrategy = EvaluationStrategy S.empty,- contextAnnotations = metaAnnotationClass}--nsref :: Namespace -> String -> Type m-nsref ns = Types.nominal . qualify ns . Name--qualify :: Namespace -> Name -> Name-qualify (Namespace gname) (Name lname) = Name $ gname ++ "." ++ lname--termElement :: Name -> Type m -> Term m -> Element m-termElement name typ term = Element {- elementName = name,- elementSchema = encodeType typ,- elementData = term}--typeElement :: Name -> Type m -> Element m-typeElement name typ = Element {- elementName = name,- elementSchema = TermElement _Type,- elementData = encodeType typ}
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Grammars.hs
@@ -1,50 +0,0 @@--- | A DSL for building BNF grammars--module Hydra.Impl.Haskell.Dsl.Grammars where--import Hydra.Kernel-import Data.String(IsString(..))---instance IsString Pattern where fromString = symbol--infixr 0 >:-(>:) :: String -> Pattern -> Pattern-l >: p = PatternLabeled $ LabeledPattern (Label l) p--alts :: [Pattern] -> Pattern-alts = PatternAlternatives--define :: String -> [Pattern] -> Production-define s pats = Production (Symbol s) pat- where- pat = case pats of- [p] -> p- _ -> alts pats--ignored :: Pattern -> Pattern-ignored = PatternIgnored--list :: [Pattern] -> Pattern-list = PatternSequence--nil :: Pattern-nil = PatternNil--opt :: Pattern -> Pattern-opt = PatternOption--plus :: Pattern -> Pattern-plus = PatternPlus--regex :: String -> Pattern-regex = PatternRegex . Regex--star :: Pattern -> Pattern-star = PatternStar--symbol :: String -> Pattern-symbol = PatternNonterminal . Symbol--terminal :: String -> Pattern-terminal = PatternConstant . Constant
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Lists.hs
@@ -1,27 +0,0 @@-module Hydra.Impl.Haskell.Dsl.Lib.Lists where--import Hydra.Phantoms-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Sources.Libraries---concat :: Datum ([a] -> a)-concat = Datum $ Terms.primitive _lists_concat--head :: Datum ([a] -> a)-head = Datum $ Terms.primitive _lists_head--intercalate :: Datum ([a] -> [a] -> [a])-intercalate = Datum $ Terms.primitive _lists_intercalate--intersperse :: Datum ([a] -> a -> [a])-intersperse = Datum $ Terms.primitive _lists_intersperse--last :: Datum ([a] -> a)-last = Datum $ Terms.primitive _lists_last--length :: Datum ([a] -> Int)-length = Datum $ Terms.primitive _lists_length----map :: Datum ((a -> b) -> [a] -> [b])---map = Datum $ Terms.primitive _lists_map
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Literals.hs
@@ -1,12 +0,0 @@-module Hydra.Impl.Haskell.Dsl.Lib.Literals where--import Hydra.Phantoms-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Sources.Libraries---showInt32 :: Datum (Int -> String)-showInt32 = Datum $ Terms.primitive _literals_showInt32--showString :: Datum (String -> String)-showString = Datum $ Terms.primitive _literals_showString
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Math.hs
@@ -1,27 +0,0 @@-module Hydra.Impl.Haskell.Dsl.Lib.Math where--import Hydra.Phantoms-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Sources.Libraries---add :: Datum (Int -> Int -> Int)-add = Datum $ Terms.primitive _math_add--div :: Datum (Int -> Int -> Int)-div = Datum $ Terms.primitive _math_div--mod :: Datum (Int -> Int -> Int)-mod = Datum $ Terms.primitive _math_mod--mul :: Datum (Int -> Int -> Int)-mul = Datum $ Terms.primitive _math_mul--neg :: Datum (Int -> Int)-neg = Datum $ Terms.primitive _math_neg--rem :: Datum (Int -> Int -> Int)-rem = Datum $ Terms.primitive _math_rem--sub :: Datum (Int -> Int -> Int)-sub = Datum $ Terms.primitive _math_sub
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Sets.hs
@@ -1,20 +0,0 @@-module Hydra.Impl.Haskell.Dsl.Lib.Sets where--import Hydra.Phantoms-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Sources.Libraries--import Data.Set-----add :: Datum (a -> Set a -> Set a)---add = Datum $ Terms.primitive _sets_add--contains :: Datum (a -> Set a -> Bool)-contains = Datum $ Terms.primitive _sets_contains--isEmpty :: Datum (Set a -> Bool)-isEmpty = Datum $ Terms.primitive _sets_isEmpty--remove :: Datum (a -> Set a -> Set a)-remove = Datum $ Terms.primitive _sets_remove
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Strings.hs
@@ -1,21 +0,0 @@-module Hydra.Impl.Haskell.Dsl.Lib.Strings where--import Hydra.Phantoms-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Sources.Libraries---cat :: Datum ([String] -> String)-cat = Datum $ Terms.primitive _strings_cat--length :: Datum (String -> Int)-length = Datum $ Terms.primitive _strings_length--splitOn :: Datum (String -> String -> [String])-splitOn = Datum $ Terms.primitive _strings_splitOn--toLower :: Datum (String -> String)-toLower = Datum $ Terms.primitive _strings_toLower--toUpper :: Datum (String -> String)-toUpper = Datum $ Terms.primitive _strings_toUpper
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Literals.hs
@@ -1,94 +0,0 @@--- | A DSL for constructing literal types and terms--module Hydra.Impl.Haskell.Dsl.Literals where--import Hydra.Kernel--import Data.Int---bigfloat :: Double -> Literal-bigfloat = float . FloatValueBigfloat--bigint :: Integer -> Literal-bigint = integer . IntegerValueBigint . fromIntegral--binary :: String -> Literal-binary = LiteralBinary--boolean :: Bool -> Literal-boolean = LiteralBoolean--expectBinary :: Literal -> Flow s String-expectBinary v = case v of- LiteralBinary b -> pure b- _ -> unexpected "binary" v--expectBoolean :: Literal -> Flow s Bool-expectBoolean v = case v of- LiteralBoolean b -> pure b- _ -> unexpected "boolean" v--expectFloat32 :: Literal -> Flow s Float-expectFloat32 v = case v of- LiteralFloat (FloatValueFloat32 f) -> pure f- _ -> unexpected "float32" v--expectFloat64 :: Literal -> Flow s Double-expectFloat64 v = case v of- LiteralFloat (FloatValueFloat64 f) -> pure f- _ -> unexpected "float64" v--expectInt32 :: Literal -> Flow s Int-expectInt32 v = case v of- LiteralInteger (IntegerValueInt32 i) -> pure i- _ -> unexpected "int32" v--expectInt64 :: Literal -> Flow s Integer-expectInt64 v = case v of- LiteralInteger (IntegerValueInt64 i) -> pure i- _ -> unexpected "int64" v--expectString :: Literal -> Flow s String-expectString v = case v of- LiteralString s -> pure s- _ -> unexpected "string" v--float32 :: Float -> Literal-float32 = float . FloatValueFloat32--float64 :: Double -> Literal-float64 = float . FloatValueFloat64--float :: FloatValue -> Literal-float = LiteralFloat--int16 :: Int16 -> Literal-int16 = integer . IntegerValueInt16 . fromIntegral--int32 :: Int -> Literal-int32 = integer . IntegerValueInt32--int64 :: Int64 -> Literal-int64 = integer . IntegerValueInt64 . fromIntegral--int8 :: Int8 -> Literal-int8 = integer . IntegerValueInt8 . fromIntegral--integer :: IntegerValue -> Literal-integer = LiteralInteger--string :: String -> Literal-string = LiteralString--uint16 :: Integer -> Literal-uint16 = integer . IntegerValueUint16 . fromIntegral--uint32 :: Integer -> Literal-uint32 = integer . IntegerValueUint32 . fromIntegral--uint64 :: Integer -> Literal-uint64 = integer . IntegerValueUint64 . fromIntegral--uint8 :: Integer -> Literal-uint8 = integer . IntegerValueUint8 . fromIntegral
− src/main/haskell/Hydra/Impl/Haskell/Dsl/PhantomLiterals.hs
@@ -1,77 +0,0 @@--- | A DSL for constructing literal terms using Haskell's built-in datatypes--module Hydra.Impl.Haskell.Dsl.PhantomLiterals where--import Hydra.Kernel-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Data.Int----- Note: does not yet properly capture arbitrary-precision floating-point numbers,--- because code generation does not.-type Bigfloat = Double---- Note: does not distinguish Binary from String, because code generation does not.-type Binary = String--bigfloat :: Bigfloat -> Datum Bigfloat-bigfloat = Datum . Terms.bigfloat--bigint :: Integer -> Datum Integer-bigint = Datum . Terms.bigint--binary :: Binary -> Datum Binary-binary = Datum . Terms.binary--bool :: Bool -> Datum Bool-bool = Datum . Terms.boolean--boolean :: Bool -> Datum Bool-boolean = bool--double :: Double -> Datum Double-double = float64--false :: Datum Bool-false = bool False--float :: Float -> Datum Float-float = float32--float32 :: Float -> Datum Float-float32 = Datum . Terms.float32--float64 :: Double -> Datum Double-float64 = Datum . Terms.float64--int :: Int -> Datum Int-int = int32--int8 :: Int8 -> Datum Int8-int8 = Datum . Terms.int8--int16 :: Int16 -> Datum Int16-int16 = Datum . Terms.int16--int32 :: Int -> Datum Int-int32 = Datum . Terms.int32--int64 :: Int64 -> Datum Int64-int64 = Datum . Terms.int64--string :: String -> Datum String-string = Datum . Terms.string--true :: Datum 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-uint16 :: Int16 -> Datum Int16-uint16 = int16-uint32 :: Int -> Datum Int-uint32 = int-uint64 :: Int64 -> Datum Int64-uint64 = int64
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Prims.hs
@@ -1,103 +0,0 @@--- | A DSL for constructing primitive function definitions--module Hydra.Impl.Haskell.Dsl.Prims where--import Hydra.Kernel-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.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---import Data.String(IsString(..))-----instance IsString (TermCoder m (Term m)) where fromString = variable--binaryPrimitive :: Name -> TermCoder m a -> TermCoder m b -> TermCoder m c -> (a -> b -> c) -> PrimitiveFunction m-binaryPrimitive name input1 input2 output compute = PrimitiveFunction name ft impl- where- ft = FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output))- impl args = do- Terms.expectNArgs 2 args- arg1 <- coderEncode (termCoderCoder input1) (args !! 0)- arg2 <- coderEncode (termCoderCoder input2) (args !! 1)- coderDecode (termCoderCoder output) $ compute arg1 arg2--boolean :: Show m => TermCoder m Bool-boolean = TermCoder Types.boolean $ Coder encode decode- where- encode = Terms.expectBoolean- decode = pure . Terms.boolean--flow :: TermCoder m s -> TermCoder m a -> TermCoder m (Flow s a)-flow states values = TermCoder (Types.nominal _Flow Types.@@ (termCoderType states) Types.@@ (termCoderType values)) $- Coder encode decode- where- encode _ = fail $ "cannot currently encode flows from terms"- decode _ = fail $ "cannot decode flows to terms"--function :: TermCoder m a -> TermCoder m b -> TermCoder m (a -> b)-function dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) $ Coder encode decode- where- encode _ = fail $ "cannot currently encode functions from terms"- decode _ = fail $ "cannot decode functions to terms"--int32 :: Show m => TermCoder m Int-int32 = TermCoder Types.int32 $ Coder encode decode- where- encode = Terms.expectInt32- decode = pure . Terms.int32--list :: Show m => TermCoder m a -> TermCoder m [a]-list els = TermCoder (Types.list $ termCoderType els) $ Coder encode decode- where- encode = Terms.expectList (coderEncode $ termCoderCoder els)- decode l = Terms.list <$> mapM (coderDecode $ termCoderCoder els) l--map :: (Ord k, Ord m, Show m) => TermCoder m k -> TermCoder m v -> TermCoder m (M.Map k v)-map keys values = TermCoder (Types.map (termCoderType keys) (termCoderType values)) $ Coder encode decode- where- encode = Terms.expectMap (coderEncode $ termCoderCoder keys) (coderEncode $ termCoderCoder values)- decode m = Terms.map . M.fromList <$> mapM decodePair (M.toList m)- where- decodePair (k, v) = do- ke <- (coderDecode $ termCoderCoder keys) k- ve <- (coderDecode $ termCoderCoder values) v- return (ke, ve)--optional :: Show m => TermCoder m a -> TermCoder m (Y.Maybe a)-optional mel = TermCoder (Types.optional $ termCoderType mel) $ Coder encode decode- where- encode = Terms.expectOptional (coderEncode $ termCoderCoder mel)- decode mv = Terms.optional <$> case mv of- Nothing -> pure Nothing- Just v -> Just <$> (coderDecode $ termCoderCoder mel) v--set :: (Ord a, Ord m, Show m) => TermCoder m a -> TermCoder m (S.Set a)-set els = TermCoder (Types.set $ termCoderType els) $ Coder encode decode- where- encode = Terms.expectSet (coderEncode $ termCoderCoder els)- decode s = Terms.set . S.fromList <$> mapM (coderDecode $ termCoderCoder els) (S.toList s)--string :: Show m => TermCoder m String-string = TermCoder Types.string $ Coder encode decode- where- encode = Terms.expectString- decode = pure . Terms.string--unaryPrimitive :: Name -> TermCoder m a -> TermCoder m b -> (a -> b) -> PrimitiveFunction m-unaryPrimitive name input1 output compute = PrimitiveFunction name ft impl- where- ft = FunctionType (termCoderType input1) $ termCoderType output- impl args = do- Terms.expectNArgs 1 args- arg1 <- coderEncode (termCoderCoder input1) (args !! 0)- coderDecode (termCoderCoder output) $ compute arg1--variable :: String -> TermCoder m (Term m)-variable v = TermCoder (Types.variable v) $ Coder encode decode- where- encode = pure- decode = pure
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Standard.hs
@@ -1,80 +0,0 @@--- | A DSL which is used as a basis for some of the other DSLs--module Hydra.Impl.Haskell.Dsl.Standard (- module Hydra.Impl.Haskell.Dsl.Standard,- module Hydra.Impl.Haskell.Dsl.Bootstrap-) where--import Hydra.Kernel-import Hydra.Meta-import Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Sources.Libraries-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Dsl.Bootstrap--import qualified Data.Map as M-import qualified Data.Maybe as Y---key_maxSize = "maxLength"-key_minSize = "minLength"--annotateTerm :: String -> Y.Maybe (Term Meta) -> Term Meta -> Term Meta-annotateTerm = setTermAnnotation coreContext--annotateType :: String -> Y.Maybe (Term Meta) -> Type Meta -> Type Meta-annotateType = setTypeAnnotation coreContext--bounded :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta-bounded min max = annotMin . annotMax- where- annotMax t = Y.maybe t (`setMaxLength` t) max- annotMin t = Y.maybe t (`setMinLength` t) max--boundedList :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta-boundedList min max et = bounded min max $ Types.list et--boundedSet :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta-boundedSet min max et = bounded min max $ Types.set et--boundedString :: Maybe Int -> Maybe Int -> Type Meta-boundedString min max = bounded min max Types.string--coreContext :: Context Meta-coreContext = bootstrapContext {- contextGraph = hydraCore,- contextFunctions = M.fromList $ fmap (\p -> (primitiveFunctionName p, p)) standardPrimitives}--doc :: String -> Type Meta -> Type Meta-doc s = setTypeDescription coreContext (Just s)--dataDoc :: String -> Term Meta -> Term Meta-dataDoc s = setTermDescription coreContext (Just s)--dataterm :: Namespace -> String -> Type Meta -> Term Meta -> Element Meta-dataterm gname lname = termElement (qualify gname (Name lname))--graphContext :: Graph Meta -> Context Meta-graphContext g = coreContext {contextGraph = g}--nonemptyList :: Type Meta -> Type Meta-nonemptyList = boundedList (Just 1) Nothing--note :: String -> Type Meta -> Type Meta-note s = doc $ "Note: " ++ s--see :: String -> Type Meta -> Type Meta-see s = doc $ "See " ++ s--setMaxLength :: Int -> Type Meta -> Type Meta-setMaxLength m = setTypeAnnotation coreContext key_maxSize (Just $ Terms.int32 m)--setMinLength :: Int -> Type Meta -> Type Meta-setMinLength m = setTypeAnnotation coreContext key_minSize (Just $ Terms.int32 m)--standardGraph :: [Element Meta] -> Graph Meta-standardGraph = elementsToGraph (Just hydraCore)--twoOrMoreList :: Type Meta -> Type Meta-twoOrMoreList = boundedList (Just 2) Nothing
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Terms.hs
@@ -1,266 +0,0 @@--- | A DSL for constructing Hydra terms--module Hydra.Impl.Haskell.Dsl.Terms where--import Hydra.Kernel-import qualified Hydra.Impl.Haskell.Dsl.Literals as Literals--import Prelude hiding (map)-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 qualified Control.Monad as CM-import Data.Int-import Data.String(IsString(..))---instance IsString (Term m) where fromString = string--annot :: m -> Term m -> Term m-annot ann t = TermAnnotated $ Annotated t ann--apply :: Term m -> Term m -> Term m-apply func arg = TermApplication $ Application func arg--bigfloat :: Double -> Term m-bigfloat = literal . Literals.bigfloat--bigint :: Integer -> Term m-bigint = literal . Literals.bigint--binary :: String -> Term m-binary = literal . Literals.binary--boolean :: Bool -> Term m-boolean = literal . Literals.boolean--cases :: Name -> [Field m] -> Term m-cases n fields = TermFunction $ FunctionElimination $ EliminationUnion $ CaseStatement n fields--compareTo :: Term m -> Term m-compareTo = TermFunction . FunctionCompareTo--constFunction :: Term m -> Term m-constFunction = lambda "_"--delta :: Term m-delta = TermFunction $ FunctionElimination EliminationElement--element :: Name -> Term m-element = TermElement--elementRef :: Element a -> Term m-elementRef = apply delta . TermElement . elementName--elementRefByName :: Name -> Term m-elementRefByName = apply delta . TermElement--eliminateNominal :: Name -> Term m-eliminateNominal = TermFunction . FunctionElimination . EliminationNominal--elimination :: Elimination m -> Term m-elimination = TermFunction . FunctionElimination--expectBinary :: Show m => Term m -> Flow s String-expectBinary = expectLiteral Literals.expectBinary--expectBoolean :: Show m => Term m -> Flow s Bool-expectBoolean = expectLiteral Literals.expectBoolean--expectFloat32 :: Show m => Term m -> Flow s Float-expectFloat32 = expectLiteral Literals.expectFloat32--expectFloat64 :: Show m => Term m -> Flow s Double-expectFloat64 = expectLiteral Literals.expectFloat64--expectInt32 :: Show m => Term m -> Flow s Int-expectInt32 = expectLiteral Literals.expectInt32--expectInt64 :: Show m => Term m -> Flow s Integer-expectInt64 = expectLiteral Literals.expectInt64--expectList :: Show m => (Term m -> Flow s a) -> Term m -> Flow s [a]-expectList f term = case stripTerm term of- TermList l -> CM.mapM f l- _ -> unexpected "list" term--expectLiteral :: Show m => (Literal -> Flow s a) -> Term m -> Flow s a-expectLiteral expect term = case stripTerm term of- TermLiteral lit -> expect lit- _ -> unexpected "literal" term--expectMap :: (Ord k, Show m) => (Term m -> Flow s k) -> (Term m -> Flow s v) -> Term m -> Flow s (M.Map k v)-expectMap fk fv term = case stripTerm term of- TermMap m -> M.fromList <$> CM.mapM expectPair (M.toList m)- where- expectPair (kterm, vterm) = do- kval <- fk kterm- vval <- fv vterm- return (kval, vval)- _ -> unexpected "map" term--expectNArgs :: Int -> [Term m] -> Flow s ()-expectNArgs n args = if L.length args /= n- then unexpected (show n ++ " arguments") (L.length args)- else pure ()--expectOptional :: Show m => (Term m -> Flow s a) -> Term m -> Flow s (Y.Maybe a)-expectOptional f term = case stripTerm term of- TermOptional mt -> case mt of- Nothing -> pure Nothing- Just t -> Just <$> f t- _ -> unexpected "optional value" term--expectRecord :: Show m => Term m -> Flow s [Field m]-expectRecord term = case stripTerm term of- TermRecord (Record _ fields) -> pure fields- _ -> unexpected "record" term--expectSet :: (Ord a, Show m) => (Term m -> Flow s a) -> Term m -> Flow s (S.Set a)-expectSet f term = case stripTerm term of- TermSet s -> S.fromList <$> CM.mapM f (S.toList s)- _ -> unexpected "set" term--expectString :: Show m => Term m -> Flow s String-expectString = expectLiteral Literals.expectString--expectUnion :: Show m => Term m -> Flow s (Field m)-expectUnion term = case stripTerm term of- TermUnion (Union _ field) -> pure field- _ -> unexpected "union" term--field :: String -> Term m -> Field m-field n = Field (FieldName n)--fieldsToMap :: [Field m] -> M.Map FieldName (Term m)-fieldsToMap fields = M.fromList $ (\(Field name term) -> (name, term)) <$> fields--float32 :: Float -> Term m-float32 = literal . Literals.float32--float64 :: Double -> Term m-float64 = literal . Literals.float64--float :: FloatValue -> Term m-float = literal . Literals.float--fold :: Term m -> Term m-fold = TermFunction . FunctionElimination . EliminationList--int16 :: Int16 -> Term m-int16 = literal . Literals.int16--int32 :: Int -> Term m-int32 = literal . Literals.int32--int64 :: Int64 -> Term m-int64 = literal . Literals.int64--int8 :: Int8 -> Term m-int8 = literal . Literals.int8--integer :: IntegerValue -> Term m-integer = literal . Literals.integer--isUnit :: Eq m => Term m -> Bool-isUnit t = stripTerm t == TermRecord (Record unitTypeName [])--lambda :: String -> Term m -> Term m-lambda param body = TermFunction $ FunctionLambda $ Lambda (Variable param) body--letTerm :: Variable -> Term m -> Term m -> Term m-letTerm v t1 t2 = TermLet $ Let v t1 t2--list :: [Term m] -> Term m-list = TermList--literal :: Literal -> Term m-literal = TermLiteral--map :: M.Map (Term m) (Term m) -> Term m-map = TermMap--mapTerm :: M.Map (Term m) (Term m) -> Term m-mapTerm = TermMap--match :: Name -> [(FieldName, Term m)] -> Term m-match n = cases n . fmap toField- where- toField (name, term) = Field name term--matchOptional :: Term m -> Term m -> Term m-matchOptional n j = TermFunction $ FunctionElimination $ EliminationOptional $ OptionalCases n j--matchWithVariants :: Name -> [(FieldName, FieldName)] -> Term m-matchWithVariants n = cases n . fmap toField- where- toField (from, to) = Field from $ constFunction $ unitVariant n to--nominal :: Name -> Term m -> Term m-nominal name term = TermNominal $ Named name term--optional :: Y.Maybe (Term m) -> Term m-optional = TermOptional--primitive :: Name -> Term m-primitive = TermFunction . FunctionPrimitive--product :: [Term m] -> Term m-product = TermProduct--projection :: Name -> FieldName -> Term m-projection n fname = TermFunction $ FunctionElimination $ EliminationRecord $ Projection n fname--record :: Name -> [Field m] -> Term m-record n fields = TermRecord $ Record n fields--requireField :: M.Map FieldName (Term m) -> FieldName -> GraphFlow m (Term m)-requireField fields fname = Y.maybe err pure $ M.lookup fname fields- where- err = fail $ "no such field: " ++ unFieldName fname--set :: S.Set (Term m) -> Term m-set = TermSet--stringList :: [String] -> Term m-stringList l = list (string <$> l)--stringSet :: Ord m => S.Set String -> Term m-stringSet strings = set $ S.fromList $ string <$> S.toList strings--string :: String -> Term m-string = TermLiteral . LiteralString--sum :: Int -> Int -> Term m -> Term m-sum i s term = TermSum $ Sum i s term--uint16 :: Integer -> Term m-uint16 = literal . Literals.uint16--uint32 :: Integer -> Term m-uint32 = literal . Literals.uint32--uint64 :: Integer -> Term m-uint64 = literal . Literals.uint64--uint8 :: Integer -> Term m-uint8 = literal . Literals.uint8--union :: Name -> Field m -> Term m-union n = TermUnion . Union n--unit :: Term m-unit = TermRecord $ Record (Name "hydra/core.UnitType") []--unitVariant :: Name -> FieldName -> Term m-unitVariant n fname = variant n fname unit--variable :: String -> Term m-variable = TermVariable . Variable--variant :: Name -> FieldName -> Term m -> Term m-variant n fname term = TermUnion $ Union n $ Field fname term--withVariant :: Name -> FieldName -> Term m-withVariant n = constFunction . unitVariant n
− src/main/haskell/Hydra/Impl/Haskell/Dsl/Types.hs
@@ -1,142 +0,0 @@--- | A DSL for constructing Hydra types--module Hydra.Impl.Haskell.Dsl.Types where--import Hydra.Kernel--import qualified Data.List as L-import qualified Data.Map as M-import Data.String(IsString(..))---instance IsString (Type m) where fromString = variable--infixr 0 >:-(>:) :: String -> Type m -> FieldType m-n >: t = field n t--infixr 0 -->-(-->) :: Type m -> Type m -> Type m-a --> b = function a b--(@@) :: Type m -> Type m -> Type m-f @@ x = apply f x--annot :: m -> Type m -> Type m-annot ann t = TypeAnnotated $ Annotated t ann--apply :: Type m -> Type m -> Type m-apply lhs rhs = TypeApplication (ApplicationType lhs rhs)--bigfloat :: Type m-bigfloat = float FloatTypeBigfloat--bigint :: Type m-bigint = integer IntegerTypeBigint--binary :: Type m-binary = literal LiteralTypeBinary--boolean :: Type m-boolean = literal LiteralTypeBoolean--element :: Type m -> Type m-element = TypeElement--enum :: [String] -> Type m-enum names = union $ (`field` unit) <$> names--field :: String -> Type m -> FieldType m-field fn = FieldType (FieldName fn)--fieldsToMap :: [FieldType m] -> M.Map FieldName (Type m)-fieldsToMap fields = M.fromList $ (\(FieldType name typ) -> (name, typ)) <$> fields--float32 :: Type m-float32 = float FloatTypeFloat32--float64 :: Type m-float64 = float FloatTypeFloat64--float :: FloatType -> Type m-float = literal . LiteralTypeFloat--function :: Type m -> Type m -> Type m-function dom cod = TypeFunction $ FunctionType dom cod--functionN :: [Type m] -> Type m -> Type m-functionN doms cod = if L.null doms- then cod- else function (L.head doms) $ functionN (L.tail doms) cod--int16 :: Type m-int16 = integer IntegerTypeInt16--int32 :: Type m-int32 = integer IntegerTypeInt32--int64 :: Type m-int64 = integer IntegerTypeInt64--int8 :: Type m-int8 = integer IntegerTypeInt8--integer :: IntegerType -> Type m-integer = literal . LiteralTypeInteger--lambda :: String -> Type m -> Type m-lambda v body = TypeLambda $ LambdaType (VariableType v) body--list :: Type m -> Type m-list = TypeList--isUnit :: Eq m => Type m -> Bool-isUnit t = stripType t == TypeRecord (RowType unitTypeName Nothing [])--literal :: LiteralType -> Type m-literal = TypeLiteral--map :: Type m -> Type m -> Type m-map kt vt = TypeMap $ MapType kt vt--nominal :: Name -> Type m-nominal = TypeNominal--optional :: Type m -> Type m-optional = TypeOptional--product :: [Type m] -> Type m-product = TypeProduct--record :: [FieldType m] -> Type m-record fields = TypeRecord $ RowType placeholderName Nothing fields--set :: Type m -> Type m-set = TypeSet--string :: Type m-string = literal LiteralTypeString--sum :: [Type m] -> Type m-sum = TypeSum--uint16 :: Type m-uint16 = integer IntegerTypeUint16--uint32 :: Type m-uint32 = integer IntegerTypeUint32--uint64 :: Type m-uint64 = integer IntegerTypeUint64--uint8 :: Type m-uint8 = integer IntegerTypeUint8--union :: [FieldType m] -> Type m-union fields = TypeUnion $ RowType placeholderName Nothing fields--unit :: Type m-unit = TypeRecord $ RowType (Name "hydra/core.UnitType") Nothing []--variable :: String -> Type m-variable = TypeVariable . VariableType
− src/main/haskell/Hydra/Impl/Haskell/Ext/Bytestrings.hs
@@ -1,12 +0,0 @@-module Hydra.Impl.Haskell.Ext.Bytestrings where--import qualified Data.ByteString.Lazy as BS-import qualified Data.Text.Lazy.Encoding as DTE-import qualified Data.Text.Lazy as TL---bytesToString :: BS.ByteString -> String-bytesToString = TL.unpack . DTE.decodeUtf8--stringToBytes :: String -> BS.ByteString-stringToBytes = DTE.encodeUtf8 . TL.pack
− src/main/haskell/Hydra/Impl/Haskell/Ext/Json/Serde.hs
@@ -1,77 +0,0 @@-module Hydra.Impl.Haskell.Ext.Json.Serde where--import Hydra.Kernel-import Hydra.Ext.Json.Coder-import qualified Hydra.Ext.Json.Model as Json-import Hydra.Impl.Haskell.Ext.Bytestrings--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.HashMap.Strict as HS-import qualified Data.Scientific as SC-import qualified Data.Char as C-import qualified Data.String as String---aesonToBytes :: A.Value -> BS.ByteString-aesonToBytes = A.encode--aesonToValue :: A.Value -> Json.Value-aesonToValue v = case v of- A.Object km -> Json.ValueObject $ M.fromList (mapPair <$> AKM.toList km)- where- mapPair (k, v) = (AK.toString k, aesonToValue v)- A.Array a -> Json.ValueArray (aesonToValue <$> 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--bytesToAeson :: BS.ByteString -> Either String A.Value-bytesToAeson = A.eitherDecode--bytesToValue :: BS.ByteString -> Either String Json.Value-bytesToValue bs = aesonToValue <$> bytesToAeson bs--jsonSerde :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) BS.ByteString)-jsonSerde typ = do- coder <- jsonCoder typ- return Coder {- coderEncode = fmap valueToBytes . coderEncode coder,- coderDecode = \bs -> case bytesToValue bs of- Left msg -> fail $ "JSON parsing failed: " ++ msg- Right v -> coderDecode coder v}--jsonSerdeStr :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) String)-jsonSerdeStr typ = do- serde <- jsonSerde typ- return Coder {- coderEncode = fmap bytesToString . coderEncode serde,- coderDecode = coderDecode serde . stringToBytes}--stringToValue :: String -> Either String Json.Value-stringToValue = bytesToValue . stringToBytes--valueToAeson :: Json.Value -> A.Value-valueToAeson v = case v of- Json.ValueArray l -> A.Array $ V.fromList (valueToAeson <$> 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, valueToAeson v)- Json.ValueString s -> A.String $ T.pack s--valueToBytes :: Json.Value -> BS.ByteString-valueToBytes = aesonToBytes . valueToAeson--valueToString :: Json.Value -> String-valueToString = bytesToString . valueToBytes
− src/main/haskell/Hydra/Impl/Haskell/Ext/Yaml/Serde.hs
@@ -1,80 +0,0 @@-module Hydra.Impl.Haskell.Ext.Yaml.Serde where--import Hydra.Kernel-import Hydra.Ext.Yaml.Coder-import qualified Hydra.Ext.Yaml.Model as YM-import Hydra.Impl.Haskell.Ext.Bytestrings--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 -> GraphFlow m (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 -> GraphFlow m YM.Node-bytesToHydraYaml = bytesToHsYaml CM.>=> hsYamlToHydraYaml--hsYamlToBytes :: DY.Node () -> BS.ByteString-hsYamlToBytes node = DY.encodeNode [DY.Doc node]--hsYamlToHydraYaml :: DY.Node a -> GraphFlow m 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--yamlSerde :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) BS.ByteString)-yamlSerde typ = do- coder <- yamlCoder typ- return Coder {- coderEncode = fmap hydraYamlToBytes . coderEncode coder,- coderDecode = bytesToHydraYaml CM.>=> coderDecode coder}--yamlSerdeStr :: (Eq m, Ord m, Read m, Show m) => Type m -> GraphFlow m (Coder (Context m) (Context m) (Term m) String)-yamlSerdeStr typ = do- serde <- yamlSerde typ- return Coder {- coderEncode = fmap LB.unpack . coderEncode serde,- coderDecode = coderDecode serde . LB.pack}
− src/main/haskell/Hydra/Impl/Haskell/Sources/Adapters/Utils.hs
@@ -1,95 +0,0 @@-module Hydra.Impl.Haskell.Sources.Adapters.Utils where--import Hydra.Kernel-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Sources.Basics-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard-import Hydra.Impl.Haskell.Dsl.Base as Base-import Hydra.Impl.Haskell.Dsl.Lib.Literals as Literals--import Prelude hiding ((++))---utilsNs = Namespace "hydra/adapters/utils"--adapterUtilsModule :: Module Meta-adapterUtilsModule = Module utilsNs elements [hydraBasicsModule] $- Just "Utilities for use in transformations"- where- elements = [- el describeFloatTypeSource,- el describeIntegerTypeSource,- el describeLiteralTypeSource,- el describePrecisionSource,- el describeTypeSource]--utils :: String -> Datum a -> Definition a-utils = Definition . fromQname utilsNs--describeFloatTypeSource :: Definition (FloatType -> String)-describeFloatTypeSource = utils "describeFloatType" $- doc "Display a floating-point type as a string" $- function (Types.nominal _FloatType) Types.string $- lambda "t" $ (ref describePrecisionSource <.> ref floatTypePrecisionSource @@ var "t") ++ string " floating-point numbers"--describeIntegerTypeSource :: Definition (IntegerType -> String)-describeIntegerTypeSource = utils "describeIntegerType" $- doc "Display an integer type as a string" $- function (Types.nominal _IntegerType) Types.string $- lambda "t" $ (ref describePrecisionSource <.> ref integerTypePrecisionSource @@ var "t")- ++ string " integers"--describeLiteralTypeSource :: Definition (LiteralType -> String)-describeLiteralTypeSource = utils "describeLiteralType" $- doc "Display a literal type as a string" $- match _LiteralType Types.string [- Case _LiteralType_binary --> constant $ string "binary strings",- Case _LiteralType_boolean --> constant $ string "boolean values",- Case _LiteralType_float --> ref describeFloatTypeSource,- Case _LiteralType_integer --> ref describeIntegerTypeSource,- Case _LiteralType_string --> constant $ string "character strings"]--describePrecisionSource :: Definition (Precision -> String)-describePrecisionSource = utils "describePrecision" $- doc "Display numeric precision as a string" $- match _Precision Types.string [- Case _Precision_arbitrary --> constant $ string "arbitrary-precision",- Case _Precision_bits --> lambda "bits" $- showInt32 @@ var "bits" ++ string "-bit"]--describeTypeSource :: Definition (Type m -> string)-describeTypeSource = utils "describeType" $- doc "Display a type as a string" $- function (Types.apply (Types.nominal _Type) (Types.variable "m")) Types.string $- lambda "typ" $ apply- (match _Type Types.string [- Case _Type_annotated --> lambda "a" $ string "annotated " ++ (ref describeTypeSource @@- (project _Annotated typeM _Annotated_subject @@ var "a")),- Case _Type_application --> constant $ string "instances of an application type",- Case _Type_literal --> ref describeLiteralTypeSource,- Case _Type_element --> lambda "t" $ string "elements containing " ++ (ref describeTypeSource @@ var "t"),- Case _Type_function --> lambda "ft" $ string "functions from "- ++ (ref describeTypeSource @@ (project _FunctionType typeM _FunctionType_domain @@ var "ft"))- ++ string " to "- ++ (ref describeTypeSource @@ (project _FunctionType typeM _FunctionType_codomain @@ var "ft")),- Case _Type_lambda --> constant $ string "polymorphic terms",- Case _Type_list --> lambda "t" $ string "lists of " ++ (ref describeTypeSource @@ var "t"),- Case _Type_map --> lambda "mt" $ string "maps from "- ++ (ref describeTypeSource @@ (project _MapType typeM _MapType_keys @@ var "mt"))- ++ string " to "- ++ (ref describeTypeSource @@ (project _MapType typeM _MapType_values @@ var "mt")),- Case _Type_nominal --> lambda "name" $ string "alias for " ++ (denom _Name @@ var "name"),- Case _Type_optional --> lambda "ot" $ string "optional " ++ (ref describeTypeSource @@ var "ot"),- Case _Type_product --> constant $ string "tuples",- Case _Type_record --> constant $ string "records",- Case _Type_set --> lambda "st" $ string "sets of " ++ (ref describeTypeSource @@ var "st"),- Case _Type_stream --> lambda "t" $ string "streams of " ++ (ref describeTypeSource @@ var "t"),- Case _Type_sum --> constant $ string "variant tuples",- Case _Type_union --> constant $ string "unions",- Case _Type_variable --> constant $ string "unspecified/parametric terms"])- (var "typ")- where- annotatedTypeM = Types.apply (Types.apply (Types.nominal _Annotated) (Types.apply (Types.nominal _Type) (Types.variable "m"))) (Types.variable "m")- functionTypeM = Types.apply (Types.nominal _FunctionType) (Types.variable "m")- typeM = Types.apply (Types.nominal _Type) (Types.variable "m")- mapTypeM = Types.apply (Types.nominal _MapType) (Types.variable "m")
− src/main/haskell/Hydra/Impl/Haskell/Sources/Basics.hs
@@ -1,318 +0,0 @@-module Hydra.Impl.Haskell.Sources.Basics where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Base as Base-import Hydra.Impl.Haskell.Sources.Module-import Hydra.Impl.Haskell.Sources.Mantle-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Lib.Lists as Lists-import Hydra.Impl.Haskell.Dsl.Lib.Strings as Strings---basicsNs = Namespace "hydra/basics"--basics :: String -> Datum a -> Definition a-basics = Definition . fromQname basicsNs--hydraBasicsModule :: Module Meta-hydraBasicsModule = Module basicsNs elements [hydraMantleModule] $- Just "Basic functions for working with types and terms"- where- elements = [- el eliminationVariantSource,- el eliminationVariantsSource,- el floatTypePrecisionSource,- el floatTypesSource,- el floatValueTypeSource,- el functionVariantSource,- el functionVariantsSource,- el integerTypeIsSignedSource,- el integerTypePrecisionSource,- el integerTypesSource,- el integerValueTypeSource,- el literalTypeSource,- el literalTypeVariantSource,- el literalVariantSource,- el literalVariantsSource,- el qnameSource,- el termVariantSource,- el termVariantsSource,- el testListsSource,- el typeVariantSource,- el typeVariantsSource]--eliminationVariantSource :: Definition (Elimination m -> EliminationVariant)-eliminationVariantSource = basics "eliminationVariant" $- doc "Find the elimination variant (constructor) for a given elimination term" $- typed (Types.function (Types.apply (Types.nominal _Elimination) (Types.variable "m")) (Types.nominal _EliminationVariant)) $- matchToEnum _Elimination _EliminationVariant [- _Elimination_element @-> _EliminationVariant_element,- _Elimination_list @-> _EliminationVariant_list,- _Elimination_nominal @-> _EliminationVariant_nominal,- _Elimination_optional @-> _EliminationVariant_optional,- _Elimination_record @-> _EliminationVariant_record,- _Elimination_union @-> _EliminationVariant_union]--eliminationVariantsSource :: Definition [EliminationVariant]-eliminationVariantsSource = basics "eliminationVariants" $- doc "All elimination variants (constructors), in a canonical order" $- typed (Types.list $ Types.nominal _EliminationVariant) $- list $ unitVariant _EliminationVariant <$> [- _EliminationVariant_element,- _EliminationVariant_list,- _EliminationVariant_nominal,- _EliminationVariant_optional,- _EliminationVariant_record,- _EliminationVariant_union]--floatTypePrecisionSource :: Definition (FloatType -> Precision)-floatTypePrecisionSource = basics "floatTypePrecision" $- doc "Find the precision of a given floating-point type" $- matchToUnion _FloatType _Precision [- _FloatType_bigfloat @-> field _Precision_arbitrary unit,- _FloatType_float32 @-> field _Precision_bits $ int 32,- _FloatType_float64 @-> field _Precision_bits $ int 64]--floatTypesSource :: Definition [FloatType]-floatTypesSource = basics "floatTypes" $- doc "All floating-point types in a canonical order" $- typed (Types.list $ Types.nominal _FloatType) $- list $ unitVariant _FloatType <$> [- _FloatType_bigfloat,- _FloatType_float32,- _FloatType_float64]--floatValueTypeSource :: Definition (FloatValue -> FloatType)-floatValueTypeSource = basics "floatValueType" $- doc "Find the float type for a given floating-point value" $- matchToEnum _FloatValue _FloatType [- _FloatValue_bigfloat @-> _FloatType_bigfloat,- _FloatValue_float32 @-> _FloatType_float32,- _FloatValue_float64 @-> _FloatType_float64]--functionVariantSource :: Definition (Function m -> FunctionVariant)-functionVariantSource = basics "functionVariant" $- doc "Find the function variant (constructor) for a given function" $- typed (Types.function (Types.apply (Types.nominal _Function) (Types.variable "m")) (Types.nominal _FunctionVariant)) $- matchToEnum _Function _FunctionVariant [- _Function_compareTo @-> _FunctionVariant_compareTo,- _Function_elimination @-> _FunctionVariant_elimination,- _Function_lambda @-> _FunctionVariant_lambda,- _Function_primitive @-> _FunctionVariant_primitive]--functionVariantsSource :: Definition [FunctionVariant]-functionVariantsSource = basics "functionVariants" $- doc "All function variants (constructors), in a canonical order" $- typed (Types.list $ Types.nominal _FunctionVariant) $- list $ unitVariant _FunctionVariant <$> [- _FunctionVariant_compareTo,- _FunctionVariant_elimination,- _FunctionVariant_lambda,- _FunctionVariant_primitive]--integerTypeIsSignedSource :: Definition (IntegerType -> Bool)-integerTypeIsSignedSource = basics "integerTypeIsSigned" $- doc "Find whether a given integer type is signed (true) or unsigned (false)" $- matchData _IntegerType [- _IntegerType_bigint @-> constant true,- _IntegerType_int8 @-> constant true,- _IntegerType_int16 @-> constant true,- _IntegerType_int32 @-> constant true,- _IntegerType_int64 @-> constant true,- _IntegerType_uint8 @-> constant false,- _IntegerType_uint16 @-> constant false,- _IntegerType_uint32 @-> constant false,- _IntegerType_uint64 @-> constant false]--integerTypePrecisionSource :: Definition (IntegerType -> Precision)-integerTypePrecisionSource = basics "integerTypePrecision" $- doc "Find the precision of a given integer type" $- matchToUnion _IntegerType _Precision [- _IntegerType_bigint @-> field _Precision_arbitrary unit,- _IntegerType_int8 @-> field _Precision_bits $ int 8,- _IntegerType_int16 @-> field _Precision_bits $ int 16,- _IntegerType_int32 @-> field _Precision_bits $ int 32,- _IntegerType_int64 @-> field _Precision_bits $ int 64,- _IntegerType_uint8 @-> field _Precision_bits $ int 8,- _IntegerType_uint16 @-> field _Precision_bits $ int 16,- _IntegerType_uint32 @-> field _Precision_bits $ int 32,- _IntegerType_uint64 @-> field _Precision_bits $ int 64]--integerTypesSource :: Definition [IntegerType]-integerTypesSource = basics "integerTypes" $- doc "All integer types, in a canonical order" $- typed (Types.list $ Types.nominal _IntegerType) $- list $ unitVariant _IntegerType <$> [- _IntegerType_bigint,- _IntegerType_int8,- _IntegerType_int16,- _IntegerType_int32,- _IntegerType_int64,- _IntegerType_uint8,- _IntegerType_uint16,- _IntegerType_uint32,- _IntegerType_uint64]--integerValueTypeSource :: Definition (IntegerValue -> IntegerType)-integerValueTypeSource = basics "integerValueType" $- doc "Find the integer type for a given integer value" $- matchToEnum _IntegerValue _IntegerType [- _IntegerValue_bigint @-> _IntegerType_bigint,- _IntegerValue_int8 @-> _IntegerType_int8,- _IntegerValue_int16 @-> _IntegerType_int16,- _IntegerValue_int32 @-> _IntegerType_int32,- _IntegerValue_int64 @-> _IntegerType_int64,- _IntegerValue_uint8 @-> _IntegerType_uint8,- _IntegerValue_uint16 @-> _IntegerType_uint16,- _IntegerValue_uint32 @-> _IntegerType_uint32,- _IntegerValue_uint64 @-> _IntegerType_uint64]--literalTypeSource :: Definition (Literal -> LiteralType)-literalTypeSource = basics "literalType" $- doc "Find the literal type for a given literal value" $- match _Literal (Types.nominal _LiteralType) [- Case _Literal_binary --> constant $ variant _LiteralType _LiteralType_binary unit,- Case _Literal_boolean --> constant $ variant _LiteralType _LiteralType_boolean unit,- Case _Literal_float --> union2 _LiteralType _LiteralType_float <.> ref floatValueTypeSource,- Case _Literal_integer --> union2 _LiteralType _LiteralType_integer <.> ref integerValueTypeSource,- Case _Literal_string --> constant $ variant _LiteralType _LiteralType_string unit]--literalTypeVariantSource :: Definition (LiteralType -> LiteralVariant)-literalTypeVariantSource = basics "literalTypeVariant" $- doc "Find the literal type variant (constructor) for a given literal value" $- matchToEnum _LiteralType _LiteralVariant [- _LiteralType_binary @-> _LiteralVariant_binary,- _LiteralType_boolean @-> _LiteralVariant_boolean,- _LiteralType_float @-> _LiteralVariant_float,- _LiteralType_integer @-> _LiteralVariant_integer,- _LiteralType_string @-> _LiteralVariant_string]--literalVariantSource :: Definition (Literal -> LiteralVariant)-literalVariantSource = basics "literalVariant" $- doc "Find the literal variant (constructor) for a given literal value" $- function (Types.nominal _Literal) (Types.nominal _LiteralVariant) $- ref literalTypeVariantSource <.> ref literalTypeSource--literalVariantsSource :: Definition [LiteralVariant]-literalVariantsSource = basics "literalVariants" $- doc "All literal variants, in a canonical order" $- typed (Types.list $ Types.nominal _LiteralVariant) $- list $ unitVariant _LiteralVariant <$> [- _LiteralVariant_binary,- _LiteralVariant_boolean,- _LiteralVariant_float,- _LiteralVariant_integer,- _LiteralVariant_string]--qnameSource :: Definition (Namespace -> String -> Name)-qnameSource = basics "qname" $- doc "Construct a qualified (dot-separated) name" $- functionN [Types.nominal _Namespace, Types.string] (Types.nominal _Name) $- lambda "ns" $- lambda "name" $- nom _Name $- apply cat $- list [apply (denom _Namespace) (var "ns"), string ".", var "name"]--termVariantSource :: Definition (Term m -> TermVariant)-termVariantSource = basics "termVariant" $- doc "Find the term variant (constructor) for a given term" $- function (Types.apply (Types.nominal _Term) (Types.variable "m")) (Types.nominal _TermVariant) $- lambda "term" $ apply- (matchToEnum _Term _TermVariant [- _Term_annotated @-> _TermVariant_annotated,- _Term_application @-> _TermVariant_application,- _Term_element @-> _TermVariant_element,- _Term_function @-> _TermVariant_function,- _Term_let @-> _TermVariant_let,- _Term_list @-> _TermVariant_list,- _Term_literal @-> _TermVariant_literal,- _Term_map @-> _TermVariant_map,- _Term_nominal @-> _TermVariant_nominal,- _Term_optional @-> _TermVariant_optional,- _Term_product @-> _TermVariant_product,- _Term_record @-> _TermVariant_record,- _Term_set @-> _TermVariant_set,- _Term_stream @-> _TermVariant_stream,- _Term_sum @-> _TermVariant_sum,- _Term_union @-> _TermVariant_union,- _Term_variable @-> _TermVariant_variable])- (var "term")--termVariantsSource :: Definition [TermVariant]-termVariantsSource = basics "termVariants" $- doc "All term (expression) variants, in a canonical order" $- typed (Types.list $ Types.nominal _TermVariant) $- list $ unitVariant _TermVariant <$> [- _TermVariant_annotated,- _TermVariant_application,- _TermVariant_literal,- _TermVariant_element,- _TermVariant_function,- _TermVariant_list,- _TermVariant_map,- _TermVariant_nominal,- _TermVariant_optional,- _TermVariant_product,- _TermVariant_record,- _TermVariant_set,- _TermVariant_stream,- _TermVariant_sum,- _TermVariant_union,- _TermVariant_variable]---- TODO: remove once there are other polymorphic functions in use-testListsSource :: Definition ([[a]] -> Int)-testListsSource = basics "testLists" $- doc "TODO: temporary. Just a token polymorphic function for testing" $- function (Types.list $ Types.list $ Types.variable "a") Types.int32 $- (lambda "els" (apply Lists.length (apply Lists.concat $ var "els")))--typeVariantSource :: Definition (Type m -> TypeVariant)-typeVariantSource = basics "typeVariant" $- doc "Find the type variant (constructor) for a given type" $- function (Types.apply (Types.nominal _Type) (Types.variable "m")) (Types.nominal _TypeVariant) $- lambda "typ" $ apply- (matchToEnum _Type _TypeVariant [- _Type_annotated @-> _TypeVariant_annotated,- _Type_application @-> _TypeVariant_application,- _Type_element @-> _TypeVariant_element,- _Type_function @-> _TypeVariant_function,- _Type_lambda @-> _TypeVariant_lambda,- _Type_list @-> _TypeVariant_list,- _Type_literal @-> _TypeVariant_literal,- _Type_map @-> _TypeVariant_map,- _Type_nominal @-> _TypeVariant_nominal,- _Type_optional @-> _TypeVariant_optional,- _Type_product @-> _TypeVariant_product,- _Type_record @-> _TypeVariant_record,- _Type_set @-> _TypeVariant_set,- _Type_stream @-> _TypeVariant_stream,- _Type_sum @-> _TypeVariant_sum,- _Type_union @-> _TypeVariant_union,- _Type_variable @-> _TypeVariant_variable])- (var "typ")--typeVariantsSource :: Definition [TypeVariant]-typeVariantsSource = basics "typeVariants" $- doc "All type variants, in a canonical order" $- typed (Types.list $ Types.nominal _TypeVariant) $- list $ unitVariant _TypeVariant <$> [- _TypeVariant_annotated,- _TypeVariant_application,- _TypeVariant_element,- _TypeVariant_function,- _TypeVariant_lambda,- _TypeVariant_list,- _TypeVariant_literal,- _TypeVariant_map,- _TypeVariant_nominal,- _TypeVariant_optional,- _TypeVariant_product,- _TypeVariant_record,- _TypeVariant_set,- _TypeVariant_stream,- _TypeVariant_sum,- _TypeVariant_union,- _TypeVariant_variable]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Compute.hs
@@ -1,160 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Compute where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Sources.Mantle---hydraComputeModule :: Module Meta-hydraComputeModule = Module ns elements [hydraMantleModule] $- Just "Abstractions for evaluation and transformations"- where- ns = Namespace "hydra/compute"- core = nsref $ moduleNamespace hydraCoreModule- mantle = nsref $ moduleNamespace hydraMantleModule- compute = nsref ns-- def = datatype ns-- elements = [- def "Adapter" $- doc "A two-level bidirectional encoder which adapts types to types and terms to terms" $- lambda "s1" $ lambda "s2" $ lambda "t1" $ lambda "t2" $ lambda "v1" $ lambda "v2" $ record [- "isLossy">: boolean,- "source">: variable "t1",- "target">: variable "t2",- "coder">: compute "Coder" @@ "s1" @@ "s2" @@ "v1" @@ "v2"],-- def "AdapterContext" $- doc "An evaluation context together with a source language and a target language" $- lambda "m" $ record [- "evaluation">: apply (compute "Context") (variable "m"),- "source">: apply (compute "Language") (variable "m"),- "target">: apply (compute "Language") (variable "m")],-- def "AnnotationClass" $- doc "A typeclass-like construct providing common functions for working with annotations" $- lambda "m" $ record [- "default">: "m",- "equal">: "m" --> "m" --> boolean,- "compare">: "m" --> "m" --> mantle "Comparison",- "show">: "m" --> string,- "read">: string --> optional "m",-- -- TODO: simplify- "termMeta">:- core "Term" @@ "m" --> "m",- "typeMeta">:- core "Type" @@ "m" --> "m",- "termDescription">:- core "Term" @@ "m" --> compute "Flow" @@ (compute "Context" @@ "m") @@ optional string,- "typeDescription">:- core "Type" @@ "m" --> compute "Flow" @@ (compute "Context" @@ "m") @@ optional string,- "termType">:- core "Term" @@ "m" --> compute "Flow" @@ (compute "Context" @@ "m") @@ optional (core "Type" @@ "m"),- "setTermDescription">:- compute "Context" @@ "m" --> optional string --> core "Term" @@ "m" --> core "Term" @@ "m",- "setTermType">:- compute "Context" @@ "m" --> optional (core "Type" @@ "m") --> core "Term" @@ "m" --> core "Term" @@ "m",- "typeOf">:- "m" --> compute "Flow" @@ (compute "Context" @@ "m") @@ optional (core "Type" @@ "m"),- "setTypeOf">:- optional (core "Type" @@ "m") --> "m" --> "m"],-- def "Coder" $- doc "An encoder and decoder; a bidirectional flow between two types" $- lambda "s1" $ lambda "s2" $ lambda "v1" $ lambda "v2" $ record [- "encode">: ("v1" --> compute "Flow" @@ "s1" @@ "v2"),- "decode">: ("v2" --> compute "Flow" @@ "s2" @@ "v1")],-- def "CoderDirection" $- doc "Indicates either the 'out' or the 'in' direction of a coder" $- enum [- "encode",- "decode"],-- def "Context" $- doc "An environment containing a graph together with primitive functions and other necessary components for evaluation" $- lambda "m" $ record [- "graph">: mantle "Graph" @@ "m",- "functions">: Types.map (core "Name") (compute "PrimitiveFunction" @@ "m"),- "strategy">: compute "EvaluationStrategy",- "annotations">: compute "AnnotationClass" @@ "m"],-- def "EvaluationStrategy" $- doc "Settings which determine how terms are evaluated" $- record [- "opaqueTermVariants">: set (mantle "TermVariant")],-- def "Flow" $- doc "A variant of the State monad with built-in logging and error handling" $- lambda "s" $ lambda "a" $- function "s" (compute "Trace" --> compute "FlowState" @@ "s" @@ "a"),-- def "FlowState" $- doc "The result of evaluating a Flow" $- lambda "s" $ lambda "a" $ record [- "value">: optional "a",- "state">: "s",- "trace">: compute "Trace"],-- def "Language" $- doc "A named language together with language-specific constraints" $- lambda "m" $ record [- "name">: compute "LanguageName",- "constraints">: apply (compute "LanguageConstraints") (variable "m")],-- def "LanguageConstraints" $- doc "A set of constraints on valid type and term expressions, characterizing a language" $- lambda "m" $ record [- "eliminationVariants">: Types.set $ mantle "EliminationVariant",- "literalVariants">: Types.set $ mantle "LiteralVariant",- "floatTypes">: Types.set $ core "FloatType",- "functionVariants">: Types.set $ mantle "FunctionVariant",- "integerTypes">: Types.set $ core "IntegerType",- "termVariants">: Types.set $ mantle "TermVariant",- "typeVariants">: Types.set $ mantle "TypeVariant",- "types">: core "Type" @@ "m" --> boolean],-- def "LanguageName" $- doc "The unique name of a language" string,-- def "Meta" $- doc "A built-in metadata container for terms" $- record [- "annotations">:- doc "A map of annotation names to annotation values" $- Types.map string (core "Term" @@ compute "Meta")],-- def "PrimitiveFunction" $- doc "A built-in function" $- lambda "m" $ record [- "name">: core "Name",- "type">: core "FunctionType" @@ "m",- "implementation">:- list (core "Term" @@ "m") --> compute "Flow" @@ (compute "Context" @@ "m") @@ (core "Term" @@ "m")],-- def "TermCoder" $- doc "A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms" $- lambda "m" $ lambda "a" $ record [- "type">: core "Type" @@ "m",- "coder">: compute "Coder" @@ (compute "Context" @@ "m") @@ (compute "Context" @@ "m") @@ (core "Term" @@ "m") @@ "a"],-- def "Trace" $- doc "A container for logging and error information" $- record [- "stack">: list string,- "messages">: list string,- "other">:- doc "A map of string keys to arbitrary terms as values, for application-specific use" $- Types.map string (core "Term" @@ compute "Meta")],-- def "TraversalOrder" $- doc "Specifies either a pre-order or post-order traversal" $- union [- "pre">: doc "Pre-order traversal" unit,- "post">: doc "Post-order traversal" unit]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Core.hs
@@ -1,378 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Core where--import Hydra.Kernel-import Hydra.Meta-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Bootstrap---hydraCore :: Graph Meta-hydraCore = elementsToGraph Nothing (moduleElements hydraCoreModule)--hydraCoreModule :: Module Meta-hydraCoreModule = Module ns elements [] $- Just "Hydra's core data model, defining types, terms, and their dependencies"- where- ns = Namespace "hydra/core"- core = nsref ns- def = datatype ns- doc s = setTypeDescription bootstrapContext (Just s)-- elements = [-- def "Annotated" $- doc "An object, such as a type or term, together with an annotation" $- lambda "a" $ lambda "m" $ record [- "subject">: "a",- "annotation">: "m"],-- def "Application" $- doc "A term which applies a function to an argument" $- lambda "m" $ record [- "function">:- doc "The left-hand side of the application" $- core "Term" @@ "m",- "argument">:- doc "The right-hand side of the application" $- core "Term" @@ "m"],-- def "ApplicationType" $- doc "The type-level analog of an application term" $- lambda "m" $ record [- "function">:- doc "The left-hand side of the application" $- core "Type" @@ "m",- "argument">:- doc "The right-hand side of the application" $- core "Type" @@ "m"],-- def "CaseStatement" $- doc "A union elimination; a case statement" $- lambda "m" $ record [- "typeName">: core "Name",- "cases">: list $ core "Field" @@ "m"],-- def "Elimination" $- doc "A corresponding elimination for an introduction term" $- lambda "m" $ union [- "element">:- doc "Eliminates an element by mapping it to its data term. This is Hydra's delta function."- unit,- "list">:- doc "Eliminates a list using a fold function; this function has the signature b -> [a] -> b" $- core "Term" @@ "m",- "nominal">:- doc "Eliminates a nominal term by extracting the wrapped term" $- core "Name",- "optional">:- doc "Eliminates an optional term by matching over the two possible cases" $- core "OptionalCases" @@ "m",- "record">:- doc "Eliminates a record by projecting a given field" $- core "Projection",- "union">:- doc "Eliminates a union term by matching over the fields of the union. This is a case statement." $- core "CaseStatement" @@ "m"],-- def "Field" $- doc "A labeled term" $- lambda "m" $ record [- "name">: core "FieldName",- "term">: core "Term" @@ "m"],-- def "FieldName" $- doc "The name of a field, unique within a record or union type"- string,-- def "FieldType" $- doc "The name and type of a field" $- lambda "m" $ record [- "name">: core "FieldName",- "type">: core "Type" @@ "m"],-- def "FloatType" $- doc "A floating-point type" $- enum [- "bigfloat",- "float32",- "float64"],-- def "FloatValue" $- doc "A floating-point literal value" $- union [- "bigfloat">:- doc "An arbitrary-precision floating-point value" bigfloat,- "float32">:- doc "A 32-bit floating-point value" float32,- "float64">:- doc "A 64-bit floating-point value" float64],-- def "Function" $- doc "A function" $- lambda "m" $ union [- "compareTo">:- doc "Compares a term with a given term of the same type, producing a Comparison" $- core "Term" @@ "m",- "elimination">:- doc "An elimination for any of a few term variants" $- core "Elimination" @@ "m",- "lambda">:- doc "A function abstraction (lambda)" $- core "Lambda" @@ "m",- "primitive">:- doc "A reference to a built-in (primitive) function" $- core "Name"],-- def "FunctionType" $- doc "A function type, also known as an arrow type" $- lambda "m" $ record [- "domain">: core "Type" @@ "m",- "codomain">: core "Type" @@ "m"],-- def "IntegerType" $- doc "An integer type" $- enum [- "bigint",- "int8",- "int16",- "int32",- "int64",- "uint8",- "uint16",- "uint32",- "uint64"],-- def "IntegerValue" $- doc "An integer literal value" $- union [- "bigint">:- doc "An arbitrary-precision integer value" bigint,- "int8">:- doc "An 8-bit signed integer value" int8,- "int16">:- doc "A 16-bit signed integer value (short value)" int16,- "int32">:- doc "A 32-bit signed integer value (int value)" int32,- "int64">:- doc "A 64-bit signed integer value (long value)" int64,- "uint8">:- doc "An 8-bit unsigned integer value (byte)" uint8,- "uint16">:- doc "A 16-bit unsigned integer value" uint16,- "uint32">:- doc "A 32-bit unsigned integer value (unsigned int)" uint32,- "uint64">:- doc "A 64-bit unsigned integer value (unsigned long)" uint64],-- def "Lambda" $- doc "A function abstraction (lambda)" $- lambda "m" $ record [- "parameter">:- doc "The parameter of the lambda" $- core "Variable",- "body">:- doc "The body of the lambda" $- core "Term" @@ "m"],-- def "LambdaType" $- doc "A type abstraction; the type-level analog of a lambda term" $- lambda "m" $ record [- "parameter">:- doc "The parameter of the lambda" $- core "VariableType",- "body">:- doc "The body of the lambda" $- core "Type" @@ "m"],-- def "Let" $- doc "A 'let' binding" $- lambda "m" $ record [- "key">: core "Variable",- "value">: core "Term" @@ "m",- "environment">: core "Term" @@ "m"],-- def "Literal" $- doc "A term constant; an instance of a literal type" $- union [- "binary">:- doc "A binary literal" binary,- "boolean">:- doc "A boolean literal" boolean,- "float">:- doc "A floating-point literal" $ core "FloatValue",- "integer">:- doc "An integer literal" $- core "IntegerValue",- "string">:- doc "A string literal" string],-- def "LiteralType" $- doc "Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants" $- union [- "binary">: unit,- "boolean">: unit,- "float">: core "FloatType",- "integer">: core "IntegerType",- "string">: unit],-- def "MapType" $- doc "A map type" $- lambda "m" $ record [- "keys">: core "Type" @@ "m",- "values">: core "Type" @@ "m"],-- def "Name" $- doc "A unique element name"- string,-- def "Named" $- doc "A term annotated with a fixed, named type; an instance of a newtype" $- lambda "m" $ record [- "typeName">: core "Name",- "term">: core "Term" @@ "m"],-- def "OptionalCases" $- doc "A case statement for matching optional terms" $- lambda "m" $ record [- "nothing">:- doc "A term provided if the optional value is nothing" $- core "Term" @@ "m",- "just">:- doc "A function which is applied of the optional value is non-nothing" $- core "Term" @@ "m"],-- def "Projection" $- doc "A record elimination; a projection" $- record [- "typeName">: core "Name",- "field">: core "FieldName"],-- def "Record" $- doc "A record, or labeled tuple; a map of field names to terms" $- lambda "m" $ record [- "typeName">: core "Name",- "fields">: list $ core "Field" @@ "m"],-- def "RowType" $- doc "A labeled record or union type" $- lambda "m" $ record [- "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. To the extent that 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" @@ "m"],-- def "Stream" $- doc "An infinite stream of terms" $- lambda "m" $ record [- "first">: core "Term" @@ "m",- "rest">: core "Stream" @@ "m"],- - def "Sum" $- doc "The unlabeled equivalent of a Union term" $- lambda "m" $ record [- "index">: int32,- "size">: int32,- "term">: core "Term" @@ "m"],-- def "Term" $- doc "A data term" $- lambda "m" $ union [- "annotated">:- doc "A term annotated with metadata" $- core "Annotated" @@ (core "Term" @@ "m") @@ "m",- "application">:- doc "A function application" $- core "Application" @@ "m",- "element">:- doc "An element reference" $- core "Name",- "function">:- doc "A function term" $- core "Function" @@ "m",- "let">:- core "Let" @@ "m",- "list">:- doc "A list" $- list $ core "Term" @@ "m",- -- TODO: list elimination- "literal">:- doc "A literal value" $- core "Literal",- "map">:- doc "A map of keys to values" $- Types.map (core "Term" @@ "m") (core "Term" @@ "m"),- "nominal">:- core "Named" @@ "m",- "optional">:- doc "An optional value" $- optional $ core "Term" @@ "m",- "product">:- doc "A tuple" $- list (core "Term" @@ "m"),- "record">:- doc "A record term" $- core "Record" @@ "m",- "set">:- doc "A set of values" $- set $ core "Term" @@ "m",- "stream">:- doc "An infinite stream of terms" $- core "Stream" @@ "m",- "sum">:- doc "A variant tuple" $- core "Sum" @@ "m",- "union">:- doc "A union term" $- core "Union" @@ "m",- "variable">:- doc "A variable reference" $- core "Variable"],-- def "Type" $- doc "A data type" $- lambda "m" $ union [- "annotated">:- doc "A type annotated with metadata" $- core "Annotated" @@ (core "Type" @@ "m") @@ "m",- "application">: core "ApplicationType" @@ "m",- "element">: core "Type" @@ "m",- "function">: core "FunctionType" @@ "m",- "lambda">: core "LambdaType" @@ "m",- "list">: core "Type" @@ "m",- "literal">: core "LiteralType",- "map">: core "MapType" @@ "m",- "nominal">: core "Name",- "optional">: core "Type" @@ "m",- "product">: list (core "Type" @@ "m"),- "record">: core "RowType" @@ "m",- "set">: core "Type" @@ "m",- "stream">: core "Type" @@ "m",- "sum">: list (core "Type" @@ "m"),- "union">: core "RowType" @@ "m",- "variable">: core "VariableType"],-- def "Variable" $- doc "A symbol which stands in for a term"- string,-- def "VariableType" $- doc "A symbol which stands in for a type"- string,-- def "Union" $- doc "An instance of a union type; i.e. a string-indexed generalization of inl() or inr()" $- lambda "m" $ record [- "typeName">: core "Name",- "field">: core "Field" @@ "m"],-- def "UnitType" $- doc "An empty record type as a canonical unit type" $- record []]
− src/main/haskell/Hydra/Impl/Haskell/Sources/CoreLang.hs
@@ -1,51 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.CoreLang where--import Hydra.Kernel-import Hydra.Compute-import Hydra.Impl.Haskell.Dsl.Base as Base-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard-import Hydra.Impl.Haskell.Sources.Basics--import qualified Data.Set as S---coreLanguageNs = Namespace "hydra/coreLang"--cl :: String -> Datum a -> Definition a-cl = Definition . fromQname coreLanguageNs--coreLangModule :: Module Meta-coreLangModule = Module coreLanguageNs elements [hydraBasicsModule] Nothing- where- elements = [--- el defHydraCoreLanguage- ]-------defHydraCoreLanguage :: Definition [Language]---defHydraCoreLanguage :: Definition [LanguageConstraints m]---defHydraCoreLanguage = cl "hydraCoreLanguage" $--- doc "The trivial language of hydra/core, which admits all types and terms" $----- nominal _Language $ ... [----- lambda "m" $ record _LanguageConstraints [--- record _LanguageConstraints [--- "eliminationVariants">: set S.empty]----ref eliminationVariantsSource-----hydraCoreLanguage :: Language m---hydraCoreLanguage = Language (LanguageName "hydra/core") $ LanguageConstraints {--- languageConstraintsEliminationVariants = S.fromList eliminationVariants,--- languageConstraintsLiteralVariants = S.fromList literalVariants,--- languageConstraintsFloatTypes = S.fromList floatTypes,--- languageConstraintsFunctionVariants = S.fromList functionVariants,--- languageConstraintsIntegerTypes = S.fromList integerTypes,--- languageConstraintsTermVariants = S.fromList termVariants,--- languageConstraintsTypeVariants = S.fromList typeVariants,--- languageConstraintsTypes = const True }-
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Avro/Schema.hs
@@ -1,140 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Ext.Avro.Schema where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Sources.Ext.Json.Model-import Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax---avroSchemaModule :: Module Meta-avroSchemaModule = Module ns elements [jsonModelModule] $- 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/avro/schema"- def = datatype ns- avro = nsref ns- json = nsref $ 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"]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Graphql/Syntax.hs
@@ -1,340 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Ext.Graphql.Syntax where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Grammars-import Hydra.Util.GrammarToModule-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard---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 Meta-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/graphql/syntax"--graphqlGrammar :: Grammar-graphqlGrammar = Grammar $ tokenDefinitions ++ documentDefinitions--tokenDefinitions :: [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 :: [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, "FieldsDefinition"],- list[descriptionOpt, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt {- [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, "EnumValuesDefinition"],- list[descriptionOpt, enum_, directivesConstOpt {- [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"]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Haskell/Ast.hs
@@ -1,422 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Haskell.Ast where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---haskellAstModule :: Module Meta-haskellAstModule = Module ns elements [] $- Just "A Haskell syntax model, loosely based on Language.Haskell.Tools.AST"- where- ns = Namespace "hydra/ext/haskell/ast"- def = datatype ns- ast = nsref 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" $- -- omitted for now: implicit and infix assertions- 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 "Pattern",- "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, ctx, unboxed tuple, parallel array, kinded, promoted, splice, quasiquote, bang,- -- lazy, unpack, nounpack, wildcard, named wildcard, sum- union [- "application">: ast "Type.Application",- "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.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"]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Java/Syntax.hs
@@ -1,1743 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Java.Syntax where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---javaSyntaxModule :: Module Meta-javaSyntaxModule = Module ns elements [] $- 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 = nsref 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"]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Json/Model.hs
@@ -1,28 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Json.Model where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---jsonModelModule :: Module Meta-jsonModelModule = Module ns elements [] $- Just "A JSON syntax model. See the BNF at https://www.json.org"- where- ns = Namespace "hydra/ext/json/model"- def = datatype ns- json = nsref ns-- elements = [-- 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]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Owl/Syntax.hs
@@ -1,601 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Owl.Syntax where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax-import Hydra.Impl.Haskell.Sources.Ext.Xml.Schema---key_iri :: String-key_iri = "iri"--withIri :: String -> Type Meta -> Type Meta-withIri iriStr = annotateType key_iri (Just $ Terms.string iriStr)--nonNegativeInteger :: Type m-nonNegativeInteger = Types.bigint--owlIri :: [Char] -> Type Meta -> Type Meta-owlIri local = withIri $ "http://www.w3.org/2002/07/owl#" ++ local--owlSyntaxModule :: Module Meta-owlSyntaxModule = Module ns elements [rdfSyntaxModule, xmlSchemaModule] $- Just "An OWL 2 syntax model. See https://www.w3.org/TR/owl2-syntax"- where- ns = Namespace "hydra/ext/owl/syntax"- def = datatype ns- inst = dataterm ns-- owl = nsref ns- rdf = nsref $ moduleNamespace rdfSyntaxModule- xsd = nsref $ moduleNamespace xmlSchemaModule-- objectPropertyConstraint lname = def lname $ record [- "annotations">: list $ owl "Annotation",- "property">: owl "ObjectPropertyExpression"]-- simpleUnion names = union $ (\n -> FieldType (FieldName $ 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 $ element $ 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"]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Pegasus/Pdl.hs
@@ -1,130 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Pegasus.Pdl where--import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Sources.Ext.Json.Model--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---pegasusPdlModule :: Module Meta-pegasusPdlModule = Module ns elements [jsonModelModule] $- 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 = nsref ns- json = nsref $ 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"]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Rdf/Syntax.hs
@@ -1,103 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---rdfSyntaxModule :: Module Meta-rdfSyntaxModule = Module ns elements [] $- Just "An RDF 1.1 syntax model"- where- ns = Namespace "hydra/ext/rdf/syntax"- def = datatype ns- rdf = nsref 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"]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Scala/Meta.hs
@@ -1,1373 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Scala.Meta where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---scalaMetaModule :: Module Meta-scalaMetaModule = Module ns elements [] $- Just "A Scala syntax model based on Scalameta (https://scalameta.org)"- where- ns = Namespace "hydra/ext/scala/meta"- def = datatype ns- meta = nsref 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--- }
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Shacl/Model.hs
@@ -1,274 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Ext.Shacl.Model where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax---shaclModelModule :: Module Meta-shaclModelModule = Module ns elements [rdfSyntaxModule] $- Just "A SHACL syntax model. See https://www.w3.org/TR/shacl"- where- ns = Namespace "hydra/ext/shacl/model"- def = datatype ns- shacl = nsref ns- rdf = nsref $ moduleNamespace rdfSyntaxModule-- elements = [-- def "Closed" $- see "https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent" $- record [- "isClosed">: boolean,- "ignoredProperties">: optional $ set $ element $ 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 $ element $ rdf "RdfsClass",-- "datatype">:- see "https://www.w3.org/TR/shacl/#DatatypeConstraintComponent" $- rdf "Iri",-- "disjoint">:- see "https://www.w3.org/TR/shacl/#DisjointConstraintComponent" $- set $ element $ rdf "Property",-- "equals">:- see "https://www.w3.org/TR/shacl/#EqualsConstraintComponent" $- set $ element $ 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 $ element $ rdf "RdfsClass",-- "targetNode">:- see "https://www.w3.org/TR/shacl/#targetNode" $- set $ rdf "IriOrLiteral",-- "targetObjectsOf">:- see "https://www.w3.org/TR/shacl/#targetObjectsOf" $- set $ element $ rdf "Property",-- "targetSubjectsOf">:- see "https://www.w3.org/TR/shacl/#targetSubjectsOf" $- set $ element $ 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 $ element $ rdf "Property",-- "lessThanOrEquals">:- see "https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent" $- set $ element $ 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"]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Shex/Syntax.hs
@@ -1,526 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Ext.Shex.Syntax where--import Hydra.Core-import Hydra.Compute-import Hydra.Module-import Hydra.Grammar-import Hydra.Impl.Haskell.Dsl.Grammars-import Hydra.Util.GrammarToModule-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard---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 Meta-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/ext/shex/syntax"--shexGrammar :: Grammar-shexGrammar = 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]*-
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/Features.hs
@@ -1,160 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Features where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---tinkerpopFeaturesModule :: Module Meta-tinkerpopFeaturesModule = Module ns elements [hydraCoreModule] $- Just ("A model derived from TinkerPop's Graph.Features. See\n" ++- " https://tinkerpop.apache.org/javadocs/current/core/org/apache/tinkerpop/gremlin/structure/Graph.Features.html\n" ++- "\n" ++- "An interface that represents the capabilities of a Graph implementation.\n" ++- "By default all methods of features return true and it is up to implementers to disable feature they don't support.\n" ++- "Users should check features prior to using various functions of TinkerPop to help ensure code portability across implementations.\n" ++- "For example, a common usage would be to check if a graph supports transactions prior to calling the commit method on Graph.tx().")- where- ns = Namespace "hydra/ext/tinkerpop/features"- core = nsref $ moduleNamespace hydraCoreModule- features = nsref ns- def = datatype ns- supports name comment = ("supports" ++ capitalize name)>: doc comment boolean-- elements = [-- def "DataTypeFeatures" $- doc "Base interface for features that relate to supporting different data types." $- record [- supports "booleanArrayValues" "Supports setting of an array of boolean values.",- supports "booleanValues" "Supports setting of a boolean value.",- supports "byteArrayValues" "Supports setting of an array of byte values.",- supports "byteValues" "Supports setting of a byte value.",- supports "doubleArrayValues" "Supports setting of an array of double values.",- supports "doubleValues" "Supports setting of a double value.",- supports "floatArrayValues" "Supports setting of an array of float values.",- supports "floatValues" "Supports setting of a float value.",- supports "integerArrayValues" "Supports setting of an array of integer values.",- supports "integerValues" "Supports setting of a integer value.",- supports "longArrayValues" "Supports setting of an array of long values.",- supports "longValues" "Supports setting of a long value.",- supports "mapValues" "Supports setting of a Map value.",- supports "mixedListValues" "Supports setting of a List value.",- supports "serializableValues" "Supports setting of a Java serializable value.",- supports "stringArrayValues" "Supports setting of an array of string values.",- supports "stringValues" "Supports setting of a string value.",- supports "uniformListValues" "Supports setting of a List value."],-- def "EdgeFeatures" $- doc "Features that are related to Edge operations." $- record [- "elementFeatures">: features "ElementFeatures",- "properties">: features "EdgePropertyFeatures",- supports "addEdges" "Determines if an Edge can be added to a Vertex.",- supports "removeEdges" "Determines if an Edge can be removed from a Vertex.",- supports "upsert" ("Determines if the Graph implementation uses upsert functionality as opposed to insert " ++- "functionality for Vertex.addEdge(String, Vertex, Object...).")],-- def "EdgePropertyFeatures" $- doc "Features that are related to Edge Property objects." $- record [- "propertyFeatures">: features "PropertyFeatures"],-- def "ElementFeatures" $- doc "Features that are related to Element objects." $- record [- supports "addProperty" "Determines if an Element allows properties to be added.",- supports "anyIds" "Determines if an Element any Java object is a suitable identifier.",- supports "customIds" "Determines if an Element has a specific custom object as their internal representation.",- supports "numericIds" "Determines if an Element has numeric identifiers as their internal representation.",- supports "removeProperty" "Determines if an Element allows properties to be removed.",- supports "stringIds" "Determines if an Element has string identifiers as their internal representation.",- supports "userSuppliedIds" "Determines if an Element can have a user defined identifier.",- supports "uuidIds" "Determines if an Element has UUID identifiers as their internal representation."--- , "willAllowId" $--- doc "Determines if an identifier will be accepted by the Graph." $--- function (v3 "Id") boolean- ],-- def "ExtraFeatures" $- doc ("Additional features which are needed for the complete specification of language constraints in Hydra, "- ++ "above and beyond TinkerPop Graph.Features") $- lambda "m" $ record [- "supportsMapKey">: function (core "Type" @@ "m") boolean],-- def "Features" $- doc ("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().\n\n" ++- "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.") $- record [- "edge">: doc "Gets the features related to edge operation." $- features "EdgeFeatures",- "graph">: doc "Gets the features related to graph operation." $- features "GraphFeatures",- "vertex">: doc "Gets the features related to vertex operation." $- features "VertexFeatures"],-- def "GraphFeatures" $- doc "Features specific to a operations of a graph." $- record [- supports "computer" "Determines if the Graph implementation supports GraphComputer based processing.",- supports "concurrentAccess" "Determines if the Graph implementation supports more than one connection to the same instance at the same time.",- supports "ioRead" "Determines if the Graph implementations supports read operations as executed with the GraphTraversalSource.io(String) step.",- supports "ioWrite" "Determines if the Graph implementations supports write operations as executed with the GraphTraversalSource.io(String) step.",- supports "persistence" "Determines if the Graph implementation supports persisting it's contents natively to disk.",- supports "threadedTransactions" "Determines if the Graph implementation supports threaded transactions which allow a transaction to be executed across multiple threads via Transaction.createThreadedTx().",- supports "transactions" "Determines if the Graph implementations supports transactions.",- "variables">:- doc "Gets the features related to graph sideEffects operation." $- features "VariableFeatures"- ],-- def "PropertyFeatures" $- doc "A base interface for Edge or Vertex Property features." $- record [- "dataTypeFeatures">: features "DataTypeFeatures",- supports "properties" "Determines if an Element allows for the processing of at least one data type defined by the features."],-- def "VariableFeatures" $- doc "Features for Graph.Variables." $- record [- "dataTypeFeatures">: features "DataTypeFeatures",- supports "variables" "If any of the features on Graph.Features.VariableFeatures is true then this value must be true."],-- def "VertexFeatures" $- doc "Features that are related to Vertex operations." $- record [- "elementFeatures">: features "ElementFeatures",--- "getCardinality" $ function (v3 "PropertyKey") (v3 "VertexProperty.Cardinality"),- "properties">: features "VertexPropertyFeatures",- supports "addVertices" "Determines if a Vertex can be added to the Graph.",- supports "duplicateMultiProperties" "Determines if a Vertex can support non-unique values on the same key.",- supports "metaProperties" "Determines if a Vertex can support properties on vertex properties.",- supports "multiProperties" "Determines if a Vertex can support multiple properties with the same key.",- supports "removeVertices" "Determines if a Vertex can be removed from the Graph.",- supports "upsert" ("Determines if the Graph implementation uses upsert functionality as opposed to insert " ++- "functionality for Graph.addVertex(String).")],-- def "VertexPropertyFeatures" $- doc "Features that are related to Vertex Property objects." $- record [- "dataTypeFeatures">: features "DataTypeFeatures",- "propertyFeatures">: features "PropertyFeatures",- -- Note: re-using ElementFeatures here rather than repeating the individual features (which are identical)- "elementFeatures">: features "ElementFeatures",- supports "remove" "Determines if a VertexProperty allows properties to be removed."]---- , def "VertexProperty.Cardinality" $--- enum ["list", "set", "single"]- ]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/Typed.hs
@@ -1,114 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Typed where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---tinkerpopTypedModule :: Module Meta-tinkerpopTypedModule = Module ns elements [hydraCoreModule] Nothing- where- ns = Namespace "hydra/ext/tinkerpop/typed"- def = datatype ns- typed = nsref ns- core = nsref $ moduleNamespace hydraCoreModule-- elements = [-- def "CollectionType" $- doc "The type of a collection, such as a list of strings or an optional integer value" $- union [- "list">: typed "Type",- "map">: typed "Type",- "optional">: typed "Type",- "set">: typed "Type"],-- def "CollectionValue" $- doc "A collection of values, such as a list of strings or an optional integer value" $- union [- "list">: list $ typed "Value",- "map">: Types.map (typed "Key") (typed "Value"),- "optional">: optional $ typed "Value",- "set">: set $ typed "Value"],-- def "Edge" $- doc "An edge, comprised of an id, an out-vertex and in-vertex id, and zero or more properties" $- record [- "id">: typed "EdgeId",- "label">: typed "Label",- "out">: typed "VertexId",- "in">: typed "VertexId",- "properties">: Types.map (typed "Key") (typed "Value")],-- def "EdgeId" $- doc "A literal value representing an edge id" $- core "Literal",-- def "EdgeIdType" $- doc "The type of a reference to an edge by id" $- typed "EdgeType",-- def "EdgeType" $- doc "The type of an edge, with characteristic id, out-vertex, in-vertex, and property types" $- record [- "id">: core "LiteralType",- "out">: typed "VertexIdType",- "in">: typed "VertexIdType",- "properties">: Types.map (typed "Key") (typed "Type")],-- def "Id" $- doc "A vertex or edge id" $- union [- "vertex">: typed "VertexId",- "edge">: typed "EdgeId"],-- def "IdType" $- doc "The type of a reference to a strongly-typed element (vertex or edge) by id" $- union [- "vertex">: typed "VertexType",- "edge">: typed "EdgeType"],-- def "Key" $- doc "A property key or map key"- string,-- def "Label" $- doc "A vertex or edge label"- string,-- def "Type" $- doc "The type of a value, such as a property value" $- union [- "literal">: core "LiteralType",- "collection">: typed "CollectionType",- "element">: typed "IdType"],-- def "Value" $- doc "A concrete value such as a number or string, a collection of other values, or an element reference" $- union [- "literal">: core "Literal",- "collection">: typed "CollectionValue",- "element">: typed "Id"],-- def "Vertex" $- doc "A vertex, comprised of an id and zero or more properties" $- record [- "id">: typed "VertexId",- "label">: typed "Label",- "properties">: Types.map (typed "Key") (typed "Value")],-- def "VertexId" $- doc "A literal value representing a vertex id" $- core "Literal",-- def "VertexIdType" $- doc "The type of a reference to a vertex by id" $- typed "VertexType",-- def "VertexType" $- doc "The type of a vertex, with characteristic id and property types" $- record [- "id">: core "LiteralType",- "properties">: Types.map (typed "Key") (typed "Type")]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/V3.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.V3 where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---tinkerpopV3Module :: Module Meta-tinkerpopV3Module = Module ns elements [hydraCoreModule] $- Just "A simple TinkerPop version 3 syntax model"- where- ns = Namespace "hydra/ext/tinkerpop/v3"- core = nsref $ moduleNamespace hydraCoreModule- v3 = nsref ns- def = datatype ns-- elements = [-- def "Edge" $- doc "An edge" $- lambda "v" $ lambda "e" $ lambda "p" $- record [- "label">: v3 "EdgeLabel",- "id">: "e",- "out">: "v",- "in">: "v",- "properties">: Types.map (v3 "PropertyKey") "p"],-- def "EdgeLabel" $- doc "The (required) label of an edge" $- string,-- def "Element" $- doc "Either a vertex or an edge" $- lambda "v" $ lambda "e" $ lambda "p" $- union [- "vertex">: v3 "Vertex" @@ "v" @@ "p",- "edge">: v3 "Edge" @@ "v" @@ "e" @@ "p"],-- def "Graph" $- doc "A graph; a self-contained collection of vertices and edges" $- lambda "v" $ lambda "e" $ lambda "p" $- record [- "vertices">: Types.set $ v3 "Vertex" @@ "v" @@ "p",- "edges">: Types.set $ v3 "Edge" @@ "v" @@ "e" @@ "p"],-- def "Property" $- doc "A key/value property" $- lambda "p" $- record [- "key">: v3 "PropertyKey",- "value">: "p"],-- def "PropertyKey" $- doc "A property key"- string,-- def "Vertex" $- doc "A vertex" $- lambda "v" $ lambda "p" $- record [- "label">: v3 "VertexLabel",- "id">: "v",- "properties">: Types.map (v3 "PropertyKey") "p"],-- def "VertexLabel" $- doc "The label of a vertex. The default (null) vertex is represented by the empty string" $- string]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Xml/Schema.hs
@@ -1,118 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Xml.Schema where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---xmlSchemaModule :: Module Meta-xmlSchemaModule = Module ns elements [] $- Just ("A partial XML Schema model, focusing on datatypes. All simple datatypes (i.e. xsd:anySimpleType and below) are included.\n" ++- "See: https://www.w3.org/TR/xmlschema-2\n" ++- "Note: for most of the XML Schema datatype definitions included here, the associated Hydra type is simply\n" ++- " the string type. Exceptions are made for xsd:boolean and most of the numeric types, where there is a clearly\n" ++- " corresponding Hydra literal type.")- where- ns = Namespace "hydra/ext/xml/schema"- def = datatype ns-- elements = datatypes ++ others-- datatypes = [- def "AnySimpleType" string,- def "AnyType" string,- def "AnyURI" string,- def "Base64Binary" string,- def "Boolean" boolean,- def "Byte" int8,- def "Date" string,- def "DateTime" string,- def "Decimal" string,- def "Double" float64,- def "Duration" string,- def "ENTITIES" string,- def "ENTITY" string,- def "Float" float32,- def "GDay" string,- def "GMonth" string,- def "GMonthDay" string,- def "GYear" string,- def "GYearMonth" string,- def "HexBinary" string,- def "ID" string,- def "IDREF" string,- def "IDREFS" string,- def "Int" int32,- def "Integer" bigint,- def "Language" string,- def "Long" int64,- def "NMTOKEN" string,- def "NOTATION" string,- def "Name" string,- def "NegativeInteger" bigint,- def "NonNegativeInteger" bigint,- def "NonPositiveInteger" bigint,- def "NormalizedString" string,- def "PositiveInteger" bigint,- def "QName" string,- def "Short" int16,- def "String" string,- def "Time" string,- def "Token" string,- def "UnsignedByte" uint8,- def "UnsignedInt" uint32,- def "UnsignedLong" uint64,- def "UnsignedShort" uint16]-- others = [- def "ConstrainingFacet" $- see "https://www.w3.org/TR/xmlschema-2/#non-fundamental" $- unit, -- TODO: concrete facets-- def "Datatype" $ enum [- "anySimpleType",- "anyType",- "anyURI",- "base64Binary",- "boolean",- "byte",- "date",- "dateTime",- "decimal",- "double",- "duration",- "ENTITIES",- "ENTITY",- "float",- "gDay",- "gMonth",- "gMonthDay",- "gYear",- "gYearMonth",- "hexBinary",- "ID",- "IDREF",- "IDREFS",- "int",- "integer",- "language",- "long",- "NMTOKEN",- "NOTATION",- "name",- "negativeInteger",- "nonNegativeInteger",- "nonPositiveInteger",- "normalizedString",- "positiveInteger",- "qName",- "short",- "string",- "time",- "token",- "unsignedByte",- "unsignedInt",- "unsignedLong",- "unsignedShort"]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Yaml/Model.hs
@@ -1,77 +0,0 @@-module Hydra.Impl.Haskell.Sources.Ext.Yaml.Model where--import Hydra.Impl.Haskell.Sources.Core--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard---yamlModelModule :: Module Meta-yamlModelModule = Module ns elements [] $- 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/yaml/model"- def = datatype ns- model = nsref 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]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Grammar.hs
@@ -1,66 +0,0 @@--- | A model for Hydra labeled-BNF grammars--module Hydra.Impl.Haskell.Sources.Grammar where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Core---hydraGrammarModule :: Module Meta-hydraGrammarModule = Module ns elements [] $- Just "A common API for BNF-based grammars, specifying context-free languages"- where- ns = Namespace "hydra/grammar"- grammar = nsref ns- def = datatype ns-- elements = [-- def "Constant" $- doc "A constant pattern"- string,-- def "Grammar" $- doc "An enhanced Backus-Naur form (BNF) grammar" $- list $ grammar "Production",-- def "Label" $- doc "A name for a pattern"- string,-- def "LabeledPattern" $- doc "A pattern together with a name (label)" $- record [- "label">: grammar "Label",- "pattern">: grammar "Pattern"],-- def "Pattern" $- doc "A pattern which matches valid expressions in the language" $- union [- "nil">: unit,- "ignored">: grammar "Pattern",- "labeled">: grammar "LabeledPattern",- "constant">: grammar "Constant",- "regex">: grammar "Regex",- "nonterminal">: grammar "Symbol",- "sequence">: list $ grammar "Pattern",- "alternatives">: list $ grammar "Pattern",- "option">: grammar "Pattern",- "star">: grammar "Pattern",- "plus">: grammar "Pattern"],-- def "Production" $- doc "A BNF production" $- record [- "symbol">: grammar "Symbol",- "pattern">: grammar "Pattern"],-- def "Regex" $- doc "A regular expression"- string,-- def "Symbol" $- doc "A nonterminal symbol"- string]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Libraries.hs
@@ -1,264 +0,0 @@-module Hydra.Impl.Haskell.Sources.Libraries where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Prims as Prims-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import qualified Hydra.Lib.Flows as Flows-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Literals as Literals-import qualified Hydra.Lib.Maps as Maps-import qualified Hydra.Lib.Math as Math-import qualified Hydra.Lib.Optionals as Optionals-import qualified Hydra.Lib.Sets as Sets-import qualified Hydra.Lib.Strings as Strings---_hydra_lib_flows :: Namespace-_hydra_lib_flows = Namespace "hydra/lib/flows"--_flows_apply :: Name-_flows_apply = qname _hydra_lib_flows "apply"--_flows_bind :: Name-_flows_bind = qname _hydra_lib_flows "bind"--_flows_map :: Name-_flows_map = qname _hydra_lib_flows "map"--_flows_pure :: Name-_flows_pure = qname _hydra_lib_flows "pure"--_hydra_lib_io :: Namespace-_hydra_lib_io = Namespace "hydra/lib/io"--_io_showTerm :: Name-_io_showTerm = qname _hydra_lib_io "showTerm"--_io_showType :: Name-_io_showType = qname _hydra_lib_io "showType"--_hydra_lib_lists :: Namespace-_hydra_lib_lists = Namespace "hydra/lib/lists"--_lists_apply :: Name-_lists_apply = qname _hydra_lib_lists "apply"--_lists_bind :: Name-_lists_bind = qname _hydra_lib_lists "bind"--_lists_concat :: Name-_lists_concat = qname _hydra_lib_lists "concat"--_lists_head :: Name-_lists_head = qname _hydra_lib_lists "head"--_lists_intercalate :: Name-_lists_intercalate = qname _hydra_lib_lists "intercalate"--_lists_intersperse :: Name-_lists_intersperse = qname _hydra_lib_lists "intersperse"--_lists_last :: Name-_lists_last = qname _hydra_lib_lists "last"--_lists_length :: Name-_lists_length = qname _hydra_lib_lists "length"--_lists_map :: Name-_lists_map = qname _hydra_lib_lists "map"--_lists_pure :: Name-_lists_pure = qname _hydra_lib_lists "pure"--_hydra_lib_literals :: Namespace-_hydra_lib_literals = Namespace "hydra/lib/literals"--_literals_showInt32 :: Name-_literals_showInt32 = qname _hydra_lib_literals "showInt32"--_literals_showString :: Name-_literals_showString = qname _hydra_lib_literals "showString"--_hydra_lib_maps :: Namespace-_hydra_lib_maps = Namespace "hydra/lib/maps"--_maps_map :: Name-_maps_map = qname _hydra_lib_maps "map"--_maps_size :: Name-_maps_size = qname _hydra_lib_maps "size"--_hydra_lib_math :: Namespace-_hydra_lib_math = Namespace "hydra/lib/math"--_math_add :: Name-_math_add = qname _hydra_lib_math "add"--_math_div :: Name-_math_div = qname _hydra_lib_math "div"--_math_mod :: Name-_math_mod = qname _hydra_lib_math "mod"--_math_mul :: Name-_math_mul = qname _hydra_lib_math "mul"--_math_neg :: Name-_math_neg = qname _hydra_lib_math "neg"--_math_rem :: Name-_math_rem = qname _hydra_lib_math "rem"--_math_sub :: Name-_math_sub = qname _hydra_lib_math "sub"--_hydra_lib_optionals :: Namespace-_hydra_lib_optionals = Namespace "hydra/lib/optionals"--_optionals_apply :: Name-_optionals_apply = qname _hydra_lib_optionals "apply"--_optionals_bind :: Name-_optionals_bind = qname _hydra_lib_optionals "bind"--_optionals_map :: Name-_optionals_map = qname _hydra_lib_optionals "map"--_optionals_pure :: Name-_optionals_pure = qname _hydra_lib_optionals "pure"--_hydra_lib_sets :: Namespace-_hydra_lib_sets = Namespace "hydra/lib/sets"--_sets_insert :: Name-_sets_insert = qname _hydra_lib_sets "add"--_sets_contains :: Name-_sets_contains = qname _hydra_lib_sets "contains"--_sets_fromList :: Name-_sets_fromList = qname _hydra_lib_sets "fromList"--_sets_isEmpty :: Name-_sets_isEmpty = qname _hydra_lib_sets "isEmpty"--_sets_map :: Name-_sets_map = qname _hydra_lib_sets "map"--_sets_remove :: Name-_sets_remove = qname _hydra_lib_sets "remove"--_sets_singleton :: Name-_sets_singleton = qname _hydra_lib_sets "pure"--_sets_size :: Name-_sets_size = qname _hydra_lib_sets "size"--_sets_toList :: Name-_sets_toList = qname _hydra_lib_sets "toList"--_hydra_lib_strings :: Namespace-_hydra_lib_strings = Namespace "hydra/lib/strings"--_strings_cat :: Name-_strings_cat = qname _hydra_lib_strings "cat"--_strings_length :: Name-_strings_length = qname _hydra_lib_strings "length"--_strings_splitOn :: Name-_strings_splitOn = qname _hydra_lib_strings "splitOn"--_strings_toLower :: Name-_strings_toLower = qname _hydra_lib_strings "toLower"--_strings_toUpper :: Name-_strings_toUpper = qname _hydra_lib_strings "toUpper"----hydraIoPrimitives = [--- unaryPrimitive _io_showTerm (variable "a) string--- ]--hydraLibFlowsPrimitives :: Show m => [PrimitiveFunction m]-hydraLibFlowsPrimitives = [- binaryPrimitive _flows_apply (flow (variable "s") (function (variable "a") (variable "b"))) (flow (variable "s") (variable "a")) (flow (variable "s") (variable "b")) Flows.apply,- binaryPrimitive _flows_bind (flow (variable "s") (variable "a")) (function (variable "a") (flow (variable "s") (variable "b"))) (flow (variable "s") (variable "b")) Flows.bind,- binaryPrimitive _flows_map (function (variable "a") (variable "b")) (flow (variable "s") (variable "a")) (flow (variable "s") (variable "b")) Flows.map,- unaryPrimitive _flows_pure (variable "a") (flow (variable "s") (variable "a")) Flows.pure]--hydraLibListsPrimitives :: Show m => [PrimitiveFunction m]-hydraLibListsPrimitives = [- binaryPrimitive _lists_apply (list $ function (variable "a") (variable "b")) (list $ variable "a") (list $ variable "b") Lists.apply,- binaryPrimitive _lists_bind (list $ variable "a") (function (variable "a") (list $ variable "b")) (list $ variable "b") Lists.bind,- unaryPrimitive _lists_concat (list $ list $ variable "a") (list $ variable "a") Lists.concat,- unaryPrimitive _lists_head (list $ variable "a") (variable "a") Lists.head,- binaryPrimitive _lists_intercalate (list $ variable "a") (list $ list $ variable "a") (list $ variable "a") Lists.intercalate,- binaryPrimitive _lists_intersperse (variable "a") (list $ variable "a") (list $ variable "a") Lists.intersperse,- unaryPrimitive _lists_last (list $ variable "a") (variable "a") Lists.last,- unaryPrimitive _lists_length (list $ variable "a") int32 Lists.length,- binaryPrimitive _lists_map (function (variable "a") (variable "b")) (list $ variable "a") (list $ variable "b") Lists.map,- unaryPrimitive _lists_pure (variable "a") (list $ variable "a") Lists.pure]--hydraLibLiteralsPrimitives :: Show m => [PrimitiveFunction m]-hydraLibLiteralsPrimitives = [- unaryPrimitive _literals_showInt32 int32 string Literals.showInt32,- unaryPrimitive _literals_showString string string Literals.showString]--hydraLibMapsPrimitives :: (Ord m, Show m) => [PrimitiveFunction m]-hydraLibMapsPrimitives = [- binaryPrimitive _optionals_map- (function (variable "v1") (variable "v2"))- (Prims.map (variable "k") (variable "v1"))- (Prims.map (variable "k") (variable "v2"))- Maps.map,- unaryPrimitive _sets_size (set $ variable "a") int32 Sets.size]--hydraLibMathInt32Primitives :: Show m => [PrimitiveFunction m]-hydraLibMathInt32Primitives = [- binaryPrimitive _math_add int32 int32 int32 Math.add,- binaryPrimitive _math_div int32 int32 int32 Math.div,- binaryPrimitive _math_mod int32 int32 int32 Math.mod,- binaryPrimitive _math_mul int32 int32 int32 Math.mul,- unaryPrimitive _math_neg int32 int32 Math.neg,- binaryPrimitive _math_rem int32 int32 int32 Math.rem,- binaryPrimitive _math_sub int32 int32 int32 Math.sub]--hydraLibOptionalsPrimitives :: Show m => [PrimitiveFunction m]-hydraLibOptionalsPrimitives = [- binaryPrimitive _optionals_apply (optional $ function (variable "a") (variable "b")) (optional $ variable "a") (optional $ variable "b") Optionals.apply,- binaryPrimitive _optionals_bind (optional $ variable "a") (function (variable "a") (optional $ variable "b")) (optional $ variable "b") Optionals.bind,- binaryPrimitive _optionals_map (function (variable "a") (variable "b")) (optional $ variable "a") (optional $ variable "b") Optionals.map,- unaryPrimitive _optionals_pure (variable "a") (optional $ variable "a") Optionals.pure]--hydraLibSetsPrimitives :: (Ord m, Show m) => [PrimitiveFunction m]-hydraLibSetsPrimitives = [- binaryPrimitive _sets_contains (variable "a") (set $ variable "a") boolean Sets.contains,- unaryPrimitive _sets_fromList (list $ variable "a") (set $ variable "a") Sets.fromList,- binaryPrimitive _sets_insert (variable "a") (set $ variable "a") (set $ variable "a") Sets.insert,- unaryPrimitive _sets_isEmpty (set $ variable "a") boolean Sets.isEmpty,- binaryPrimitive _sets_map (function (variable "a") (variable "b")) (set $ variable "a") (set $ variable "b") Sets.map,- binaryPrimitive _sets_remove (variable "a") (set $ variable "a") (set $ variable "a") Sets.remove,- unaryPrimitive _sets_singleton (variable "a") (set $ variable "a") Sets.singleton,- unaryPrimitive _sets_size (set $ variable "a") int32 Sets.size,- unaryPrimitive _sets_toList (set $ variable "a") (list $ variable "a") Sets.toList]--hydraLibStringsPrimitives :: Show m => [PrimitiveFunction m]-hydraLibStringsPrimitives = [- unaryPrimitive _strings_cat (list string) string Strings.cat,- unaryPrimitive _strings_length string int32 Strings.length,- binaryPrimitive _strings_splitOn string string (list string) Strings.splitOn,- unaryPrimitive _strings_toLower string string Strings.toLower,- unaryPrimitive _strings_toUpper string string Strings.toUpper]--standardPrimitives :: (Ord m, Show m) => [PrimitiveFunction m]-standardPrimitives =- hydraLibFlowsPrimitives- ++ hydraLibListsPrimitives- ++ hydraLibLiteralsPrimitives- ++ hydraLibMapsPrimitives- ++ hydraLibMathInt32Primitives- ++ hydraLibOptionalsPrimitives- ++ hydraLibSetsPrimitives- ++ hydraLibStringsPrimitives
− src/main/haskell/Hydra/Impl/Haskell/Sources/Mantle.hs
@@ -1,131 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Mantle where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Core---hydraMantleModule :: Module Meta-hydraMantleModule = Module ns elements [] $- Just "A set of types which supplement hydra/core with type variants, graphs, and elements"- where- ns = Namespace "hydra/mantle"- core = nsref $ moduleNamespace hydraCoreModule- mantle = nsref ns- def = datatype ns-- elements = [-- def "Comparison" $- doc "An equality judgement: less than, equal to, or greater than" $- enum [- "lessThan",- "equalTo",- "greaterThan"],-- def "Element" $- doc "A graph element, having a name, data term (value), and schema term (type)" $- lambda "m" $ record [- "name">: core "Name",- "schema">: core "Term" @@ "m",- "data">: core "Term" @@ "m"],-- def "EliminationVariant" $- doc "The identifier of an elimination constructor" $- enum [- "element",- "list",- "nominal",- "optional",- "record",- "union"],-- def "FunctionVariant" $- doc "The identifier of a function constructor" $- enum [- "compareTo",- "elimination",- "lambda",- "primitive"],-- def "Graph" $- doc ("A graph, or set of named terms, together with its schema graph") $- lambda "m" $ record [- "elements">:- doc "All of the elements in the graph" $- Types.map (core "Name") (mantle "Element" @@ "m"),- "schema">:- doc "The schema graph to this graph. If omitted, the graph is its own schema graph." $- optional $ mantle "Graph" @@ "m"],-- def "LiteralVariant" $- doc "The identifier of a literal constructor" $- enum [- "binary",- "boolean",- "float",- "integer",- "string"],-- def "Precision" $- doc "Numeric precision: arbitrary precision, or precision to a specified number of bits" $- union [- "arbitrary">: unit,- "bits">: int32],-- def "TermVariant" $- doc "The identifier of a term expression constructor" $- enum [- "annotated",- "application",- "element",- "function",- "let",- "list",- "literal",- "map",- "nominal",- "optional",- "product",- "record",- "set",- "stream",- "sum",- "union",- "variable"],-- def "TypeScheme" $- doc "A type expression together with free type variables occurring in the expression" $- lambda "m" $ record [- "variables">: list $ core "VariableType",- "type">: core "Type" @@ "m"],-- def "TypeVariant" $- doc "The identifier of a type constructor" $- enum [- "annotated",- "application",- "element",- "function",- "lambda",- "list",- "literal",- "map",- "nominal",- "optional",- "product",- "record",- "set",- "stream",- "sum",- "union",- "variable"],-- def "TypedTerm" $- doc "A type together with an instance of the type" $- lambda "m" $ record [- "type">: core "Type" @@ "m",- "term">: core "Term" @@ "m"]]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Module.hs
@@ -1,42 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Module where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Mantle---hydraModuleModule :: Module Meta-hydraModuleModule = Module ns elements [hydraMantleModule] $- Just "A model for Hydra namespaces and modules (collections of elements in the same namespace)"- where- ns = Namespace "hydra/module"- mantle = nsref $ moduleNamespace hydraMantleModule- mod = nsref ns- def = datatype ns-- elements = [-- def "FileExtension" string,- - def "Module" $- doc "A logical collection of elements in the same namespace, having dependencies on zero or more other modules" $- lambda "m" $ record [- "namespace">:- doc "A common prefix for all element names in the module" $- mod "Namespace",- "elements">:- doc "The elements defined in this module" $- list $ mantle "Element" @@ "m",- "dependencies">:- doc "Any additional modules this one has a direct dependency upon" $- list $ mod "Module" @@ "m",- "description">:- doc "An optional human-readable description of the module" $- optional string],-- def "Namespace" $- doc "A prefix for element names"- string]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Phantoms.hs
@@ -1,43 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Sources.Phantoms where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Sources.Compute---hydraPhantomsModule :: Module Meta-hydraPhantomsModule = Module ns elements [hydraComputeModule] $- Just "Phantom types for use in model definitions"- where- ns = Namespace "hydra/phantoms"- core = nsref $ moduleNamespace hydraCoreModule- evaluation = nsref $ moduleNamespace hydraComputeModule- phantoms = nsref ns- def = datatype ns-- elements = [- def "Case" $- doc "An association of a field name (as in a case statement) with a phantom type" $- lambda "a" $ core "FieldName",-- def "Datum" $- doc "An association of a term with a phantom type" $- lambda "a" $ (core "Term") @@ (evaluation "Meta"),-- def "Definition" $- doc "An association with a named term with a phantom type" $- lambda "a" $ record [- "name">: core "Name",- "datum">: phantoms "Datum" @@ "a"],-- def "Fld" $- doc "An association with a term-level field with a phantom type" $- lambda "a" $ (core "Field") @@ (evaluation "Meta"),-- def "Reference" $- doc "A pure association with a phantom type" $- lambda "a" $ unit]
− src/main/haskell/Hydra/Impl/Haskell/Sources/Util/Codetree/Ast.hs
@@ -1,81 +0,0 @@-module Hydra.Impl.Haskell.Sources.Util.Codetree.Ast where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.Impl.Haskell.Sources.Core---codetreeAstModule :: Module Meta-codetreeAstModule = Module ns elements [] $- Just "A model which provides a common syntax tree for Hydra serializers"- where- ns = Namespace "hydra/util/codetree/ast"- def = datatype ns- ast = nsref ns-- elements = [-- def "Associativity" $- doc "Operator associativity" $- enum ["none", "left", "right", "both"],-- def "BlockStyle" $- doc "Formatting option for code blocks" $- record [- "indent">: boolean,- "newlineBeforeContent">: boolean,- "newlineAfterContent">: boolean],-- def "BracketExpr" $- doc "An expression enclosed by brackets" $- record [- "brackets">: ast "Brackets",- "enclosed">: ast "Expr",- "style">: ast "BlockStyle"],-- def "Brackets" $- doc "Matching open and close bracket symbols" $- record [- "open">: ast "Symbol",- "close">: ast "Symbol"],-- def "Expr" $- doc "An abstract expression" $- union [- "const">: ast "Symbol",- "op">: ast "OpExpr",- "brackets">: ast "BracketExpr"],-- def "Op" $- doc "An operator symbol" $- record [- "symbol">: ast "Symbol",- "padding">: ast "Padding",- "precedence">: ast "Precedence",- "associativity">: ast "Associativity"],-- def "OpExpr" $- doc "An operator expression" $- record [- "op">: ast "Op",- "lhs">: ast "Expr",- "rhs">: ast "Expr"],-- def "Padding" $- doc "Left and right padding for an operator" $- record [- "left">: ast "Ws",- "right">: ast "Ws"],-- def "Precedence" $- doc "Operator precedence" $- int32,-- def "Symbol" $- doc "Any symbol"- string,-- def "Ws" $- doc "One of several classes of whitespace" $- enum ["none", "space", "break", "breakAndIndent", "doubleBreak"]]
+ src/main/haskell/Hydra/Inference.hs view
@@ -0,0 +1,140 @@+-- | 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)
src/main/haskell/Hydra/Kernel.hs view
@@ -1,50 +1,78 @@--- | A proxy for the Hydra kernel, i.e. the code which must be present in every Hydra implementation.--- This currently includes most modules in the top-level Hydra.* namespace, as well as some Hydra.Util.* modules.--- The adapter and inference frameworks, as well as Hydra.CoreDecoding, Hydra.CoreEncoding, Hydra.Meta, and Hydra.Reduction are logically part of the kernel,--- but are excluded for now due to circular dependencies.+-- | A proxy for the Hydra kernel, i.e. the code which must be present in every Hydra implementation, and can be imported as a unit. +-- Note: Hydra.Grammar is part of the kernel, but is not a default import because the names of its types clash with those of other types. module Hydra.Kernel (- module Hydra.Adapters.Utils,+ module Hydra.AdapterUtils,+ module Hydra.Adapters, module Hydra.Basics,- module Hydra.Common,+ module Hydra.Coders, module Hydra.Compute,+ module Hydra.Constants,+ module Hydra.Constraints, module Hydra.Core,--- module Hydra.CoreDecoding,--- module Hydra.CoreEncoding,+ module Hydra.CoreDecoding,+ module Hydra.CoreEncoding, module Hydra.CoreLanguage,- module Hydra.Grammar,+ module Hydra.Extras,+ module Hydra.Graph,+ module Hydra.Inference,+ module Hydra.Annotations, module Hydra.Lexical,+ module Hydra.LiteralAdapters, module Hydra.Mantle,--- module Hydra.Meta,+ module Hydra.Messages, module Hydra.Module,- module Hydra.Monads, module Hydra.Phantoms,--- module Hydra.Reduction,+ module Hydra.Printing,+ module Hydra.Query,+ module Hydra.Reduction, module Hydra.Rewriting,- module Hydra.Util.Debug,- module Hydra.Util.Formatting,--- module Hydra.Util.GrammarToModule,- module Hydra.Util.Sorting,+ module Hydra.Strip,+ module Hydra.TermAdapters,+ module Hydra.Tier1,+ module Hydra.Tier2,+ module Hydra.Tier3,+ module Hydra.Tools.Debug,+ module Hydra.Tools.Formatting,+ module Hydra.Tools.Sorting,+ module Hydra.Workflow,+-- module Hydra.Ast,+-- module Hydra.Tools.GrammarToModule, ) where -import Hydra.Adapters.Utils+import Hydra.AdapterUtils+import Hydra.Adapters import Hydra.Basics-import Hydra.Common+import Hydra.Coders import Hydra.Compute+import Hydra.Constants+import Hydra.Constraints import Hydra.Core---import Hydra.CoreDecoding---import Hydra.CoreEncoding+import Hydra.CoreDecoding+import Hydra.CoreEncoding import Hydra.CoreLanguage-import Hydra.Grammar+import Hydra.Extras+import Hydra.Graph+import Hydra.Inference+import Hydra.Annotations import Hydra.Lexical+import Hydra.LiteralAdapters import Hydra.Mantle---import Hydra.Meta+import Hydra.Messages import Hydra.Module-import Hydra.Monads import Hydra.Phantoms---import Hydra.Reduction+import Hydra.Printing+import Hydra.Query+import Hydra.Reduction import Hydra.Rewriting-import Hydra.Util.Debug-import Hydra.Util.Formatting---import Hydra.Util.GrammarToModule-import Hydra.Util.Sorting+import Hydra.Strip+import Hydra.TermAdapters+import Hydra.Tier1+import Hydra.Tier2+import Hydra.Tier3+import Hydra.Tools.Debug+import Hydra.Tools.Formatting+import Hydra.Tools.Sorting+import Hydra.Workflow+--import Hydra.Ast+--import Hydra.Tools.GrammarToModule
+ src/main/haskell/Hydra/Langs/Avro/Coder.hs view
@@ -0,0 +1,389 @@+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
+ src/main/haskell/Hydra/Langs/Avro/Language.hs view
@@ -0,0 +1,32 @@+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 }
+ src/main/haskell/Hydra/Langs/Avro/SchemaJson.hs view
@@ -0,0 +1,166 @@+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
+ src/main/haskell/Hydra/Langs/Graphql/Coder.hs view
@@ -0,0 +1,164 @@+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
+ src/main/haskell/Hydra/Langs/Graphql/Language.hs view
@@ -0,0 +1,51 @@+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"]
+ src/main/haskell/Hydra/Langs/Graphql/Serde.hs view
@@ -0,0 +1,106 @@+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]
+ src/main/haskell/Hydra/Langs/Haskell/Coder.hs view
@@ -0,0 +1,373 @@+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
+ src/main/haskell/Hydra/Langs/Haskell/Language.hs view
@@ -0,0 +1,77 @@+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"]
+ src/main/haskell/Hydra/Langs/Haskell/Operators.hs view
@@ -0,0 +1,42 @@+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
+ src/main/haskell/Hydra/Langs/Haskell/Serde.hs view
@@ -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.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
+ src/main/haskell/Hydra/Langs/Haskell/Settings.hs view
@@ -0,0 +1,7 @@+module Hydra.Langs.Haskell.Settings where++newtypesNotTypedefs :: Bool+newtypesNotTypedefs = True++useCoreImport :: Bool+useCoreImport = True
+ src/main/haskell/Hydra/Langs/Haskell/Utils.hs view
@@ -0,0 +1,109 @@+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)
+ src/main/haskell/Hydra/Langs/Java/Coder.hs view
@@ -0,0 +1,974 @@+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
+ src/main/haskell/Hydra/Langs/Java/Names.hs view
@@ -0,0 +1,39 @@+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"]
+ src/main/haskell/Hydra/Langs/Java/Serde.hs view
@@ -0,0 +1,926 @@+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]
+ src/main/haskell/Hydra/Langs/Java/Settings.hs view
@@ -0,0 +1,4 @@+module Hydra.Langs.Java.Settings where++listsAsArrays :: Bool+listsAsArrays = False
+ src/main/haskell/Hydra/Langs/Java/Utils.hs view
@@ -0,0 +1,556 @@+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"
+ src/main/haskell/Hydra/Langs/Json/Coder.hs view
@@ -0,0 +1,194 @@+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'
+ src/main/haskell/Hydra/Langs/Json/Eliminate.hs view
@@ -0,0 +1,54 @@+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
+ src/main/haskell/Hydra/Langs/Json/Language.hs view
@@ -0,0 +1,33 @@+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 }
+ src/main/haskell/Hydra/Langs/Json/Serde.hs view
@@ -0,0 +1,80 @@+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.HashMap.Strict as HS+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
+ src/main/haskell/Hydra/Langs/Pegasus/Coder.hs view
@@ -0,0 +1,188 @@+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)
+ src/main/haskell/Hydra/Langs/Pegasus/Language.hs view
@@ -0,0 +1,41 @@+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 }
+ src/main/haskell/Hydra/Langs/Pegasus/Serde.hs view
@@ -0,0 +1,81 @@+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]
+ src/main/haskell/Hydra/Langs/Protobuf/Coder.hs view
@@ -0,0 +1,297 @@+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
+ src/main/haskell/Hydra/Langs/Protobuf/Serde.hs view
@@ -0,0 +1,147 @@+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
+ src/main/haskell/Hydra/Langs/Rdf/Serde.hs view
@@ -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.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 "."]
+ src/main/haskell/Hydra/Langs/Rdf/Utils.hs view
@@ -0,0 +1,87 @@+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#"
+ src/main/haskell/Hydra/Langs/Scala/Coder.hs view
@@ -0,0 +1,227 @@+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
+ src/main/haskell/Hydra/Langs/Scala/Language.hs view
@@ -0,0 +1,71 @@+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"]
+ src/main/haskell/Hydra/Langs/Scala/Prepare.hs view
@@ -0,0 +1,64 @@+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])
+ src/main/haskell/Hydra/Langs/Scala/Serde.hs view
@@ -0,0 +1,139 @@+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
+ src/main/haskell/Hydra/Langs/Scala/Utils.hs view
@@ -0,0 +1,68 @@+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
+ src/main/haskell/Hydra/Langs/Shacl/Coder.hs view
@@ -0,0 +1,197 @@+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)
+ src/main/haskell/Hydra/Langs/Shacl/Language.hs view
@@ -0,0 +1,34 @@+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 }
+ src/main/haskell/Hydra/Langs/Tinkerpop/Coder.hs view
@@ -0,0 +1,353 @@+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"
+ src/main/haskell/Hydra/Langs/Tinkerpop/Language.hs view
@@ -0,0 +1,96 @@+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
+ src/main/haskell/Hydra/Langs/Tinkerpop/TermsToElements.hs view
@@ -0,0 +1,251 @@+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
+ src/main/haskell/Hydra/Langs/Yaml/Coder.hs view
@@ -0,0 +1,116 @@+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
+ src/main/haskell/Hydra/Langs/Yaml/Language.hs view
@@ -0,0 +1,26 @@+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 }
+ src/main/haskell/Hydra/Langs/Yaml/Modules.hs view
@@ -0,0 +1,39 @@+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"
+ src/main/haskell/Hydra/Langs/Yaml/Serde.hs view
@@ -0,0 +1,80 @@+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}
src/main/haskell/Hydra/Lexical.hs view
@@ -1,16 +1,15 @@ -- | Functions for retrieving elements and primitive functions from a graph context -module Hydra.Lexical (- module Hydra.Lexical,- module Hydra.Common,- ) where+module Hydra.Lexical where -import Hydra.Common+import Hydra.Basics+import Hydra.Strip import Hydra.Core-import Hydra.Module+import Hydra.Extras+import Hydra.Graph import Hydra.Compute-import Hydra.Mantle-import Hydra.Monads+import Hydra.Tier1+import Hydra.Tier2 import qualified Data.List as L import qualified Data.Map as M@@ -18,56 +17,49 @@ import Control.Monad -deref :: Term m -> GraphFlow m (Term m)-deref term = case stripTerm term of- TermElement name -> dereferenceElement name >>= deref- TermNominal (Named _ term') -> deref term'- _ -> pure term--dereferenceElement :: Name -> GraphFlow m (Term m)-dereferenceElement en = do- cx <- getState- case M.lookup en (graphElements $ contextGraph cx) of- Nothing -> fail $ "element " ++ unName en ++ " does not exist"- Just e -> pure $ elementData e--lookupPrimitiveFunction :: Context m -> Name -> Maybe (PrimitiveFunction m)-lookupPrimitiveFunction cx fn = M.lookup fn $ contextFunctions cx--primitiveFunctionArity :: PrimitiveFunction m -> Int-primitiveFunctionArity = arity . primitiveFunctionType- where- arity (FunctionType _ cod) = 1 + case stripType cod of- TypeFunction ft -> arity ft- _ -> 0+dereferenceElement :: Name -> Flow Graph (Maybe Element)+dereferenceElement name = do+ g <- getState+ return $ M.lookup name (graphElements g) -requireElement :: Name -> GraphFlow m (Element m)+requireElement :: Name -> Flow Graph Element requireElement name = do- cx <- getState- Y.maybe (err cx) pure $ M.lookup name $ graphElements $ contextGraph cx+ mel <- dereferenceElement name+ case mel of+ Just el -> return el+ Nothing -> getState >>= err where- err cx = fail $ "no such element: " ++ unName name- ++ ". Available elements: {" ++ L.intercalate ", " (ellipsis (unName . elementName <$> M.elems (graphElements $ contextGraph cx))) ++ "}"+ err g = fail $ "no such element: " ++ unName name+ ++ ". Available elements: {" ++ L.intercalate ", " (ellipsis (unName . elementName <$> M.elems (graphElements g))) ++ "}" where- ellipsis strings = if L.length strings > 3--- ellipsis strings = if L.length strings < 0- then L.take 3 strings ++ ["..."]- else strings+ showAll = False+ ellipsis = id+-- ellipsis strings = if L.length strings > 3 && not showAll+-- then L.take 3 strings ++ ["..."]+-- else strings -requirePrimitiveFunction :: Name -> GraphFlow m (PrimitiveFunction m)-requirePrimitiveFunction fn = do+requirePrimitive :: Name -> Flow Graph Primitive+requirePrimitive fn = do cx <- getState- Y.maybe err pure $ lookupPrimitiveFunction cx fn+ Y.maybe err pure $ lookupPrimitive cx fn where err = fail $ "no such primitive function: " ++ unName fn --- Note: assuming for now that primitive functions and evaluation strategy are the same in the schema graph-schemaContext :: Context m -> Context m-schemaContext cx = case graphSchema (contextGraph cx) of- Nothing -> cx- Just g -> cx {contextGraph = g}+-- TODO: distinguish between lambda-bound and let-bound variables+resolveTerm :: Name -> Flow Graph (Maybe Term)+resolveTerm name = do+ g <- getState+ Y.maybe (pure Nothing) recurse $ M.lookup name $ graphElements g+ where+ recurse el = case stripTerm (elementData el) of+ TermVariable name' -> resolveTerm name'+ _ -> pure $ Just $ elementData el -withSchemaContext :: GraphFlow m a -> GraphFlow m a+-- Note: assuming for now that primitive functions are the same in the schema graph+schemaContext :: Graph -> Graph+schemaContext g = Y.fromMaybe g (graphSchema g)++withSchemaContext :: Flow Graph x -> Flow Graph x withSchemaContext f = do cx <- getState withState (schemaContext cx) f
+ src/main/haskell/Hydra/Lib/Equality.hs view
@@ -0,0 +1,74 @@+-- | Haskell implementations of hydra/lib/equality primitives. These simply make use of derived Eq.++module Hydra.Lib.Equality where++import Hydra.Core++import Data.Int+++equalBinary :: String -> String -> Bool+equalBinary = (==)++equalBoolean :: Bool -> Bool -> Bool+equalBoolean = (==)++equalBigfloat :: Double -> Double -> Bool+equalBigfloat = (==)++equalFloat32 :: Float -> Float -> Bool+equalFloat32 = (==)++equalFloat64 :: Double -> Double -> Bool+equalFloat64 = (==)++equalBigint :: Integer -> Integer -> Bool+equalBigint = (==)++equalInt8 :: Int8 -> Int8 -> Bool+equalInt8 = (==)++equalInt16 :: Int16 -> Int16 -> Bool+equalInt16 = (==)++equalInt32 :: Int -> Int -> Bool+equalInt32 = (==)++equalInt64 :: Int64 -> Int64 -> Bool+equalInt64 = (==)++equalUint8 :: Int16 -> Int16 -> Bool+equalUint8 = (==)++equalUint16 :: Int -> Int -> Bool+equalUint16 = (==)++equalUint32 :: Int64 -> Int64 -> Bool+equalUint32 = (==)++equalUint64 :: Integer -> Integer -> Bool+equalUint64 = (==)++equalString :: String -> String -> Bool+equalString = (==)++equalTerm :: Term -> Term -> Bool+equalTerm = (==)++equalType :: Type -> Type -> Bool+equalType = (==)++gtInt32 :: Int -> Int -> Bool+gtInt32 = (>)++gteInt32 :: Int -> Int -> Bool+gteInt32 = (>=)++identity :: x -> x+identity = id++ltInt32 :: Int -> Int -> Bool+ltInt32 = (<)++lteInt32 :: Int -> Int -> Bool+lteInt32 = (<=)
src/main/haskell/Hydra/Lib/Flows.hs view
@@ -2,17 +2,48 @@ module Hydra.Lib.Flows where -import Hydra.Kernel+import Hydra.Compute+import qualified Hydra.Tier1 as Tier1 +import qualified Control.Monad as CM -apply :: Flow s (a -> b) -> Flow s a -> Flow s b++-- Haskell-specific helpers++instance Functor (Flow s) where+ fmap = CM.liftM+instance Applicative (Flow s) where+ pure = return+ (<*>) = CM.ap+instance Monad (Flow s) where+ return x = Flow $ \s t -> FlowState (Just x) s t+ p >>= k = Flow q'+ where+ q' s0 t0 = FlowState y s2 t2+ where+ FlowState x s1 t1 = unFlow p s0 t0+ FlowState y s2 t2 = case x of+ Just x' -> unFlow (k x') s1 t1+ Nothing -> FlowState Nothing s1 t1+instance MonadFail (Flow s) where+ fail msg = Flow $ \s t -> FlowState Nothing s (Tier1.pushError msg t)++-- Primitive functions++apply :: Flow s (x -> y) -> Flow s x -> Flow s y apply = (<*>) -bind :: Flow s a -> (a -> Flow s b) -> Flow s b+bind :: Flow s x -> (x -> Flow s y) -> Flow s y bind = (>>=) -map :: (a -> b) -> Flow s a -> Flow s b+fail :: String -> Flow s x+fail = CM.fail++map :: (x -> y) -> Flow s x -> Flow s y map = fmap -pure :: a -> Flow s a+mapList :: (x -> Flow s y) -> [x] -> Flow s [y]+mapList = CM.mapM++pure :: x -> Flow s x pure = return
src/main/haskell/Hydra/Lib/Io.hs view
@@ -1,51 +1,80 @@--- | Haskell implementations of hydra/lib/io primitives+-- | Tier-1 library which provides Haskell implementations of hydra/lib/io primitives. module Hydra.Lib.Io ( showTerm, showType,- coreContext, ) where -import Hydra.Kernel-import Hydra.Ext.Json.Coder-import qualified Hydra.Ext.Json.Model as Json-import Hydra.Impl.Haskell.Dsl.Standard-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Ext.Json.Serde+import Hydra.Core+import Hydra.Compute+import Hydra.Graph+import Hydra.Langs.Json.Coder+import Hydra.Dsl.Annotations+import Hydra.Langs.Json.Serde import Hydra.CoreEncoding+import Hydra.Rewriting+import Hydra.Annotations+import Hydra.Tier1+import qualified Hydra.Json as Json+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types import qualified Data.Map as M import qualified Data.Maybe as Y -showTerm :: Ord m => Term m -> String-showTerm term = fromFlow coreContext $ coderEncode termStringCoder encoded- where- encoded = encodeTerm $ rewriteTermMeta (const $ Meta M.empty) term+noGraph :: Graph+noGraph = Graph {+ graphElements = M.empty,+ graphEnvironment = M.empty,+ graphTypes = M.empty,+ graphBody = Terms.list [],+ graphPrimitives = M.empty,+ graphSchema = Nothing} -termJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Json.Value-termJsonCoder = fromFlow coreContext $ jsonCoder $ Types.nominal _Term -termStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String-termStringCoder = Coder mout min+showTerm :: Term -> String+showTerm term = fromFlow "fail" noGraph (jsonValueToString <$> untypedTermToJson term)++-- coder <- termStringCoder+-- coderEncode coder encoded+-- where+-- --encoded = coreEncodeTerm $ rewriteTermMeta (const $ Kv M.empty) term+-- encoded = rewriteTermMeta (const $ Kv M.empty) term++termStringCoder :: Flow Graph (Coder Graph Graph Term String)+termStringCoder = do+ termJsonCoder <- jsonCoder $ TypeVariable _Term+ return $ Coder (mout termJsonCoder) (min termJsonCoder) where- mout term = valueToString <$> coderEncode termJsonCoder term- min s = case stringToValue s of+ mout termJsonCoder term = jsonValueToString <$> coderEncode termJsonCoder term+ min termJsonCoder s = case stringToJsonValue s of Left msg -> fail $ "failed to parse JSON value: " ++ msg Right v -> coderDecode termJsonCoder v -showType :: Ord m => Type m -> String-showType typ = fromFlow coreContext $ coderEncode typeStringCoder encoded- where- encoded = encodeType $ rewriteTypeMeta (const $ Meta M.empty) typ+--showType :: Type -> String+--showType typ = fromFlow "fail" noGraph $ do+-- coder <- typeStringCoder+-- coderEncode coder encoded+-- where+-- encoded = coreEncodeType $ rewriteTypeMeta (const $ Kv M.empty) typ -typeJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Json.Value-typeJsonCoder = fromFlow coreContext $ jsonCoder $ Types.nominal _Type+-- TODO: for now, we are bypassing the complexity of TermAdapters because of issues yet to be resolved+showType :: Type -> String+showType = showTerm . coreEncodeType+--showType typ = case flowStateValue result of+-- Nothing -> "failed to encode type:\n" ++ show (traceMessages $ flowStateTrace result)+-- Just s -> s+-- where+-- result = unFlow (jsonValueToString <$> untypedTermToJson encoded) noGraph emptyTrace+-- encoded = stripTermRecursive $ coreEncodeType typ -typeStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String-typeStringCoder = Coder mout min+typeStringCoder :: Flow Graph (Coder Graph Graph Term String)+typeStringCoder = do+ typeJsonCoder <- jsonCoder $ TypeVariable _Type+ return $ Coder (mout typeJsonCoder) (min typeJsonCoder) where- mout term = valueToString <$> coderEncode typeJsonCoder term- min s = case stringToValue s of+ mout typeJsonCoder term = jsonValueToString <$> coderEncode typeJsonCoder term+ min typeJsonCoder s = case stringToJsonValue s of Left msg -> fail $ "failed to parse as JSON value: " ++ msg Right v -> coderDecode typeJsonCoder v
src/main/haskell/Hydra/Lib/Lists.hs view
@@ -2,6 +2,11 @@ module Hydra.Lib.Lists where +import Hydra.Compute+import Hydra.Core+import Hydra.Graph+import qualified Hydra.Dsl.Terms as Terms+ import qualified Data.List as L @@ -14,6 +19,15 @@ concat :: [[a]] -> [a] concat = L.concat +concat2 :: [a] -> [a] -> [a]+concat2 l1 l2 = l1 ++ l2++cons :: a -> [a] -> [a]+cons = (:)++foldl :: (b -> a -> b) -> b -> [a] -> b+foldl = L.foldl+ head :: [a] -> a head = L.head @@ -32,5 +46,21 @@ map :: (a -> b) -> [a] -> [b] map = fmap +nub :: Eq a => [a] -> [a]+nub = L.nub++null :: [a] -> Bool+null = L.null+ pure :: a -> [a]-pure x = [x]+pure e = [e]++reverse :: [a] -> [a]+reverse = L.reverse++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:_) = Just x++tail :: [a] -> [a]+tail = L.tail
src/main/haskell/Hydra/Lib/Literals.hs view
@@ -2,17 +2,77 @@ module Hydra.Lib.Literals where +import Data.Int --- TODO: expose as a primitive+ bigfloatToBigint :: Double -> Integer bigfloatToBigint = round --- TODO: expose as a primitive+bigfloatToFloat32 :: Double -> Float+bigfloatToFloat32 = realToFrac++bigfloatToFloat64 :: Double -> Double+bigfloatToFloat64 = id+ bigintToBigfloat :: Integer -> Double bigintToBigfloat = fromIntegral +bigintToInt8 :: Integer -> Int8+bigintToInt8 = fromIntegral++bigintToInt16 :: Integer -> Int16+bigintToInt16 = fromIntegral++bigintToInt32 :: Integer -> Int+bigintToInt32 = fromIntegral++bigintToInt64 :: Integer -> Int64+bigintToInt64 = fromIntegral++bigintToUint8 :: Integer -> Int16+bigintToUint8 = fromIntegral++bigintToUint16 :: Integer -> Int+bigintToUint16 = fromIntegral++bigintToUint32 :: Integer -> Int64+bigintToUint32 = fromIntegral++bigintToUint64 :: Integer -> Integer+bigintToUint64 = id++float32ToBigfloat :: Float -> Double+float32ToBigfloat = realToFrac++float64ToBigfloat :: Double -> Double+float64ToBigfloat = id++int8ToBigint :: Int8 -> Integer+int8ToBigint = fromIntegral++int16ToBigint :: Int16 -> Integer+int16ToBigint = fromIntegral++int32ToBigint :: Int -> Integer+int32ToBigint = fromIntegral++int64ToBigint :: Int64 -> Integer+int64ToBigint = fromIntegral+ showInt32 :: Int -> String showInt32 = show showString :: String -> String showString = show++uint8ToBigint :: Int16 -> Integer+uint8ToBigint = fromIntegral++uint16ToBigint :: Int -> Integer+uint16ToBigint = fromIntegral++uint32ToBigint :: Int64 -> Integer+uint32ToBigint = fromIntegral++uint64ToBigint :: Integer -> Integer+uint64ToBigint = id
+ src/main/haskell/Hydra/Lib/Logic.hs view
@@ -0,0 +1,20 @@+-- | Haskell implementations of hydra/lib/logic (logic and control flow) primitives++module Hydra.Lib.Logic where++import Hydra.Core++import Data.Int+++and :: Bool -> Bool -> Bool+and x y = x && y++ifElse :: a -> a -> Bool -> a+ifElse x y b = if b then x else y++not :: Bool -> Bool+not = Prelude.not++or :: Bool -> Bool -> Bool+or x y = x || y
src/main/haskell/Hydra/Lib/Maps.hs view
@@ -5,8 +5,41 @@ import qualified Data.Map as M +empty :: M.Map k v+empty = M.empty++fromList :: Ord k => [(k, v)] -> M.Map k v+fromList = M.fromList++insert :: Ord k => k -> v -> M.Map k v -> M.Map k v+insert = M.insert++isEmpty :: M.Map k v -> Bool+isEmpty = M.null++keys :: M.Map k v -> [k]+keys = M.keys++lookup :: Ord k => k -> M.Map k v -> Maybe v+lookup = M.lookup+ map :: (v1 -> v2) -> M.Map k v1 -> M.Map k v2 map = fmap +mapKeys :: (Ord k1, Ord k2) => (k1 -> k2) -> M.Map k1 v -> M.Map k2 v+mapKeys = M.mapKeys++remove :: Ord k => k -> M.Map k v -> M.Map k v+remove = M.delete++singleton :: k -> v -> M.Map k v+singleton = M.singleton+ size :: M.Map k v -> Int size = M.size++toList :: M.Map k v -> [(k, v)]+toList = M.toList++values :: M.Map k v -> [v]+values = M.elems
src/main/haskell/Hydra/Lib/Optionals.hs view
@@ -11,8 +11,23 @@ bind :: Y.Maybe a -> (a -> Y.Maybe b) -> Y.Maybe b bind = (>>=) +cat :: [Y.Maybe a] -> [a]+cat = Y.catMaybes++fromMaybe :: a -> Y.Maybe a -> a+fromMaybe = Y.fromMaybe++isJust :: Y.Maybe a -> Bool+isJust = Y.isJust++isNothing :: Y.Maybe a -> Bool+isNothing = Y.isNothing+ map :: (a -> b) -> Y.Maybe a -> Y.Maybe b map = fmap++maybe :: b -> (a -> b) -> Y.Maybe a -> b+maybe = Y.maybe pure :: a -> Y.Maybe a pure = Just
src/main/haskell/Hydra/Lib/Sets.hs view
@@ -5,30 +5,42 @@ import qualified Data.Set as S -contains :: Ord a => a -> S.Set a -> Bool+contains :: Ord x => x -> S.Set x -> Bool contains = S.member -fromList :: Ord a => [a] -> S.Set a+difference :: Ord x => S.Set x -> S.Set x -> S.Set x+difference = S.difference++empty :: S.Set x+empty = S.empty++fromList :: Ord x => [x] -> S.Set x fromList = S.fromList -insert :: Ord a => a -> S.Set a -> S.Set a+insert :: Ord x => x -> S.Set x -> S.Set x insert = S.insert -isEmpty :: S.Set a -> Bool+intersection :: Ord x => S.Set x -> S.Set x -> S.Set x+intersection = S.intersection++isEmpty :: S.Set x -> Bool isEmpty = S.null -- Note: the presence of a 'map' function does not imply that sets are a functor in Hydra-map :: Ord b => (a -> b) -> S.Set a -> S.Set b+map :: Ord y => (x -> y) -> S.Set x -> S.Set y map f = S.fromList . fmap f . S.toList -remove :: Ord a => a -> S.Set a -> S.Set a+remove :: Ord x => x -> S.Set x -> S.Set x remove = S.delete -singleton :: a -> S.Set a+singleton :: x -> S.Set x singleton = S.singleton -size :: S.Set a -> Int+size :: S.Set x -> Int size = S.size -toList :: Ord a => S.Set a -> [a]+toList :: Ord x => S.Set x -> [x] toList = S.toList++union :: Ord x => S.Set x -> S.Set x -> S.Set x+union = S.union
src/main/haskell/Hydra/Lib/Strings.hs view
@@ -10,11 +10,26 @@ cat :: [String] -> String cat = L.concat +cat2 :: String -> String -> String+cat2 s1 s2 = s1 ++ s2++fromList :: [Int] -> String+fromList = fmap C.chr++intercalate :: String -> [String] -> String+intercalate = L.intercalate++isEmpty :: String -> Bool+isEmpty = L.null+ length :: String -> Int length = L.length splitOn :: String -> String -> [String] splitOn = LS.splitOn++toList :: String -> [Int]+toList = fmap C.ord toLower :: String -> String toLower = fmap C.toLower
+ src/main/haskell/Hydra/LiteralAdapters.hs view
@@ -0,0 +1,189 @@+-- | Adapter framework for literal types and terms++module Hydra.LiteralAdapters (+ literalAdapter,+ floatAdapter,+ integerAdapter,+) where++import Hydra.Printing+import Hydra.AdapterUtils+import Hydra.Basics+import Hydra.Coders+import Hydra.Compute+import Hydra.Core+import Hydra.Graph+import Hydra.Lexical+import Hydra.Mantle+import Hydra.Tier1+import Hydra.Tier2++import qualified Data.List as L+import qualified Data.Set as S+++literalAdapter :: LiteralType -> Flow (AdapterContext) (SymmetricAdapter s LiteralType Literal)+literalAdapter lt = do+ cx <- getState+ chooseAdapter (alts cx) (supported cx) describeLiteralType lt+ where+ supported cx = literalTypeIsSupported (constraints cx)+ constraints cx = languageConstraints $ adapterContextLanguage cx++ alts cx t = case t of+ LiteralTypeBinary -> pure $ fallbackAdapter t+ LiteralTypeBoolean -> pure $ if noIntegerVars+ then fallbackAdapter t+ else do+ adapter <- integerAdapter IntegerTypeUint8+ let step' = adapterCoder adapter+ let step = Coder encode decode+ where+ encode (LiteralBoolean bv) = LiteralInteger <$> coderEncode step' (toInt bv)+ where+ toInt bv = IntegerValueUint8 $ if bv then 1 else 0+ decode (LiteralInteger iv) = LiteralBoolean <$> do+ (IntegerValueUint8 v) <- coderDecode step' iv+ return $ v == 1+ return $ Adapter False t (LiteralTypeInteger $ adapterTarget adapter) step+ LiteralTypeFloat ft -> pure $ if noFloatVars+ then fallbackAdapter t+ else do+ adapter <- floatAdapter ft+ let step = bidirectional+ $ \dir l -> case l of+ LiteralFloat fv -> LiteralFloat <$> encodeDecode dir (adapterCoder adapter) fv+ _ -> unexpected "floating-point literal" (show l)+ return $ Adapter (adapterIsLossy adapter) t (LiteralTypeFloat $ adapterTarget adapter) step+ LiteralTypeInteger it -> pure $ if noIntegerVars+ then fallbackAdapter t+ else do+ adapter <- integerAdapter it+ let step = bidirectional+ $ \dir (LiteralInteger iv) -> LiteralInteger+ <$> encodeDecode dir (adapterCoder adapter) iv+ return $ Adapter (adapterIsLossy adapter) t (LiteralTypeInteger $ adapterTarget adapter) step+ LiteralTypeString -> pure $ fail "no substitute for the literal string type"+ where+ noFloatVars = not (S.member LiteralVariantFloat $ languageConstraintsLiteralVariants $ constraints cx)+ || S.null (languageConstraintsFloatTypes $ constraints cx)+ noIntegerVars = not (S.member LiteralVariantInteger $ languageConstraintsLiteralVariants $ constraints cx)+ || S.null (languageConstraintsIntegerTypes $ constraints cx)+ noStrings = not $ supported cx LiteralTypeString++ fallbackAdapter t = if noStrings+ then fail "cannot serialize unsupported type; strings are unsupported"+ else warn msg $ pure $ Adapter False t LiteralTypeString step+ where+ msg = disclaimer False (describeLiteralType t) (describeLiteralType LiteralTypeString)+ step = Coder encode decode+ where+ -- TODO: this format is tied to Haskell+ encode av = pure $ LiteralString $ case av of+ LiteralBinary s -> s+ LiteralBoolean b -> if b then "true" else "false"+ _ -> show av+ decode (LiteralString s) = pure $ case t of+ LiteralTypeBinary -> LiteralBinary s+ LiteralTypeBoolean -> LiteralBoolean $ s == "true"+ _ -> read s++comparePrecision :: Precision -> Precision -> Ordering+comparePrecision p1 p2 = if p1 == p2 then EQ else case (p1, p2) of+ (PrecisionArbitrary, _) -> GT+ (_, PrecisionArbitrary) -> LT+ (PrecisionBits b1, PrecisionBits b2) -> compare b1 b2++disclaimer :: Bool -> String -> String -> String+disclaimer lossy source target = "replace " ++ source ++ " with " ++ target+ ++ if lossy then " (lossy)" else ""++floatAdapter :: FloatType -> Flow (AdapterContext) (SymmetricAdapter s FloatType FloatValue)+floatAdapter ft = do+ cx <- getState+ let supported = floatTypeIsSupported $ languageConstraints $ adapterContextLanguage cx+ chooseAdapter alts supported describeFloatType ft+ where+ alts t = makeAdapter t <$> case t of+ FloatTypeBigfloat -> [FloatTypeFloat64, FloatTypeFloat32]+ FloatTypeFloat32 -> [FloatTypeFloat64, FloatTypeBigfloat]+ FloatTypeFloat64 -> [FloatTypeBigfloat, FloatTypeFloat32]+ where+ makeAdapter source target = warn msg $ pure $ Adapter lossy source target step+ where+ lossy = comparePrecision (floatTypePrecision source) (floatTypePrecision target) == GT+ step = Coder (pure . convertFloatValue target) (pure . convertFloatValue source)+ msg = disclaimer lossy (describeFloatType source) (describeFloatType target)++integerAdapter :: IntegerType -> Flow (AdapterContext) (SymmetricAdapter s IntegerType IntegerValue)+integerAdapter it = do+ cx <- getState+ let supported = integerTypeIsSupported $ languageConstraints $ adapterContextLanguage cx+ chooseAdapter alts supported describeIntegerType it+ where+ alts t = makeAdapter t <$> case t of+ IntegerTypeBigint -> L.reverse unsignedPref+ IntegerTypeInt8 -> signed 1+ IntegerTypeInt16 -> signed 2+ IntegerTypeInt32 -> signed 3+ IntegerTypeInt64 -> signed 4+ IntegerTypeUint8 -> unsigned 1+ IntegerTypeUint16 -> unsigned 2+ IntegerTypeUint32 -> unsigned 3+ IntegerTypeUint64 -> unsigned 4+ where+ signed i = L.drop (i*2) signedPref ++ [IntegerTypeBigint] ++ L.drop (8-(i*2)+1) signedNonPref+ unsigned i = L.drop (i*2) unsignedPref ++ [IntegerTypeBigint] ++ L.drop (8-(i*2)+1) unsignedNonPref+ signedPref = interleave signedOrdered unsignedOrdered+ unsignedPref = interleave unsignedOrdered signedOrdered+ signedNonPref = L.reverse unsignedPref+ unsignedNonPref = L.reverse signedPref++ interleave xs ys = L.concat (L.transpose [xs, ys])++ signedOrdered = L.filter+ (\v -> integerTypeIsSigned v && integerTypePrecision v /= PrecisionArbitrary) integerTypes+ unsignedOrdered = L.filter+ (\v -> not (integerTypeIsSigned v) && integerTypePrecision v /= PrecisionArbitrary) integerTypes++ makeAdapter source target = warn msg $ pure $ Adapter lossy source target step+ where+ lossy = comparePrecision (integerTypePrecision source) (integerTypePrecision target) /= LT+ step = Coder (pure . convertIntegerValue target) (pure . convertIntegerValue source)+ msg = disclaimer lossy (describeIntegerType source) (describeIntegerType target)++convertFloatValue :: FloatType -> FloatValue -> FloatValue+convertFloatValue target = encoder . decoder+ where+ decoder fv = case fv of+ FloatValueBigfloat d -> d+ FloatValueFloat32 f -> realToFrac f+ FloatValueFloat64 d -> d+ encoder d = case target of+ FloatTypeBigfloat -> FloatValueBigfloat d+ FloatTypeFloat32 -> FloatValueFloat32 $ realToFrac d+ FloatTypeFloat64 -> FloatValueFloat64 d++convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue+convertIntegerValue target = encoder . decoder+ where+ decoder iv = case iv of+ IntegerValueBigint v -> v+ IntegerValueInt8 v -> fromIntegral v+ IntegerValueInt16 v -> fromIntegral v+ IntegerValueInt32 v -> fromIntegral v+ IntegerValueInt64 v -> fromIntegral v+ IntegerValueUint8 v -> fromIntegral v+ IntegerValueUint16 v -> fromIntegral v+ IntegerValueUint32 v -> fromIntegral v+ IntegerValueUint64 v -> fromIntegral v+ encoder d = case target of+ IntegerTypeBigint -> IntegerValueBigint d+ IntegerTypeInt8 -> IntegerValueInt8 $ fromIntegral d+ IntegerTypeInt16 -> IntegerValueInt16 $ fromIntegral d+ IntegerTypeInt32 -> IntegerValueInt32 $ fromIntegral d+ IntegerTypeInt64 -> IntegerValueInt64 $ fromIntegral d+ IntegerTypeUint8 -> IntegerValueUint8 $ fromIntegral d+ IntegerTypeUint16 -> IntegerValueUint16 $ fromIntegral d+ IntegerTypeUint32 -> IntegerValueUint32 $ fromIntegral d+ IntegerTypeUint64 -> IntegerValueUint64 $ fromIntegral d
− src/main/haskell/Hydra/Meta.hs
@@ -1,140 +0,0 @@--- | Functions for working with Meta, the default annotation type in Hydra--module Hydra.Meta where--import Hydra.Core-import Hydra.Compute-import Hydra.CoreDecoding-import Hydra.CoreEncoding-import Hydra.Common-import Hydra.Monads-import Hydra.Mantle-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms--import qualified Data.Map as M-import qualified Data.Maybe as Y---aggregateAnnotations :: (a -> Maybe (Annotated a Meta)) -> a -> Meta-aggregateAnnotations getAnn t = Meta $ M.fromList $ addMeta [] t- where- addMeta m t = case getAnn t of- Nothing -> m- Just (Annotated t' (Meta other)) -> addMeta (m ++ M.toList other) t'--getAnnotation :: String -> Meta -> Maybe (Term Meta)-getAnnotation key (Meta m) = M.lookup key m--getAttr :: String -> Flow s (Maybe (Term Meta))-getAttr key = Flow q- where- q s0 t0 = FlowState (Just $ M.lookup key $ traceOther t0) s0 t0--getAttrWithDefault :: String -> Term Meta -> Flow s (Term Meta)-getAttrWithDefault key def = Y.fromMaybe def <$> getAttr key--getDescription :: Meta -> GraphFlow Meta (Y.Maybe String)-getDescription meta = case getAnnotation metaDescription meta of- Nothing -> pure Nothing- Just term -> case term of- TermLiteral (LiteralString s) -> pure $ Just s- _ -> fail $ "unexpected value for " ++ show metaDescription ++ ": " ++ show term--getTermAnnotation :: Context Meta -> String -> Term Meta -> Y.Maybe (Term Meta)-getTermAnnotation cx key = getAnnotation key . termMetaInternal--getTermDescription :: Term Meta -> GraphFlow Meta (Y.Maybe String)-getTermDescription = getDescription . termMetaInternal--getType :: Meta -> GraphFlow Meta (Y.Maybe (Type Meta))-getType meta = case getAnnotation metaType meta of- Nothing -> pure Nothing- Just dat -> Just <$> decodeType dat--getTypeDescription :: Type Meta -> GraphFlow Meta (Y.Maybe String)-getTypeDescription = getDescription . typeMetaInternal--metaAnnotationClass :: AnnotationClass Meta-metaAnnotationClass = AnnotationClass {- annotationClassDefault = Meta M.empty,- annotationClassEqual = (==),- annotationClassCompare = \m1 m2 -> toComparison $ m1 `compare` m2,- annotationClassShow = show,- annotationClassRead = read,-- -- TODO: simplify- annotationClassTermMeta = termMetaInternal,- annotationClassTypeMeta = typeMetaInternal,- annotationClassTermDescription = getTermDescription,- annotationClassTypeDescription = getTypeDescription,- annotationClassTermType = getType . termMetaInternal,- annotationClassSetTermDescription = setTermDescription,- annotationClassSetTermType = setTermType,- annotationClassTypeOf = getType,- annotationClassSetTypeOf = setType}- where- toComparison c = case c of- LT -> ComparisonLessThan- EQ -> ComparisonEqualTo- GT -> ComparisonGreaterThan--metaDescription :: String-metaDescription = "description"--metaType :: String-metaType = "type"--nextCount :: String -> Flow s Int-nextCount attrName = do- count <- getAttrWithDefault attrName (Terms.int32 0) >>= Terms.expectInt32- putAttr attrName (Terms.int32 $ count + 1)- return count--putAttr :: String -> Term Meta -> 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 Meta) -> Meta -> Meta-setAnnotation key val (Meta m) = Meta $ M.alter (const val) key m--setDescription :: Y.Maybe String -> Meta -> Meta-setDescription d = setAnnotation metaDescription (Terms.string <$> d)--setTermAnnotation :: Context Meta -> String -> Y.Maybe (Term Meta) -> Term Meta -> Term Meta-setTermAnnotation cx key val term = if meta == annotationClassDefault (contextAnnotations cx)- then term'- else TermAnnotated $ Annotated term' meta- where- term' = stripTerm term- meta = setAnnotation key val $ termMetaInternal term--setTermDescription :: Context Meta -> Y.Maybe String -> Term Meta -> Term Meta-setTermDescription cx d = setTermAnnotation cx metaDescription (Terms.string <$> d)--setTermType :: Context Meta -> Y.Maybe (Type Meta) -> Term Meta -> Term Meta-setTermType cx d = setTermAnnotation cx metaType (encodeType <$> d)--setType :: Y.Maybe (Type Meta) -> Meta -> Meta-setType mt = setAnnotation metaType (encodeType <$> mt)--setTypeAnnotation :: Context Meta -> String -> Y.Maybe (Term Meta) -> Type Meta -> Type Meta-setTypeAnnotation cx key val typ = if meta == annotationClassDefault (contextAnnotations cx)- then typ'- else TypeAnnotated $ Annotated typ' meta- where- typ' = stripType typ- meta = setAnnotation key val $ typeMetaInternal typ--setTypeDescription :: Context Meta -> Y.Maybe String -> Type Meta -> Type Meta-setTypeDescription cx d = setTypeAnnotation cx metaDescription (Terms.string <$> d)--termMetaInternal :: Term Meta -> Meta-termMetaInternal = aggregateAnnotations $ \t -> case t of- TermAnnotated a -> Just a- _ -> Nothing--typeMetaInternal :: Type Meta -> Meta-typeMetaInternal = aggregateAnnotations $ \t -> case t of- TypeAnnotated a -> Just a- _ -> Nothing
− src/main/haskell/Hydra/Monads.hs
@@ -1,118 +0,0 @@--- | Functions and type class implementations for working with Hydra's built-in Flow monad--module Hydra.Monads (- module Hydra.Common,- module Hydra.Core,- module Hydra.Compute,- module Hydra.Monads,-) where--import Hydra.Common-import Hydra.Core-import Hydra.Compute--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y-import Control.Monad-import qualified System.IO as IO---type GraphFlow m = Flow (Context m)--instance Functor (Flow s) where- fmap = liftM-instance Applicative (Flow s) where- pure = return- (<*>) = ap-instance Monad (Flow s) where- return x = Flow $ \s t -> FlowState (Just x) s t- p >>= k = Flow q'- where- q' s0 t0 = FlowState y s2 t2- where- FlowState x s1 t1 = unFlow p s0 t0- FlowState y s2 t2 = case x of- Just x' -> unFlow (k x') s1 t1- Nothing -> FlowState Nothing s1 t1-instance MonadFail (Flow s) where- fail msg = Flow $ \s t -> FlowState Nothing s (pushError msg t)- where- pushError msg t = t {traceMessages = errorMsg:(traceMessages t)}- where- errorMsg = "Error: " ++ msg ++ " (" ++ L.intercalate " > " (L.reverse $ traceStack t) ++ ")"--emptyTrace :: Trace-emptyTrace = Trace [] [] M.empty--flowSucceeds :: s -> Flow s a -> Bool-flowSucceeds cx f = Y.isJust $ flowStateValue $ unFlow f cx emptyTrace--flowWarning :: String -> Flow s a -> Flow s a-flowWarning msg b = Flow u'- where- u' s0 t0 = FlowState v s1 t2- where- FlowState v s1 t1 = unFlow b s0 t0- t2 = t1 {traceMessages = ("Warning: " ++ msg):(traceMessages t1)}--fromFlow :: s -> Flow s a -> a-fromFlow cx f = case flowStateValue (unFlow f cx emptyTrace) of- Just x -> x--fromFlowIo :: s -> Flow s a -> IO.IO a-fromFlowIo cx f = case mv of- Just v -> pure v- Nothing -> fail $ traceSummary trace- where- FlowState mv _ trace = unFlow f cx emptyTrace--getState :: Flow s s-getState = Flow q- where- f = pure ()- q s0 t0 = case v1 of- Nothing -> FlowState Nothing s1 t1- Just _ -> FlowState (Just s1) s1 t1- where- FlowState v1 s1 t1 = unFlow f s0 t0--putState :: s -> Flow s ()-putState cx = Flow q- where- q s0 t0 = FlowState v cx t1- where- FlowState v _ t1 = unFlow f s0 t0- f = pure ()--traceSummary :: Trace -> String-traceSummary t = L.intercalate "\n" (messageLines ++ keyvalLines)- where- messageLines = L.nub $ traceMessages t- keyvalLines = if M.null (traceOther t)- then []- else ("key/value pairs:"):(toLine <$> M.toList (traceOther t))- where- toLine (k, v) = "\t" ++ k ++ ": " ++ show v--unexpected :: (MonadFail m, Show a1) => String -> a1 -> m a2-unexpected cat obj = fail $ "expected " ++ cat ++ " but found: " ++ show obj--withState :: s1 -> Flow s1 a -> Flow s2 a-withState cx0 f = Flow q- where- q cx1 t1 = FlowState v cx1 t2- where- FlowState v _ t2 = unFlow f cx0 t1--withTrace :: String -> Flow s a -> Flow s a-withTrace msg f = Flow q- where- q s0 t0 = FlowState v s1 t3- where- FlowState v s1 t2 = unFlow f s0 t1- t1 = t0 {traceStack = msg:(traceStack t0)}- t3 = t2 {traceStack = traceStack t0}--withWarning :: String -> a -> Flow s a-withWarning msg x = flowWarning msg $ pure x
src/main/haskell/Hydra/Reduction.hs view
@@ -2,23 +2,29 @@ module Hydra.Reduction where -import Hydra.Core-import Hydra.Monads-import Hydra.Compute-import Hydra.Rewriting import Hydra.Basics-import Hydra.Lexical-import Hydra.Lexical+import Hydra.Strip+import Hydra.Compute+import Hydra.Core import Hydra.CoreDecoding-import Hydra.Meta+import Hydra.Extras+import Hydra.Graph+import Hydra.Annotations+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 -alphaConvert :: Ord m => Variable -> Term m -> Term m -> Term m+alphaConvert :: Name -> Term -> Term -> Term alphaConvert vold tnew = rewriteTerm rewrite id where rewrite recurse term = case term of@@ -29,143 +35,120 @@ _ -> recurse term -- For demo purposes. This should be generalized to enable additional side effects of interest.-countPrimitiveFunctionInvocations :: Bool-countPrimitiveFunctionInvocations = True+countPrimitiveInvocations :: Bool+countPrimitiveInvocations = True --- | A beta reduction function which is designed for safety, not speed.--- This function does not assume that term to be evaluated is in a normal form,--- and will provide an informative error message if evaluation fails.--- Type checking is assumed to have already occurred.-betaReduceTerm :: (Ord m, Show m) => Term m -> GraphFlow m (Term m)-betaReduceTerm = reduce M.empty+-- 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 where- reduce bindings term = do- cx <- getState- if termIsOpaque (contextStrategy cx) term- then pure term- else case stripTerm term of- TermApplication (Application func arg) -> reduceb func >>= reduceApplication bindings [arg]- TermLiteral _ -> done- TermElement _ -> done- TermFunction f -> reduceFunction f- TermList terms -> TermList <$> CM.mapM reduceb terms- TermMap map -> TermMap <$> fmap M.fromList (CM.mapM reducePair $ M.toList map)- where- reducePair (k, v) = (,) <$> reduceb k <*> reduceb v- TermNominal (Named name term') -> (\t -> TermNominal (Named name t)) <$> reduce bindings term'- TermOptional m -> TermOptional <$> CM.mapM reduceb m- TermRecord (Record n fields) -> TermRecord <$> (Record n <$> CM.mapM reduceField fields)- TermSet terms -> TermSet <$> fmap S.fromList (CM.mapM reduceb $ S.toList terms)- TermUnion (Union n f) -> TermUnion <$> (Union n <$> reduceField f)- TermVariable var@(Variable v) -> case M.lookup var bindings of- Nothing -> fail $ "cannot reduce free variable " ++ v- Just t -> reduceb t- where- done = pure term- reduceb = reduce bindings- reduceField (Field n t) = Field n <$> reduceb t- reduceFunction f = case f of- FunctionElimination el -> case el of- EliminationElement -> done- EliminationOptional (OptionalCases nothing just) -> TermFunction . FunctionElimination . EliminationOptional <$>- (OptionalCases <$> reduceb nothing <*> reduceb just)- EliminationRecord _ -> done- EliminationUnion (CaseStatement n cases) ->- TermFunction . FunctionElimination . EliminationUnion . CaseStatement n <$> CM.mapM reduceField cases- FunctionCompareTo other -> TermFunction . FunctionCompareTo <$> reduceb other- FunctionLambda (Lambda v body) -> TermFunction . FunctionLambda . Lambda v <$> reduceb body- FunctionPrimitive _ -> done-- -- Assumes that the function is closed and fully reduced. The arguments may not be.- reduceApplication bindings args f = if L.null args then pure f else case stripTerm f of- TermApplication (Application func arg) -> reduce bindings func- >>= reduceApplication bindings (arg:args)-- TermFunction f -> case f of- FunctionElimination e -> case e of- EliminationElement -> do- arg <- reduce bindings $ L.head args- case stripTerm arg of- TermElement name -> dereferenceElement name- >>= reduce bindings- >>= reduceApplication bindings (L.tail args)- _ -> fail "tried to apply data (delta) to a non- element reference"-- EliminationOptional (OptionalCases nothing just) -> do- arg <- (reduce bindings $ L.head args) >>= deref- case stripTerm arg of- TermOptional m -> case m of- Nothing -> reduce bindings nothing- Just t -> reduce bindings just >>= reduceApplication bindings (t:L.tail args)- _ -> fail $ "tried to apply an optional case statement to a non-optional term: " ++ show arg+ reduce eager = reduceTerm eager M.empty - EliminationUnion (CaseStatement _ cases) -> do- arg <- (reduce bindings $ L.head args) >>= deref- case stripTerm arg of- TermUnion (Union _ (Field fname t)) -> if L.null matching- then fail $ "no case for field named " ++ unFieldName fname- else reduce bindings (fieldTerm $ L.head matching)- >>= reduceApplication bindings (t:L.tail args)- where- matching = L.filter (\c -> fieldName c == fname) cases- _ -> fail $ "tried to apply a case statement to a non- union term: " ++ show arg+ mapping recurse mid = do+ inner <- if doRecurse eager mid then recurse mid else pure mid+ applyIfNullary eager inner [] - -- TODO: FunctionCompareTo+ doRecurse eager term = eager && case term of+ TermFunction (FunctionLambda _) -> False+ _ -> True - FunctionPrimitive name -> do- prim <- requirePrimitiveFunction name- let arity = primitiveFunctionArity prim- if L.length args >= arity- then do- if countPrimitiveFunctionInvocations- then nextCount ("count_" ++ unName name)- else pure 0- (mapM (reduce bindings) $ L.take arity args)- >>= primitiveFunctionImplementation prim- >>= reduce bindings- >>= reduceApplication bindings (L.drop arity args)- else unwind- where- unwind = pure $ L.foldl (\l r -> TermApplication $ Application l r) (TermFunction f) args+ -- Reduce an argument only if evaluation is lazy (i.e. the argument may not already have been reduced)+ reduceArg eager arg = if eager then pure arg else reduce False arg - FunctionLambda (Lambda v body) -> reduce (M.insert v (L.head args) bindings) body- >>= reduceApplication bindings (L.tail args)+ applyToArguments fun args = case args of+ [] -> fun+ (h:r) -> applyToArguments (Terms.apply fun h) r - -- TODO: FunctionProjection+ replaceFreeName toReplace replacement = rewriteTerm mapping id+ where+ mapping recurse inner = case inner of+ TermFunction (FunctionLambda (Lambda param body)) -> if param == toReplace then inner else recurse inner+ TermVariable name -> if name == toReplace then replacement else inner+ _ -> recurse inner - _ -> fail $ "unsupported function variant: " ++ show (functionVariant f)+ applyIfNullary eager original args = case stripTerm original of+ TermApplication (Application fun arg) -> applyIfNullary eager fun (arg:args)+ TermFunction fun -> case fun of+ FunctionElimination elm -> case args of+ [] -> pure original+ -- Reduce the argument prior to application, regardless of laziness+ (arg:remainingArgs) -> do+ reducedArg <- reduceArg eager $ stripTerm arg+ reducedResult <- applyElimination elm reducedArg >>= reduce eager+ applyIfNullary eager reducedResult remainingArgs+ FunctionLambda (Lambda param body) -> case args of+ [] -> pure original+ (arg:remainingArgs) -> do+ reducedArg <- reduce eager $ stripTerm arg+ reducedResult <- reduce eager $ replaceFreeName param reducedArg body+ applyIfNullary eager reducedResult remainingArgs+ FunctionPrimitive name -> do+ prim <- requirePrimitive name+ let arity = primitiveArity prim+ if arity > L.length args+ -- Not enough arguments available; back out+ then return $ applyToArguments original args+ else do+ let argList = L.take arity args+ let remainingArgs = L.drop arity args+ reducedArgs <- CM.mapM (reduceArg eager) argList+ reducedResult <- primitiveImplementation prim reducedArgs >>= reduce eager+ applyIfNullary eager reducedResult remainingArgs+ TermVariable _ -> pure $ applyToArguments original args -- TODO: dereference variables+ _ -> pure $ applyToArguments original args - _ -> fail $ "tried to apply a non-function: " ++ show (termVariant f)+ applyElimination elm reducedArg = case elm of+ EliminationList _ -> fail "list eliminations are unsupported"+ EliminationOptional _ -> fail "optional eliminations are unsupported"+ EliminationRecord proj -> do+ fields <- Expect.recordWithName (projectionTypeName proj) $ stripTerm reducedArg+ let matchingFields = L.filter (\f -> fieldName f == projectionField proj) fields+ if L.null matchingFields+ then fail $ "no such field: " ++ unName (projectionField proj) ++ " in " ++ unName (projectionTypeName proj) ++ " record"+ else pure $ fieldTerm $ L.head matchingFields+ EliminationUnion (CaseStatement name def fields) -> do+ field <- Expect.injectionWithName name reducedArg+ let matchingFields = L.filter (\f -> fieldName f == fieldName field) fields+ if L.null matchingFields+ then case def of+ Just d -> pure d+ Nothing -> fail $ "no such field " ++ unName (fieldName field) ++ " in " ++ unName name ++ " case statement"+ else pure $ Terms.apply (fieldTerm $ L.head matchingFields) (fieldTerm field)+ EliminationWrap name -> Expect.wrap name reducedArg -- 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 :: (Ord m, Show m) => Type m -> GraphFlow m (Type m)+betaReduceType :: Type -> Flow (Graph) (Type) betaReduceType typ = do- cx <- getState :: GraphFlow m (Context m)- return $ rewriteType (mapExpr cx) id typ+ g <- getState :: Flow (Graph) (Graph)+ rewriteTypeM mapExpr (pure . id) typ where- mapExpr cx rec t = case rec t of- TypeApplication a -> reduceApp a- t' -> t'+ mapExpr recurse t = do+ r <- recurse t+ case r of+ TypeApplication a -> reduceApp a+ t' -> pure t' where reduceApp (ApplicationType lhs rhs) = case lhs of- TypeAnnotated (Annotated t' ann) -> TypeAnnotated (Annotated (reduceApp (ApplicationType t' rhs)) ann)- TypeLambda (LambdaType v body) -> fromFlow cx $ betaReduceType $ replaceFreeVariableType v rhs body+ TypeAnnotated (AnnotatedType t' ann) -> do+ a <- reduceApp $ ApplicationType t' rhs+ return $ TypeAnnotated $ AnnotatedType a ann+ TypeLambda (LambdaType v body) -> betaReduceType $ replaceFreeName v rhs body -- nominal types are transparent- TypeNominal name -> fromFlow cx $ betaReduceType $ TypeApplication $ ApplicationType t' rhs- where- t' = fromFlow cx $ requireType name+ TypeVariable name -> do+ t' <- requireType name+ betaReduceType $ TypeApplication $ ApplicationType t' rhs -- | Apply the special rules: -- ((\x.e1) e2) == e1, where x does not appear free in e1 -- and -- ((\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 :: Ord m => Term m -> Term m+contractTerm :: Term -> Term contractTerm = rewriteTerm rewrite id where rewrite recurse term = case rec of- TermApplication (Application lhs rhs) -> case stripTerm lhs of+ TermApplication (Application lhs rhs) -> case fullyStripTerm lhs of TermFunction (FunctionLambda (Lambda v body)) -> if isFreeIn v body then body else alphaConvert v rhs body@@ -175,18 +158,18 @@ rec = recurse term -- Note: unused / untested-etaReduceTerm :: Term m -> Term m+etaReduceTerm :: Term -> Term etaReduceTerm term = case term of- TermAnnotated (Annotated term1 ann) -> TermAnnotated (Annotated (etaReduceTerm term1) ann)+ TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated (AnnotatedTerm (etaReduceTerm term1) ann) TermFunction (FunctionLambda l) -> reduceLambda l _ -> noChange where reduceLambda (Lambda v body) = case etaReduceTerm body of- TermAnnotated (Annotated body1 ann) -> reduceLambda (Lambda v body1)+ TermAnnotated (AnnotatedTerm body1 ann) -> reduceLambda (Lambda v body1) TermApplication a -> reduceApplication a where reduceApplication (Application lhs rhs) = case etaReduceTerm rhs of- TermAnnotated (Annotated rhs1 ann) -> reduceApplication (Application lhs rhs1)+ TermAnnotated (AnnotatedTerm rhs1 ann) -> reduceApplication (Application lhs rhs1) TermVariable v1 -> if v == v1 && isFreeIn v lhs then etaReduceTerm lhs else noChange@@ -195,44 +178,37 @@ noChange = term -- | Whether a term is closed, i.e. represents a complete program-termIsClosed :: Term m -> Bool+termIsClosed :: Term -> Bool termIsClosed = S.null . freeVariablesInTerm --- | Whether a term is opaque to reduction, i.e. need not be reduced-termIsOpaque :: EvaluationStrategy -> Term m -> Bool-termIsOpaque strategy term = S.member (termVariant term) (evaluationStrategyOpaqueTermVariants strategy)- -- | Whether a term has been fully reduced to a "value"-termIsValue :: Context m -> EvaluationStrategy -> Term m -> Bool-termIsValue cx strategy term = termIsOpaque strategy term || case stripTerm term of+termIsValue :: Graph -> Term -> Bool+termIsValue g term = case stripTerm term of TermApplication _ -> False TermLiteral _ -> True- TermElement _ -> True TermFunction f -> functionIsValue f TermList els -> forList els TermMap map -> L.foldl- (\b (k, v) -> b && termIsValue cx strategy k && termIsValue cx strategy v)+ (\b (k, v) -> b && termIsValue g k && termIsValue g v) True $ M.toList map TermOptional m -> case m of Nothing -> True- Just term -> termIsValue cx strategy term+ Just term -> termIsValue g term TermRecord (Record _ fields) -> checkFields fields TermSet els -> forList $ S.toList els- TermUnion (Union _ field) -> checkField field+ TermUnion (Injection _ field) -> checkField field TermVariable _ -> False where- forList els = L.foldl (\b t -> b && termIsValue cx strategy t) True els- checkField = termIsValue cx strategy . fieldTerm+ forList els = L.foldl (\b t -> b && termIsValue g t) True els+ checkField = termIsValue g . fieldTerm checkFields = L.foldl (\b f -> b && checkField f) True functionIsValue f = case f of- FunctionCompareTo other -> termIsValue cx strategy other FunctionElimination e -> case e of- EliminationElement -> True- EliminationNominal _ -> True- EliminationOptional (OptionalCases nothing just) -> termIsValue cx strategy nothing- && termIsValue cx strategy just+ EliminationWrap _ -> True+ EliminationOptional (OptionalCases nothing just) -> termIsValue g nothing+ && termIsValue g just EliminationRecord _ -> True- EliminationUnion (CaseStatement _ cases) -> checkFields cases- FunctionLambda (Lambda _ body) -> termIsValue cx strategy body+ EliminationUnion (CaseStatement _ def cases) -> checkFields cases && (Y.maybe True (termIsValue g) def)+ FunctionLambda (Lambda _ body) -> termIsValue g body FunctionPrimitive _ -> True
src/main/haskell/Hydra/Rewriting.hs view
@@ -2,13 +2,21 @@ module Hydra.Rewriting where +import Hydra.Basics+import Hydra.Strip+import Hydra.Coders+import Hydra.Compute import Hydra.Core-import Hydra.Monads+import Hydra.CoreEncoding+import Hydra.Extras+import Hydra.Graph import Hydra.Module import Hydra.Lexical-import Hydra.Compute import Hydra.Mantle-import Hydra.Util.Sorting+import Hydra.Tools.Sorting+import Hydra.Tier1+import Hydra.Tier2+import Hydra.Tools.Debug import qualified Control.Monad as CM import qualified Data.List as L@@ -17,95 +25,137 @@ import qualified Data.Maybe as Y --- | Turn arbitrary terms like 'compareTo 42' into terms like '\x.compareTo 42 x',--- whose arity (in the absences of application terms) is equal to the depth of nested lambdas.--- This function leaves application terms intact, simply rewriting their left and right subterms.-expandLambdas :: Ord m => Term m -> GraphFlow m (Term m)-expandLambdas = rewriteTermM (expand []) (pure . id)+-- beneathTermAnnotations :: (Term -> Term) -> Term -> Term+-- beneathTermAnnotations f term = case term of+-- TermAnnotated (AnnotatedTerm term1 ann) ->+-- TermAnnotated (AnnotatedTerm (beneathTermAnnotationsM f term1) ann)+-- TermTyped (TypedTerm term1 typ) ->+-- TermTyped $ TypedTerm (beneathTermAnnotationsM f term1) typ+-- _ -> f term+--+-- beneathTermAnnotationsM :: (Term -> Flow s Term) -> Term -> Flow s Term+-- beneathTermAnnotationsM f term = case term of+-- TermAnnotated (AnnotatedTerm term1 ann) ->+-- TermAnnotated <$> (AnnotatedTerm <$> beneathTermAnnotationsM f term1 <*> pure ann)+-- TermTyped (TypedTerm term1 typ) ->+-- TermTyped <$> (TypedTerm <$> beneathTermAnnotationsM f term1 <*> pure typ)+-- _ -> f term++elementsWithDependencies :: [Element] -> Flow Graph [Element]+elementsWithDependencies original = CM.mapM requireElement allDepNames where- expand args recurse term = case term of- TermAnnotated (Annotated term' ann) -> TermAnnotated <$> (Annotated <$> expand args recurse term' <*> pure ann)- TermApplication (Application lhs rhs) -> do- rhs' <- expandLambdas rhs- expand (rhs':args) recurse lhs- TermFunction f -> case f of- FunctionCompareTo _ -> pad args 1 <$> recurse term- FunctionElimination _ -> pad args 1 <$> recurse term- FunctionLambda _ -> passThrough- FunctionPrimitive name -> do- prim <- requirePrimitiveFunction name- return $ pad args (primitiveFunctionArity prim) term- _ -> passThrough- where- passThrough = pad args 0 <$> recurse term+ depNames = S.toList . termDependencyNames True False False . elementData+ allDepNames = L.nub $ (elementName <$> original) ++ (L.concat $ depNames <$> original) - pad args arity term = L.foldl lam (L.foldl app term args') $ L.reverse variables+-- | Recursively transform arbitrary terms like 'add 42' into terms like '\x.add 42 x',+-- 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+ where+ rewrite recurse term = case getFunType term of+ Nothing -> recurse term+ Just (doms, cod) -> expand doms cod term where- variables = L.take (max 0 (arity - L.length args)) ((\i -> Variable $ "v" ++ show i) <$> [1..])- args' = args ++ (TermVariable <$> variables)+ toNaryFunType typ = case stripType typ of+ TypeFunction (FunctionType dom0 cod0) -> (dom0 : doms, cod1)+ where+ (doms, cod1) = toNaryFunType cod0+ d -> ([], d)+ getFunType term = toNaryFunType <$> getTermType term - app lhs rhs = TermApplication $ Application lhs rhs- lam body v = TermFunction $ FunctionLambda $ Lambda v body+ expand doms cod term = case term of+ TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated $ AnnotatedTerm (expand doms cod term1) ann+ TermApplication (Application lhs rhs) -> case getTermType rhs of+ 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 $+ expand (L.tail doms) cod body+ _ -> pad 1 doms cod term+ TermLet (Let bindings env) -> TermLet $ Let (expandBinding <$> bindings) $ expand doms cod env+ where+ expandBinding (LetBinding name term1 typ) = LetBinding name (expandTypedLambdas term1) typ+ TermTyped (TypedTerm term1 typ) -> TermTyped $ TypedTerm (expand doms cod term1) typ+ _ -> recurse term -foldOverTerm :: TraversalOrder -> (a -> Term m -> a) -> a -> Term m -> a-foldOverTerm order fld b0 term = case order of- TraversalOrderPre -> L.foldl (foldOverTerm order fld) (fld b0 term) children- TraversalOrderPost -> fld (L.foldl (foldOverTerm order fld) b0 children) term- where- children = subterms term+ pad i doms cod term = if L.null doms+ then term+ else TermFunction $ FunctionLambda $ Lambda var $+ 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+ 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 -foldOverType :: TraversalOrder -> (a -> Type m -> a) -> a -> Type m -> a-foldOverType order fld b0 typ = case order of- TraversalOrderPre -> L.foldl (foldOverType order fld) (fld b0 typ) children- TraversalOrderPost -> fld (L.foldl (foldOverType order fld) b0 children) typ+flattenLetTerms :: Term -> Term+flattenLetTerms = rewriteTerm flatten id where- children = subtypes typ+ flatten recurse term = case recurse term of+ TermLet (Let bindings body) -> TermLet $ Let newBindings body+ where+ newBindings = L.concat (forResult . rewriteBinding <$> bindings)+ where+ forResult (h, rest) = (h:rest)+ rewriteBinding (LetBinding k0 v0 t) = case v0 of+ TermAnnotated (AnnotatedTerm v1 ann) -> ((LetBinding k0 (TermAnnotated $ AnnotatedTerm v2 ann) t), deps)+ where+ ((LetBinding _ v2 _), deps) = rewriteBinding (LetBinding k0 v1 t)+ TermLet (Let bindings1 body1) -> ((LetBinding k0 newBody t), newBinding <$> bindings1)+ where+ newBody = replaceVars body1+ newBinding (LetBinding kn vn t) = LetBinding (qualify kn) (replaceVars vn) t+ qualify n = Name $ prefix ++ unName n+ replaceVars = substituteVariables subst+ subst = M.fromList (toSubstPair <$> bindings1)+ where+ toSubstPair (LetBinding n _ _) = (n, qualify n)+ prefix = unName k0 ++ "_"+ v1 -> ((LetBinding k0 v1 t), [])+ term0 -> term0 -freeVariablesInScheme :: Show m => TypeScheme m -> S.Set VariableType+freeVariablesInScheme :: TypeScheme -> S.Set Name freeVariablesInScheme (TypeScheme vars t) = S.difference (freeVariablesInType t) (S.fromList vars) -freeVariablesInTerm :: Term m -> S.Set Variable-freeVariablesInTerm term = case term of- TermAnnotated (Annotated term1 _) -> freeVariablesInTerm term1- TermFunction (FunctionLambda (Lambda var body)) -> S.delete var $ freeVariablesInTerm body- TermVariable v -> S.fromList [v]- _ -> L.foldl (\s t -> S.union s $ freeVariablesInTerm t) S.empty $ subterms term--freeVariablesInType :: Type m -> S.Set VariableType-freeVariablesInType = foldOverType TraversalOrderPost fld S.empty- where- fld vars typ = case typ of- TypeVariable v -> S.insert v vars- _ -> vars--moduleDependencyNamespaces :: Bool -> Bool -> Bool -> Module m -> S.Set Namespace-moduleDependencyNamespaces withEls withPrims withNoms mod = S.delete (moduleNamespace mod) names+-- | 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 where- names = S.fromList (namespaceOfEager <$> S.toList elNames)- elNames = L.foldl (\s t -> S.union s $ termDependencyNames withEls withPrims withNoms t) S.empty $- (elementData <$> moduleElements mod) ++ (elementSchema <$> moduleElements mod)+ f recurse typ = do+ tr <- recurse typ+ case tr of+ TypeVariable v -> case M.lookup v schema of+ Just t -> inlineType schema t+ Nothing -> fail $ "No such type in schema: " ++ unName v+ t -> return t -isFreeIn :: Variable -> Term m -> Bool+isFreeIn :: Name -> Term -> Bool isFreeIn v term = not $ S.member v $ freeVariablesInTerm term -- | Recursively remove term annotations, including within subterms-removeTermAnnotations :: Ord m => Term m -> Term m+removeTermAnnotations :: Term -> Term removeTermAnnotations = rewriteTerm remove id where remove recurse term = case term of- TermAnnotated (Annotated term' _) -> remove recurse term'+ TermAnnotated (AnnotatedTerm term' _) -> remove recurse term'+ TermTyped (TypedTerm term' _) -> remove recurse term' _ -> recurse term -- | Recursively remove type annotations, including within subtypes-removeTypeAnnotations :: Ord m => Type m -> Type m+removeTypeAnnotations :: Type -> Type removeTypeAnnotations = rewriteType remove id where remove recurse typ = case recurse typ of- TypeAnnotated (Annotated typ' _) -> remove recurse typ'+ TypeAnnotated (AnnotatedType typ' _) -> remove recurse typ' _ -> recurse typ -replaceFreeVariableType :: Ord m => VariableType -> Type m -> Type m -> Type m-replaceFreeVariableType v rep = rewriteType mapExpr id+replaceFreeName :: Name -> Type -> Type -> Type+replaceFreeName v rep = rewriteType mapExpr id where mapExpr recurse t = case t of TypeLambda (LambdaType v' body) -> if v == v'@@ -114,63 +164,76 @@ TypeVariable v' -> if v == v' then rep else t _ -> recurse t -rewrite :: ((a -> b) -> a -> b) -> ((a -> b) -> a -> b) -> a -> b+rewrite :: ((x -> y) -> x -> y) -> ((x -> y) -> x -> y) -> x -> y rewrite fsub f = recurse where recurse = f (fsub recurse) -rewriteTerm :: Ord b => ((Term a -> Term b) -> Term a -> Term b) -> (a -> b) -> Term a -> Term b+rewriteTerm :: ((Term -> Term) -> Term -> Term) -> (M.Map String Term -> M.Map String Term) -> Term -> Term rewriteTerm f mf = rewrite fsub f where fsub recurse term = case term of- TermAnnotated (Annotated ex ann) -> TermAnnotated $ Annotated (recurse ex) (mf ann)+ TermAnnotated (AnnotatedTerm ex ann) -> TermAnnotated $ AnnotatedTerm (recurse ex) (mf ann) TermApplication (Application lhs rhs) -> TermApplication $ Application (recurse lhs) (recurse rhs)- TermElement name -> TermElement name TermFunction fun -> TermFunction $ case fun of- FunctionCompareTo other -> FunctionCompareTo $ recurse other FunctionElimination e -> FunctionElimination $ case e of- EliminationElement -> EliminationElement- EliminationNominal name -> EliminationNominal name+ EliminationList fld -> EliminationList $ recurse fld EliminationOptional (OptionalCases nothing just) -> EliminationOptional (OptionalCases (recurse nothing) (recurse just))+ EliminationProduct tp -> EliminationProduct tp EliminationRecord p -> EliminationRecord p- EliminationUnion (CaseStatement n cases) -> EliminationUnion $ CaseStatement n (forField <$> cases)+ 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 FunctionPrimitive name -> FunctionPrimitive name- TermLet (Let v t1 t2) -> TermLet $ Let v (recurse t1) (recurse t2)+ TermLet (Let bindings env) -> TermLet $ Let (mapBinding <$> bindings) (recurse env)+ where+ mapBinding (LetBinding k v t) = LetBinding k (recurse v) t TermList els -> TermList $ recurse <$> els TermLiteral v -> TermLiteral v TermMap m -> TermMap $ M.fromList $ (\(k, v) -> (recurse k, recurse v)) <$> M.toList m- TermNominal (Named name t) -> TermNominal (Named name $ recurse t)+ TermWrap (WrappedTerm name t) -> TermWrap (WrappedTerm name $ recurse t) TermOptional m -> TermOptional $ recurse <$> m TermProduct tuple -> TermProduct (recurse <$> tuple) 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- TermUnion (Union n field) -> TermUnion $ Union n $ forField field+ TermTyped (TypedTerm term1 type2) -> TermTyped $ TypedTerm (recurse term1) type2+ TermUnion (Injection n field) -> TermUnion $ Injection n $ forField field TermVariable v -> TermVariable v where forField f = f {fieldTerm = recurse (fieldTerm f)} -rewriteTermM :: Ord b => ((Term a -> Flow s (Term b)) -> Term a -> (Flow s (Term b))) -> (a -> Flow s b) -> Term a -> Flow s (Term b)+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 where fsub recurse term = case term of- TermAnnotated (Annotated ex ma) -> TermAnnotated <$> (Annotated <$> recurse ex <*> mf ma)+ TermAnnotated (AnnotatedTerm ex ma) -> TermAnnotated <$> (AnnotatedTerm <$> recurse ex <*> mf ma) TermApplication (Application lhs rhs) -> TermApplication <$> (Application <$> recurse lhs <*> recurse rhs)- TermElement name -> pure $ TermElement name TermFunction fun -> TermFunction <$> case fun of- FunctionCompareTo other -> FunctionCompareTo <$> recurse other FunctionElimination e -> FunctionElimination <$> case e of- EliminationElement -> pure EliminationElement- EliminationNominal name -> pure $ EliminationNominal name+ EliminationList fld -> EliminationList <$> recurse fld EliminationOptional (OptionalCases nothing just) -> EliminationOptional <$> (OptionalCases <$> recurse nothing <*> recurse just)+ EliminationProduct tp -> pure $ EliminationProduct tp EliminationRecord p -> pure $ EliminationRecord p- EliminationUnion (CaseStatement n cases) -> EliminationUnion <$> (CaseStatement n <$> (CM.mapM forField cases))+ EliminationUnion (CaseStatement n def cases) -> do+ rdef <- case def of+ Nothing -> pure Nothing+ 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) FunctionPrimitive name -> pure $ FunctionPrimitive name- TermLet (Let v t1 t2) -> TermLet <$> (Let v <$> recurse t1 <*> recurse t2)+ TermLet (Let bindings env) -> TermLet <$> (Let <$> (CM.mapM mapBinding bindings) <*> recurse env)+ where+ mapBinding (LetBinding k v t) = do+ v' <- recurse v+ return $ LetBinding k v' t TermList els -> TermList <$> (CM.mapM recurse els) TermLiteral v -> pure $ TermLiteral v TermMap m -> TermMap <$> (M.fromList <$> CM.mapM forPair (M.toList m))@@ -179,129 +242,186 @@ km <- recurse k vm <- recurse v return (km, vm)- TermNominal (Named name t) -> TermNominal <$> (Named name <$> recurse t) TermOptional m -> TermOptional <$> (CM.mapM recurse m) TermProduct tuple -> TermProduct <$> (CM.mapM recurse tuple) TermRecord (Record n fields) -> TermRecord <$> (Record n <$> (CM.mapM forField fields)) TermSet s -> TermSet <$> (S.fromList <$> (CM.mapM recurse $ S.toList s)) TermSum (Sum i s trm) -> TermSum <$> (Sum i s <$> recurse trm)- TermUnion (Union n field) -> TermUnion <$> (Union n <$> forField field)+ TermTyped (TypedTerm term1 type2) -> TermTyped <$> (TypedTerm <$> recurse term1 <*> pure type2)+ TermUnion (Injection n field) -> TermUnion <$> (Injection n <$> forField field) TermVariable v -> pure $ TermVariable v+ TermWrap (WrappedTerm name t) -> TermWrap <$> (WrappedTerm name <$> recurse t) where forField f = do t <- recurse (fieldTerm f) return f {fieldTerm = t} -rewriteTermMeta :: Ord b => (a -> b) -> Term a -> Term b+rewriteTermMeta :: (M.Map String Term -> M.Map String Term) -> Term -> Term rewriteTermMeta = rewriteTerm mapExpr where mapExpr recurse term = recurse term -rewriteType :: ((Type a -> Type b) -> Type a -> Type b) -> (a -> b) -> Type a -> Type b+rewriteTermMetaM :: (M.Map String Term -> Flow s (M.Map String Term)) -> Term -> Flow s Term+rewriteTermMetaM = rewriteTermM mapExpr+ where+ mapExpr recurse term = recurse term++rewriteType :: ((Type -> Type) -> Type -> Type) -> (M.Map String Term -> M.Map String Term) -> Type -> Type rewriteType f mf = rewrite fsub f where fsub recurse typ = case typ of- TypeAnnotated (Annotated t ann) -> TypeAnnotated $ Annotated (recurse t) (mf ann)+ TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated $ AnnotatedType (recurse t) (mf ann) TypeApplication (ApplicationType lhs rhs) -> TypeApplication $ ApplicationType (recurse lhs) (recurse rhs)- TypeElement t -> TypeElement $ recurse t TypeFunction (FunctionType dom cod) -> TypeFunction (FunctionType (recurse dom) (recurse cod)) TypeLambda (LambdaType v b) -> TypeLambda (LambdaType v $ recurse b) TypeList t -> TypeList $ recurse t TypeLiteral lt -> TypeLiteral lt TypeMap (MapType kt vt) -> TypeMap (MapType (recurse kt) (recurse vt))- TypeNominal name -> TypeNominal name TypeOptional t -> TypeOptional $ recurse t TypeProduct types -> TypeProduct (recurse <$> types)- TypeRecord (RowType name extends fields) -> TypeRecord $ RowType name extends (forfield <$> fields)+ TypeRecord (RowType name extends fields) -> TypeRecord $ RowType name extends (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 extends fields) -> TypeUnion $ RowType name extends (forField <$> fields) TypeVariable v -> TypeVariable v+ TypeWrap (WrappedType name t) -> TypeWrap $ WrappedType name $ recurse t where- forfield f = f {fieldTypeType = recurse (fieldTypeType f)}+ forField f = f {fieldTypeType = recurse (fieldTypeType f)} -rewriteTypeMeta :: (a -> b) -> Type a -> Type b+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+ where+ fsub recurse typ = case typ of+ TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated <$> (AnnotatedType <$> recurse t <*> mf 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)+ TypeList t -> TypeList <$> recurse t+ TypeLiteral lt -> pure $ TypeLiteral lt+ 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)+ 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)+ TypeVariable v -> pure $ TypeVariable v+ TypeWrap (WrappedType name t) -> TypeWrap <$> (WrappedType <$> pure name <*> recurse t)+ where+ forField f = do+ t <- recurse $ fieldTypeType f+ return f {fieldTypeType = t}++rewriteTypeMeta :: (M.Map String Term -> M.Map String Term) -> Type -> Type rewriteTypeMeta = rewriteType mapExpr where mapExpr recurse term = recurse term -simplifyTerm :: Ord m => Term m -> Term m+simplifyTerm :: Term -> Term simplifyTerm = rewriteTerm simplify id where- simplify recurse term = recurse $ case stripTerm term of- TermApplication (Application lhs rhs) -> case stripTerm lhs of+ simplify recurse term = recurse $ case fullyStripTerm term of+ TermApplication (Application lhs rhs) -> case fullyStripTerm lhs of TermFunction (FunctionLambda (Lambda var body)) -> if S.member var (freeVariablesInTerm body)- then case stripTerm rhs of+ then case fullyStripTerm rhs of TermVariable v -> simplifyTerm $ substituteVariable var v body _ -> term else simplifyTerm body _ -> term _ -> term -substituteVariable :: Ord m => Variable -> Variable -> Term m -> Term m+stripTermRecursive :: Term -> Term+stripTermRecursive = rewriteTerm strip id+ where+ strip recurse term = case recurse term of+ TermAnnotated (AnnotatedTerm t _) -> t+ TermTyped (TypedTerm t _) -> t+ t -> t++substituteVariable :: Name -> Name -> Term -> Term substituteVariable from to = rewriteTerm replace id where replace recurse term = case term of- TermVariable x -> recurse $ (TermVariable $ if x == from then to else x)+ TermVariable x -> (TermVariable $ if x == from then to else x) TermFunction (FunctionLambda (Lambda var _)) -> if var == from then term else recurse term _ -> recurse term -subterms :: Term m -> [Term m]-subterms term = case term of- TermAnnotated (Annotated t _) -> [t]- TermApplication (Application lhs rhs) -> [lhs, rhs]- TermFunction f -> case f of- FunctionCompareTo other -> [other]- FunctionElimination e -> case e of- EliminationOptional (OptionalCases nothing just) -> [nothing, just]- EliminationUnion (CaseStatement _ cases) -> fieldTerm <$> cases- _ -> []- FunctionLambda (Lambda _ body) -> [body]- _ -> []- TermLet (Let _ t1 t2) -> [t1, t2]- TermList els -> els- TermMap m -> L.concat ((\(k, v) -> [k, v]) <$> M.toList m)- TermNominal (Named _ t) -> [t]- TermOptional m -> Y.maybeToList m- TermProduct tuple -> tuple- TermRecord (Record n fields) -> fieldTerm <$> fields- TermSet s -> S.toList s- TermSum (Sum _ _ trm) -> [trm]- TermUnion (Union _ field) -> [fieldTerm field]- _ -> []--subtypes :: Type m -> [Type m]-subtypes typ = case typ of- TypeAnnotated (Annotated t _) -> [t]- TypeApplication (ApplicationType lhs rhs) -> [lhs, rhs]- TypeElement et -> [et]- TypeFunction (FunctionType dom cod) -> [dom, cod]- TypeLambda (LambdaType v body) -> [body]- TypeList lt -> [lt]- TypeLiteral _ -> []- TypeMap (MapType kt vt) -> [kt, vt]- TypeNominal _ -> []- TypeOptional ot -> [ot]- TypeProduct types -> types- TypeRecord rt -> fieldTypeType <$> rowTypeFields rt- TypeSet st -> [st]- TypeSum types -> types- TypeUnion rt -> fieldTypeType <$> rowTypeFields rt- TypeVariable _ -> []+substituteVariables :: M.Map Name Name -> Term -> Term+substituteVariables subst = rewriteTerm replace id+ 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+ Nothing -> recurse term+ Just _ -> term+ _ -> recurse term -termDependencyNames :: Bool -> Bool -> Bool -> Term m -> S.Set Name-termDependencyNames withEls withPrims withNoms = foldOverTerm TraversalOrderPre addNames S.empty+-- Note: does not distinguish between bound and free variables; use freeVariablesInTerm for that+termDependencyNames :: Bool -> Bool -> Bool -> Term -> S.Set Name+termDependencyNames withVars withPrims withNoms = foldOverTerm TraversalOrderPre addNames S.empty where addNames names term = case term of- TermElement name -> if withEls then S.insert name names else names- TermFunction (FunctionPrimitive name) -> if withPrims then S.insert name names else names- TermNominal (Named name _) -> if withNoms then S.insert name names else names- _ -> names+ TermFunction f -> case f of+ FunctionPrimitive name -> prim name+ FunctionElimination e -> case e of+ EliminationRecord (Projection name _) -> nominal name+ EliminationUnion (CaseStatement name _ _) -> nominal name+ EliminationWrap name -> nominal name+ _ -> names+ _ -> names+ TermRecord (Record name _) -> nominal name+ TermUnion (Injection name _) -> nominal name+ TermVariable name -> var name+ TermWrap (WrappedTerm name _) -> nominal name+ _ -> names+ where+ nominal name = if withNoms then S.insert name names else names+ prim name = if withPrims then S.insert name names else names+ var name = if withVars then S.insert name names else names -topologicalSortElements :: [Element m] -> Maybe [Name]+topologicalSortElements :: [Element] -> Either [[Name]] [Name] topologicalSortElements els = topologicalSort $ adjlist <$> els where- adjlist e = (elementName e, S.toList $ termDependencyNames True True True $ elementData e)+ adjlist e = (elementName e, S.toList $ termDependencyNames False True True $ elementData e)++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
+ src/main/haskell/Hydra/Rules.hs view
@@ -0,0 +1,348 @@+-- | 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)
+ src/main/haskell/Hydra/Scratchpad.hs view
@@ -0,0 +1,4 @@+module Hydra.Scratchpad where++import Hydra.Core+import Hydra.Compute
+ src/main/haskell/Hydra/Sources/Core.hs view
@@ -0,0 +1,398 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Core(+ hydraCore,+ hydraCoreModule,+ module Hydra.Kernel,+) where++import Hydra.Kernel+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types+++hydraCore :: Graph+hydraCore = elementsToGraph bootstrapGraph Nothing (moduleElements hydraCoreModule)++hydraCoreModule :: Module+hydraCoreModule = Module ns elements [] [] $+ Just "Hydra's core data model, defining types, terms, and their dependencies"+ where+ ns = Namespace "hydra/core"+ core = typeref ns+ def = datatype ns+ doc s = setTypeDescription (Just s)++ elements = [++ def "AnnotatedTerm" $+ doc "A term together with an annotation" $+ record [+ "subject">: core "Term",+ "annotation">: Types.map string $ core "Term"],++ def "AnnotatedType" $+ doc "A type together with an annotation" $+ record [+ "subject">: core "Type",+ "annotation">: Types.map string $ core "Term"],++ def "Application" $+ doc "A term which applies a function to an argument" $+ record [+ "function">:+ doc "The left-hand side of the application" $+ core "Term",+ "argument">:+ doc "The right-hand side of the application" $+ core "Term"],++ def "ApplicationType" $+ doc "The type-level analog of an application term" $+ record [+ "function">:+ doc "The left-hand side of the application" $+ core "Type",+ "argument">:+ doc "The right-hand side of the application" $+ core "Type"],++ def "CaseStatement" $+ doc "A union elimination; a case statement" $+ record [+ "typeName">: core "Name",+ "default">: optional (core "Term"),+ "cases">: list $ core "Field"],++ def "Elimination" $+ doc "A corresponding elimination for an introduction term" $+ union [+ "list">:+ doc "Eliminates a list using a fold function; this function has the signature b -> [a] -> b" $+ core "Term",+ "optional">:+ doc "Eliminates an optional term by matching over the two possible cases" $+ core "OptionalCases",+ "product">:+ doc "Eliminates a tuple by projecting the component at a given 0-indexed offset" $+ core "TupleProjection",+ "record">:+ doc "Eliminates a record by projecting a given field" $+ core "Projection",+ "union">:+ doc "Eliminates a union term by matching over the fields of the union. This is a case statement." $+ core "CaseStatement",+ "wrap">:+ doc "Unwrap a wrapped term" $+ core "Name"],++ def "Field" $+ doc "A name/term pair" $+ record [+ "name">: core "Name",+ "term">: core "Term"],++ def "FieldType" $+ doc "A name/type pair" $+ record [+ "name">: core "Name",+ "type">: core "Type"],++ def "FloatType" $+ doc "A floating-point type" $+ enum [+ "bigfloat",+ "float32",+ "float64"],++ def "FloatValue" $+ doc "A floating-point literal value" $+ union [+ "bigfloat">:+ doc "An arbitrary-precision floating-point value" bigfloat,+ "float32">:+ doc "A 32-bit floating-point value" float32,+ "float64">:+ doc "A 64-bit floating-point value" float64],++ def "Function" $+ doc "A function" $+ union [+ "elimination">:+ doc "An elimination for any of a few term variants" $+ core "Elimination",+ "lambda">:+ doc "A function abstraction (lambda)" $+ core "Lambda",+ "primitive">:+ doc "A reference to a built-in (primitive) function" $+ core "Name"],++ def "FunctionType" $+ doc "A function type, also known as an arrow type" $+ record [+ "domain">: core "Type",+ "codomain">: core "Type"],++ def "Injection" $+ doc "An instance of a union type; i.e. a string-indexed generalization of inl() or inr()" $+ record [+ "typeName">: core "Name",+ "field">: core "Field"],++ def "IntegerType" $+ doc "An integer type" $+ enum [+ "bigint",+ "int8",+ "int16",+ "int32",+ "int64",+ "uint8",+ "uint16",+ "uint32",+ "uint64"],++ def "IntegerValue" $+ doc "An integer literal value" $+ union [+ "bigint">:+ doc "An arbitrary-precision integer value" bigint,+ "int8">:+ doc "An 8-bit signed integer value" int8,+ "int16">:+ doc "A 16-bit signed integer value (short value)" int16,+ "int32">:+ doc "A 32-bit signed integer value (int value)" int32,+ "int64">:+ doc "A 64-bit signed integer value (long value)" int64,+ "uint8">:+ doc "An 8-bit unsigned integer value (byte)" uint8,+ "uint16">:+ doc "A 16-bit unsigned integer value" uint16,+ "uint32">:+ doc "A 32-bit unsigned integer value (unsigned int)" uint32,+ "uint64">:+ doc "A 64-bit unsigned integer value (unsigned long)" uint64],++ def "Lambda" $+ doc "A function abstraction (lambda)" $+ record [+ "parameter">:+ doc "The parameter of the lambda" $+ core "Name",+ "body">:+ doc "The body of the lambda" $+ core "Term"],++ def "LambdaType" $+ doc "A type abstraction; the type-level analog of a lambda term" $+ record [+ "parameter">:+ doc "The variable which is bound by the lambda" $+ core "Name",+ "body">:+ doc "The body of the lambda" $+ core "Type"],++ def "Let" $+ doc "A set of (possibly recursive) 'let' bindings together with an environment in which they are bound" $+ record [+ "bindings">: list $ core "LetBinding",+ "environment">: core "Term"],++ def "LetBinding" $+ doc "A field with an optional type scheme, used to bind variables to terms in a 'let' expression" $+ record [+ "name">: core "Name",+ "term">: core "Term",+ "type">: optional $ core "TypeScheme"],++ def "Literal" $+ doc "A term constant; an instance of a literal type" $+ union [+ "binary">:+ doc "A binary literal" binary,+ "boolean">:+ doc "A boolean literal" boolean,+ "float">:+ doc "A floating-point literal" $ core "FloatValue",+ "integer">:+ doc "An integer literal" $+ core "IntegerValue",+ "string">:+ doc "A string literal" string],++ def "LiteralType" $+ doc "Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants" $+ union [+ "binary">: unit,+ "boolean">: unit,+ "float">: core "FloatType",+ "integer">: core "IntegerType",+ "string">: unit],++ def "MapType" $+ doc "A map type" $+ record [+ "keys">: core "Type",+ "values">: core "Type"],++ def "Name" $+ doc "A symbol which stands for a term, type, or element"+ $ wrap string,++ def "WrappedTerm" $+ doc "A term wrapped in a type name" $+ record [+ "typeName">: core "Name",+ "object">: core "Term"],++ def "WrappedType" $+ doc "A type wrapped in a type name" $+ record [+ "typeName">: core "Name",+ "object">: core "Type"],++ def "OptionalCases" $+ doc "A case statement for matching optional terms" $+ record [+ "nothing">:+ doc "A term provided if the optional value is nothing" $+ core "Term",+ "just">:+ doc "A function which is applied if the optional value is non-nothing" $+ core "Term"],++ def "Projection" $+ doc "A record elimination; a projection" $+ record [+ "typeName">:+ doc "The name of the record type" $+ core "Name",+ "field">:+ doc "The name of the projected field" $+ core "Name"],++ def "Record" $+ doc "A record, or labeled tuple; a map of field names to terms" $+ record [+ "typeName">: core "Name",+ "fields">: list $ core "Field"],++ def "RowType" $+ doc "A labeled record or union type" $+ record [+ "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"],++ def "Sum" $+ doc "The unlabeled equivalent of an Injection term" $+ record [+ "index">: int32,+ "size">: int32,+ "term">: core "Term"],++ def "Term" $+ doc "A data term" $+ union [+ "annotated">:+ doc "A term annotated with metadata" $+ core "AnnotatedTerm",+ "application">:+ doc "A function application" $+ core "Application",+ "function">:+ doc "A function term" $+ core "Function",+ "let">:+ core "Let",+ "list">:+ doc "A list" $+ list $ core "Term",+ -- TODO: list elimination+ "literal">:+ doc "A literal value" $+ core "Literal",+ "map">:+ doc "A map of keys to values" $+ Types.map (core "Term") (core "Term"),+ "optional">:+ doc "An optional value" $+ optional $ core "Term",+ "product">:+ doc "A tuple" $+ list (core "Term"),+ "record">:+ doc "A record term" $+ core "Record",+ "set">:+ doc "A set of values" $+ set $ core "Term",+ "sum">:+ doc "A variant tuple" $+ core "Sum",+ "typed">:+ doc "A term annotated with its type" $+ core "TypedTerm",+ "union">:+ doc "An injection; an instance of a union type" $+ core "Injection",+ "variable">:+ doc "A variable reference" $+ core "Name",+ "wrap">:+ core "WrappedTerm"],++ def "TupleProjection" $+ doc "A tuple elimination; a projection from an integer-indexed product" $+ record [+ "arity">:+ doc "The arity of the tuple"+ int32,+ "index">:+ doc "The 0-indexed offset from the beginning of the tuple"+ int32],++ def "Type" $+ doc "A data type" $+ union [+ "annotated">: core "AnnotatedType",+ "application">: core "ApplicationType",+ "function">: core "FunctionType",+ "lambda">: core "LambdaType",+ "list">: core "Type",+ "literal">: core "LiteralType",+ "map">: core "MapType",+ "optional">: core "Type",+ "product">: list (core "Type"),+ "record">: core "RowType",+ "set">: core "Type",+ "sum">: list (core "Type"),+ "union">: core "RowType",+ "variable">: core "Name",+ "wrap">: core "WrappedType"],++ def "TypeScheme" $+ doc "A type expression together with free type variables occurring in the expression" $+ record [+ "variables">: list $ core "Name",+ "type">: core "Type"],++ def "TypedTerm" $+ doc "A term together with its type" $+ record [+ "term">: core "Term",+ "type">: core "Type"],++ def "Unit" $+ doc "An empty record as a canonical unit value" $+ record []]
+ src/main/haskell/Hydra/Sources/Libraries.hs view
@@ -0,0 +1,416 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Libraries where++import Hydra.Kernel+import qualified Hydra.Dsl.Expect as Expect+import Hydra.Dsl.Prims as Prims+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types++import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Io as Io+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Literals as Literals+import qualified Hydra.Lib.Logic as Logic+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Math as Math+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Lib.Strings as Strings++import qualified Data.List as L+++_hydra_lib_equality :: Namespace+_hydra_lib_equality = Namespace "hydra/lib/equality"++_equality_equalBinary = qname _hydra_lib_equality "equalBinary" :: Name+_equality_equalBoolean = qname _hydra_lib_equality "equalBoolean" :: Name+_equality_equalBigfloat = qname _hydra_lib_equality "equalBigfloat" :: Name+_equality_equalFloat32 = qname _hydra_lib_equality "equalFloat32" :: Name+_equality_equalFloat64 = qname _hydra_lib_equality "equalFloat64" :: Name+_equality_equalBigint = qname _hydra_lib_equality "equalBigint" :: Name+_equality_equalInt8 = qname _hydra_lib_equality "equalInt8" :: Name+_equality_equalInt16 = qname _hydra_lib_equality "equalInt16" :: Name+_equality_equalInt32 = qname _hydra_lib_equality "equalInt32" :: Name+_equality_equalInt64 = qname _hydra_lib_equality "equalInt64" :: Name+_equality_equalTerm = qname _hydra_lib_equality "equalTerm" :: Name+_equality_equalType = qname _hydra_lib_equality "equalType" :: Name+_equality_equalUint8 = qname _hydra_lib_equality "equalUint8" :: Name+_equality_equalUint16 = qname _hydra_lib_equality "equalUint16" :: Name+_equality_equalUint32 = qname _hydra_lib_equality "equalUint32" :: Name+_equality_equalUint64 = qname _hydra_lib_equality "equalUint64" :: Name+_equality_equalString = qname _hydra_lib_equality "equalString" :: Name+_equality_identity = qname _hydra_lib_equality "identity" :: Name+_equality_gtInt32 = qname _hydra_lib_equality "gtInt32" :: Name+_equality_gteInt32 = qname _hydra_lib_equality "gteInt32" :: Name+_equality_ltInt32 = qname _hydra_lib_equality "ltInt32" :: Name+_equality_lteInt32 = qname _hydra_lib_equality "lteInt32" :: Name++_hydra_lib_flows :: Namespace+_hydra_lib_flows = Namespace "hydra/lib/flows"++_flows_apply = qname _hydra_lib_flows "apply" :: Name+_flows_bind = qname _hydra_lib_flows "bind" :: Name+_flows_fail = qname _hydra_lib_flows "fail" :: Name+_flows_map = qname _hydra_lib_flows "map" :: Name+_flows_mapList = qname _hydra_lib_flows "mapList" :: Name+_flows_pure = qname _hydra_lib_flows "pure" :: Name++_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++_hydra_lib_lists :: Namespace+_hydra_lib_lists = Namespace "hydra/lib/lists"++_lists_apply = qname _hydra_lib_lists "apply" :: 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_foldl = qname _hydra_lib_lists "foldl" :: Name+_lists_head = qname _hydra_lib_lists "head" :: Name+_lists_intercalate = qname _hydra_lib_lists "intercalate" :: Name+_lists_intersperse = qname _hydra_lib_lists "intersperse" :: Name+_lists_last = qname _hydra_lib_lists "last" :: Name+_lists_length = qname _hydra_lib_lists "length" :: Name+_lists_map = qname _hydra_lib_lists "map" :: Name+_lists_nub = qname _hydra_lib_lists "nub" :: Name+_lists_null = qname _hydra_lib_lists "null" :: Name+_lists_pure = qname _hydra_lib_lists "pure" :: Name+_lists_reverse = qname _hydra_lib_lists "reverse" :: Name+_lists_safeHead = qname _hydra_lib_lists "safeHead" :: Name+_lists_tail = qname _hydra_lib_lists "tail" :: Name++_hydra_lib_literals :: Namespace+_hydra_lib_literals = Namespace "hydra/lib/literals"++_literals_bigfloatToBigint = qname _hydra_lib_literals "bigfloatToBigint" :: Name+_literals_bigfloatToFloat32 = qname _hydra_lib_literals "bigfloatToFloat32" :: Name+_literals_bigfloatToFloat64 = qname _hydra_lib_literals "bigfloatToFloat64" :: Name+_literals_bigintToBigfloat = qname _hydra_lib_literals "bigintToBigfloat" :: Name+_literals_bigintToInt8 = qname _hydra_lib_literals "bigintToInt8" :: Name+_literals_bigintToInt16 = qname _hydra_lib_literals "bigintToInt16" :: Name+_literals_bigintToInt32 = qname _hydra_lib_literals "bigintToInt32" :: Name+_literals_bigintToInt64 = qname _hydra_lib_literals "bigintToInt64" :: Name+_literals_bigintToUint8 = qname _hydra_lib_literals "bigintToUint8" :: Name+_literals_bigintToUint16 = qname _hydra_lib_literals "bigintToUint16" :: Name+_literals_bigintToUint32 = qname _hydra_lib_literals "bigintToUint32" :: Name+_literals_bigintToUint64 = qname _hydra_lib_literals "bigintToUint64" :: Name+_literals_float32ToBigfloat = qname _hydra_lib_literals "float32ToBigfloat" :: Name+_literals_float64ToBigfloat = qname _hydra_lib_literals "float64ToBigfloat" :: Name+_literals_int8ToBigint = qname _hydra_lib_literals "int8ToBigint" :: Name+_literals_int16ToBigint = qname _hydra_lib_literals "int16ToBigint" :: Name+_literals_int32ToBigint = qname _hydra_lib_literals "int32ToBigint" :: Name+_literals_int64ToBigint = qname _hydra_lib_literals "int64ToBigint" :: Name+_literals_showInt32 = qname _hydra_lib_literals "showInt32" :: Name+_literals_showString = qname _hydra_lib_literals "showString" :: Name+_literals_uint8ToBigint = qname _hydra_lib_literals "uint8ToBigint" :: Name+_literals_uint16ToBigint = qname _hydra_lib_literals "uint16ToBigint" :: Name+_literals_uint32ToBigint = qname _hydra_lib_literals "uint32ToBigint" :: Name+_literals_uint64ToBigint = qname _hydra_lib_literals "uint64ToBigint" :: Name++_hydra_lib_logic :: Namespace+_hydra_lib_logic = Namespace "hydra/lib/logic"++_logic_and = qname _hydra_lib_logic "and" :: Name+_logic_ifElse = qname _hydra_lib_logic "ifElse" :: Name+_logic_not = qname _hydra_lib_logic "not" :: Name+_logic_or = qname _hydra_lib_logic "or" :: Name++_hydra_lib_maps :: Namespace+_hydra_lib_maps = Namespace "hydra/lib/maps"++_maps_empty = qname _hydra_lib_maps "empty" :: Name+_maps_fromList = qname _hydra_lib_maps "fromList" :: Name+_maps_insert = qname _hydra_lib_maps "insert" :: Name+_maps_isEmpty = qname _hydra_lib_maps "isEmpty" :: Name+_maps_keys = qname _hydra_lib_maps "keys" :: Name+_maps_lookup = qname _hydra_lib_maps "lookup" :: Name+_maps_map = qname _hydra_lib_maps "map" :: Name+_maps_mapKeys = qname _hydra_lib_maps "mapKeys" :: Name+_maps_remove = qname _hydra_lib_maps "remove" :: Name+_maps_singleton = qname _hydra_lib_maps "singleton" :: Name+_maps_size = qname _hydra_lib_maps "size" :: Name+_maps_toList = qname _hydra_lib_maps "toList" :: Name+_maps_values = qname _hydra_lib_maps "values" :: Name++_hydra_lib_math :: Namespace+_hydra_lib_math = Namespace "hydra/lib/math"++_math_add = qname _hydra_lib_math "add" :: Name+_math_div = qname _hydra_lib_math "div" :: Name+_math_mod = qname _hydra_lib_math "mod" :: Name+_math_mul = qname _hydra_lib_math "mul" :: Name+_math_neg = qname _hydra_lib_math "neg" :: Name+_math_rem = qname _hydra_lib_math "rem" :: Name+_math_sub = qname _hydra_lib_math "sub" :: Name++_hydra_lib_optionals :: Namespace+_hydra_lib_optionals = Namespace "hydra/lib/optionals"++_optionals_apply :: Name+_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_fromMaybe = qname _hydra_lib_optionals "fromMaybe" :: Name+_optionals_isJust = qname _hydra_lib_optionals "isJust" :: Name+_optionals_isNothing = qname _hydra_lib_optionals "isNothing" :: Name+_optionals_map = qname _hydra_lib_optionals "map" :: Name+_optionals_maybe = qname _hydra_lib_optionals "maybe" :: Name+_optionals_pure = qname _hydra_lib_optionals "pure" :: Name++_hydra_lib_sets :: Namespace+_hydra_lib_sets = Namespace "hydra/lib/sets"++_sets_insert = qname _hydra_lib_sets "add" :: Name+_sets_contains = qname _hydra_lib_sets "contains" :: Name+_sets_difference = qname _hydra_lib_sets "difference" :: Name+_sets_empty = qname _hydra_lib_sets "empty" :: Name+_sets_fromList = qname _hydra_lib_sets "fromList" :: Name+_sets_intersection = qname _hydra_lib_sets "intersection" :: Name+_sets_isEmpty = qname _hydra_lib_sets "isEmpty" :: Name+_sets_map = qname _hydra_lib_sets "map" :: Name+_sets_remove = qname _hydra_lib_sets "remove" :: Name+_sets_singleton = qname _hydra_lib_sets "singleton" :: Name+_sets_size = qname _hydra_lib_sets "size" :: Name+_sets_toList = qname _hydra_lib_sets "toList" :: Name+_sets_union = qname _hydra_lib_sets "union" :: Name++_hydra_lib_strings :: Namespace+_hydra_lib_strings = Namespace "hydra/lib/strings"++_strings_cat = qname _hydra_lib_strings "cat" :: Name+_strings_cat2 = qname _hydra_lib_strings "cat2" :: Name+_strings_fromList = qname _hydra_lib_strings "fromList" :: Name+_strings_intercalate = qname _hydra_lib_strings "intercalate" :: Name+_strings_isEmpty = qname _hydra_lib_strings "isEmpty" :: Name+_strings_length = qname _hydra_lib_strings "length" :: Name+_strings_splitOn = qname _hydra_lib_strings "splitOn" :: Name+_strings_toList = qname _hydra_lib_strings "toList" :: Name+_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"++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]++standardPrimitives :: [Primitive]+standardPrimitives =+ hydraLibEqualityPrimitives+ ++ hydraLibFlowsPrimitives+ ++ hydraLibIoPrimitives+ ++ hydraLibListsPrimitives+ ++ hydraLibLiteralsPrimitives+ ++ hydraLibLogicPrimitives+ ++ hydraLibMapsPrimitives+ ++ hydraLibMathInt32Primitives+ ++ hydraLibOptionalsPrimitives+ ++ hydraLibSetsPrimitives+ ++ hydraLibStringsPrimitives
+ src/main/haskell/Hydra/Sources/Tier0/All.hs view
@@ -0,0 +1,50 @@+module Hydra.Sources.Tier0.All(+ module Hydra.Sources.Tier0.All,+ module Hydra.Sources.Core,+ module Hydra.Sources.Tier0.Ast,+ module Hydra.Sources.Tier0.Coders,+ module Hydra.Sources.Tier0.Compute,+ module Hydra.Sources.Tier0.Constraints,+ module Hydra.Sources.Tier0.Grammar,+ module Hydra.Sources.Tier0.Graph,+ module Hydra.Sources.Tier0.Json,+ module Hydra.Sources.Tier0.Mantle,+ module Hydra.Sources.Tier0.Module,+ module Hydra.Sources.Tier0.Phantoms,+ module Hydra.Sources.Tier0.Query,+ module Hydra.Sources.Tier0.Testing,+ module Hydra.Sources.Tier0.Workflow,+) where++import Hydra.Sources.Core+import Hydra.Sources.Tier0.Ast+import Hydra.Sources.Tier0.Coders+import Hydra.Sources.Tier0.Compute+import Hydra.Sources.Tier0.Constraints+import Hydra.Sources.Core+import Hydra.Sources.Tier0.Grammar+import Hydra.Sources.Tier0.Graph+import Hydra.Sources.Tier0.Json+import Hydra.Sources.Tier0.Mantle+import Hydra.Sources.Tier0.Module+import Hydra.Sources.Tier0.Phantoms+import Hydra.Sources.Tier0.Query+import Hydra.Sources.Tier0.Testing+import Hydra.Sources.Tier0.Workflow++tier0Modules :: [Module]+tier0Modules = [+ hydraAstModule,+ hydraCodersModule,+ hydraComputeModule,+ hydraConstraintsModule,+ hydraCoreModule,+ hydraGrammarModule,+ hydraGraphModule,+ hydraMantleModule,+ hydraModuleModule,+ hydraPhantomsModule,+ hydraQueryModule,+ hydraTestingModule,+ hydraWorkflowModule,+ jsonModelModule]
+ src/main/haskell/Hydra/Sources/Tier0/Ast.hs view
@@ -0,0 +1,105 @@+module Hydra.Sources.Tier0.Ast where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++hydraAstModule :: Module+hydraAstModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "A model which provides a common syntax tree for Hydra serializers"+ where+ ns = Namespace "hydra/ast"+ def = datatype ns+ ast = typeref ns++ elements = [++ def "Associativity" $+ doc "Operator associativity" $+ enum ["none", "left", "right", "both"],++ def "BlockStyle" $+ doc "Formatting option for code blocks" $+ record [+ "indent">: optional string,+ "newlineBeforeContent">: boolean,+ "newlineAfterContent">: boolean],++ def "BracketExpr" $+ doc "An expression enclosed by brackets" $+ record [+ "brackets">: ast "Brackets",+ "enclosed">: ast "Expr",+ "style">: ast "BlockStyle"],++ def "Brackets" $+ doc "Matching open and close bracket symbols" $+ record [+ "open">: ast "Symbol",+ "close">: ast "Symbol"],++ def "Expr" $+ doc "An abstract expression" $+ union [+ "const">: ast "Symbol",+ "indent">: ast "IndentedExpression",+ "op">: ast "OpExpr",+ "brackets">: ast "BracketExpr"],++ def "IndentedExpression" $+ doc "An expression indented in a certain style" $+ record [+ "style">: ast "IndentStyle",+ "expr">: ast "Expr"],++ def "IndentStyle" $+ doc "Any of several indentation styles" $+ union [+ "allLines">: string,+ "subsequentLines">: string],++ def "Op" $+ doc "An operator symbol" $+ record [+ "symbol">: ast "Symbol",+ "padding">: ast "Padding",+ "precedence">: ast "Precedence",+ "associativity">: ast "Associativity"],++ def "OpExpr" $+ doc "An operator expression" $+ record [+ "op">: ast "Op",+ "lhs">: ast "Expr",+ "rhs">: ast "Expr"],++ def "Padding" $+ doc "Left and right padding for an operator" $+ record [+ "left">: ast "Ws",+ "right">: ast "Ws"],++ def "Precedence" $+ doc "Operator precedence" $+ int32,++ def "Symbol" $+ doc "Any symbol"+ string,++ def "Ws" $+ doc "One of several classes of whitespace" $+ union [+ "none">: unit,+ "space">: unit,+ "break">: unit,+ "breakAndIndent">: string,+ "doubleBreak">: unit]]
+ src/main/haskell/Hydra/Sources/Tier0/Coders.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Coders where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core++import Hydra.Sources.Tier0.Compute+import Hydra.Sources.Tier0.Graph+import Hydra.Sources.Tier0.Mantle+++hydraCodersModule :: Module+hydraCodersModule = Module ns elements [hydraMantleModule, hydraGraphModule] [hydraCoreModule] $+ Just "Abstractions for paired transformations between languages"+ where+ ns = Namespace "hydra/coders"+ core = typeref $ moduleNamespace hydraCoreModule+ compute = typeref $ moduleNamespace hydraComputeModule+ graph = typeref $ moduleNamespace hydraGraphModule+ mantle = typeref $ moduleNamespace hydraMantleModule+ coders = typeref ns++ def = datatype ns++ elements = [++ def "AdapterContext" $+ doc "An evaluation context together with a source language and a target language" $+ record [+ "graph">: graph "Graph",+ "language">: coders "Language",+ "adapters">: Types.map (core "Name") (compute "Adapter"+ @@ coders "AdapterContext" @@ coders "AdapterContext"+ @@ core "Type" @@ core "Type"+ @@ core "Term" @@ core "Term")],++ def "CoderDirection" $+ doc "Indicates either the 'out' or the 'in' direction of a coder" $+ enum [+ "encode",+ "decode"],++ def "Language" $+ doc "A named language together with language-specific constraints" $+ record [+ "name">: coders "LanguageName",+ "constraints">: coders "LanguageConstraints"],++ def "LanguageConstraints" $+ doc "A set of constraints on valid type and term expressions, characterizing a language" $+ record [+ "eliminationVariants">:+ doc "All supported elimination variants" $+ Types.set $ mantle "EliminationVariant",+ "literalVariants">:+ doc "All supported literal variants" $+ Types.set $ mantle "LiteralVariant",+ "floatTypes">:+ doc "All supported float types" $+ Types.set $ core "FloatType",+ "functionVariants">:+ doc "All supported function variants" $+ Types.set $ mantle "FunctionVariant",+ "integerTypes">:+ doc "All supported integer types" $+ Types.set $ core "IntegerType",+ "termVariants">:+ doc "All supported term variants" $+ Types.set $ mantle "TermVariant",+ "typeVariants">:+ doc "All supported type variants" $+ Types.set $ mantle "TypeVariant",+ "types">:+ doc "A logical set of types, as a predicate which tests a type for inclusion" $+ core "Type" --> boolean],++ def "LanguageName" $+ doc "The unique name of a language" string,++ def "TraversalOrder" $+ doc "Specifies either a pre-order or post-order traversal" $+ union [+ "pre">: doc "Pre-order traversal" unit,+ "post">: doc "Post-order traversal" unit]]
+ src/main/haskell/Hydra/Sources/Tier0/Compute.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Compute where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++hydraComputeModule :: Module+hydraComputeModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "Abstractions for single- and bidirectional transformations"+ where+ ns = Namespace "hydra/compute"+ core = typeref $ moduleNamespace hydraCoreModule+ compute = typeref ns++ def = datatype ns++ elements = [++ def "Adapter" $+ doc "A two-level bidirectional encoder which adapts types to types and terms to terms" $+ lambda "s1" $ lambda "s2" $ lambda "t1" $ lambda "t2" $ lambda "v1" $ lambda "v2" $ record [+ "isLossy">: boolean,+ "source">: var "t1",+ "target">: var "t2",+ "coder">: compute "Coder" @@ "s1" @@ "s2" @@ "v1" @@ "v2"],++ def "Bicoder" $+ doc "A two-level encoder and decoder, operating both at a type level and an instance (data) level" $+ lambda "s1" $ lambda "s2" $ lambda "t1" $ lambda "t2" $ lambda "v1" $ lambda "v2" $ record [+ "encode">: "t1" --> compute "Adapter" @@ "s1" @@ "s2" @@ "t1" @@ "t2" @@ "v1" @@ "v2",+ "decode">: "t2" --> compute "Adapter" @@ "s2" @@ "s1" @@ "t2" @@ "t1" @@ "v2" @@ "v1"],++ def "Coder" $+ doc "An encoder and decoder; a bidirectional flow between two types" $+ lambda "s1" $ lambda "s2" $ lambda "v1" $ lambda "v2" $ record [+ "encode">: ("v1" --> compute "Flow" @@ "s1" @@ "v2"),+ "decode">: ("v2" --> compute "Flow" @@ "s2" @@ "v1")],++ def "Flow" $+ doc "A variant of the State monad with built-in logging and error handling" $+ lambda "s" $ lambda "x" $+ function "s" (compute "Trace" --> compute "FlowState" @@ "s" @@ "x"),++ def "FlowState" $+ doc "The result of evaluating a Flow" $+ lambda "s" $ lambda "x" $ record [+ "value">: optional "x",+ "state">: "s",+ "trace">: compute "Trace"],++ def "Trace" $+ doc "A container for logging and error information" $+ record [+ "stack">: list string,+ "messages">: list string,+ "other">:+ doc "A map of string keys to arbitrary terms as values, for application-specific use" $+ Types.map string (core "Term")]]
+ src/main/haskell/Hydra/Sources/Tier0/Constraints.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Constraints where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core++import Hydra.Sources.Tier0.Query+++hydraConstraintsModule :: Module+hydraConstraintsModule = Module ns elements [hydraQueryModule] [hydraCoreModule] $+ Just "A model for path- and pattern-based graph constraints, which may be considered as part of the schema of a graph"+ where+ ns = Namespace "hydra/constraints"+ core = typeref $ moduleNamespace hydraCoreModule+ query = typeref $ moduleNamespace hydraQueryModule+ constraints = typeref ns+ def = datatype ns++ elements = [++ def "PathEquation" $+ doc "A declared equivalence between two abstract paths in a graph" $+ record [+ "left">: query "Path",+ "right">: query "Path"],++ def "PatternImplication" $+ doc "A pattern which, if it matches in a given graph, implies that another pattern must also match. Query variables are shared between the two patterns." $+ record [+ "antecedent">: query "Pattern",+ "consequent">: query "Pattern"]]
+ src/main/haskell/Hydra/Sources/Tier0/Grammar.hs view
@@ -0,0 +1,72 @@+-- | A model for Hydra labeled-BNF grammars++module Hydra.Sources.Tier0.Grammar where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++hydraGrammarModule :: Module+hydraGrammarModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "A common API for BNF-based grammars, specifying context-free languages"+ where+ ns = Namespace "hydra/grammar"+ grammar = typeref ns+ def = datatype ns++ elements = [++ def "Constant" $+ doc "A constant pattern"+ string,++ def "Grammar" $+ doc "An enhanced Backus-Naur form (BNF) grammar" $+ list $ grammar "Production",++ def "Label" $+ doc "A name for a pattern"+ string,++ def "LabeledPattern" $+ doc "A pattern together with a name (label)" $+ record [+ "label">: grammar "Label",+ "pattern">: grammar "Pattern"],++ def "Pattern" $+ doc "A pattern which matches valid expressions in the language" $+ union [+ "nil">: unit,+ "ignored">: grammar "Pattern",+ "labeled">: grammar "LabeledPattern",+ "constant">: grammar "Constant",+ "regex">: grammar "Regex",+ "nonterminal">: grammar "Symbol",+ "sequence">: list $ grammar "Pattern",+ "alternatives">: list $ grammar "Pattern",+ "option">: grammar "Pattern",+ "star">: grammar "Pattern",+ "plus">: grammar "Pattern"],++ def "Production" $+ doc "A BNF production" $+ record [+ "symbol">: grammar "Symbol",+ "pattern">: grammar "Pattern"],++ def "Regex" $+ doc "A regular expression"+ string,++ def "Symbol" $+ doc "A nonterminal symbol"+ string]
+ src/main/haskell/Hydra/Sources/Tier0/Graph.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Graph where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core++import Hydra.Sources.Tier0.Compute+++hydraGraphModule :: Module+hydraGraphModule = Module ns elements [hydraComputeModule] [hydraCoreModule] $+ Just "The extension to graphs of Hydra's core type system (hydra/core)"+ where+ ns = Namespace "hydra/graph"+ core = typeref $ moduleNamespace hydraCoreModule+ compute = typeref $ moduleNamespace hydraComputeModule+ graph = typeref ns+ def = datatype ns++ elements = [++ def "Comparison" $+ doc "An equality judgement: less than, equal to, or greater than" $+ enum [+ "lessThan",+ "equalTo",+ "greaterThan"],++ def "Graph" $+ doc "A graph, or set of name/term bindings together with parameters (annotations, primitives) and a schema graph" $+ record [++ -- TODO: remove this; replace it with 'environment'+ "elements">:+ doc "All of the elements in the graph" $+ Types.map (core "Name") (graph "Element"),++ "environment">:+ doc "The lambda environment of this graph context; it indicates whether a variable is bound by a lambda (Nothing) or a let (Just term)" $+ Types.map (core "Name") (optional $ core "Term"),+ "types">:+ doc "The typing environment of the graph" $+ Types.map (core "Name") (core "Type"),+ "body">:+ doc "The body of the term which generated this context" $+ core "Term",+ "primitives">:+ doc "All supported primitive constants and functions, by name" $+ Types.map (core "Name") (graph "Primitive"),+ "schema">:+ doc "The schema of this graph. If this parameter is omitted (nothing), the graph is its own schema graph." $+ optional $ graph "Graph"],++ def "Element" $+ doc "A graph element, having a name, data term (value), and schema term (type)" $+ record [+ "name">: core "Name",+ "data">: core "Term"],++ def "Primitive" $+ doc "A built-in function" $+ record [+ "name">:+ doc "The unique name of the primitive function" $+ core "Name",+ "type">:+ doc "The type signature of the primitive function" $+ core "Type",+ "implementation">:+ doc "A concrete implementation of the primitive function" $+ list (core "Term") --> compute "Flow" @@ (graph "Graph") @@ (core "Term")],++ def "TermCoder" $+ doc "A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms" $+ lambda "x" $ record [+ "type">: core "Type",+ "coder">: compute "Coder" @@ (graph "Graph") @@ (graph "Graph") @@ (core "Term") @@ "x"],++ def "TypeClass" $+ doc "Any of a small number of built-in type classes" $+ enum [+ "equality",+ "ordering"]]
+ src/main/haskell/Hydra/Sources/Tier0/Json.hs view
@@ -0,0 +1,35 @@+-- | A simple JSON model. This model is part of the Hydra kernel, despite JSON being an external language; JSON support is built in to Hydra++module Hydra.Sources.Tier0.Json where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++jsonModelModule :: Module+jsonModelModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "A JSON syntax model. See the BNF at https://www.json.org"+ where+ ns = Namespace "hydra/json"+ def = datatype ns+ json = typeref ns++ elements = [++ 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]]
+ src/main/haskell/Hydra/Sources/Tier0/Mantle.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Mantle where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++hydraMantleModule :: Module+hydraMantleModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "A set of types which supplement hydra/core with type variants, graphs, and elements"+ where+ ns = Namespace "hydra/mantle"+ core = typeref $ moduleNamespace hydraCoreModule+ mantle = typeref ns+ def = datatype ns++ elements = [++ def "Either" $+ doc "A disjoint union between a 'left' type and a 'right' type" $+ lambda "a" $ lambda "b" $ union [+ "left">: "a",+ "right">: "b"],++ def "EliminationVariant" $+ doc "The identifier of an elimination constructor" $+ enum [+ "list",+ "optional",+ "product",+ "record",+ "union",+ "wrap"],++ def "FunctionVariant" $+ doc "The identifier of a function constructor" $+ enum [+ "elimination",+ "lambda",+ "primitive"],++ def "LiteralVariant" $+ doc "The identifier of a literal constructor" $+ enum [+ "binary",+ "boolean",+ "float",+ "integer",+ "string"],++ def "Precision" $+ doc "Numeric precision: arbitrary precision, or precision to a specified number of bits" $+ union [+ "arbitrary">: unit,+ "bits">: int32],++ def "TermVariant" $+ doc "The identifier of a term expression constructor" $+ enum [+ "annotated",+ "application",+ "function",+ "let",+ "list",+ "literal",+ "map",+ "optional",+ "product",+ "record",+ "set",+ "sum",+ "typed",+ "union",+ "variable",+ "wrap"],++ def "TypeVariant" $+ doc "The identifier of a type constructor" $+ enum [+ "annotated",+ "application",+ "function",+ "lambda",+ "list",+ "literal",+ "map",+ "optional",+ "product",+ "record",+ "set",+ "sum",+ "union",+ "variable",+ "wrap"]]
+ src/main/haskell/Hydra/Sources/Tier0/Module.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Module where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core++import Hydra.Sources.Tier0.Graph+++hydraModuleModule :: Module+hydraModuleModule = Module ns elements [hydraGraphModule] [hydraCoreModule] $+ Just "A model for Hydra namespaces and modules (collections of elements in the same namespace)"+ where+ ns = Namespace "hydra/module"+ graph = typeref $ moduleNamespace hydraGraphModule+ mod = typeref ns+ def = datatype ns++ elements = [++ def "FileExtension" string,++ def "Module" $+ doc "A logical collection of elements in the same namespace, having dependencies on zero or more other modules" $+ record [+ "namespace">:+ doc "A common prefix for all element names in the module" $+ mod "Namespace",+ "elements">:+ doc "The elements defined in this module" $+ list $ graph "Element",+ "termDependencies">:+ doc "Any modules which the term expressions of this module directly depend upon" $+ list $ mod "Module",+ "typeDependencies">:+ doc "Any modules which the type expressions of this module directly depend upon" $+ list $ mod "Module",+ "description">:+ doc "An optional human-readable description of the module" $+ optional string],++ def "Namespace" $+ doc "A prefix for element names"+ string,++ def "QualifiedName" $+ doc "A qualified name consisting of an optional namespace together with a mandatory local name" $+ record [+ "namespace">: optional $ mod "Namespace",+ "local">: string]]
+ src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Phantoms where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core++import Hydra.Sources.Tier0.Compute+++hydraPhantomsModule :: Module+hydraPhantomsModule = Module ns elements [hydraComputeModule] [hydraCoreModule] $+ Just "Phantom types for use in model definitions"+ where+ ns = Namespace "hydra/phantoms"+ core = typeref $ moduleNamespace hydraCoreModule+ phantoms = typeref ns+ def = datatype ns++ elements = [+ def "Case" $+ 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" $+ lambda "a" $ record [+ "name">: core "Name",+ "datum">: phantoms "Datum" @@ "a"],++ def "Fld" $+ 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]
+ src/main/haskell/Hydra/Sources/Tier0/Query.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Query where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++hydraQueryModule :: Module+hydraQueryModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "A model for language-agnostic graph pattern queries"+ where+ ns = Namespace "hydra/query"+ core = typeref $ moduleNamespace hydraCoreModule+ query = typeref ns+ def = datatype ns++ elements = [+ def "ComparisonConstraint" $+ doc "One of several comparison operators" $+ enum ["equal", "notEqual", "lessThan", "greaterThan", "lessThanOrEqual", "greaterThanOrEqual"],++ def "Edge" $+ doc "An abstract edge based on a record type" $+ record [+ "type">:+ doc "The name of a record type, for which the edge also specifies an out- and an in- projection" $+ core "Name",+ "out">:+ doc "The field representing the out-projection of the edge. Defaults to 'out'." $+ optional $ core "Name",+ "in">:+ doc "The field representing the in-projection of the edge. Defaults to 'in'." $+ optional $ core "Name"],++ def "GraphPattern" $+ doc "A query pattern which matches within a designated component subgraph" $+ record [+ "graph">:+ doc "The name of the component graph" $+ core "Name",+ "patterns">:+ doc "The patterns to match within the subgraph" $+ list (query "Pattern")],++ def "Node" $+ doc "A node in a query expression; it may be a term, a variable, or a wildcard" $+ union [+ "term">:+ doc "A graph term; an expression which is valid in the graph being matched" $+ core "Term",+ "variable">:+ doc "A query variable, not to be confused with a variable term" $+ query "Variable",+ "wildcard">:+ doc "An anonymous variable which we do not care to join across patterns" unit],++ def "Path" $+ doc "A query path" $+ union [+ "step">:+ doc "A path given by a single step" $+ query "Step",+ "regex">:+ doc "A path given by a regular expression quantifier applied to another path" $+ query "RegexSequence",+ "inverse">:+ doc "A path given by the inverse of another path" $+ query "Path"],++ def "Pattern" $+ doc "A query pattern" $+ union [+ "triple">:+ doc "A subject/predicate/object pattern" $+ query "TriplePattern",+ "negation">:+ doc "The negation of another pattern" $+ query "Pattern",+ "conjunction">:+ doc "The conjunction ('and') of several other patterns" $+ list (query "Pattern"),+ "disjunction">:+ doc "The disjunction (inclusive 'or') of several other patterns" $+ list (query "Pattern"),+ "graph">:+ doc "A pattern which matches within a named subgraph" $+ query "GraphPattern"],++ def "Query" $+ doc "A SELECT-style graph pattern matching query" $+ record [+ "variables">:+ doc "The variables selected by the query" $+ list $ query "Variable",+ "patterns">:+ doc "The patterns to be matched" $+ list (query "Pattern")],++ def "Range" $+ doc "A range from min to max, inclusive" $+ record [+ "min">: int32,+ "max">: int32],++ def "RegexQuantifier" $+ doc "A regular expression quantifier" $+ union [+ "one">: doc "No quantifier; matches a single occurrence" unit,+ "zeroOrOne">: doc "The ? quanifier; matches zero or one occurrence" unit,+ "zeroOrMore">: doc "The * quantifier; matches any number of occurrences" unit,+ "oneOrMore">: doc "The + quantifier; matches one or more occurrences" unit,+ "exactly">: doc "The {n} quantifier; matches exactly n occurrences" int32,+ "atLeast">: doc "The {n,} quantifier; matches at least n occurrences" int32,+ "range">: doc "The {n, m} quantifier; matches between n and m (inclusive) occurrences" $ query "Range"],++ def "RegexSequence" $+ doc "A path with a regex quantifier" $+ record [+ "path">: query "Path",+ "quantifier">: query "RegexQuantifier"],++ def "Step" $+ doc "An atomic function as part of a query. When applied to a graph, steps are typed by function types." $+ union [+ "edge">:+ doc "An out-to-in traversal of an abstract edge" $+ query "Edge",+ "project">:+ doc "A projection from a record through one of its fields" $+ core "Projection",+ "compare">:+ doc "A comparison of two terms" $+ query "ComparisonConstraint"],++ def "TriplePattern" $+ doc "A subject/predicate/object pattern" $+ record [+ "subject">: query "Node",+ "predicate">: query "Path",+ "object">: query "Node"],++ def "Variable" $+ doc "A query variable"+ string]
+ src/main/haskell/Hydra/Sources/Tier0/Testing.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Testing where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core+++hydraTestingModule :: Module+hydraTestingModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $+ Just "A model for unit testing"+ where+ ns = Namespace "hydra/testing"+ def = datatype ns+ core = typeref $ moduleNamespace hydraCoreModule+ testing = typeref ns++ elements = [++ def "EvaluationStyle" $+ doc "One of two evaluation styles: eager or lazy" $+ enum ["eager", "lazy"],++ def "TestCase" $+ doc "A simple test case with an input and an expected output" $+ record [+ "description">: optional string,+ "evaluationStyle">: testing "EvaluationStyle",+ "input">: core "Term",+ "output">: core "Term"],++ def "TestGroup" $+ doc "A collection of test cases with a name and optional description" $+ record [+ "name">: string,+ "description">: optional string,+ "subgroups">: list (testing "TestGroup"),+ "cases">: list (testing "TestCase")]]
+ src/main/haskell/Hydra/Sources/Tier0/Workflow.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier0.Workflow where++-- Standard Tier-0 imports+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.Annotations+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Core++import Hydra.Sources.Tier0.Compute+import Hydra.Sources.Tier0.Graph+import Hydra.Sources.Tier0.Module+++hydraWorkflowModule :: Module+hydraWorkflowModule = Module ns elements [hydraModuleModule, hydraComputeModule, hydraGraphModule] [hydraCoreModule] $+ Just "A model for Hydra transformation workflows"+ where+ ns = Namespace "hydra/workflow"+ mod = typeref $ moduleNamespace hydraModuleModule+ compute = typeref $ moduleNamespace hydraComputeModule+ core = typeref $ moduleNamespace hydraCoreModule+ graph = typeref $ moduleNamespace hydraGraphModule+ wf = typeref ns+ def = datatype ns++ elements = [++ def "HydraSchemaSpec" $+ doc "The specification of a Hydra schema, provided as a set of modules and a distinguished type" $+ record [+ "modules">:+ doc "The modules to include in the schema graph" $+ list $ mod "Module",+ "typeName">:+ doc "The name of the top-level type; all data which passes through the workflow will be instances of this type" $+ core "Name"],++ def "LastMile" $+ doc "The last mile of a transformation, which encodes and serializes terms to a file" $+ lambda "s" $ lambda "a" $ record [+ "encoder">:+ doc "An encoder for terms to a list of output objects" $+ core "Type" --> compute "Flow" @@ "s"+ @@ (core "Term" --> graph "Graph" --> compute "Flow" @@ "s" @@ list "a"),+ "serializer">:+ doc "A function which serializes a list of output objects to a string representation" $+ list "a" --> compute "Flow" @@ "s" @@ string,+ "fileExtension">:+ doc "A file extension for the generated file(s)"+ string],++ def "SchemaSpec" $+ doc "The specification of a schema at the source end of a workflow" $+ union [+ "hydra">:+ doc "A native Hydra schema" $+ wf "HydraSchemaSpec",+ "file">:+ doc "A schema provided as a file, available at the given file path" $+ string,+ "provided">:+ doc "A schema which will be provided within the workflow" $+ unit],++ def "TransformWorkflow" $+ doc "The specification of a workflow which takes a schema specification, reads data from a directory, and writes data to another directory" $+ record [+ "name">:+ doc "A descriptive name for the workflow"+ string,+ "schemaSpec">:+ doc "The schema specification" $+ wf "SchemaSpec",+ "srcDir">:+ doc "The source directory"+ string,+ "destDir">:+ doc "The destination directory"+ string]]
+ src/main/haskell/Hydra/Sources/Tier1/All.hs view
@@ -0,0 +1,24 @@+module Hydra.Sources.Tier1.All(+ module Hydra.Sources.Tier1.All,+ module Hydra.Sources.Tier0.All,+ module Hydra.Sources.Tier1.Constants,+ module Hydra.Sources.Tier1.CoreEncoding,+ module Hydra.Sources.Tier1.Messages,+ module Hydra.Sources.Tier1.Strip,+ module Hydra.Sources.Tier1.Tier1,+) where++import Hydra.Sources.Tier0.All+import Hydra.Sources.Tier1.Constants+import Hydra.Sources.Tier1.CoreEncoding hiding (ref)+import Hydra.Sources.Tier1.Messages+import Hydra.Sources.Tier1.Strip+import Hydra.Sources.Tier1.Tier1++tier1Modules :: [Module]+tier1Modules = [+ coreEncodingModule,+ hydraConstantsModule,+ hydraMessagesModule,+ hydraStripModule,+ hydraTier1Module]
+ src/main/haskell/Hydra/Sources/Tier1/Constants.hs view
@@ -0,0 +1,51 @@+module Hydra.Sources.Tier1.Constants 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+++constantsDefinition :: String -> Datum a -> Definition a+constantsDefinition = definitionInModule hydraConstantsModule++hydraConstantsModule :: Module+hydraConstantsModule = Module (Namespace "hydra/constants") elements [] tier0Modules $+ Just ("A module for tier-0 constants.")+ where+ elements = [+ el ignoredVariableDef,+ el placeholderNameDef,+ el maxTraceDepthDef]++ignoredVariableDef :: Definition String+ignoredVariableDef = constantsDefinition "ignoredVariable" $+ string "_"++placeholderNameDef :: Definition Name+placeholderNameDef = constantsDefinition "placeholderName" $+ doc "A placeholder name for row types as they are being constructed" $+ wrap _Name $ string "Placeholder"++maxTraceDepthDef :: Definition Int+maxTraceDepthDef = constantsDefinition "maxTraceDepth" $ int32 50
+ src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs view
@@ -0,0 +1,424 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier1.CoreEncoding where++-- TODO: use standard Tier-1 imports+import Hydra.Sources.Tier0.All+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.ShorthandTypes+import Hydra.Dsl.Base as Base+import qualified Hydra.Dsl.Core as Core+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Libraries++import qualified Data.Map as M+import qualified Data.Set as S+++coreEncodingModule :: Module+coreEncodingModule = Module (Namespace "hydra/coreEncoding") elements [] tier0Modules $+ Just ("Mapping of hydra/core constructs in a host language like Haskell or Java "+ ++ " to their native Hydra counterparts as terms. "+ ++ " This includes an implementation of LambdaGraph's epsilon encoding (types to terms).")+ where+ elements = [+ el coreEncodeAnnotatedTermDef,+ el coreEncodeAnnotatedTypeDef,+ el coreEncodeApplicationDef,+ el coreEncodeApplicationTypeDef,+ el coreEncodeCaseStatementDef,+ el coreEncodeEliminationDef,+ el coreEncodeFieldDef,+ el coreEncodeFieldTypeDef,+ el coreEncodeFloatTypeDef,+ el coreEncodeFloatValueDef,+ el coreEncodeFunctionDef,+ el coreEncodeFunctionTypeDef,+ el coreEncodeInjectionDef,+ el coreEncodeIntegerTypeDef,+ el coreEncodeIntegerValueDef,+ el coreEncodeLambdaDef,+ el coreEncodeLambdaTypeDef,+ el coreEncodeLetDef,+ el coreEncodeLetBindingDef,+ el coreEncodeLiteralDef,+ el coreEncodeLiteralTypeDef,+ el coreEncodeMapTypeDef,+ el coreEncodeNameDef,+ el coreEncodeOptionalCasesDef,+ el coreEncodeProjectionDef,+ el coreEncodeRecordDef,+ el coreEncodeRowTypeDef,+ el coreEncodeSumDef,+ el coreEncodeTermDef,+ el coreEncodeTupleProjectionDef,+ el coreEncodeTypeDef,+ el coreEncodeTypeSchemeDef,+ el coreEncodeWrappedTermDef,+ el coreEncodeWrappedTypeDef]++coreEncodingDefinition :: String -> Type -> Datum x -> Definition x+coreEncodingDefinition label dom datum = definitionInModule coreEncodingModule ("coreEncode" ++ label) $+ function dom termT datum++encodedBinary :: Datum String -> Datum Term+encodedBinary = encodedLiteral . Core.literalBinary++encodedBoolean :: Datum Bool -> Datum Term+encodedBoolean = encodedLiteral . Core.literalBoolean++encodedCase :: Name -> Name -> Datum (a -> Term) -> Field+encodedCase tname fname enc = field fname $ lambda "v" $ encodedVariant tname fname (enc @@ var "v")++encodedField :: Name -> Datum Term -> Datum Term+encodedField fname term = encodedFieldRaw (encodedName fname) term++encodedFieldRaw :: Datum Name -> Datum Term -> Datum Term+encodedFieldRaw (Datum fname) (Datum term) = Datum $ Terms.record _Field [+ Field _Field_name fname,+ Field _Field_term term]++encodedFloatValue :: Datum FloatValue -> Datum Term+encodedFloatValue = encodedLiteral . Core.literalFloat++encodedInjection :: Name -> Name -> Datum Term -> Datum Term+encodedInjection tname fname term = Datum $ Terms.record _Injection [+ field _Injection_typeName $ encodedName tname,+ field _Injection_field $ encodedField fname term]++encodedInt32 :: Datum Int -> Datum Term+encodedInt32 v = encodedIntegerValue $ variant _IntegerValue _IntegerValue_int32 v++encodedIntegerValue :: Datum IntegerValue -> Datum Term+encodedIntegerValue = encodedLiteral . Core.literalInteger++encodedList :: Datum [a] -> Datum Term+encodedList = variant _Term _Term_list++encodedLiteral :: Datum Literal -> Datum Term+encodedLiteral = variant _Term _Term_literal++encodedMap :: Datum (M.Map k v) -> Datum Term+encodedMap = variant _Term _Term_map++encodedName :: Name -> Datum Name+encodedName = wrap _Name . string . unName++encodedWrappedTerm :: Name -> Datum Term -> Datum 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 [+ Field _WrappedTerm_typeName name,+ Field _WrappedTerm_object term]++encodedOptional :: Datum (Maybe a) -> Datum Term+encodedOptional = variant _Term _Term_optional++encodedRecord :: Name -> [Field] -> Datum Term+encodedRecord tname fields = Datum $ 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++encodedSet :: Datum (S.Set a) -> Datum Term+encodedSet = variant _Term _Term_set++encodedString :: Datum String -> Datum Term+encodedString = encodedLiteral . variant _Literal _Literal_string++encodedUnion :: Datum Term -> Datum Term+encodedUnion = variant _Term _Term_union++encodedVariant :: Name -> Name -> Datum Term -> Datum Term+encodedVariant tname fname term = encodedUnion $ encodedInjection tname fname term++coreEncodeAnnotatedTermDef :: Definition (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 = 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 = 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 = 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 = coreEncodingDefinition "CaseStatement" caseStatementT $+ lambda "cs" $ encodedRecord _CaseStatement [+ field _CaseStatement_typeName $ ref coreEncodeNameDef @@ (Core.caseStatementTypeName @@ var "cs"),+ field _CaseStatement_default $ encodedOptional+ (primitive _optionals_map @@ ref coreEncodeTermDef @@ (Core.caseStatementDefault @@ var "cs")),+ field _CaseStatement_cases $ encodedList+ (primitive _lists_map @@ ref coreEncodeFieldDef @@ (Core.caseStatementCases @@ var "cs"))]++coreEncodeEliminationDef :: Definition (Elimination -> Term)+coreEncodeEliminationDef = coreEncodingDefinition "Elimination" eliminationT $+ match _Elimination Nothing [+ ecase _Elimination_list coreEncodeTermDef,+ ecase _Elimination_optional coreEncodeOptionalCasesDef,+ ecase _Elimination_product coreEncodeTupleProjectionDef,+ ecase _Elimination_record coreEncodeProjectionDef,+ ecase _Elimination_union coreEncodeCaseStatementDef,+ ecase _Elimination_wrap coreEncodeNameDef]+ where+ ecase fname funname = encodedCase _Elimination fname (ref funname)++coreEncodeFieldDef :: Definition (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 = 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 = 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++coreEncodeFloatValueDef :: Definition (FloatValue -> Term)+coreEncodeFloatValueDef = coreEncodingDefinition "FloatValue" floatValueT $+ match _FloatValue Nothing (varField <$> [+ _FloatValue_bigfloat,+ _FloatValue_float32,+ _FloatValue_float64])+ where+ varField fname = field fname $ lambda "v" $ encodedVariant _FloatValue fname $ encodedFloatValue $+ variant _FloatValue fname $ var "v"++coreEncodeFunctionDef :: Definition (Function -> Term)+coreEncodeFunctionDef = coreEncodingDefinition "Function" functionT $+ match _Function Nothing [+ ecase _Function_elimination coreEncodeEliminationDef,+ ecase _Function_lambda coreEncodeLambdaDef,+ ecase _Function_primitive coreEncodeNameDef]+ where+ ecase fname funname = encodedCase _Function fname (ref funname)++coreEncodeFunctionTypeDef :: Definition (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 = 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 = coreEncodingDefinition "IntegerType" integerTypeT $+ match _IntegerType Nothing (cs <$> [+ _IntegerType_bigint,+ _IntegerType_int8,+ _IntegerType_int16,+ _IntegerType_int32,+ _IntegerType_int64,+ _IntegerType_uint8,+ _IntegerType_uint16,+ _IntegerType_uint32,+ _IntegerType_uint64])+ where+ cs fname = field fname $ constant $ Datum $ coreEncodeTerm $ unDatum $ unitVariant _IntegerType fname++coreEncodeIntegerValueDef :: Definition (IntegerValue -> Term)+coreEncodeIntegerValueDef = coreEncodingDefinition "IntegerValue" integerValueT $+ match _IntegerValue Nothing (varField <$> [+ _IntegerValue_bigint,+ _IntegerValue_int8,+ _IntegerValue_int16,+ _IntegerValue_int32,+ _IntegerValue_int64,+ _IntegerValue_uint8,+ _IntegerValue_uint16,+ _IntegerValue_uint32,+ _IntegerValue_uint64])+ where+ varField fname = field fname $ lambda "v" $ encodedVariant _IntegerValue fname $ encodedIntegerValue $+ variant _IntegerValue fname $ var "v"++coreEncodeLambdaDef :: Definition (Lambda -> Term)+coreEncodeLambdaDef = coreEncodingDefinition "Lambda" lambdaT $+ lambda "l" $ encodedRecord _Lambda [+ field _Lambda_parameter $ ref coreEncodeNameDef @@ (Core.lambdaParameter @@ var "l"),+ field _Lambda_body $ ref coreEncodeTermDef @@ (Core.lambdaBody @@ var "l")]++coreEncodeLambdaTypeDef :: Definition (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 = 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 = 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 = coreEncodingDefinition "Literal" literalT $+ match _Literal Nothing [+ varField _Literal_binary $ encodedBinary $ var "v",+ varField _Literal_boolean $ encodedBoolean $ var "v",+ varField _Literal_float (ref coreEncodeFloatValueDef @@ var "v"),+ varField _Literal_integer (ref coreEncodeIntegerValueDef @@ var "v"),+ varField _Literal_string $ encodedString $ var "v"]+ where+ varField fname = field fname . lambda "v" . encodedVariant _Literal fname++coreEncodeLiteralTypeDef :: Definition (LiteralType -> Term)+coreEncodeLiteralTypeDef = coreEncodingDefinition "LiteralType" literalTypeT $+ match _LiteralType Nothing [+ csunit _LiteralType_binary,+ csunit _LiteralType_boolean,+ cs _LiteralType_float coreEncodeFloatTypeDef,+ cs _LiteralType_integer coreEncodeIntegerTypeDef,+ 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++coreEncodeMapTypeDef :: Definition (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 = coreEncodingDefinition "Name" nameT $+ lambda "fn" $ encodedWrappedTerm _Name $ encodedString $ unwrap _Name @@ var "fn"++coreEncodeOptionalCasesDef :: Definition (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 = 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 = 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 = 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 = 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 = coreEncodingDefinition "Term" termT $+ match _Term (Just $ encodedString $ string "not implemented") [+ ecase _Term_annotated (ref coreEncodeAnnotatedTermDef),+ ecase _Term_application (ref coreEncodeApplicationDef),+ ecase _Term_function (ref coreEncodeFunctionDef),+ ecase _Term_let (ref coreEncodeLetDef),+ ecase _Term_literal (ref coreEncodeLiteralDef),+ ecase' _Term_list $ encodedList $ primitive _lists_map @@ (ref coreEncodeTermDef) @@ var "v",+-- -- TODO: map encoding+-- ecase' _Term_map $ encodedMap+ ecase' _Term_optional $ encodedOptional (primitive _optionals_map @@ ref coreEncodeTermDef @@ var "v"),+ ecase' _Term_product $ encodedList (primitive _lists_map @@ ref coreEncodeTermDef @@ var "v"),+ ecase _Term_record (ref coreEncodeRecordDef),+ ecase' _Term_set $ encodedSet $ primitive _sets_map @@ (ref coreEncodeTermDef) @@ var "v",+ ecase _Term_sum (ref coreEncodeSumDef),+ ecase _Term_union (ref coreEncodeInjectionDef),+ ecase _Term_variable $ ref coreEncodeNameDef,+ ecase _Term_wrap $ ref coreEncodeWrappedTermDef]+ where+ ecase = encodedCase _Term+ ecase' fname = field fname . lambda "v" . encodedVariant _Term fname++coreEncodeTupleProjectionDef :: Definition (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 = coreEncodingDefinition "Type" typeT $+ match _Type Nothing [+ field _Type_annotated $ lambda "v" $ variant _Term _Term_annotated $ record _AnnotatedTerm [+ field _AnnotatedTerm_subject $ ref coreEncodeTypeDef @@ (Core.annotatedTypeSubject @@ var "v"),+ field _AnnotatedTerm_annotation $ Core.annotatedTypeAnnotation @@ var "v"],+ csref _Type_application coreEncodeApplicationTypeDef,+ csref _Type_function coreEncodeFunctionTypeDef,+ csref _Type_lambda coreEncodeLambdaTypeDef,+ csref _Type_list coreEncodeTypeDef,+ csref _Type_literal coreEncodeLiteralTypeDef,+ csref _Type_map coreEncodeMapTypeDef,+ csref _Type_optional coreEncodeTypeDef,+ cs _Type_product $ encodedList $ primitive _lists_map @@ ref coreEncodeTypeDef @@ var "v",+ csref _Type_record coreEncodeRowTypeDef,+ csref _Type_set coreEncodeTypeDef,+ cs _Type_sum $ encodedList $ primitive _lists_map @@ ref coreEncodeTypeDef @@ var "v",+ csref _Type_union coreEncodeRowTypeDef,+ csref _Type_variable coreEncodeNameDef,+ csref _Type_wrap coreEncodeWrappedTypeDef]+ where+ cs fname term = field fname $ lambda "v" $ encodedVariant _Type fname term+ csref fname fun = cs fname (ref fun @@ var "v")++coreEncodeTypeSchemeDef :: Definition (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)+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 = coreEncodingDefinition "WrappedType" wrappedTypeT $+ lambda "nt" $ encodedRecord _WrappedType [+ field _WrappedType_typeName $ ref coreEncodeNameDef @@ (Core.wrappedTypeTypeName @@ var "nt"),+ field _WrappedType_object $ ref coreEncodeTypeDef @@ (Core.wrappedTypeObject @@ var "nt")]
+ src/main/haskell/Hydra/Sources/Tier1/Messages.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier1.Messages 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+++messagesDefinition :: String -> Datum a -> Definition a+messagesDefinition = definitionInModule hydraMessagesModule++hydraMessagesModule :: Module+hydraMessagesModule = Module (Namespace "hydra/messages") elements [] tier0Modules $+ Just "A collection of standard error and warning messages"+ where+ elements = [+ el warningAutoGeneratedFileDef]++warningAutoGeneratedFileDef :: Definition String+warningAutoGeneratedFileDef = messagesDefinition "warningAutoGeneratedFile" $+ string "Note: this is an automatically generated file. Do not edit."
+ src/main/haskell/Hydra/Sources/Tier1/Strip.hs view
@@ -0,0 +1,73 @@+module Hydra.Sources.Tier1.Strip 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+++stripDefinition :: String -> Datum a -> Definition a+stripDefinition = definitionInModule hydraStripModule++hydraStripModule :: Module+hydraStripModule = Module (Namespace "hydra/strip") elements [] tier0Modules $+ Just "Several functions for stripping annotations from types and terms."+ where+ elements = [+ el fullyStripTermDef,+ el stripTermDef,+ el stripTypeDef,+ el stripTypeParametersDef]++fullyStripTermDef :: Definition (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)+ ] @@ (var "t"))++stripTermDef :: Definition (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)+ ] @@ (var "t"))++stripTypeDef :: Definition (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)+ ] @@ (var "t"))++stripTypeParametersDef :: Definition (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"))+ ] @@ (ref stripTypeDef @@ var "t")
+ src/main/haskell/Hydra/Sources/Tier1/Tier1.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier1.Tier1 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.Constants+import Hydra.Sources.Tier1.Strip+++tier1Definition :: String -> Datum a -> Definition a+tier1Definition = definitionInModule hydraTier1Module++hydraTier1Module :: Module+hydraTier1Module = Module (Namespace "hydra/tier1") elements+ [hydraComputeModule, hydraConstantsModule, hydraStripModule] tier0Modules $+ Just ("A module for miscellaneous tier-1 functions and constants.")+ where+ elements = [+ el floatValueToBigfloatDef,+ el integerValueToBigintDef,+ el isLambdaDef,+ el unqualifyNameDef,+ -- Rewriting.hs+ el foldOverTermDef,+ el foldOverTypeDef,+ el freeVariablesInTermDef,+ el freeVariablesInTypeDef,+ el subtermsDef,+ el subtypesDef,+ -- Flows.hs+ el emptyTraceDef,+ el flowSucceedsDef,+ el fromFlowDef,+ el mutateTraceDef,+ el pushErrorDef,+ el warnDef,+ el withFlagDef,+ el withStateDef,+ el withTraceDef+ ]++floatValueToBigfloatDef :: Definition (Double -> Double)+floatValueToBigfloatDef = tier1Definition "floatValueToBigfloat" $+ doc "Convert a floating-point value of any precision to a bigfloat" $+ function floatValueT Types.bigfloat $+ match _FloatValue Nothing [+ _FloatValue_bigfloat>>: Equality.identity,+ _FloatValue_float32>>: Literals.float32ToBigfloat,+ _FloatValue_float64>>: Literals.float64ToBigfloat]++integerValueToBigintDef :: Definition (IntegerValue -> Integer)+integerValueToBigintDef = tier1Definition "integerValueToBigint" $+ doc "Convert an integer value of any precision to a bigint" $+ function integerValueT Types.bigint $+ match _IntegerValue Nothing [+ _IntegerValue_bigint>>: Equality.identity,+ _IntegerValue_int8>>: Literals.int8ToBigint,+ _IntegerValue_int16>>: Literals.int16ToBigint,+ _IntegerValue_int32>>: Literals.int32ToBigint,+ _IntegerValue_int64>>: Literals.int64ToBigint,+ _IntegerValue_uint8>>: Literals.uint8ToBigint,+ _IntegerValue_uint16>>: Literals.uint16ToBigint,+ _IntegerValue_uint32>>: Literals.uint32ToBigint,+ _IntegerValue_uint64>>: Literals.uint64ToBigint]++isLambdaDef :: Definition (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 $+ lambda "term" $ (match _Term (Just false) [+ _Term_function>>: match _Function (Just false) [+ _Function_lambda>>: constant true],+ _Term_let>>: lambda "lt" (ref isLambdaDef @@ (project _Let _Let_environment @@ var "lt"))])+ @@ (ref fullyStripTermDef @@ var "term")++-- Rewriting.hs++foldOverTermDef :: Definition (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] $+ lambda "order" $ lambda "fld" $ lambda "b0" $ lambda "term" $ (match _TraversalOrder Nothing [+ _TraversalOrder_pre>>: constant (Base.fold (ref foldOverTermDef @@ var "order" @@ var "fld")+ @@ (var "fld" @@ var "b0" @@ var "term")+ @@ (ref subtermsDef @@ var "term")),+ _TraversalOrder_post>>: constant (var "fld"+ @@ (Base.fold (ref foldOverTermDef @@ var "order" @@ var "fld")+ @@ (var "b0")+ @@ (ref subtermsDef @@ var "term"))+ @@ var "term")] @@ var "order")++foldOverTypeDef :: Definition (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] $+ lambda "order" $ lambda "fld" $ lambda "b0" $ lambda "typ" $ (match _TraversalOrder Nothing [+ _TraversalOrder_pre>>: constant (Base.fold (ref foldOverTypeDef @@ var "order" @@ var "fld")+ @@ (var "fld" @@ var "b0" @@ var "typ")+ @@ (ref subtypesDef @@ var "typ")),+ _TraversalOrder_post>>: constant (var "fld"+ @@ (Base.fold (ref foldOverTypeDef @@ var "order" @@ var "fld")+ @@ (var "b0")+ @@ (ref subtypesDef @@ var "typ"))+ @@ var "typ")] @@ var "order")++freeVariablesInTermDef :: Definition (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) $+ lambda "term" (+ (match _Term (Just $ var "dfltVars") [+ _Term_function>>: match _Function (Just $ var "dfltVars") [+ _Function_lambda>>: lambda "l" (Sets.remove+ @@ (Core.lambdaParameter @@ var "l")+ @@ (ref freeVariablesInTermDef @@ (Core.lambdaBody @@ var "l")))],+-- TODO: restore the following+-- _Term_let>>: lambda "l" (Sets.difference+-- @@ (ref freeVariablesInTermDef @@ (Core.letEnvironment @@ var "l"))+-- @@ (Sets.fromList @@ (Lists.map @@ first @@ (Maps.toList @@ (Core.letBindings @@ var "l"))))),+ _Term_variable>>: lambda "v" (Sets.singleton @@ var "v")] @@ var "term")+ `with` [+ "dfltVars">: typed (setT nameT) $ Base.fold (lambda "s" $ lambda "t" $ Sets.union @@ var "s" @@ (ref freeVariablesInTermDef @@ var "t"))+ @@ Sets.empty+ @@ (ref subtermsDef @@ var "term")])++freeVariablesInTypeDef :: Definition (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) $+ lambda "typ" (+ (match _Type (Just $ var "dfltVars") [+ _Type_lambda>>: lambda "lt" (Sets.remove+ @@ (Core.lambdaTypeParameter @@ var "lt")+ @@ (ref freeVariablesInTypeDef @@ (Core.lambdaTypeBody @@ var "lt"))),+ -- TODO: let-types+ _Type_variable>>: lambda "v" (Sets.singleton @@ var "v")] @@ var "typ")+ `with` [+ "dfltVars">: typed (setT nameT) $ Base.fold (lambda "s" $ lambda "t" $ Sets.union @@ var "s" @@ (ref freeVariablesInTypeDef @@ var "t"))+ @@ Sets.empty+ @@ (ref subtypesDef @@ var "typ")])++subtermsDef :: Definition (Term -> [Term])+subtermsDef = tier1Definition "subterms" $+ doc "Find the children of a given term" $+ function termT (listT termT) $+ match _Term Nothing [+ _Term_annotated>>: lambda "at" $ list [Core.annotatedTermSubject @@ var "at"],+ _Term_application>>: lambda "p" $ list [+ Core.applicationFunction @@ var "p",+ Core.applicationArgument @@ var "p"],+ _Term_function>>: match _Function (Just $ list []) [+ _Function_elimination>>: match _Elimination (Just $ list []) [+ _Elimination_list>>: lambda "fld" $ list [var "fld"],+ _Elimination_optional>>: lambda "oc" $ list [+ Core.optionalCasesNothing @@ var "oc",+ Core.optionalCasesJust @@ var "oc"],+ _Elimination_union>>: lambda "cs" $ Lists.concat2+ @@ ((matchOpt (list []) (lambda "t" $ list [var "t"])) @@ (Core.caseStatementDefault @@ var "cs"))+ @@ (Lists.map @@ Core.fieldTerm @@ (Core.caseStatementCases @@ var "cs"))],+ _Function_lambda>>: lambda "l" $ list [Core.lambdaBody @@ var "l"]],+ _Term_let>>: lambda "lt" $ Lists.cons+ @@ (Core.letEnvironment @@ var "lt")+ @@ (Lists.map @@ Core.letBindingTerm @@ (Core.letBindings @@ var "lt")),+ _Term_list>>: lambda "l" $ var "l",+ _Term_literal>>: constant $ list [],+ _Term_map>>: lambda "m" (Lists.concat @@+ (Lists.map @@ (lambda "p" $ list [first @@ var "p", second @@ var "p"]) @@ (Maps.toList @@ var "m"))),+ _Term_optional>>: matchOpt (list []) (lambda "t" $ list [var "t"]),+ _Term_product>>: lambda "tuple" $ var "tuple",+ _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_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])+subtypesDef = tier1Definition "subtypes" $+ doc "Find the children of a given type expression" $+ function typeT (listT typeT) $+ match _Type Nothing [+ _Type_annotated>>: lambda "at" $ list [Core.annotatedTypeSubject @@ var "at"],+ _Type_application>>: lambda "at" $ list [+ Core.applicationTypeFunction @@ var "at",+ Core.applicationTypeArgument @@ var "at"],+ _Type_function>>: lambda "ft" $ list [+ Core.functionTypeDomain @@ var "ft",+ Core.functionTypeCodomain @@ var "ft"],+ _Type_lambda>>: lambda "lt" $ list [Core.lambdaTypeBody @@ var "lt"],+ _Type_list>>: lambda "lt" $ list [var "lt"],+ _Type_literal>>: constant $ list [],+ _Type_map>>: lambda "mt" $ list [+ Core.mapTypeKeys @@ var "mt",+ Core.mapTypeValues @@ var "mt"],+ _Type_optional>>: lambda "ot" $ list [var "ot"],+ _Type_product>>: lambda "pt" $ var "pt",+ _Type_record>>: lambda "rt" (Lists.map @@ Core.fieldTypeType @@ (Core.rowTypeFields @@ var "rt")),+ _Type_set>>: lambda "st" $ list [var "st"],+ _Type_sum>>: lambda "st" $ var "st",+ _Type_union>>: lambda "rt" (Lists.map @@ Core.fieldTypeType @@ (Core.rowTypeFields @@ var "rt")),+ _Type_variable>>: constant $ list [],+ _Type_wrap>>: lambda "nt" $ list [Core.wrappedTypeObject @@ var "nt"]]++unqualifyNameDef :: Definition (QualifiedName -> Name)+unqualifyNameDef = tier1Definition "unqualifyName" $+ doc "Convert a qualified name to a dot-separated name" $+ function qualifiedNameT nameT $+ lambda "qname" $ (wrap _Name $ var "prefix" ++ (project _QualifiedName _QualifiedName_local @@ var "qname"))+ `with` [+ "prefix">: matchOpt (string "") (lambda "n" $ (unwrap _Namespace @@ var "n") ++ string ".")+ @@ (project _QualifiedName _QualifiedName_namespace @@ var "qname")]++-- Flows.hs++emptyTraceDef :: Definition Trace+emptyTraceDef = tier1Definition "emptyTrace" $+ record _Trace [+ _Trace_stack>>: list [],+ _Trace_messages>>: list [],+ _Trace_other>>: Maps.empty]++flowSucceedsDef :: Definition (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 = 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"))) $+ lambda "def" $ lambda "cx" $ lambda "f" $+ 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 = tier1Definition "mutateTrace" $+ functionN [+ Types.function traceT (eitherT Types.string traceT),+ Types.functionN [traceT, traceT, traceT],+ flowSAT,+ flowSAT] $+ lambda "mutate" $ lambda "restore" $ lambda "f" $ wrap _Flow (+ lambda "s0" $ lambda "t0" (+ ((match _Either Nothing [+ _Either_left>>: var "forLeft",+ _Either_right>>: var "forRight"])+ @@ (var "mutate" @@ var "t0"))+ `with` [+ "forLeft">:+ lambda "msg" $ Flows.flowState nothing (var "s0") (ref pushErrorDef @@ var "msg" @@ var "t0"),+ -- retain the updated state, but reset the trace after execution+ "forRight">:+ function traceT (flowStateT (Types.var "s") (Types.var "s")) $+ lambda "t1" ((Flows.flowState+ (Flows.flowStateValue @@ var "f2")+ (Flows.flowStateState @@ var "f2")+ (var "restore" @@ var "t0" @@ (Flows.flowStateTrace @@ var "f2")))+ `with` [+ -- execute the internal flow after augmenting the trace+ "f2">: Flows.unFlow @@ var "f" @@ var "s0" @@ var "t1"+ ])]))+ where+ eitherT l r = Types.applyN [TypeVariable _Either, l, r]++pushErrorDef :: Definition (String -> Trace -> Trace)+pushErrorDef = tier1Definition "pushError" $+ doc "Push an error message" $+ functionN [Types.string, traceT, traceT] $+ lambda "msg" $ lambda "t" $ ((Flows.trace+ (Flows.traceStack @@ var "t")+ (Lists.cons @@ var "errorMsg" @@ (Flows.traceMessages @@ var "t"))+ (Flows.traceOther @@ var "t"))+ `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 = tier1Definition "warn" $+ doc "Continue the current flow after adding a warning message" $+ functionN [Types.string, flowSAT, flowSAT] $+ lambda "msg" $ lambda "b" $ wrap _Flow $ lambda "s0" $ lambda "t0" (+ (Flows.flowState+ (Flows.flowStateValue @@ var "f1")+ (Flows.flowStateState @@ var "f1")+ (var "addMessage" @@ (Flows.flowStateTrace @@ var "f1")))+ `with` [+ "f1">: Flows.unFlow @@ var "b" @@ var "s0" @@ var "t0",+ "addMessage">: lambda "t" $ Flows.trace+ (Flows.traceStack @@ var "t")+ (Lists.cons @@ ("Warning: " ++ var "msg") @@ (Flows.traceMessages @@ var "t"))+ (Flows.traceOther @@ var "t")])++withFlagDef :: Definition (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) $+ lambda "flag" ((ref mutateTraceDef @@ var "mutate" @@ var "restore")+ `with` [+ "mutate">: lambda "t" $ inject _Either _Either_right $ (Flows.trace+ (Flows.traceStack @@ var "t")+ (Flows.traceMessages @@ var "t")+ (Maps.insert @@ var "flag" @@ (inject _Term _Term_literal $ inject _Literal _Literal_boolean $ boolean True) @@ (Flows.traceOther @@ var "t"))),+ "restore">: lambda "ignored" $ lambda "t1" $ Flows.trace+ (Flows.traceStack @@ var "t1")+ (Flows.traceMessages @@ var "t1")+ (Maps.remove @@ var "flag" @@ (Flows.traceOther @@ var "t1"))])++withStateDef :: Definition (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) $+ lambda "cx0" $ lambda "f" $+ wrap _Flow $ lambda "cx1" $ lambda "t1" (+ (Flows.flowState (Flows.flowStateValue @@ var "f1") (var "cx1") (Flows.flowStateTrace @@ var "f1"))+ `with` [+ "f1">:+ 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 = tier1Definition "withTrace" $+ doc "Continue the current flow after augmenting the trace" $+ functionN [Types.string, flowSAT, flowSAT] $+ lambda "msg" ((ref mutateTraceDef @@ var "mutate" @@ var "restore")+ `with` [+ -- augment the trace+ "mutate">: lambda "t" $ Logic.ifElse+ @@ (inject _Either _Either_left $ string "maximum trace depth exceeded. This may indicate an infinite loop")+ @@ (inject _Either _Either_right $ Flows.trace+ (Lists.cons @@ var "msg" @@ (Flows.traceStack @@ var "t"))+ (Flows.traceMessages @@ var "t")+ (Flows.traceOther @@ var "t"))+ @@ (Equality.gteInt32 @@ (Lists.length @@ (Flows.traceStack @@ var "t")) @@ ref maxTraceDepthDef),+ -- reset the trace stack after execution+ "restore">: lambda "t0" $ lambda "t1" $ Flows.trace+ (Flows.traceStack @@ var "t0")+ (Flows.traceMessages @@ var "t1")+ (Flows.traceOther @@ var "t1")])
+ src/main/haskell/Hydra/Sources/Tier2/All.hs view
@@ -0,0 +1,25 @@+module Hydra.Sources.Tier2.All(+ module Hydra.Sources.Tier2.All,+ module Hydra.Sources.Tier1.All,+ module Hydra.Sources.Tier2.Basics,+ module Hydra.Sources.Tier2.CoreLanguage,+ module Hydra.Sources.Tier2.Extras,+ module Hydra.Sources.Tier2.Printing,+ module Hydra.Sources.Tier2.Tier2,+) where++import Hydra.Sources.Tier1.All+import Hydra.Sources.Tier2.Basics+import Hydra.Sources.Tier2.CoreLanguage+import Hydra.Sources.Tier2.Extras+import Hydra.Sources.Tier2.Printing+import Hydra.Sources.Tier2.Tier2++tier2Modules :: [Module]+tier2Modules = [+ hydraBasicsModule,+ hydraCoreLanguageModule,+ hydraExtrasModule,+ hydraPrintingModule,+ hydraStripModule,+ hydraTier2Module]
+ src/main/haskell/Hydra/Sources/Tier2/Basics.hs view
@@ -0,0 +1,481 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier2.Basics where++-- Standard Tier-2 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.Tier1.All+++basicsDefinition :: String -> Datum a -> Definition a+basicsDefinition = definitionInModule hydraBasicsModule++hydraBasicsModule :: Module+hydraBasicsModule = Module (Namespace "hydra/basics") elements+ [hydraTier1Module]+ tier0Modules $+ Just "A tier-2 module of basic functions for working with types and terms."+ where+ elements = [+ el eliminationVariantDef,+ el eliminationVariantsDef,+ el floatTypePrecisionDef,+ el floatTypesDef,+ el floatValueTypeDef,+ el functionVariantDef,+ el functionVariantsDef,+ el idDef,+ el integerTypeIsSignedDef,+ el integerTypePrecisionDef,+ el integerTypesDef,+ el integerValueTypeDef,+ el literalTypeDef,+ el literalTypeVariantDef,+ el literalVariantDef,+ el literalVariantsDef,+ el termVariantDef,+ el termVariantsDef,+ el typeVariantDef,+ el typeVariantsDef,+ -- Formatting.hs+ el capitalizeDef,+ el decapitalizeDef,+ el mapFirstLetterDef,+ -- Common.hs+ el fieldMapDef,+ el fieldTypeMapDef,+ el isEncodedTypeDef,+ el isTypeDef,+ el isUnitTermDef,+ el isUnitTypeDef,+ el elementsToGraphDef,+ el localNameOfEagerDef,+ el localNameOfLazyDef,+ el namespaceOfEagerDef,+ el namespaceOfLazyDef,+ el namespaceToFilePathDef,+ el qualifyNameEagerDef,+ el qualifyNameLazyDef+ ]++eliminationVariantDef :: Definition (Elimination -> EliminationVariant)+eliminationVariantDef = basicsDefinition "eliminationVariant" $+ doc "Find the elimination variant (constructor) for a given elimination term" $+ function eliminationT eliminationVariantT $+ matchToEnum _Elimination _EliminationVariant Nothing [+ _Elimination_list @-> _EliminationVariant_list,+ _Elimination_optional @-> _EliminationVariant_optional,+ _Elimination_product @-> _EliminationVariant_product,+ _Elimination_record @-> _EliminationVariant_record,+ _Elimination_union @-> _EliminationVariant_union,+ _Elimination_wrap @-> _EliminationVariant_wrap]++eliminationVariantsDef :: Definition [EliminationVariant]+eliminationVariantsDef = basicsDefinition "eliminationVariants" $+ doc "All elimination variants (constructors), in a canonical order" $+ typed (listT eliminationVariantT) $+ list $ unitVariant _EliminationVariant <$> [+ _EliminationVariant_list,+ _EliminationVariant_wrap,+ _EliminationVariant_optional,+ _EliminationVariant_product,+ _EliminationVariant_record,+ _EliminationVariant_union]++floatTypePrecisionDef :: Definition (FloatType -> Precision)+floatTypePrecisionDef = basicsDefinition "floatTypePrecision" $+ doc "Find the precision of a given floating-point type" $+ function floatTypeT precisionT $+ matchToUnion _FloatType _Precision Nothing [+ _FloatType_bigfloat @-> field _Precision_arbitrary unit,+ _FloatType_float32 @-> field _Precision_bits $ int 32,+ _FloatType_float64 @-> field _Precision_bits $ int 64]++floatTypesDef :: Definition [FloatType]+floatTypesDef = basicsDefinition "floatTypes" $+ doc "All floating-point types in a canonical order" $+ typed (listT floatTypeT) $+ list $ unitVariant _FloatType <$> [+ _FloatType_bigfloat,+ _FloatType_float32,+ _FloatType_float64]++floatValueTypeDef :: Definition (FloatValue -> FloatType)+floatValueTypeDef = basicsDefinition "floatValueType" $+ doc "Find the float type for a given floating-point value" $+ function floatValueT floatTypeT $+ matchToEnum _FloatValue _FloatType Nothing [+ _FloatValue_bigfloat @-> _FloatType_bigfloat,+ _FloatValue_float32 @-> _FloatType_float32,+ _FloatValue_float64 @-> _FloatType_float64]++functionVariantDef :: Definition (Function -> FunctionVariant)+functionVariantDef = basicsDefinition "functionVariant" $+ doc "Find the function variant (constructor) for a given function" $+ function functionT functionVariantT $+ matchToEnum _Function _FunctionVariant Nothing [+ _Function_elimination @-> _FunctionVariant_elimination,+ _Function_lambda @-> _FunctionVariant_lambda,+ _Function_primitive @-> _FunctionVariant_primitive]++functionVariantsDef :: Definition [FunctionVariant]+functionVariantsDef = basicsDefinition "functionVariants" $+ doc "All function variants (constructors), in a canonical order" $+ typed (listT functionVariantT) $+ list $ unitVariant _FunctionVariant <$> [+ _FunctionVariant_elimination,+ _FunctionVariant_lambda,+ _FunctionVariant_primitive]++idDef :: Definition (a -> a)+idDef = basicsDefinition "id" $+ doc "The identity function" $+ function aT aT $+ lambda "x" $ var "x"++integerTypeIsSignedDef :: Definition (IntegerType -> Bool)+integerTypeIsSignedDef = basicsDefinition "integerTypeIsSigned" $+ doc "Find whether a given integer type is signed (true) or unsigned (false)" $+ function integerTypeT booleanT $+ matchData _IntegerType Nothing [+ _IntegerType_bigint @-> constant true,+ _IntegerType_int8 @-> constant true,+ _IntegerType_int16 @-> constant true,+ _IntegerType_int32 @-> constant true,+ _IntegerType_int64 @-> constant true,+ _IntegerType_uint8 @-> constant false,+ _IntegerType_uint16 @-> constant false,+ _IntegerType_uint32 @-> constant false,+ _IntegerType_uint64 @-> constant false]++integerTypePrecisionDef :: Definition (IntegerType -> Precision)+integerTypePrecisionDef = basicsDefinition "integerTypePrecision" $+ doc "Find the precision of a given integer type" $+ function integerTypeT precisionT $+ matchToUnion _IntegerType _Precision Nothing [+ _IntegerType_bigint @-> field _Precision_arbitrary unit,+ _IntegerType_int8 @-> field _Precision_bits $ int 8,+ _IntegerType_int16 @-> field _Precision_bits $ int 16,+ _IntegerType_int32 @-> field _Precision_bits $ int 32,+ _IntegerType_int64 @-> field _Precision_bits $ int 64,+ _IntegerType_uint8 @-> field _Precision_bits $ int 8,+ _IntegerType_uint16 @-> field _Precision_bits $ int 16,+ _IntegerType_uint32 @-> field _Precision_bits $ int 32,+ _IntegerType_uint64 @-> field _Precision_bits $ int 64]++integerTypesDef :: Definition [IntegerType]+integerTypesDef = basicsDefinition "integerTypes" $+ doc "All integer types, in a canonical order" $+ typed (listT integerTypeT) $+ list $ unitVariant _IntegerType <$> [+ _IntegerType_bigint,+ _IntegerType_int8,+ _IntegerType_int16,+ _IntegerType_int32,+ _IntegerType_int64,+ _IntegerType_uint8,+ _IntegerType_uint16,+ _IntegerType_uint32,+ _IntegerType_uint64]++integerValueTypeDef :: Definition (IntegerValue -> IntegerType)+integerValueTypeDef = basicsDefinition "integerValueType" $+ doc "Find the integer type for a given integer value" $+ function integerValueT integerTypeT $+ matchToEnum _IntegerValue _IntegerType Nothing [+ _IntegerValue_bigint @-> _IntegerType_bigint,+ _IntegerValue_int8 @-> _IntegerType_int8,+ _IntegerValue_int16 @-> _IntegerType_int16,+ _IntegerValue_int32 @-> _IntegerType_int32,+ _IntegerValue_int64 @-> _IntegerType_int64,+ _IntegerValue_uint8 @-> _IntegerType_uint8,+ _IntegerValue_uint16 @-> _IntegerType_uint16,+ _IntegerValue_uint32 @-> _IntegerType_uint32,+ _IntegerValue_uint64 @-> _IntegerType_uint64]++literalTypeDef :: Definition (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]++literalTypeVariantDef :: Definition (LiteralType -> LiteralVariant)+literalTypeVariantDef = basicsDefinition "literalTypeVariant" $+ doc "Find the literal type variant (constructor) for a given literal value" $+ function literalTypeT literalVariantT $+ matchToEnum _LiteralType _LiteralVariant Nothing [+ _LiteralType_binary @-> _LiteralVariant_binary,+ _LiteralType_boolean @-> _LiteralVariant_boolean,+ _LiteralType_float @-> _LiteralVariant_float,+ _LiteralType_integer @-> _LiteralVariant_integer,+ _LiteralType_string @-> _LiteralVariant_string]++literalVariantDef :: Definition (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 = basicsDefinition "literalVariants" $+ doc "All literal variants, in a canonical order" $+ typed (listT literalVariantT) $+ list $ unitVariant _LiteralVariant <$> [+ _LiteralVariant_binary,+ _LiteralVariant_boolean,+ _LiteralVariant_float,+ _LiteralVariant_integer,+ _LiteralVariant_string]++termVariantDef :: Definition (Term -> TermVariant)+termVariantDef = basicsDefinition "termVariant" $+ doc "Find the term variant (constructor) for a given term" $+ function termT termVariantT $+ matchToEnum _Term _TermVariant Nothing [+ _Term_annotated @-> _TermVariant_annotated,+ _Term_application @-> _TermVariant_application,+ _Term_function @-> _TermVariant_function,+ _Term_let @-> _TermVariant_let,+ _Term_list @-> _TermVariant_list,+ _Term_literal @-> _TermVariant_literal,+ _Term_map @-> _TermVariant_map,+ _Term_optional @-> _TermVariant_optional,+ _Term_product @-> _TermVariant_product,+ _Term_record @-> _TermVariant_record,+ _Term_set @-> _TermVariant_set,+ _Term_sum @-> _TermVariant_sum,+ _Term_typed @-> _TermVariant_typed,+ _Term_union @-> _TermVariant_union,+ _Term_variable @-> _TermVariant_variable,+ _Term_wrap @-> _TermVariant_wrap]++termVariantsDef :: Definition [TermVariant]+termVariantsDef = basicsDefinition "termVariants" $+ doc "All term (expression) variants, in a canonical order" $+ typed (listT termVariantT) $+ list $ unitVariant _TermVariant <$> [+ _TermVariant_annotated,+ _TermVariant_application,+ _TermVariant_literal,+ _TermVariant_function,+ _TermVariant_list,+ _TermVariant_map,+ _TermVariant_optional,+ _TermVariant_product,+ _TermVariant_record,+ _TermVariant_set,+ _TermVariant_sum,+ _TermVariant_typed,+ _TermVariant_union,+ _TermVariant_variable,+ _TermVariant_wrap]++typeVariantDef :: Definition (Type -> TypeVariant)+typeVariantDef = basicsDefinition "typeVariant" $+ doc "Find the type variant (constructor) for a given type" $+ function typeT typeVariantT $+ matchToEnum _Type _TypeVariant Nothing [+ _Type_annotated @-> _TypeVariant_annotated,+ _Type_application @-> _TypeVariant_application,+ _Type_function @-> _TypeVariant_function,+ _Type_lambda @-> _TypeVariant_lambda,+ _Type_list @-> _TypeVariant_list,+ _Type_literal @-> _TypeVariant_literal,+ _Type_map @-> _TypeVariant_map,+ _Type_optional @-> _TypeVariant_optional,+ _Type_product @-> _TypeVariant_product,+ _Type_record @-> _TypeVariant_record,+ _Type_set @-> _TypeVariant_set,+ _Type_sum @-> _TypeVariant_sum,+ _Type_union @-> _TypeVariant_union,+ _Type_variable @-> _TypeVariant_variable,+ _Type_wrap @-> _TypeVariant_wrap]++typeVariantsDef :: Definition [TypeVariant]+typeVariantsDef = basicsDefinition "typeVariants" $+ doc "All type variants, in a canonical order" $+ typed (listT typeVariantT) $+ list $ unitVariant _TypeVariant <$> [+ _TypeVariant_annotated,+ _TypeVariant_application,+ _TypeVariant_function,+ _TypeVariant_lambda,+ _TypeVariant_list,+ _TypeVariant_literal,+ _TypeVariant_map,+ _TypeVariant_wrap,+ _TypeVariant_optional,+ _TypeVariant_product,+ _TypeVariant_record,+ _TypeVariant_set,+ _TypeVariant_sum,+ _TypeVariant_union,+ _TypeVariant_variable]++-- Formatting.hs++capitalizeDef :: Definition (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 = 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 = basicsDefinition "mapFirstLetter" $+ doc "A helper which maps the first letter of a string to another string" $+ function (funT stringT stringT) (funT stringT stringT) $+ lambda "mapping" $ lambda "s" ((Logic.ifElse+ @@ var "s"+ @@ (Strings.cat2 @@ var "firstLetter" @@ (Strings.fromList @@ (Lists.tail @@ var "list")))+ @@ (Strings.isEmpty @@ var "s"))+ `with` [+ "firstLetter">: var "mapping" @@ (Strings.fromList @@ (Lists.pure @@ (Lists.head @@ var "list"))),+ "list">: typed (listT int32T) $ Strings.toList @@ var "s"])++-- Common.hs++fieldMapDef :: Definition ([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")]++fieldTypeMapDef :: Definition ([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")]++isEncodedTypeDef :: Definition (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"))+ ]) @@ (ref stripTermDef @@ var "t")++isTypeDef :: Definition (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+ ]) @@ (ref stripTypeDef @@ var "t")++isUnitTermDef :: Definition (Term -> Bool)+isUnitTermDef = basicsDefinition "isUnitTerm" $+ function termT booleanT $+ lambda "t" $ Equality.equalTerm @@ (ref fullyStripTermDef @@ var "t") @@ Datum (coreEncodeTerm Terms.unit)++isUnitTypeDef :: Definition (Term -> Bool)+isUnitTypeDef = basicsDefinition "isUnitType" $+ function typeT booleanT $+ lambda "t" $ Equality.equalType @@ (ref stripTypeDef @@ var "t") @@ Datum (coreEncodeType unitT)++elementsToGraphDef :: Definition (Graph -> Maybe Graph -> [Element] -> Graph)+elementsToGraphDef = basicsDefinition "elementsToGraph" $+ function graphT (funT (optionalT graphT) (funT (TypeList elementT) graphT)) $+ lambda "parent" $ lambda "schema" $ lambda "elements" $+ Graph.graph+ (Maps.fromList @@ (Lists.map @@ var "toPair" @@ var "elements"))+ (Graph.graphEnvironment @@ var "parent")+ (Graph.graphTypes @@ var "parent")+ (Graph.graphBody @@ var "parent")+ (Graph.graphPrimitives @@ var "parent")+ (var "schema")+ `with` [+ "toPair" >: lambda "el" $ pair (project _Element _Element_name @@ var "el", var "el")]++localNameOfEagerDef :: Definition (Name -> String)+localNameOfEagerDef = basicsDefinition "localNameOfEager" $+ function nameT stringT $+ Module.qualifiedNameLocal <.> ref qualifyNameEagerDef++localNameOfLazyDef :: Definition (Name -> String)+localNameOfLazyDef = basicsDefinition "localNameOfLazy" $+ function nameT stringT $+ Module.qualifiedNameLocal <.> ref qualifyNameLazyDef++namespaceOfEagerDef :: Definition (Name -> Maybe Namespace)+namespaceOfEagerDef = basicsDefinition "namespaceOfEager" $+ function nameT (optionalT namespaceT) $+ Module.qualifiedNameNamespace <.> ref qualifyNameEagerDef++namespaceOfLazyDef :: Definition (Name -> Maybe Namespace)+namespaceOfLazyDef = basicsDefinition "namespaceOfLazy" $+ function nameT (optionalT namespaceT) $+ Module.qualifiedNameNamespace <.> ref qualifyNameLazyDef++namespaceToFilePathDef :: Definition (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"))+ `with` [+ "parts">: Lists.map @@ (Logic.ifElse @@ ref capitalizeDef @@ ref idDef @@ var "caps") @@ (Strings.splitOn @@ "/" @@ (unwrap _Namespace @@ var "ns"))])++qualifyNameEagerDef :: Definition (Name -> QualifiedName)+qualifyNameEagerDef = basicsDefinition "qualifyNameEager" $+ function nameT qualifiedNameT $+ lambda "name" $ ((Logic.ifElse+ @@ Module.qualifiedName nothing (unwrap _Name @@ 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")])++qualifyNameLazyDef :: Definition (Name -> QualifiedName)+qualifyNameLazyDef = basicsDefinition "qualifyNameLazy" $+ function nameT qualifiedNameT $+ lambda "name" $ (Logic.ifElse+ @@ Module.qualifiedName nothing (unwrap _Name @@ 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"))]
+ src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier2.CoreLanguage where++-- Standard Tier-2 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.Tier1.All++import Hydra.Sources.Tier2.Basics+++hydraCoreLanguageModule :: Module+hydraCoreLanguageModule = Module ns elements+ [hydraBasicsModule]+ tier0Modules $+ Just "Language constraints for Hydra Core"+ where+ ns = Namespace "hydra/coreLanguage"+ elements = [el hydraCoreLanguageDef]++hydraCoreLanguageDef :: Definition Language+hydraCoreLanguageDef = definitionInModule hydraCoreLanguageModule "hydraCoreLanguage" $+ doc "Language constraints for Java" $+ typed languageT $+ record _Language [+ _Language_name>>: wrap _LanguageName "hydra/core",+ _Language_constraints>>: record _LanguageConstraints [+ _LanguageConstraints_eliminationVariants>>: Sets.fromList @@ ref eliminationVariantsDef,+ _LanguageConstraints_literalVariants>>: Sets.fromList @@ ref literalVariantsDef,+ _LanguageConstraints_floatTypes>>: Sets.fromList @@ ref floatTypesDef,+ _LanguageConstraints_functionVariants>>: Sets.fromList @@ ref functionVariantsDef,+ _LanguageConstraints_integerTypes>>: Sets.fromList @@ ref integerTypesDef,+ _LanguageConstraints_termVariants>>: Sets.fromList @@ ref termVariantsDef,+ _LanguageConstraints_typeVariants>>: Sets.fromList @@ ref typeVariantsDef,+ _LanguageConstraints_types>>: constant true]]
+ src/main/haskell/Hydra/Sources/Tier2/Extras.hs view
@@ -0,0 +1,128 @@+module Hydra.Sources.Tier2.Extras (hydraExtrasModule) where++-- Standard Tier-2 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.Tier1.All+++hydraExtrasDefinition :: String -> Datum a -> Definition a+hydraExtrasDefinition = definitionInModule hydraExtrasModule++hydraExtrasModule :: Module+hydraExtrasModule = Module (Namespace "hydra/extras") elements+ [hydraGraphModule, hydraMantleModule, hydraComputeModule]+ tier0Modules $+ Just "Basic functions which depend on primitive functions"+ where+ elements = [+ el functionArityDef,+ el lookupPrimitiveDef,+ el primitiveArityDef,+ el qnameDef,+ el termArityDef,+ el typeArityDef,+ el uncurryTypeDef,+ el getAnnotationDef+-- el getAttrDef+ ]++functionArityDef :: Definition (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 $+ doc "TODO: This function needs to be monadic, so we can look up the primitive" (int32 42)]++lookupPrimitiveDef :: Definition (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")++primitiveArityDef :: Definition (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))++qnameDef :: Definition (Namespace -> String -> Name)+qnameDef = hydraExtrasDefinition "qname" $+ doc "Construct a qualified (dot-separated) name" $+ functionN [namespaceT, stringT, nameT] $+ lambda "ns" $ lambda "name" $+ nom _Name $+ apply Strings.cat $+ list [apply (unwrap _Namespace) (var "ns"), string ".", var "name"]++termArityDef :: Definition (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]+ -- Note: ignoring variables which might resolve to functions++typeArityDef :: Definition (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")))]++uncurryTypeDef :: Definition (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)" $+ lambda "t" ((match _Type (Just $ list [var "t"]) [+ _Type_annotated>>: ref uncurryTypeDef <.> Core.annotatedTypeSubject,+ _Type_application>>: ref uncurryTypeDef <.> Core.applicationTypeFunction,+ _Type_lambda>>: ref uncurryTypeDef <.> Core.lambdaTypeBody,+ _Type_function>>: lambda "ft" $ Lists.cons+ @@ (Core.functionTypeDomain @@ var "ft")+ @@ (ref uncurryTypeDef @@ (Core.functionTypeCodomain @@ var "ft"))]) @@ var "t")++-- hydra/kv++getAnnotationDef :: Definition (String -> M.Map String Term -> Maybe Term)+getAnnotationDef = hydraExtrasDefinition "getAnnotation" $+ functionN [stringT, 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"]
+ src/main/haskell/Hydra/Sources/Tier2/Printing.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier2.Printing where++-- Standard Tier-2 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.Tier1.All++import Hydra.Sources.Tier2.Basics+++hydraPrintingModule :: Module+hydraPrintingModule = Module (Namespace "hydra/printing") elements+ [hydraBasicsModule]+ tier0Modules $+ Just "Utilities for use in transformations"+ where+ elements = [+ el describeFloatTypeDef,+ el describeIntegerTypeDef,+ el describeLiteralTypeDef,+ el describePrecisionDef,+ el describeTypeDef]++printingDefinition :: String -> Datum a -> Definition a+printingDefinition = definitionInModule hydraPrintingModule+++describeFloatTypeDef :: Definition (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 = 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 = 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"]++describePrecisionDef :: Definition (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"]++describeTypeDef :: Definition (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 @@+ (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 "+ ++ (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 "+ ++ (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 "+ ++ (ref describeTypeDef @@ (project _WrappedType _WrappedType_object @@ var "n"))]
+ src/main/haskell/Hydra/Sources/Tier2/Tier2.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier2.Tier2 where++-- Standard Tier-2 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.Tier1.All+++tier2Definition :: String -> Datum a -> Definition a+tier2Definition = definitionInModule hydraTier2Module++hydraTier2Module :: Module+hydraTier2Module = Module (Namespace "hydra/tier2") elements+ [hydraGraphModule, hydraMantleModule, hydraComputeModule, hydraStripModule] tier0Modules $+ Just ("A module for miscellaneous tier-2 functions and constants.")+ where+ elements = [+ el getStateDef,+ el getTermTypeDef,+ el putStateDef,+ el requireElementTypeDef,+ el requireTermTypeDef,+ el unexpectedDef+ ]++getStateDef :: Definition (Flow s s)+getStateDef = tier2Definition "getState" $+ doc "Get the state of the current flow" $+ typed flowSST $+ wrap _Flow (lambda "s0" $ lambda "t0" $ (+ (lambda "v" $ lambda "s" $ lambda "t" $ (+ (matchOpt+ (Flows.flowState nothing (var "s") (var "t"))+ (constant (Flows.flowState (just $ var "s") (var "s") (var "t"))))+ @@ var "v"))+ @@ (Flows.flowStateValue @@ var "fs1") @@ (Flows.flowStateState @@ var "fs1") @@ (Flows.flowStateTrace @@ var "fs1"))+ `with` [+ "fs1">:+ 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 = tier2Definition "getTermType" $+ doc "Get the annotated type of a given term, if any" $+ function termT (optionalT typeT) $+ match _Term (Just nothing) [+ "annotated">: ref getTermTypeDef <.> project _AnnotatedTerm _AnnotatedTerm_subject,+ "typed">: lambda "tt" $ just (project _TypedTerm _TypedTerm_type @@ var "tt")]++putStateDef :: Definition (s -> Flow s ())+putStateDef = tier2Definition "putState" $+ doc "Set the state of a flow" $+ function sT (flowT sT unitT) $+ lambda "cx" $ wrap _Flow $ lambda "s0" $ lambda "t0" (+ (Flows.flowState+ (Flows.flowStateValue @@ var "f1")+ (var "cx")+ (Flows.flowStateTrace @@ var "f1"))+ `with` [+ "f1">: Flows.unFlow @@ (Flows.pure @@ unit) @@ var "s0" @@ var "t0"])++requireElementTypeDef :: Definition (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) $+ lambda "el" $ ((var "withType" @@ (ref getTermTypeDef @@ (project _Element _Element_data @@ var "el")))+ `with` [+ "withType">: matchOpt+ (Flows.fail @@ ("missing type annotation for element " ++ (unwrap _Name @@ (project _Element _Element_name @@ var "el"))))+ Flows.pure])++requireTermTypeDef :: Definition (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) $+ (var "withType" <.> ref getTermTypeDef)+ `with` [+ "withType">: matchOpt+ (Flows.fail @@ "missing type annotation")+ Flows.pure]++unexpectedDef :: Definition (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)) $+ lambda "expected" $ lambda "actual" $ Flows.fail @@ ("expected " ++ var "expected" ++ " but found: " ++ var "actual")
+ src/main/haskell/Hydra/Sources/Tier3/All.hs view
@@ -0,0 +1,15 @@+module Hydra.Sources.Tier3.All(+ module Hydra.Sources.Tier3.All,+ module Hydra.Sources.Tier2.All,+ module Hydra.Sources.Tier3.Tier3,+) where++import Hydra.Sources.Tier2.All+import Hydra.Sources.Tier3.Tier3++kernelModules :: [Module]+kernelModules = tier0Modules ++ tier1Modules ++ tier2Modules ++ tier3Modules++tier3Modules :: [Module]+tier3Modules = [+ hydraTier3Module]
+ src/main/haskell/Hydra/Sources/Tier3/Tier3.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier3.Tier3 where++-- Standard Tier-3 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+++tier3Definition :: String -> Datum a -> Definition 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 $+ Just ("A module for miscellaneous tier-3 functions and constants.")+ where+ elements = [+ el traceSummaryDef+ ]++traceSummaryDef :: Definition (Trace -> String)+traceSummaryDef = tier3Definition "traceSummary" $+ doc "Summarize a trace as a string" $+ function traceT stringT $+ lambda "t" $ (+ (Strings.intercalate @@ "\n" @@ (Lists.concat2 @@ var "messageLines" @@ var "keyvalLines"))+ `with` [+ "messageLines">: (Lists.nub @@ (Flows.traceMessages @@ var "t")),+ "keyvalLines">: Logic.ifElse+ @@ (list [])+ @@ (Lists.cons @@ "key/value pairs: "+ @@ (Lists.map @@ (var "toLine") @@ (Maps.toList @@ (Flows.traceOther @@ var "t"))))+ @@ (Maps.isEmpty @@ (Flows.traceOther @@ var "t")),+ "toLine">:+ function (pairT stringT termT) stringT $+ lambda "pair" $ "\t" ++ (first @@ var "pair") ++ ": " ++ (Io.showTerm @@ (second @@ var "pair"))])
+ src/main/haskell/Hydra/Sources/Tier4/All.hs view
@@ -0,0 +1,88 @@+module Hydra.Sources.Tier4.All(+ module Hydra.Sources.Tier4.All,+ module Hydra.Sources.Tier3.All,+ -- Note: individual Tier-4 modules are not exported, as they are currently not guaranteed to be free of name collisions+) 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.Test.TestSuite+++allModules :: [Module]+allModules = mainModules ++ testModules++mainModules :: [Module]+mainModules = kernelModules ++ tier4LangModules++testModules :: [Module]+testModules = [+ testSuiteModule]++tier4LangModules :: [Module]+tier4LangModules = [+ avroSchemaModule,+ deltaParquetModule,+ 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,+ yamlModelModule]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Avro/Schema.hs view
@@ -0,0 +1,138 @@+{-# 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"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/Features.hs view
@@ -0,0 +1,328 @@+{-# 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
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Cypher/OpenCypher.hs view
@@ -0,0 +1,1049 @@+{-# 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' ;
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Graphql/Syntax.hs view
@@ -0,0 +1,338 @@+{-# 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Haskell/Ast.hs view
@@ -0,0 +1,432 @@+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"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Language.hs view
@@ -0,0 +1,143 @@+{-# 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Java/Syntax.hs view
@@ -0,0 +1,1742 @@+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"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Json/Decoding.hs view
@@ -0,0 +1,96 @@+{-# 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")
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Kusto/Kql.hs view
@@ -0,0 +1,274 @@+{-# 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Owl/Syntax.hs view
@@ -0,0 +1,599 @@+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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Delta.hs view
@@ -0,0 +1,62 @@+{-# 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Parquet/Format.hs view
@@ -0,0 +1,1758 @@+{-# 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<Encoding> 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<string> 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<KeyValue> 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<PageEncodingStats> 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<string> 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<ColumnChunk> 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<SortingColumn> 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<PageLocation> 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 <array-field>[i] refers to the page at OffsetIndex.page_locations[i]+-- */+-- struct ColumnIndex {+ def "ColumnIndex" $+ doc ("Description for ColumnIndex. " +++ "Each <array-field>[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<bool> 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<binary> 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<binary> 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<i64> 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<SchemaElement> 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<RowGroup> row_groups+ "rowGroups">:+ doc "Row groups in this file" $+ list $ parquet "RowGroup",+--+-- /** Optional key/value metadata **/+-- 5: optional list<KeyValue> 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+-- * <Application> version <App Version> (build <App Build Hash>).+-- * 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 " +++ "<Application> version <App Version> (build <App Build Hash>). " +++ "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<ColumnOrder> 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]]+-- }
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Pegasus/Pdl.hs view
@@ -0,0 +1,128 @@+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"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Any.hs view
@@ -0,0 +1,151 @@+{-# 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": <string>,+-- // "lastName": <string>+-- // }+-- //+-- // 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]]+-- }
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Language.hs view
@@ -0,0 +1,96 @@+{-# 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/Proto3.hs view
@@ -0,0 +1,164 @@+{-# 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+ ]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Protobuf/SourceContext.hs view
@@ -0,0 +1,35 @@+{-# 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]]+-- }
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Python/Python3.hs view
@@ -0,0 +1,1399 @@+{-# 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"]]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Rdf/Syntax.hs view
@@ -0,0 +1,102 @@+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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/RelationalModel.hs view
@@ -0,0 +1,83 @@+{-# 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"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Scala/Meta.hs view
@@ -0,0 +1,1372 @@+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+-- }
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Shacl/Model.hs view
@@ -0,0 +1,273 @@+{-# 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"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Shex/Syntax.hs view
@@ -0,0 +1,524 @@+{-# 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]*+
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Sql/Ansi.hs view
@@ -0,0 +1,1016 @@+{-# 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 = [+ -- <approximate numeric literal> ::= <mantissa> E <exponent>+ define "ApproximateNumericLiteral" [regex $ mantissa ++ "E" ++ exponent],++ -- <binary string literal> ::=+ -- X <quote> [ { <hexit> <hexit> }... ] <quote>+ -- [ { <separator> <quote> [ { <hexit> <hexit> }... ] <quote> }... ]+ -- [ ESCAPE <escape character> ]+ define "BinaryStringLiteral" unsupported,++ -- <character string literal> ::=+ -- [ <introducer> <character set specification> ]+ -- <quote> [ <character representation> ... ] <quote>+ -- [ { <separator> <quote> [ <character representation> ... ] <quote> }... ]+ define "CharacterStringLiteral" [regex $+ opt(introducer ++ characterSetSpecification)+ ++ quote ++ star(characterRepresentation) ++ quote+ ++ star(separator ++ quote ++ star(characterRepresentation) ++ quote)],++ -- <column name> ::= <identifier>+ define "ColumnName" [regex identifier],++ -- <date string> ::= <quote> <unquoted date string> <quote>+ define "DateString" unsupported,++ -- <domain name> ::= <schema qualified name>+ define "DomainName" [regex schemaQualifiedName],++ -- <exact numeric literal> ::=+ -- <unsigned integer> [ <period> [ <unsigned integer> ] ]+ -- | <period> <unsigned integer>+ define "ExactNumericLiteral" [regex $ or [+ unsignedInteger ++ opt (period ++ unsignedInteger),+ period ++ unsignedInteger]],++ -- <left bracket or trigraph> ::= <left bracket> | <left bracket trigraph>+ define "LeftBracketOrTrigraph" [regex $ or [leftBracket, leftBracketTrigraph]],++ -- <right bracket or trigraph> ::= <right bracket> | <right bracket trigraph>+ define "RightBracketOrTrigraph" [regex $ or [rightBracket, rightBracketTrigraph]],++ -- <national character string literal> ::=+ -- N <quote> [ <character representation> ... ] <quote>+ -- [ { <separator> <quote> [ <character representation> ... ] <quote> }... ]+ define "NationalCharacterStringLiteral" unsupported,++ -- <path-resolved user-defined type name> ::= <user-defined type name>+ define "PathResolvedUserDefinedTypeName" [regex userDefinedTypeName],++ -- <table name> ::= <local or schema qualified name>+ define "TableName" [regex localOrSchemaQualifiedName],++ -- <time string> ::= <quote> <unquoted time string> <quote>+ define "TimeString" unsupported,++ -- <timestamp string> ::= <quote> <unquoted timestamp string> <quote>+ define "TimestampLiteral" unsupported,++ -- <Unicode character string literal> ::=+ -- [ <introducer> <character set specification> ]+ -- U <ampersand> <quote> [ <Unicode representation> ... ] <quote>+ -- [ { <separator> <quote> [ <Unicode representation> ... ] <quote> }... ]+ -- [ ESCAPE <escape character> ]+ define "UnicodeCharacterStringLiteral" unsupported,++ -- <unsigned integer> ::= <digit> ...+ define "UnsignedInteger" [regex unsignedInteger]]+ where+ opt pat = par pat ++ "?"+ or pats = par $ L.intercalate "|" (par <$> pats)+ par pat = "(" ++ pat ++ ")"+ plus pat = par pat ++ "+"+ star pat = par pat ++ "*"++ -- <actual identifier> ::= <regular identifier> | <delimited identifier>+ actualIdentifier = regularIdentifier -- Note: this is a simplification++ -- <asterisk> ::= *+ asterisk = "*"++ -- <bracketed comment> ::=+ -- <bracketed comment introducer> <bracketed comment contents> <bracketed comment terminator>+ bracketedComment = bracketedCommentIntroducer ++ bracketedCommentContents ++ bracketedCommentTerminator++ -- <bracketed comment contents> ::= [ { <comment character> | <separator> }... ]+ bracketedCommentContents = star $ or [commentCharacter, separator]++ -- <bracketed comment introducer> ::= <slash> <asterisk>+ bracketedCommentIntroducer = slash ++ asterisk++ -- <bracketed comment terminator> ::= <asterisk> <slash>+ bracketedCommentTerminator = asterisk ++ slash++ -- <catalog name> ::= <identifier>+ catalogName = identifier++ -- <character representation> ::= <nonquote character> | <quote symbol>+ characterRepresentation = or [nonquoteCharacter, quoteSymbol]++ -- <character set specification> ::=+ -- <standard character set name>+ -- | <implementation-defined character set name>+ -- | <user-defined character set name>+ characterSetSpecification = "" -- TODO++ -- <comment> ::= <simple comment> | <bracketed comment>+ comment = or[simpleComment, bracketedComment]++ -- <comment character> ::= <nonquote character> | <quote>+ commentCharacter = or [nonquoteCharacter, quote]++ -- <digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9+ digit = "[0-9]"++ -- <exact numeric literal> ::=+ -- <unsigned integer> [ <period> [ <unsigned integer> ] ]+ -- | <period> <unsigned integer>+ exactNumericLiteral = or [+ unsignedInteger ++ opt (period ++ opt unsignedInteger),+ period ++ unsignedInteger]++ -- <exponent> ::= <signed integer>+ exponent = signedInteger++ -- <identifier> ::= <actual identifier>+ identifier = actualIdentifier++ -- <identifier body> ::= <identifier start> [ <identifier part> ... ]+ identifierBody = identifierStart ++ star identifierPart++ -- <identifier extend> ::= !! See the Syntax Rules.+ identifierExtend = "[0-9_]" -- TODO++ -- <identifier part> ::= <identifier start> | <identifier extend>+ identifierPart = or [identifierStart, identifierExtend]++ -- <identifier start> ::= !! See the Syntax Rules.+ identifierStart = "[A-Za-z]" -- TODO++ -- <introducer> ::= <underscore>+ introducer = underscore++ -- <left bracket> ::= [+ leftBracket = "["++ -- <left bracket trigraph> ::= ??(+ leftBracketTrigraph = "??("++ -- <local or schema qualifier> ::= <schema name> | MODULE+ localOrSchemaQualifier = or [schemaName, "MODULE"]++ -- <local or schema qualified name> ::= [ <local or schema qualifier> <period> ] <qualified identifier>+ localOrSchemaQualifiedName = opt (localOrSchemaQualifier ++ period) ++ qualifiedIdentifier++ -- <mantissa> ::= <exact numeric literal>+ mantissa = exactNumericLiteral++ -- <minus sign> ::= -+ minusSign = "-"++ -- <newline> ::= !! See the Syntax Rules.+ newline = "[\\n]" -- TODO++ -- <nonquote character> ::= !! See the Syntax Rules.+ nonquoteCharacter = "[ -&(-~]" -- TODO++ -- <period> ::= .+ period = "[.]"++ -- <plus sign> ::= ++ plusSign = "+"++ -- <quote> ::= '+ quote = "'"++ -- <quote symbol> ::= <quote> <quote>+ quoteSymbol = quote ++ quote++ -- <qualified identifier> ::= <identifier>+ qualifiedIdentifier = identifier++ -- <regular identifier> ::= <identifier body>+ regularIdentifier = identifierBody++ -- <right bracket> ::= ]+ rightBracket = "]"++ -- <right bracket trigraph> ::= ??)+ rightBracketTrigraph = "??)"++ -- <separator> ::= { <comment> | <white space> }...+ separator = star(or[comment, whiteSpace])++ -- <schema name> ::= [ <catalog name> <period> ] <unqualified schema name>+ schemaName = opt (catalogName ++ period) ++ unqualifiedSchemaName++ -- <schema qualified name> ::= [ <schema name> <period> ] <qualified identifier>+ schemaQualifiedName = opt (schemaName ++ period) ++ qualifiedIdentifier++ -- <schema qualified type name> ::= [ <schema name> <period> ] <qualified identifier>+ schemaQualifiedTypeName = opt (schemaName ++ period) ++ qualifiedIdentifier++ -- <sign> ::= <plus sign> | <minus sign>+ sign = or [plusSign, minusSign]++ -- <signed integer> ::= [ <sign> ] <unsigned integer>+ signedInteger = opt sign ++ unsignedInteger++ -- <simple comment> ::= <simple comment introducer> [ <comment character> ... ] <newline>+ simpleComment = simpleCommentIntroducer ++ star(commentCharacter) ++ newline++ -- <simple comment introducer> ::= <minus sign> <minus sign> [ <minus sign> ... ]+ simpleCommentIntroducer = minusSign ++ plus(minusSign)++ slash = "/"++ -- <underscore> ::= _+ underscore = "_"++ -- <unqualified schema name> ::= <schema name>+ unqualifiedSchemaName = schemaName++ -- <unsigned integer> ::= <digit> ...+ unsignedInteger = plus digit++ -- <user-defined type name> ::= <schema qualified type name>+ userDefinedTypeName = schemaQualifiedTypeName++ whiteSpace = "[ \\t]" -- TODO++productions :: [G.Production]+productions = [+ -- <approximate numeric type> ::=+ -- FLOAT [ <left paren> <precision> <right paren> ]+ -- | REAL+ -- | DOUBLE PRECISION+ define "ApproximateNumericType" [+ "float">: list[float_, opt(parens["Precision"])],+ "real">: real_,+ "double">: double_precision_],++ -- <array element> ::= <value expression>+ define "ArrayElement" [+ "ValueExpression"],++ -- <array element list> ::= <array element> [ { <comma> <array element> }... ]+ define "ArrayElementList" [commaList "ArrayElement"],++ -- <array element reference> ::=+ -- <array value expression> <left bracket or trigraph> <numeric value expression> <right bracket or trigraph>+ define "ArrayElementReference" unsupported,++ -- <array type> ::= <data type> ARRAY [ <left bracket or trigraph> <unsigned integer> <right bracket or trigraph> ]+ define "ArrayType" unsupported,++ -- <array value constructor> ::=+ -- <array value constructor by enumeration>+ -- | <array value constructor by query>+ define "ArrayValueConstructor" [+ "enumeration">: "ArrayValueConstructorByEnumeration",+ "query">: "ArrayValueConstructorByQuery"],++ -- <array value constructor by query> ::=+ -- ARRAY <left paren> <query expression> [ <order by clause> ] <right paren>+ define "ArrayValueConstructorByQuery" unsupported,++ -- <array value constructor by enumeration> ::=+ -- ARRAY <left bracket or trigraph> <array element list> <right bracket or trigraph>+ define "ArrayValueConstructorByEnumeration" [+ list[array_, "LeftBracketOrTrigraph", "ArrayElementList", "RightBracketOrTrigraph"]],++ -- <array value expression> ::= <array concatenation> | <array factor>+ define "ArrayValueExpression" unsupported,++ -- <as subquery clause> ::= [ <left paren> <column name list> <right paren> ] AS <subquery> <with or without data>+ define "AsSubqueryClause" unsupported,++ -- <attribute or method reference> ::=+ -- <value expression primary> <dereference operator> <qualified identifier>+ -- [ <SQL argument list> ]+ define "AttributeOrMethodReference" unsupported,++ -- <binary large object string type> ::=+ -- BINARY LARGE OBJECT [ <left paren> <large object length> <right paren> ]+ -- | BLOB [ <left paren> <large object length> <right paren> ]+ define "BinaryLargeObjectStringType" [+ "binary">: list[binary_large_object_, opt(parens["LargeObjectLength"])],+ "blob">: list[blob_, opt(parens["LargeObjectLength"])]],++ -- <boolean factor> ::= [ NOT ] <boolean test>+ define "BooleanFactor" [+ list[opt(not_), "BooleanTest"]],++ -- <boolean literal> ::= TRUE | FALSE | UNKNOWN+ define "BooleanLiteral" [+ true_,+ false_,+ unknown_],++ -- <boolean predicand> ::=+ -- <parenthesized boolean value expression>+ -- | <nonparenthesized value expression primary>+ define "BooleanPredicand" unsupported,++ -- <boolean primary> ::= <predicate> | <boolean predicand>+ define "BooleanPrimary" [+ "predicate">: "Predicate",+ "predicand">: "BooleanPredicand"],++ -- <boolean term> ::=+ -- <boolean factor>+ -- | <boolean term> AND <boolean factor>+ define "BooleanTerm" [+ "factor">: "BooleanFactor",+ "and">: list[+ "lhs">: "BooleanTerm",+ and_,+ "rhs">: "BooleanFactor"]],++ -- <boolean test> ::= <boolean primary> [ IS [ NOT ] <truth value> ]+ define "BooleanTest" [+ list["BooleanPrimary", opt(list[is_, opt(not_), "TruthValue"])]],++ -- <boolean type> ::= BOOLEAN+ define "BooleanType" [+ boolean_],++ -- <boolean value expression> ::=+ -- <boolean term>+ -- | <boolean value expression> OR <boolean term>+ define "BooleanValueExpression" [+ "term">: "BooleanTerm",+ "or">: list[+ "lhs">: "BooleanValueExpression",+ or_,+ "rhs">: "BooleanTerm"]],++ -- <case expression> ::= <case abbreviation> | <case specification>+ define "CaseExpression" unsupported,++ -- <cast specification> ::= CAST <left paren> <cast operand> AS <cast target> <right paren>+ define "CastSpecification" unsupported,++ -- <character set specification> ::=+ -- <standard character set name>+ -- | <implementation-defined character set name>+ -- | <user-defined character set name>+ define "CharacterSetSpecification" unsupported,++ -- <character string type> ::=+ -- CHARACTER [ <left paren> <length> <right paren> ]+ -- | CHAR [ <left paren> <length> <right paren> ]+ -- | CHARACTER VARYING <left paren> <length> <right paren>+ -- | CHAR VARYING <left paren> <length> <right paren>+ -- | VARCHAR <left paren> <length> <right paren>+ -- | CHARACTER LARGE OBJECT [ <left paren> <large object length> <right paren> ]+ -- | CHAR LARGE OBJECT [ <left paren> <large object length> <right paren> ]+ -- | CLOB [ <left paren> <large object length> <right paren> ]+ define "CharacterStringType" [+ "character">: list[character_, opt(parens["Length"])],+ "char">: list[char_, opt(parens["Length"])],+ "characterVarying">: list[character_varying_, left_paren_, "Length", right_paren_],+ "charVarying">: list[char_varying_, left_paren_, "Length", right_paren_],+ "varchar">: list[varchar_, left_paren_, "Length", right_paren_],+ "characterLargeObject">: list[character_large_object_, opt(parens["LargeObjectLength"])],+ "charLargeObject">: list[char_large_object_, opt(parens["LargeObjectLength"])],+ "clob">: list[clob_, opt(parens["LargeObjectLength"])]],++ -- <collate clause> ::= COLLATE <collation name>+ define "CollateClause" unsupported,++ -- <collection type> ::= <array type> | <multiset type>+ define "CollectionType" [+ "array">: "ArrayType",+ "multiset">: "MultisetType"],++ -- <collection value constructor> ::= <array value constructor> | <multiset value constructor>+ define "CollectionValueConstructor" [+ "array">: "ArrayValueConstructor",+ "multiset">: "MultisetValueConstructor"],++ -- <collection value expression> ::= <array value expression> | <multiset value expression>+ define "CollectionValueExpression" [+ "array">: "ArrayValueExpression",+ "multiset">: "MultisetValueExpression"],++ -- <column constraint definition> ::= [ <constraint name definition> ] <column constraint> [ <constraint characteristics> ]+ define "ColumnConstraintDefinition" unsupported,++ -- <column definition> ::=+ -- <column name> [ <data type> | <domain name> ] [ <reference scope check> ]+ -- [ <default clause> | <identity column specification> | <generation clause> ]+ -- [ <column constraint definition> ... ] [ <collate clause> ]+ define "ColumnDefinition" [+ list[+ "name">: "ColumnName",+ "typeOrDomain">: opt(alts["DataType", "DomainName"]),+ "refScope">: opt"ReferenceScopeCheck",+ "defaultOrIdentityOrGeneration">: opt(alts["DefaultClause", "IdentityColumnSpecification", "GenerationClause"]),+ "constraints">: star"ColumnConstraintDefinition",+ "collate">: opt"CollateClause"]],++ -- <column name list> ::= <column name> [ { <comma> <column name> }... ]+ define "ColumnNameList" [commaList "ColumnName"],++ -- <column options> ::= <column name> WITH OPTIONS <column option list>+ define "ColumnOptions" unsupported,++ -- <column reference> ::=+ -- <basic identifier chain>+ -- | MODULE <period> <qualified identifier> <period> <column name>+ define "ColumnReference" unsupported,++ -- <common value expression> ::=+ -- <numeric value expression>+ -- | <string value expression>+ -- | <datetime value expression>+ -- | <interval value expression>+ -- | <user-defined type value expression>+ -- | <reference value expression>+ -- | <collection value expression>+ define "CommonValueExpression" [+ "numeric">: "NumericValueExpression",+ "string">: "StringValueExpression",+ "datetime">: "DatetimeValueExpression",+ "interval">: "IntervalValueExpression",+ "userDefined">: "UserDefinedTypeValueExpression",+ "reference">: "ReferenceValueExpression",+ "collection">: "CollectionValueExpression"],++ -- <contextually typed row value expression> ::=+ -- <row value special case>+ -- | <contextually typed row value constructor>+ define "ContextuallyTypedRowValueExpression" [+ "specialCase">: "RowValueSpecialCase",+ "constructor">: "ContextuallyTypedRowValueConstructor"],++ -- <contextually typed row value constructor> ::=+ -- <common value expression>+ -- | <boolean value expression>+ -- | <contextually typed value specification>+ -- | <left paren> <contextually typed row value constructor element> <comma> <contextually typed row value constructor element list> <right paren>+ -- | ROW <left paren> <contextually typed row value constructor element list> <right paren>+ define "ContextuallyTypedRowValueConstructor" unsupported,++ -- <contextually typed row value expression list> ::= <contextually typed row value expression> [ { <comma> <contextually typed row value expression> }... ]+ define "ContextuallyTypedRowValueExpressionList" [commaList "ContextuallyTypedRowValueExpression"],++ -- <contextually typed table value constructor> ::= VALUES <contextually typed row value expression list>+ define "ContextuallyTypedTableValueConstructor" [+ list[values_, "ContextuallyTypedRowValueExpressionList"]],++ -- <data type> ::=+ -- <predefined type>+ -- | <row type>+ -- | <path-resolved user-defined type name>+ -- | <reference type>+ -- | <collection type>+ define "DataType" [+ "predefined">: "PredefinedType",+ "row">: "RowType",+ "named">: "PathResolvedUserDefinedTypeName",+ "reference">: "ReferenceType",+ "collection">: "CollectionType"],++ -- <date literal> ::= DATE <date string>+ define "DateLiteral" [+ list[date_, "DateString"]],++ -- <datetime literal> ::= <date literal> | <time literal> | <timestamp literal>+ define "DatetimeLiteral" [+ "date">: "DateLiteral",+ "time">: "TimeLiteral",+ "timestamp">: "TimestampLiteral"],++ -- <datetime type> ::=+ -- DATE+ -- | TIME [ <left paren> <time precision> <right paren> ] [ <with or without time zone> ]+ -- | TIMESTAMP [ <left paren> <timestamp precision> <right paren> ] [ <with or without time zone> ]+ define "DatetimeType" unsupported,++ -- <datetime value expression> ::=+ -- <datetime term>+ -- | <interval value expression> <plus sign> <datetime term>+ -- | <datetime value expression> <plus sign> <interval term>+ -- | <datetime value expression> <minus sign> <interval term>+ define "DatetimeValueExpression" unsupported,++ -- <default clause> ::= DEFAULT <default option>+ define "DefaultClause" unsupported,++ -- <exact numeric type> ::=+ -- NUMERIC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+ -- | DECIMAL [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+ -- | DEC [ <left paren> <precision> [ <comma> <scale> ] <right paren> ]+ -- | SMALLINT+ -- | INTEGER+ -- | INT+ -- | BIGINT+ define "ExactNumericType" [+ "numeric">: list[numeric_, opt(parens["Precision", opt(list[comma_, "Scale"])])],+ "decimal">: list[decimal_, opt(parens["Precision", opt(list[comma_, "Scale"])])],+ "dec">: list[dec_, opt(parens["Precision", opt(list[comma_, "Scale"])])],+ "smallint">: smallint_,+ "integer">: integer_,+ "int">: int_,+ "bigint">: bigint_],++ -- <field reference> ::= <value expression primary> <period> <field name>+ define "FieldReference" unsupported,++ -- <from constructor> ::=+ -- [ <left paren> <insert column list> <right paren> ] [ <override clause> ] <contextually typed table value constructor>+ define "FromConstructor" [+ list[+ "columns">: opt(parens["InsertColumnList"]),+ "override">: opt"OverrideClause",+ "values">: "ContextuallyTypedTableValueConstructor"]],++ -- <from default> ::= DEFAULT VALUES+ define "FromDefault" [+ default_values_],++ -- <from subquery> ::= [ <left paren> <insert column list> <right paren> ] [ <override clause> ] <query expression>+ define "FromSubquery" unsupported,++ -- <general literal> ::=+ -- <character string literal>+ -- | <national character string literal>+ -- | <Unicode character string literal>+ -- | <binary string literal>+ -- | <datetime literal>+ -- | <interval literal>+ -- | <boolean literal>+ define "GeneralLiteral" [+ "string">: "CharacterStringLiteral",+ "nationalString">: "NationalCharacterStringLiteral",+ "unicode">: "UnicodeCharacterStringLiteral",+ "binary">: "BinaryStringLiteral",+ "dateTime">: "DatetimeLiteral",+ "interval">: "IntervalLiteral",+ "boolean">: "BooleanLiteral"],++ -- <general value specification> ::=+ -- <host parameter specification>+ -- | <SQL parameter reference>+ -- | <dynamic parameter specification>+ -- | <embedded variable specification>+ -- | <current collation specification>+ -- | CURRENT_DEFAULT_TRANSFORM_GROUP+ -- | CURRENT_PATH+ -- | CURRENT_ROLE+ -- | CURRENT_TRANSFORM_GROUP_FOR_TYPE <path-resolved user-defined type name>+ -- | CURRENT_USER+ -- | SESSION_USER+ -- | SYSTEM_USER+ -- | USER+ -- | VALUE+ define "GeneralValueSpecification" unsupported,++ -- <generation clause> ::= <generation rule> AS <generation expression>+ define "GenerationClause" unsupported,++ -- <global or local> ::= GLOBAL | LOCAL+ define "GlobalOrLocal" [+ "global">: global_,+ "local">: local_],++ -- <identity column specification> ::=+ -- GENERATED { ALWAYS | BY DEFAULT } AS IDENTITY+ -- [ <left paren> <common sequence generator options> <right paren> ]+ define "IdentityColumnSpecification" unsupported,++ -- <insert column list> ::= <column name list>+ define "InsertColumnList" [+ "ColumnNameList"],++ -- <insert columns and source> ::=+ -- <from subquery>+ -- | <from constructor>+ -- | <from default>+ define "InsertColumnsAndSource" [+ "subquery">: "FromSubquery",+ "constructor">: "FromConstructor",+ "default">: "FromDefault"],++ -- <insert statement> ::= INSERT INTO <insertion target> <insert columns and source>+ define "InsertStatement" [+ list[+ insert_into_,+ "target">: "InsertionTarget",+ "columnsAndSource">: "InsertColumnsAndSource"]],++ -- <insertion target> ::= <table name>+ define "InsertionTarget" [+ "TableName"],++ -- <interval literal> ::= INTERVAL [ <sign> ] <interval string> <interval qualifier>+ define "IntervalLiteral" unsupported,++ -- <interval type> ::= INTERVAL <interval qualifier>+ define "IntervalType" unsupported,++ -- <interval value expression> ::=+ -- <interval term>+ -- | <interval value expression 1> <plus sign> <interval term 1>+ -- | <interval value expression 1> <minus sign> <interval term 1>+ -- | <left paren> <datetime value expression> <minus sign> <datetime term> <right paren> <interval qualifier>+ define "IntervalValueExpression" unsupported,++ -- <large object length> ::=+ -- <unsigned integer> [ <multiplier> ] [ <char length units> ]+ -- | <large object length token> [ <char length units> ]+ define "LargeObjectLength" unsupported,++ -- <length> ::= <unsigned integer>+ define "Length" [+ "UnsignedInteger"],++ -- <like clause> ::= LIKE <table name> [ <like options> ]+ define "LikeClause" unsupported,++ -- <method invocation> ::= <direct invocation> | <generalized invocation>+ define "MethodInvocation" unsupported,++ -- <multiset element reference> ::=+ -- ELEMENT <left paren> <multiset value expression> <right paren>+ define "MultisetElementReference" unsupported,++ -- <multiset type> ::= <data type> MULTISET+ define "MultisetType" [+ list["DataType", multiset_]],++ -- <multiset value constructor> ::=+ -- <multiset value constructor by enumeration>+ -- | <multiset value constructor by query>+ -- | <table value constructor by query>+ define "MultisetValueConstructor" unsupported,++ -- <multiset value expression> ::=+ -- <multiset term>+ -- | <multiset value expression> MULTISET UNION [ ALL | DISTINCT ] <multiset term>+ -- | <multiset value expression> MULTISET EXCEPT [ ALL | DISTINCT ] <multiset term>+ define "MultisetValueExpression" unsupported,++ -- <national character string type> ::=+ -- NATIONAL CHARACTER [ <left paren> <length> <right paren> ]+ -- | NATIONAL CHAR [ <left paren> <length> <right paren> ]+ -- | NCHAR [ <left paren> <length> <right paren> ]+ -- | NATIONAL CHARACTER VARYING <left paren> <length> <right paren>+ -- | NATIONAL CHAR VARYING <left paren> <length> <right paren>+ -- | NCHAR VARYING <left paren> <length> <right paren>+ -- | NATIONAL CHARACTER LARGE OBJECT [ <left paren> <large object length> <right paren> ]+ -- | NCHAR LARGE OBJECT [ <left paren> <large object length> <right paren> ]+ -- | NCLOB [ <left paren> <large object length> <right paren> ]+ define "NationalCharacterStringType" unsupported,++ -- <new specification> ::= NEW <routine invocation>+ define "NewSpecification" unsupported,++ -- <next value expression> ::= NEXT VALUE FOR <sequence generator name>+ define "NextValueExpression" unsupported,++ -- <numeric type> ::= <exact numeric type> | <approximate numeric type>+ define "NumericType" [+ "exact">: "ExactNumericType",+ "approximate">: "ApproximateNumericType"],++ -- <numeric value expression> ::=+ -- <term>+ -- | <numeric value expression> <plus sign> <term>+ -- | <numeric value expression> <minus sign> <term>+ define "NumericValueExpression" unsupported,++ -- <override clause> ::= OVERRIDING USER VALUE | OVERRIDING SYSTEM VALUE+ define "OverrideClause" [+ overriding_user_value_,+ overriding_system_value],++ -- <parenthesized value expression> ::= <left paren> <value expression> <right paren>+ define "ParenthesizedValueExpression" [+ parens["ValueExpression"]],++ -- <precision> ::= <unsigned integer>+ define "Precision" [+ "UnsignedInteger"],++ -- <predefined type> ::=+ -- <character string type> [ CHARACTER SET <character set specification> ] [ <collate clause> ]+ -- | <national character string type> [ <collate clause> ]+ -- | <binary large object string type>+ -- | <numeric type>+ -- | <boolean type>+ -- | <datetime type>+ -- | <interval type>+ 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"],++ -- <predicate> ::=+ -- <comparison predicate>+ -- | <between predicate>+ -- | <in predicate>+ -- | <like predicate>+ -- | <similar predicate>+ -- | <null predicate>+ -- | <quantified comparison predicate>+ -- | <exists predicate>+ -- | <unique predicate>+ -- | <normalized predicate>+ -- | <match predicate>+ -- | <overlaps predicate>+ -- | <distinct predicate>+ -- | <member predicate>+ -- | <submultiset predicate>+ -- | <set predicate>+ -- | <type predicate>+ define "Predicate" unsupported,++ -- <query expression> ::= [ <with clause> ] <query expression body>+ define "QueryExpression" unsupported,++ -- <reference scope check> ::= REFERENCES ARE [ NOT ] CHECKED [ ON DELETE <reference scope check action> ]+ define "ReferenceScopeCheck" unsupported,++ -- <reference type> ::= REF <left paren> <referenced type> <right paren> [ <scope clause> ]+ define "ReferenceType" unsupported,++ -- <row type> ::= ROW <row type body>+ define "RowType" unsupported,++ -- <row value special case> ::= <nonparenthesized value expression primary>+ define "RowValueSpecialCase" [+ "NonparenthesizedValueExpressionPrimary"],++ -- <nonparenthesized value expression primary> ::=+ -- <unsigned value specification>+ -- | <column reference>+ -- | <set function specification>+ -- | <window function>+ -- | <scalar subquery>+ -- | <case expression>+ -- | <cast specification>+ -- | <field reference>+ -- | <subtype treatment>+ -- | <method invocation>+ -- | <static method invocation>+ -- | <new specification>+ -- | <attribute or method reference>+ -- | <reference resolution>+ -- | <collection value constructor>+ -- | <array element reference>+ -- | <multiset element reference>+ -- | <routine invocation>+ -- | <next value expression>+ 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"],++ -- <reference resolution> ::= DEREF <left paren> <reference value expression> <right paren>+ define "ReferenceResolution" unsupported,++ -- <reference value expression> ::= <value expression primary>+ define "ReferenceValueExpression" [+ "ValueExpressionPrimary"],++ -- <row value expression> ::=+ -- <row value special case>+ -- | <explicit row value constructor>+ define "RowValueExpression" unsupported,++ -- <routine invocation> ::= <routine name> <SQL argument list>+ define "RoutineInvocation" unsupported,++ -- <scalar subquery> ::= <subquery>+ define "ScalarSubquery" [+ "Subquery"],++ -- <scale> ::= <unsigned integer>+ define "Scale" [+ "UnsignedInteger"],++ -- <self-referencing column specification> ::= REF IS <self-referencing column name> <reference generation>+ define "SelfReferencingColumnSpecification" unsupported,++ -- <set function specification> ::= <aggregate function> | <grouping operation>+ define "SetFunctionSpecification" unsupported,++ -- <static method invocation> ::=+ -- <path-resolved user-defined type name> <double colon> <method name> [ <SQL argument list> ]+ define "StaticMethodInvocation" unsupported,++ -- <string value expression> ::= <character value expression> | <blob value expression>+ define "StringValueExpression" unsupported,++ -- <subquery> ::= <left paren> <query expression> <right paren>+ define "Subquery" [+ parens["QueryExpression"]],++ -- <subtable clause> ::= UNDER <supertable clause>+ define "SubtableClause" unsupported,++ -- <subtype treatment> ::=+ -- TREAT <left paren> <subtype operand> AS <target subtype> <right paren>+ define "SubtypeTreatment" unsupported,++ -- <table commit action> ::= PRESERVE | DELETE+ define "TableCommitAction" [+ "preserve">: preserve_,+ "delete">: delete_],++ -- <table constraint definition> ::= [ <constraint name definition> ] <table constraint> [ <constraint characteristics> ]+ define "TableConstraintDefinition" unsupported,++ -- <table contents source> ::=+ -- <table element list>+ -- | OF <path-resolved user-defined type name> [ <subtable clause> ] [ <table element list> ]+ -- | <as subquery clause>+ define "TableContentsSource" [+ "list">: "TableElementList",+ "subtable">: list [+ of_,+ "type">: "PathResolvedUserDefinedTypeName",+ "subtable">: opt"SubtableClause",+ "elements">: opt"TableElementList"],+ "subquery">: "AsSubqueryClause"],++ -- <table definition> ::=+ -- CREATE [ <table scope> ] TABLE <table name> <table contents source>+ -- [ ON COMMIT <table commit action> ROWS ]+ define "TableDefinition" [+ list[+ create_,+ "scope">: opt"TableScope",+ table_,+ "name">: "TableName",+ "source">: "TableContentsSource",+ "commitActions">: opt(list[on_commit_, "TableCommitAction", rows_])]],++ -- <table element> ::=+ -- <column definition>+ -- | <table constraint definition>+ -- | <like clause>+ -- | <self-referencing column specification>+ -- | <column options>+ define "TableElement" [+ "column">: "ColumnDefinition",+ "tableConstraint">: "TableConstraintDefinition",+ "like">: "LikeClause",+ "selfReferencingColumn">: "SelfReferencingColumnSpecification",+ "columOptions">: "ColumnOptions"],++ -- <table element list> ::= <left paren> <table element> [ { <comma> <table element> }... ] <right paren>+ define "TableElementList" [+ parens[commaList "TableElement"]],++ -- <table scope> ::= <global or local> TEMPORARY+ define "TableScope" [+ list["GlobalOrLocal", temporary_]],++ -- <time literal> ::= TIME <time string>+ define "TimeLiteral" [+ list[time_, "TimeString"]],++ define "TruthValue" [+ true_,+ false_,+ unknown_],++ -- <unsigned literal> ::= <unsigned numeric literal> | <general literal>+ define "UnsignedLiteral" [+ "numeric">: "UnsignedNumericLiteral",+ "general">: "GeneralLiteral"],++ -- <unsigned numeric literal> ::= <exact numeric literal> | <approximate numeric literal>+ define "UnsignedNumericLiteral" [+ "exact">: "ExactNumericLiteral",+ "approximate">: "ApproximateNumericLiteral"],++ -- <unsigned value specification> ::= <unsigned literal> | <general value specification>+ define "UnsignedValueSpecification" [+ "literal">: "UnsignedLiteral",+ "general">: "GeneralValueSpecification"],++ -- <user-defined type value expression> ::= <value expression primary>+ define "UserDefinedTypeValueExpression" [+ "ValueExpressionPrimary"],++ -- <value expression> ::=+ -- <common value expression>+ -- | <boolean value expression>+ -- | <row value expression>+ define "ValueExpression" [+ "common">: "CommonValueExpression",+ "boolean">: "BooleanValueExpression",+ "row">: "RowValueExpression"],++ -- <value expression primary> ::=+ -- <parenthesized value expression>+ -- | <nonparenthesized value expression primary>+ define "ValueExpressionPrimary" [+ "parens">: "ParenthesizedValueExpression",+ "noparens">: "NonparenthesizedValueExpressionPrimary"],++ -- <window function> ::= <window function type> OVER <window name or specification>+ define "WindowFunction" unsupported]++and_ = terminal "AND"+array_ = terminal "ARRAY"+bigint_ = terminal "BIGINT"+binary_large_object_ = terminal "BINARY LARGE OBJECT"+blob_ = terminal "BLOB"+boolean_ = terminal "BOOLEAN"+char_ = terminal "CHAR"+char_large_object_ = terminal "CHAR LARGE OBJECT"+char_varying_ = terminal "CHAR VARYING"+character_ = terminal "CHARACTER"+character_large_object_ = terminal "CHARACTER LARGE OBJECT"+character_set_ = terminal "CHARACTER SET"+character_varying_ = terminal "CHARACTER VARYING"+clob_ = terminal "CLOB"+comma_ = terminal ","+create_ = terminal "CREATE"+date_ = terminal "DATE"+dec_ = terminal "DEC"+decimal_ = terminal "DECIMAL"+default_values_ = terminal "DEFAULT VALUES"+delete_ = terminal "DELETE"+double_precision_ = terminal "DOUBLE PRECISION"+false_ = terminal "FALSE"+float_ = terminal "FLOAT"+global_ = terminal "GLOBAL"+insert_into_ = terminal "INSERT INTO"+int_ = terminal "INT"+integer_ = terminal "INTEGER"+is_ = terminal "IS"+left_paren_ = terminal "("+local_ = terminal "LOCAL"+multiset_ = terminal "MULTISET"+numeric_ = terminal "NUMERIC"+of_ = terminal "OF"+not_ = terminal "NOT"+on_commit_ = terminal "ON COMMIT"+or_ = terminal "OR"+overriding_user_value_ = terminal "OVERRIDING USER VALUE"+overriding_system_value = terminal "OVERRIDING SYSTEM VALUE"+preserve_ = terminal "PRESERVE"+real_ = terminal "REAL"+right_paren_ = terminal ")"+rows_ = terminal "ROWS"+smallint_ = terminal "SMALLINT"+table_ = terminal "TABLE"+temporary_ = terminal "TEMPORARY"+time_ = terminal "TIME"+true_ = terminal "TRUE"+unknown_ = terminal "UNKNOWN"+values_ = terminal "VALUES"+varchar_ = terminal "VARCHAR"++commaList pat = list[+ "first">: pat,+ "rest">: star(list[comma_, pat])]+parens ps = list $ [left_paren_] ++ ps ++ [right_paren_]+unsupported = [terminal "unsupported"]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tabular.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.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/langs/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")]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Features.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.Tinkerpop.Features where++import Hydra.Sources.Tier3.All+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types+++tinkerpopFeaturesModule :: Module+tinkerpopFeaturesModule = Module ns elements [hydraCoreModule] tier0Modules $+ Just ("A model derived from TinkerPop's Graph.Features. See\n" +++ " https://tinkerpop.apache.org/javadocs/current/core/org/apache/tinkerpop/gremlin/structure/Graph.Features.html\n" +++ "\n" +++ "An interface that represents the capabilities of a Graph implementation.\n" +++ "By default all methods of features return true and it is up to implementers to disable feature they don't support.\n" +++ "Users should check features prior to using various functions of TinkerPop to help ensure code portability across implementations.\n" +++ "For example, a common usage would be to check if a graph supports transactions prior to calling the commit method on Graph.tx().")+ where+ ns = Namespace "hydra/langs/tinkerpop/features"+ core = typeref $ moduleNamespace hydraCoreModule+ features = typeref ns+ def = datatype ns+ supports name comment = ("supports" ++ capitalize name)>: doc comment boolean++ elements = [++ def "DataTypeFeatures" $+ doc "Base interface for features that relate to supporting different data types." $+ record [+ supports "booleanArrayValues" "Supports setting of an array of boolean values.",+ supports "booleanValues" "Supports setting of a boolean value.",+ supports "byteArrayValues" "Supports setting of an array of byte values.",+ supports "byteValues" "Supports setting of a byte value.",+ supports "doubleArrayValues" "Supports setting of an array of double values.",+ supports "doubleValues" "Supports setting of a double value.",+ supports "floatArrayValues" "Supports setting of an array of float values.",+ supports "floatValues" "Supports setting of a float value.",+ supports "integerArrayValues" "Supports setting of an array of integer values.",+ supports "integerValues" "Supports setting of a integer value.",+ supports "longArrayValues" "Supports setting of an array of long values.",+ supports "longValues" "Supports setting of a long value.",+ supports "mapValues" "Supports setting of a Map value.",+ supports "mixedListValues" "Supports setting of a List value.",+ supports "serializableValues" "Supports setting of a Java serializable value.",+ supports "stringArrayValues" "Supports setting of an array of string values.",+ supports "stringValues" "Supports setting of a string value.",+ supports "uniformListValues" "Supports setting of a List value."],++ def "EdgeFeatures" $+ doc "Features that are related to Edge operations." $+ record [+ "elementFeatures">: features "ElementFeatures",+ "properties">: features "EdgePropertyFeatures",+ supports "addEdges" "Determines if an Edge can be added to a Vertex.",+ supports "removeEdges" "Determines if an Edge can be removed from a Vertex.",+ supports "upsert" ("Determines if the Graph implementation uses upsert functionality as opposed to insert " +++ "functionality for Vertex.addEdge(String, Vertex, Object...).")],++ def "EdgePropertyFeatures" $+ doc "Features that are related to Edge Property objects." $+ record [+ "propertyFeatures">: features "PropertyFeatures"],++ def "ElementFeatures" $+ doc "Features that are related to Element objects." $+ record [+ supports "addProperty" "Determines if an Element allows properties to be added.",+ supports "anyIds" "Determines if an Element any Java object is a suitable identifier.",+ supports "customIds" "Determines if an Element has a specific custom object as their internal representation.",+ supports "numericIds" "Determines if an Element has numeric identifiers as their internal representation.",+ supports "removeProperty" "Determines if an Element allows properties to be removed.",+ supports "stringIds" "Determines if an Element has string identifiers as their internal representation.",+ supports "userSuppliedIds" "Determines if an Element can have a user defined identifier.",+ supports "uuidIds" "Determines if an Element has UUID identifiers as their internal representation."+-- , "willAllowId" $+-- doc "Determines if an identifier will be accepted by the Graph." $+-- function (v3 "Id") boolean+ ],++ def "ExtraFeatures" $+ doc ("Additional features which are needed for the complete specification of language constraints in Hydra, "+ ++ "above and beyond TinkerPop Graph.Features") $+ lambda "a" $ record [+ "supportsMapKey">: function (core "Type") boolean],++ def "Features" $+ doc ("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().\n\n" +++ "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.") $+ record [+ "edge">: doc "Gets the features related to edge operation." $+ features "EdgeFeatures",+ "graph">: doc "Gets the features related to graph operation." $+ features "GraphFeatures",+ "vertex">: doc "Gets the features related to vertex operation." $+ features "VertexFeatures"],++ def "GraphFeatures" $+ doc "Features specific to a operations of a graph." $+ record [+ supports "computer" "Determines if the Graph implementation supports GraphComputer based processing.",+ supports "concurrentAccess" "Determines if the Graph implementation supports more than one connection to the same instance at the same time.",+ supports "ioRead" "Determines if the Graph implementations supports read operations as executed with the GraphTraversalSource.io(String) step.",+ supports "ioWrite" "Determines if the Graph implementations supports write operations as executed with the GraphTraversalSource.io(String) step.",+ supports "persistence" "Determines if the Graph implementation supports persisting it's contents natively to disk.",+ supports "threadedTransactions" "Determines if the Graph implementation supports threaded transactions which allow a transaction to be executed across multiple threads via Transaction.createThreadedTx().",+ supports "transactions" "Determines if the Graph implementations supports transactions.",+ "variables">:+ doc "Gets the features related to graph sideEffects operation." $+ features "VariableFeatures"+ ],++ def "PropertyFeatures" $+ doc "A base interface for Edge or Vertex Property features." $+ record [+ "dataTypeFeatures">: features "DataTypeFeatures",+ supports "properties" "Determines if an Element allows for the processing of at least one data type defined by the features."],++ def "VariableFeatures" $+ doc "Features for Graph.Variables." $+ record [+ "dataTypeFeatures">: features "DataTypeFeatures",+ supports "variables" "If any of the features on Graph.Features.VariableFeatures is true then this value must be true."],++ def "VertexFeatures" $+ doc "Features that are related to Vertex operations." $+ record [+ "elementFeatures">: features "ElementFeatures",+-- "getCardinality" $ function (v3 "PropertyKey") (v3 "VertexProperty.Cardinality"),+ "properties">: features "VertexPropertyFeatures",+ supports "addVertices" "Determines if a Vertex can be added to the Graph.",+ supports "duplicateMultiProperties" "Determines if a Vertex can support non-unique values on the same key.",+ supports "metaProperties" "Determines if a Vertex can support properties on vertex properties.",+ supports "multiProperties" "Determines if a Vertex can support multiple properties with the same key.",+ supports "removeVertices" "Determines if a Vertex can be removed from the Graph.",+ supports "upsert" ("Determines if the Graph implementation uses upsert functionality as opposed to insert " +++ "functionality for Graph.addVertex(String).")],++ def "VertexPropertyFeatures" $+ doc "Features that are related to Vertex Property objects." $+ record [+ "dataTypeFeatures">: features "DataTypeFeatures",+ "propertyFeatures">: features "PropertyFeatures",+ -- Note: re-using ElementFeatures here rather than repeating the individual features (which are identical)+ "elementFeatures">: features "ElementFeatures",+ supports "remove" "Determines if a VertexProperty allows properties to be removed."]++-- , def "VertexProperty.Cardinality" $+-- enum ["list", "set", "single"]+ ]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Gremlin.hs view
@@ -0,0 +1,3547 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.Tinkerpop.Gremlin where++import Hydra.Sources.Tier3.All+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types++import Hydra.Sources.Core+++gremlinModule :: Module+gremlinModule = Module ns elements [hydraCoreModule] tier0Modules $+ Just ("A Gremlin model, based on the Gremlin ANTLR grammar "+ ++ "(master branch, as of 2024-06-30).")+ where+ ns = Namespace "hydra/langs/tinkerpop/gremlin"+ gremlin = typeref ns+ def = datatype ns++ defArgument name typ = def name $ union [+ "value">: typ,+ "variable">: variable]++ booleanLiteral = boolean+ booleanArgument = gremlin "BooleanArgument"+ classType = identifier+ dateArgument = gremlin "DateArgument"+ dateLiteral = gremlin "DateLiteral"+ floatArgument = gremlin "FloatArgument"+ floatLiteral = gremlin "FloatLiteral"+ genericLiteral = gremlin "GenericLiteral"+ genericLiteralArgument = gremlin "GenericLiteralArgument"+ genericLiteralCollection = gremlin "GenericLiteralCollection"+ genericLiteralList = gremlin "GenericLiteralList"+ genericLiteralMap = gremlin "GenericLiteralMap"+ genericLiteralMapArgument = gremlin "GenericLiteralMapArgument"+ genericLiteralMapNullableArgument = gremlin "GenericLiteralMapNullableArgument"+ genericLiteralRange = gremlin "GenericLiteralRange"+ genericLiteralSet = gremlin "GenericLiteralSet"+ genericLiteralVarargs = nonemptyList genericLiteralArgument+ identifier = gremlin "Identifier"+ integerArgument = gremlin "IntegerArgument"+ integerLiteral = gremlin "IntegerLiteral"+ keyword = gremlin "Keyword"+ nestedTraversal = gremlin "NestedTraversal"+ nestedTraversalList = list nestedTraversal+ numericLiteral = gremlin "NumericLiteral"+ optionalGenericLiteralVarargs = list genericLiteralArgument+ optionalStringLiteralVarargs = list stringNullableArgument+ stringArgument = gremlin "StringArgument"+ stringLiteral = string+ stringLiteralVarargs = nonemptyList stringNullableArgument+ stringNullableArgument = gremlin "StringNullableArgument"+ stringNullableLiteral = optional stringLiteral+ structureVertex = gremlin "StructureVertex"+ structureVertexArgument = gremlin "StructureVertexArgument"+ terminatedTraversal = gremlin "TerminatedTraversal"+ traversalBarrier = unit+ traversalBiFunctionArgument = gremlin "TraversalBiFunctionArgument"+ traversalCardinality = gremlin "TraversalCardinality"+ traversalCardinalityArgument = gremlin "TraversalCardinalityArgument"+ traversalColumn = gremlin "TraversalColumn"+ traversalColumnArgument = gremlin "TraversalColumnArgument"+ traversalComparator = traversalOrder+ traversalComparatorArgument = gremlin "TraversalComparatorArgument"+ traversalDT = gremlin "TraversalDT"+ traversalDirection = gremlin "TraversalDirection"+ traversalDirectionArgument = gremlin "TraversalDirectionArgument"+ traversalFunction = gremlin "TraversalFunction"+ traversalFunctionArgument = gremlin "TraversalFunctionArgument"+ traversalMergeArgument = gremlin "TraversalMergeArgument"+ traversalOperator = gremlin "TraversalOperator"+ traversalOrder = gremlin "TraversalOrder"+ traversalOrderArgument = gremlin "TraversalOrderArgument"+ traversalMerge = gremlin "TraversalMerge"+ traversalMethod = gremlin "TraversalMethod"+ traversalPick = gremlin "TraversalPick"+ traversalPop = gremlin "TraversalPop"+ traversalPopArgument = gremlin "TraversalPopArgument"+ traversalPredicate = gremlin "TraversalPredicate"+ traversalSackMethod = traversalBarrier+ traversalScope = gremlin "TraversalScope"+ traversalScopeArgument = gremlin "TraversalScopeArgument"+ traversalToken = gremlin "TraversalToken"+ traversalTokenArgument = gremlin "TraversalTokenArgument"+ variable = identifier++ elements = [++-- /*+-- * Licensed to the Apache Software Foundation (ASF) under one+-- * or more contributor license agreements. See the NOTICE file+-- * distributed with this work for additional information+-- * regarding copyright ownership. The ASF licenses this file+-- * to you under the Apache License, Version 2.0 (the+-- * "License"); you may not use this file except in compliance+-- * with the License. You may obtain a copy of the License at+-- *+-- * http://www.apache.org/licenses/LICENSE-2.0+-- *+-- * Unless required by applicable law or agreed to in writing,+-- * software distributed under the License is distributed on an+-- * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY+-- * KIND, either express or implied. See the License for the+-- * specific language governing permissions and limitations+-- * under the License.+-- */+-- grammar Gremlin;+--+-- /*********************************************+-- PARSER RULES+-- **********************************************/+--+-- queryList+-- : query (SEMI? query)* SEMI? EOF+-- ;++ def "QueryList" $ nonemptyList $ gremlin "Query",++-- query+ def "Query" $ union [+-- : traversalSource+-- | traversalSource DOT transactionPart+ "traversalSource">: gremlin "TraversalSourceQuery",+-- | rootTraversal+-- | rootTraversal DOT traversalTerminalMethod+ "rootTraversal">: gremlin "RootTraversalQuery",+-- | query DOT 'toString' LPAREN RPAREN+ "toString">: unit,+-- | emptyQuery+ "empty">: unit],+-- ;++ def "TraversalSourceQuery" $ record [+ "source">: gremlin "TraversalSource",+ "transactionPart">: optional $ gremlin "TransactionPart"],++ def "RootTraversalQuery" $ record [+ "root">: gremlin "RootTraversal",+ "terminalMethod">: optional $ gremlin "TraversalTerminalMethod"],++-- emptyQuery+-- : EmptyStringLiteral+-- ;+--+-- traversalSource+-- : TRAVERSAL_ROOT+-- | TRAVERSAL_ROOT DOT traversalSourceSelfMethod+-- | traversalSource DOT traversalSourceSelfMethod+-- ;++ def "TraversalSource" $ list $ gremlin "TraversalSourceSelfMethod",++-- transactionPart+-- : 'tx' LPAREN RPAREN DOT 'begin' LPAREN RPAREN+-- | 'tx' LPAREN RPAREN DOT 'commit' LPAREN RPAREN+-- | 'tx' LPAREN RPAREN DOT 'rollback' LPAREN RPAREN+-- ;++ def "TransactionPart" $ enum [+ "begin",+ "commit",+ "rollback"],++-- rootTraversal+-- : traversalSource DOT traversalSourceSpawnMethod+-- | traversalSource DOT traversalSourceSpawnMethod DOT chainedTraversal+-- | traversalSource DOT traversalSourceSpawnMethod DOT chainedParentOfGraphTraversal+-- ;++ def "RootTraversal" $ record [+ "source">: gremlin "TraversalSource",+ "spawnMethod">: gremlin "TraversalSourceSpawnMethod",+ "chained">: list $ gremlin "ChainedTraversalElement"],++-- traversalSourceSelfMethod+ def "TraversalSourceSelfMethod" $ union [+-- : traversalSourceSelfMethod_withBulk+ "withBulk">: boolean,+-- | traversalSourceSelfMethod_withPath+ "withPath">: unit,+-- | traversalSourceSelfMethod_withSack+ "withSack">: gremlin "GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument",+-- | traversalSourceSelfMethod_withSideEffect+ "withSideEffect">: gremlin "StringArgumentAndGenericLiteralArgument",+-- | traversalSourceSelfMethod_withStrategies+ "withStrategies">: nonemptyList $ gremlin "TraversalStrategy",+-- | traversalSourceSelfMethod_withoutStrategies+ "withoutStrategies">: nonemptyList classType,+-- | traversalSourceSelfMethod_with+ "with">: gremlin "StringArgumentAndOptionalGenericLiteralArgument"],+-- ;++-- traversalSourceSelfMethod_withBulk+-- : 'withBulk' LPAREN booleanArgument RPAREN+-- ;+--+-- traversalSourceSelfMethod_withPath+-- : 'withPath' LPAREN RPAREN+-- ;+--+-- traversalSourceSelfMethod_withSack+-- : 'withSack' LPAREN genericLiteralArgument RPAREN+-- | 'withSack' LPAREN genericLiteralArgument COMMA traversalBiFunctionArgument RPAREN+-- ;++ def "GenericLiteralArgumentAndOptionalTraversalBiFunctionArgument" $ record [+ "literal">: genericLiteralArgument,+ "biFunction">: optional traversalBiFunctionArgument],++-- traversalSourceSelfMethod_withSideEffect+-- : 'withSideEffect' LPAREN stringArgument COMMA genericLiteralArgument RPAREN+-- ;++ def "StringArgumentAndGenericLiteralArgument" $ record [+ "string">: stringArgument,+ "literal">: genericLiteralArgument],++-- traversalSourceSelfMethod_withStrategies+-- : 'withStrategies' LPAREN traversalStrategy (COMMA traversalStrategyList)? RPAREN+-- ;+--+-- traversalSourceSelfMethod_withoutStrategies+-- : 'withoutStrategies' LPAREN classType (COMMA classTypeList)? RPAREN+-- ;+--+-- traversalSourceSelfMethod_with+-- : 'with' LPAREN stringArgument RPAREN+-- | 'with' LPAREN stringArgument COMMA genericLiteralArgument RPAREN+-- ;++ def "StringArgumentAndOptionalGenericLiteralArgument" $ record [+ "string">: stringArgument,+ "literal">: optional genericLiteralArgument],++-- traversalSourceSpawnMethod+ def "TraversalSourceSpawnMethod" $ union [+-- : traversalSourceSpawnMethod_addE+ "addE">: gremlin "StringArgumentOrNestedTraversal",+-- | traversalSourceSpawnMethod_addV+ "addV">: optional $ gremlin "StringArgumentOrNestedTraversal",+-- | traversalSourceSpawnMethod_E+ "e">: genericLiteralVarargs,+-- | traversalSourceSpawnMethod_V+ "v">: genericLiteralVarargs,+-- | traversalSourceSpawnMethod_mergeE+ "mergeV">: gremlin "GenericLiteralMapNullableArgumentOrNestedTraversal",+-- | traversalSourceSpawnMethod_mergeV+ "mergeE">: gremlin "GenericLiteralMapNullableArgumentOrNestedTraversal",+-- | traversalSourceSpawnMethod_inject+ "inject">: genericLiteralVarargs,+-- | traversalSourceSpawnMethod_io+ "io">: stringArgument,+-- | traversalSourceSpawnMethod_call+ "call">: optional $ gremlin "ServiceCall",+-- | traversalSourceSpawnMethod_union+ "union">: nestedTraversalList],+-- ;++-- traversalSourceSpawnMethod_addE+-- : 'addE' LPAREN stringArgument RPAREN+-- | 'addE' LPAREN nestedTraversal RPAREN+-- ;++-- traversalSourceSpawnMethod_addV+-- : 'addV' LPAREN RPAREN+-- | 'addV' LPAREN stringArgument RPAREN+-- | 'addV' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalSourceSpawnMethod_E+-- : 'E' LPAREN genericLiteralVarargs RPAREN+-- ;+--+-- traversalSourceSpawnMethod_V+-- : 'V' LPAREN genericLiteralVarargs RPAREN+-- ;+--+-- traversalSourceSpawnMethod_inject+-- : 'inject' LPAREN genericLiteralVarargs RPAREN+-- ;+--+-- traversalSourceSpawnMethod_io+-- : 'io' LPAREN stringArgument RPAREN+-- ;+--+-- traversalSourceSpawnMethod_mergeV+-- : 'mergeV' LPAREN genericLiteralMapNullableArgument RPAREN #traversalSourceSpawnMethod_mergeV_Map+-- | 'mergeV' LPAREN nestedTraversal RPAREN #traversalSourceSpawnMethod_mergeV_Traversal+-- ;++ def "GenericLiteralMapNullableArgumentOrNestedTraversal" $ union [+ "map">: genericLiteralMapNullableArgument,+ "traversal">: nestedTraversal],++-- traversalSourceSpawnMethod_mergeE+-- : 'mergeE' LPAREN genericLiteralMapNullableArgument RPAREN #traversalSourceSpawnMethod_mergeE_Map+-- | 'mergeE' LPAREN nestedTraversal RPAREN #traversalSourceSpawnMethod_mergeE_Traversal+-- ;+--+-- traversalSourceSpawnMethod_call+-- : 'call' LPAREN RPAREN #traversalSourceSpawnMethod_call_empty+-- | 'call' LPAREN stringArgument RPAREN #traversalSourceSpawnMethod_call_string+-- | 'call' LPAREN stringArgument COMMA genericLiteralMapArgument RPAREN #traversalSourceSpawnMethod_call_string_map+-- | 'call' LPAREN stringArgument COMMA nestedTraversal RPAREN #traversalSourceSpawnMethod_call_string_traversal+-- | 'call' LPAREN stringArgument COMMA genericLiteralMapArgument COMMA nestedTraversal RPAREN #traversalSourceSpawnMethod_call_string_map_traversal+-- ;++ def "ServiceCall" $ record [+ "service">: stringArgument,+ "arguments">: gremlin "ServiceArguments"],++ def "ServiceArguments" $ union [+ "map">: optional genericLiteralMapArgument,+ "traversal">: optional nestedTraversal],++-- traversalSourceSpawnMethod_union+-- : 'union' LPAREN nestedTraversalList RPAREN+-- ;+--+-- chainedTraversal+-- : traversalMethod+-- | chainedTraversal DOT traversalMethod+-- | chainedTraversal DOT chainedParentOfGraphTraversal+-- ;++ def "ChainedTraversal" $ record [+ "first">: traversalMethod,+ "rest">: gremlin "ChainedTraversalElement"],++ def "ChainedTraversalElement" $ union [+ "method">: traversalMethod,+ "self">: gremlin "TraversalSelfMethod"],++-- chainedParentOfGraphTraversal+-- : traversalSelfMethod+-- | chainedParentOfGraphTraversal DOT traversalSelfMethod+-- ;+--+-- nestedTraversal+-- : rootTraversal+-- | chainedTraversal+-- | ANON_TRAVERSAL_ROOT DOT chainedTraversal+-- ;++ def "NestedTraversal" $ union [+ "root">: gremlin "RootTraversal",+ "chained">: gremlin "ChainedTraversal",+ "anonymous">: gremlin "ChainedTraversal"],++-- terminatedTraversal+-- : rootTraversal DOT traversalTerminalMethod+-- ;++ def "TerminatedTraversal" $ record [+ "root">: gremlin "RootTraversal",+ "terminal">: gremlin "TraversalTerminalMethod"],++-- traversalMethod+ def "TraversalMethod" $ union [ -- TODO+-- : traversalMethod_V+ "v">: genericLiteralVarargs,+-- | traversalMethod_E+ "e">: genericLiteralVarargs,+-- | traversalMethod_addE+ "addE">: gremlin "StringArgumentOrNestedTraversal",+-- | traversalMethod_addV+ "addV">: optional $ gremlin "StringArgumentOrNestedTraversal",+-- | traversalMethod_mergeE+ "mergeE">: optional $ gremlin "GenericLiteralMapNullableArgumentOrNestedTraversal",+-- | traversalMethod_mergeV+ "mergeV">: optional $ gremlin "GenericLiteralMapNullableArgumentOrNestedTraversal",+-- | traversalMethod_aggregate+ "aggregate">: gremlin "OptionalTraversalScopeArgumentAndStringArgument",+-- | traversalMethod_all+ "all">: traversalPredicate,+-- | traversalMethod_and+ "and">: nestedTraversalList,+-- | traversalMethod_any+ "any">: traversalPredicate,+-- | traversalMethod_as+ "as">: gremlin "StringArgumentAndOptionalStringLiteralVarargs",+-- | traversalMethod_barrier+ "barrier">: optional $ gremlin "TraversalSackMethodArgumentOrIntegerArgument",+-- | traversalMethod_both+ "both">: stringLiteralVarargs,+-- | traversalMethod_bothE+ "bothE">: stringLiteralVarargs,+-- | traversalMethod_bothV+ "bothV">: unit,+-- | traversalMethod_branch+ "branch">: nestedTraversal,+-- | traversalMethod_by+ "by">: gremlin "ByArgs",+-- | traversalMethod_cap+ "cap">: gremlin "StringArgumentAndOptionalStringLiteralVarargs",+-- | traversalMethod_choose+ "choose">: gremlin "ChooseArgs",+-- | traversalMethod_coalesce+ "coalesce">: nestedTraversalList,+-- | traversalMethod_coin+ "coin">: floatArgument,+-- | traversalMethod_conjoin+ "conjoin">: stringArgument,+-- | traversalMethod_connectedComponent+ "connectedComponent">: unit,+-- | traversalMethod_constant+ "constant">: genericLiteralArgument,+-- | traversalMethod_count+ "count">: optional traversalScopeArgument,+-- | traversalMethod_cyclicPath+ "cyclicPath">: unit,+-- | traversalMethod_dedup+ "dedup">: gremlin "DedupArgs",+-- | traversalMethod_difference+ "difference">: genericLiteralArgument,+-- | traversalMethod_disjunct+ "disjunct">: genericLiteralArgument,+-- | traversalMethod_drop+ "drop">: unit,+-- | traversalMethod_elementMap+ "elementMap">: stringLiteralVarargs,+-- | traversalMethod_emit+ "emit">: optional $ gremlin "PredicateOrTraversal",+-- | traversalMethod_filter+ "filter">: gremlin "PredicateOrTraversal",+-- | traversalMethod_flatMap+ "flatMap">: nestedTraversal,+-- | traversalMethod_fold+ "fold">: optional $ gremlin "GenericLiteralArgumentAndTraversalBiFunctionArgument",+-- | traversalMethod_from+ "from">: gremlin "FromArgs",+-- | traversalMethod_group+ "group">: optional stringArgument,+-- | traversalMethod_groupCount+ "groupCount">: optional stringArgument,+-- | traversalMethod_has+ "has">: gremlin "HasArgs",+-- | traversalMethod_hasId+ "hasId">: gremlin "GenericLiteralArgumentAndTraversalPredicate",+-- | traversalMethod_hasKey+ "hasKey">: gremlin "TraversalPredicateOrStringLiteralVarargs",+-- | traversalMethod_hasLabel+ "hasLabel">: gremlin "TraversalPredicateOrStringLiteralVarargs",+-- | traversalMethod_hasNot+ "hasNot">: stringNullableArgument,+-- | traversalMethod_hasValue+ "hasValue">: gremlin "TraversalPredicateOrGenericLiteralArgument",+-- | traversalMethod_id+ "id">: unit,+-- | traversalMethod_identity+ "identity">: unit,+-- | traversalMethod_in+ "in">: stringLiteralVarargs,+-- | traversalMethod_inE+ "inE">: stringLiteralVarargs,+-- | traversalMethod_intersect+ "intersect">: genericLiteralArgument,+-- | traversalMethod_inV+ "inV">: unit,+-- | traversalMethod_index+ "index">: unit,+-- | traversalMethod_inject+ "inject">: genericLiteralVarargs,+-- | traversalMethod_is+ "is">: gremlin "TraversalPredicateOrGenericLiteralArgument",+-- | traversalMethod_key+ "key">: unit,+-- | traversalMethod_label+ "label">: unit,+-- | traversalMethod_limit+ "limit">: gremlin "OptionalTraversalScopeArgumentAndIntegerArgument",+-- | traversalMethod_local+ "local">: nestedTraversal,+-- | traversalMethod_loops+ "loops">: optional stringArgument,+-- | traversalMethod_map+ "map">: nestedTraversal,+-- | traversalMethod_match+ "match">: nestedTraversalList,+-- | traversalMethod_math+ "math">: stringArgument,+-- | traversalMethod_max+ "max">: optional traversalScopeArgument,+-- | traversalMethod_mean+ "mean">: optional traversalScopeArgument,+-- | traversalMethod_min+ "min">: optional traversalScopeArgument,+-- | traversalMethod_none+ "none">: traversalPredicate,+-- | traversalMethod_not+ "not">: nestedTraversal,+-- | traversalMethod_option+ "option">: gremlin "OptionArgs",+-- | traversalMethod_optional+ "optional">: nestedTraversal,+-- | traversalMethod_or+ "or">: nestedTraversalList,+-- | traversalMethod_order+ "order">: optional traversalScopeArgument,+-- | traversalMethod_otherV+ "otherV">: unit,+-- | traversalMethod_out+ "out">: stringLiteralVarargs,+-- | traversalMethod_outE+ "outE">: stringLiteralVarargs,+-- | traversalMethod_outV+ "outV">: unit,+-- | traversalMethod_pageRank+ "pageRank">: optional floatArgument,+-- | traversalMethod_path+ "path">: unit,+-- | traversalMethod_peerPressure+ "peerPressure">: unit,+-- | traversalMethod_profile+ "profile">: optional stringArgument,+-- | traversalMethod_project+ "project">: gremlin "StringArgumentAndOptionalStringLiteralVarargs",+-- | traversalMethod_properties+ "properties">: stringLiteralVarargs,+-- | traversalMethod_property+ "property">: gremlin "PropertyArgs",+-- | traversalMethod_propertyMap+ "propertyMap">: stringLiteralVarargs,+-- | traversalMethod_range+ "range">: gremlin "RangeArgs",+-- | traversalMethod_read+ "read">: unit,+-- | traversalMethod_repeat+ "repeat">: gremlin "OptionalStringArgumentAndNestedTraversal",+-- | traversalMethod_sack+ "sack">: optional traversalBiFunctionArgument,+-- | traversalMethod_sample+ "sample">: gremlin "OptionalTraversalScopeArgumentAndIntegerArgument",+-- | traversalMethod_select+ "select">: gremlin "SelectArgs",+-- | traversalMethod_combine+ "combine">: genericLiteralArgument,+-- | traversalMethod_product+ "product">: genericLiteralArgument,+-- | traversalMethod_merge+ "merge">: genericLiteralArgument,+-- | traversalMethod_shortestPath+ "shortestPath">: unit,+-- | traversalMethod_sideEffect+ "sideEffect">: nestedTraversal,+-- | traversalMethod_simplePath+ "simplePath">: unit,+-- | traversalMethod_skip+ "skip">: gremlin "OptionalTraversalScopeArgumentAndIntegerArgument",+-- | traversalMethod_store+ "store">: stringArgument,+-- | traversalMethod_subgraph+ "subgraph">: stringArgument,+-- | traversalMethod_sum+ "sum">: optional traversalScopeArgument,+-- | traversalMethod_tail+ "tail">: optional $ gremlin "TailArgs",+-- | traversalMethod_fail+ "fail">: optional stringArgument,+-- | traversalMethod_timeLimit+-- | traversalMethod_times+ "times">: integerArgument,+-- | traversalMethod_to+ "to">: gremlin "ToArgs",+-- | traversalMethod_toE+ "toE">: gremlin "DirectionAndVarargs",+-- | traversalMethod_toV+ "toV">: traversalDirectionArgument,+-- | traversalMethod_tree+ "tree">: optional stringArgument,+-- | traversalMethod_unfold+ "unfold">: unit,+-- | traversalMethod_union+ "union">: nestedTraversalList,+-- | traversalMethod_until+ "until">: gremlin "PredicateOrTraversal",+-- | traversalMethod_value+ "value">: unit,+-- | traversalMethod_valueMap+ "valueMap">: gremlin "ValueMapArgs",+-- | traversalMethod_values+ "values">: stringLiteralVarargs,+-- | traversalMethod_where+ "where">: gremlin "WhereArgs",+-- | traversalMethod_with+ "with">: gremlin "WithArgs",+-- | traversalMethod_write+ "write">: unit,+-- | traversalMethod_element+ "element">: stringLiteralVarargs,+-- | traversalMethod_call+ "call">: gremlin "ServiceCall",+-- | traversalMethod_concat+ "concat">: gremlin "ConcatArgs",+-- | traversalMethod_asString+ "asString">: optional traversalScopeArgument,+-- | traversalMethod_format+ "format">: stringArgument,+-- | traversalMethod_toUpper+ "toUpper">: optional traversalScopeArgument,+-- | traversalMethod_toLower+ "toLower">: optional traversalScopeArgument,+-- | traversalMethod_length+ "length">: optional traversalScopeArgument,+-- | traversalMethod_trim+ "trim">: optional traversalScopeArgument,+-- | traversalMethod_lTrim+ "lTrim">: optional traversalScopeArgument,+-- | traversalMethod_rTrim+ "rTrim">: optional traversalScopeArgument,+-- | traversalMethod_reverse+ "reverse">: unit,+-- | traversalMethod_replace+ "replace">: gremlin "ReplaceArgs",+-- | traversalMethod_split+ "split">: gremlin "SplitArgs",+-- | traversalMethod_substring+ "substring">: gremlin "SubstringArgs",+-- | traversalMethod_asDate+ "asDate">: unit,+-- | traversalMethod_dateAdd+ "dateAdd">: gremlin "DateAddArgs",+-- | traversalMethod_dateDiff+ "dateDiff">: gremlin "DateDiffArgs"],+-- ;++-- traversalMethod_V+-- : 'V' LPAREN genericLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_E+-- : 'E' LPAREN genericLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_addE+-- : 'addE' LPAREN stringArgument RPAREN #traversalMethod_addE_String+-- | 'addE' LPAREN nestedTraversal RPAREN #traversalMethod_addE_Traversal+-- ;++ def "StringArgumentOrNestedTraversal" $ union [+ "string">: stringArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_addV+-- : 'addV' LPAREN RPAREN #traversalMethod_addV_Empty+-- | 'addV' LPAREN stringArgument RPAREN #traversalMethod_addV_String+-- | 'addV' LPAREN nestedTraversal RPAREN #traversalMethod_addV_Traversal+-- ;++-- traversalMethod_mergeV+-- : 'mergeV' LPAREN RPAREN #traversalMethod_mergeV_empty+-- | 'mergeV' LPAREN genericLiteralMapNullableArgument RPAREN #traversalMethod_mergeV_Map+-- | 'mergeV' LPAREN nestedTraversal RPAREN #traversalMethod_mergeV_Traversal+-- ;++-- traversalMethod_mergeE+-- : 'mergeE' LPAREN RPAREN #traversalMethod_mergeE_empty+-- | 'mergeE' LPAREN genericLiteralMapNullableArgument RPAREN #traversalMethod_mergeE_Map+-- | 'mergeE' LPAREN nestedTraversal RPAREN #traversalMethod_mergeE_Traversal+-- ;++-- traversalMethod_aggregate+-- : 'aggregate' LPAREN traversalScopeArgument COMMA stringArgument RPAREN #traversalMethod_aggregate_Scope_String+-- | 'aggregate' LPAREN stringArgument RPAREN #traversalMethod_aggregate_String+-- ;++ def "OptionalTraversalScopeArgumentAndStringArgument" $ record [+ "scope">: optional traversalScopeArgument,+ "string">: stringArgument],++-- traversalMethod_all+-- : 'all' LPAREN traversalPredicate RPAREN #traversalMethod_all_P+-- ;+--+-- traversalMethod_and+-- : 'and' LPAREN nestedTraversalList RPAREN+-- ;+--+-- traversalMethod_any+-- : 'any' LPAREN traversalPredicate RPAREN #traversalMethod_any_P+-- ;+--+-- traversalMethod_as+-- : 'as' LPAREN stringArgument (COMMA stringLiteralVarargs)? RPAREN+-- ;++ def "StringArgumentAndOptionalStringLiteralVarargs" $ record [+ "first">: stringArgument,+ "rest">: optionalStringLiteralVarargs],++-- traversalMethod_barrier+-- : 'barrier' LPAREN traversalSackMethodArgument RPAREN #traversalMethod_barrier_Consumer+-- | 'barrier' LPAREN RPAREN #traversalMethod_barrier_Empty+-- | 'barrier' LPAREN integerArgument RPAREN #traversalMethod_barrier_int+-- ;++ def "TraversalSackMethodArgumentOrIntegerArgument" $ union [+ "consumer">: gremlin "TraversalSackMethodArgument",+ "int">: integerArgument],++--+-- traversalMethod_both+-- : 'both' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_bothE+-- : 'bothE' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_bothV+-- : 'bothV' LPAREN RPAREN+-- ;+--+-- traversalMethod_branch+-- : 'branch' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_by+-- : 'by' LPAREN traversalComparatorArgument RPAREN #traversalMethod_by_Comparator+-- | 'by' LPAREN RPAREN #traversalMethod_by_Empty+-- | 'by' LPAREN traversalFunctionArgument RPAREN #traversalMethod_by_Function+-- | 'by' LPAREN traversalFunctionArgument COMMA traversalComparatorArgument RPAREN #traversalMethod_by_Function_Comparator+-- | 'by' LPAREN traversalOrderArgument RPAREN #traversalMethod_by_Order+-- | 'by' LPAREN stringArgument RPAREN #traversalMethod_by_String+-- | 'by' LPAREN stringArgument COMMA traversalComparatorArgument RPAREN #traversalMethod_by_String_Comparator+-- | 'by' LPAREN traversalTokenArgument RPAREN #traversalMethod_by_T+-- | 'by' LPAREN nestedTraversal RPAREN #traversalMethod_by_Traversal+-- | 'by' LPAREN nestedTraversal COMMA traversalComparatorArgument RPAREN #traversalMethod_by_Traversal_Comparator+-- ;++ def "ByArgs" $ union [+ "order">: traversalOrderArgument,+ "token">: traversalTokenArgument,+ "other">: gremlin "ByOtherArgs"],++ def "ByOtherArgs" $ union [+ "comparator">: optional traversalComparatorArgument,+ "other">: optional $ gremlin "TraversalFunctionArgumentOrStringArgumentOrNestedTraversal"],++ def "TraversalFunctionArgumentOrStringArgumentOrNestedTraversal" $ union [+ "function">: traversalFunctionArgument,+ "string">: stringArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_cap+-- : 'cap' LPAREN stringArgument (COMMA stringLiteralVarargs)? RPAREN+-- ;+--+-- traversalMethod_choose+-- : 'choose' LPAREN traversalFunctionArgument RPAREN #traversalMethod_choose_Function+-- | 'choose' LPAREN traversalPredicate COMMA nestedTraversal RPAREN #traversalMethod_choose_Predicate_Traversal+-- | 'choose' LPAREN traversalPredicate COMMA nestedTraversal COMMA nestedTraversal RPAREN #traversalMethod_choose_Predicate_Traversal_Traversal+-- | 'choose' LPAREN nestedTraversal RPAREN #traversalMethod_choose_Traversal+-- | 'choose' LPAREN nestedTraversal COMMA nestedTraversal RPAREN #traversalMethod_choose_Traversal_Traversal+-- | 'choose' LPAREN nestedTraversal COMMA nestedTraversal COMMA nestedTraversal RPAREN #traversalMethod_choose_Traversal_Traversal_Traversal+-- ;++ def "ChooseArgs" $ union [+ "function">: traversalFunctionArgument,+ "predicateTraversal">: gremlin "PredicateTraversalArgument",+ "traversal">: gremlin "NestedTraversalArgument"],++ def "PredicateTraversalArgument" $ record [+ "predicate">: traversalPredicate,+ "traversal1">: nestedTraversal,+ "traversal2">: optional $ nestedTraversal],++ def "NestedTraversalArgument" $ record [+ "traversal1">: nestedTraversal,+ "traversal2">: optional $ nestedTraversal,+ "traversal3">: optional $ nestedTraversal],++-- traversalMethod_coalesce+-- : 'coalesce' LPAREN nestedTraversalList RPAREN+-- ;+--+-- traversalMethod_coin+-- : 'coin' LPAREN floatArgument RPAREN+-- ;+--+-- traversalMethod_combine+-- : 'combine' LPAREN genericLiteralArgument RPAREN #traversalMethod_combine_Object+-- ;+--+-- traversalMethod_connectedComponent+-- : 'connectedComponent' LPAREN RPAREN+-- ;+--+-- traversalMethod_constant+-- : 'constant' LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalMethod_count+-- : 'count' LPAREN RPAREN #traversalMethod_count_Empty+-- | 'count' LPAREN traversalScopeArgument RPAREN #traversalMethod_count_Scope+-- ;+--+-- traversalMethod_cyclicPath+-- : 'cyclicPath' LPAREN RPAREN+-- ;+--+-- traversalMethod_dedup+-- : 'dedup' LPAREN traversalScopeArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_dedup_Scope_String+-- | 'dedup' LPAREN stringLiteralVarargs RPAREN #traversalMethod_dedup_String+-- ;++ def "DedupArgs" $ union [+ "scopeString">: gremlin "ScopeStringArgument",+ "string">: stringLiteralVarargs],++ def "ScopeStringArgument" $ record [+ "scope">: traversalScopeArgument,+ "strings">: optionalStringLiteralVarargs],++-- traversalMethod_difference+-- : 'difference' LPAREN genericLiteralArgument RPAREN #traversalMethod_difference_Object+-- ;+--+-- traversalMethod_disjunct+-- : 'disjunct' LPAREN genericLiteralArgument RPAREN #traversalMethod_disjunct_Object+-- ;+--+-- traversalMethod_drop+-- : 'drop' LPAREN RPAREN+-- ;+--+-- traversalMethod_elementMap+-- : 'elementMap' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_emit+-- : 'emit' LPAREN RPAREN #traversalMethod_emit_Empty+-- | 'emit' LPAREN traversalPredicate RPAREN #traversalMethod_emit_Predicate+-- | 'emit' LPAREN nestedTraversal RPAREN #traversalMethod_emit_Traversal+-- ;++ def "PredicateOrTraversal" $ union [+ "predicate">: traversalPredicate,+ "traversal">: nestedTraversal],++-- traversalMethod_filter+-- : 'filter' LPAREN traversalPredicate RPAREN #traversalMethod_filter_Predicate+-- | 'filter' LPAREN nestedTraversal RPAREN #traversalMethod_filter_Traversal+-- ;++-- traversalMethod_flatMap+-- : 'flatMap' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_fold+-- : 'fold' LPAREN RPAREN #traversalMethod_fold_Empty+-- | 'fold' LPAREN genericLiteralArgument COMMA traversalBiFunctionArgument RPAREN #traversalMethod_fold_Object_BiFunction+-- ;++ def "GenericLiteralArgumentAndTraversalBiFunctionArgument" $ record [+ "literal">: genericLiteralArgument,+ "biFunction">: traversalBiFunctionArgument],++-- traversalMethod_from+-- : 'from' LPAREN stringArgument RPAREN #traversalMethod_from_String+-- | 'from' LPAREN structureVertexArgument RPAREN #traversalMethod_from_Vertex+-- | 'from' LPAREN nestedTraversal RPAREN #traversalMethod_from_Traversal+-- ;++ def "FromArgs" $ union [+ "string">: stringArgument,+ "vertex">: structureVertexArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_group+-- : 'group' LPAREN RPAREN #traversalMethod_group_Empty+-- | 'group' LPAREN stringArgument RPAREN #traversalMethod_group_String+-- ;+--+-- traversalMethod_groupCount+-- : 'groupCount' LPAREN RPAREN #traversalMethod_groupCount_Empty+-- | 'groupCount' LPAREN stringArgument RPAREN #traversalMethod_groupCount_String+-- ;+--+-- traversalMethod_has+-- : 'has' LPAREN stringNullableArgument RPAREN #traversalMethod_has_String+-- | 'has' LPAREN stringNullableArgument COMMA genericLiteralArgument RPAREN #traversalMethod_has_String_Object+-- | 'has' LPAREN stringNullableArgument COMMA traversalPredicate RPAREN #traversalMethod_has_String_P+-- | 'has' LPAREN stringNullableArgument COMMA stringNullableArgument COMMA genericLiteralArgument RPAREN #traversalMethod_has_String_String_Object+-- | 'has' LPAREN stringNullableArgument COMMA stringNullableArgument COMMA traversalPredicate RPAREN #traversalMethod_has_String_String_P+-- | 'has' LPAREN stringNullableArgument COMMA nestedTraversal RPAREN #traversalMethod_has_String_Traversal+-- | 'has' LPAREN traversalTokenArgument COMMA genericLiteralArgument RPAREN #traversalMethod_has_T_Object+-- | 'has' LPAREN traversalTokenArgument COMMA traversalPredicate RPAREN #traversalMethod_has_T_P+-- | 'has' LPAREN traversalTokenArgument COMMA nestedTraversal RPAREN #traversalMethod_has_T_Traversal+-- ;++ def "HasArgs" $ union [+ "string">: gremlin "HasStringArgumentAndOptionalStringLiteralVarargs",+ "traversalToken">: gremlin "HasTraversalTokenArgs"],++ def "HasStringArgumentAndOptionalStringLiteralVarargs" $ record [+ "string">: stringNullableArgument,+ "rest">: optional $ gremlin "HasStringArgumentAndOptionalStringLiteralVarargsRest"],++ def "HasStringArgumentAndOptionalStringLiteralVarargsRest" $ union [+ "object">: genericLiteralArgument,+ "predicate">: traversalPredicate,+ "stringObject">: gremlin "StringNullableArgumentAndGenericLiteralArgument",+ "stringPredicate">: gremlin "StringNullableArgumentAndTraversalPredicate",+ "traversal">: nestedTraversal],++ def "StringNullableArgumentAndGenericLiteralArgument" $ record [+ "string">: stringNullableArgument,+ "literal">: genericLiteralArgument],++ def "StringNullableArgumentAndTraversalPredicate" $ record [+ "string">: stringNullableArgument,+ "predicate">: traversalPredicate],++ def "HasTraversalTokenArgs" $ record [+ "traversalToken">: traversalTokenArgument,+ "rest">: gremlin "HasTraversalTokenArgsRest"],++ def "HasTraversalTokenArgsRest" $ union [+ "literal">: genericLiteralArgument,+ "predicate">: traversalPredicate,+ "traversal">: nestedTraversal],++-- traversalMethod_hasId+-- : 'hasId' LPAREN genericLiteralArgument (COMMA genericLiteralVarargs)? RPAREN #traversalMethod_hasId_Object_Object+-- | 'hasId' LPAREN traversalPredicate RPAREN #traversalMethod_hasId_P+-- ;++ def "GenericLiteralArgumentAndTraversalPredicate" $ union [+ "literal">: genericLiteralArgument,+ "predicate">: traversalPredicate],++-- traversalMethod_hasKey+-- : 'hasKey' LPAREN traversalPredicate RPAREN #traversalMethod_hasKey_P+-- | 'hasKey' LPAREN stringNullableArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_hasKey_String_String+-- ;++ def "TraversalPredicateOrStringLiteralVarargs" $ union [+ "predicate">: traversalPredicate,+ "string">: stringLiteralVarargs],++-- traversalMethod_hasLabel+-- : 'hasLabel' LPAREN traversalPredicate RPAREN #traversalMethod_hasLabel_P+-- | 'hasLabel' LPAREN stringNullableArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_hasLabel_String_String+-- ;+--+-- traversalMethod_hasNot+-- : 'hasNot' LPAREN stringNullableArgument RPAREN+-- ;+--+-- traversalMethod_hasValue+-- : 'hasValue' LPAREN genericLiteralArgument (COMMA genericLiteralVarargs)? RPAREN #traversalMethod_hasValue_Object_Object+-- | 'hasValue' LPAREN traversalPredicate RPAREN #traversalMethod_hasValue_P+-- ;++ def "TraversalPredicateOrGenericLiteralArgument" $ union [+ "predicate">: traversalPredicate,+ "literal">: list genericLiteralArgument],++-- traversalMethod_id+-- : 'id' LPAREN RPAREN+-- ;+--+-- traversalMethod_identity+-- : 'identity' LPAREN RPAREN+-- ;+--+-- traversalMethod_in+-- : 'in' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_inE+-- : 'inE' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_intersect+-- : 'intersect' LPAREN genericLiteralArgument RPAREN #traversalMethod_intersect_Object+-- ;+--+-- traversalMethod_inV+-- : 'inV' LPAREN RPAREN+-- ;+--+-- traversalMethod_index+-- : 'index' LPAREN RPAREN+-- ;+--+-- traversalMethod_inject+-- : 'inject' LPAREN genericLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_is+-- : 'is' LPAREN genericLiteralArgument RPAREN #traversalMethod_is_Object+-- | 'is' LPAREN traversalPredicate RPAREN #traversalMethod_is_P+-- ;+--+-- traversalMethod_conjoin+-- : 'conjoin' LPAREN stringArgument RPAREN #traversalMethod_conjoin_String+-- ;+--+-- traversalMethod_key+-- : 'key' LPAREN RPAREN+-- ;+--+-- traversalMethod_label+-- : 'label' LPAREN RPAREN+-- ;+--+-- traversalMethod_limit+-- : 'limit' LPAREN traversalScopeArgument COMMA integerArgument RPAREN #traversalMethod_limit_Scope_long+-- | 'limit' LPAREN integerArgument RPAREN #traversalMethod_limit_long+-- ;++-- traversalMethod_local+-- : 'local' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_loops+-- : 'loops' LPAREN RPAREN #traversalMethod_loops_Empty+-- | 'loops' LPAREN stringArgument RPAREN #traversalMethod_loops_String+-- ;+--+-- traversalMethod_map+-- : 'map' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_match+-- : 'match' LPAREN nestedTraversalList RPAREN+-- ;+--+-- traversalMethod_math+-- : 'math' LPAREN stringArgument RPAREN+-- ;+--+-- traversalMethod_max+-- : 'max' LPAREN RPAREN #traversalMethod_max_Empty+-- | 'max' LPAREN traversalScopeArgument RPAREN #traversalMethod_max_Scope+-- ;+--+-- traversalMethod_mean+-- : 'mean' LPAREN RPAREN #traversalMethod_mean_Empty+-- | 'mean' LPAREN traversalScopeArgument RPAREN #traversalMethod_mean_Scope+-- ;+--+-- traversalMethod_merge+-- : 'merge' LPAREN genericLiteralArgument RPAREN #traversalMethod_merge_Object+-- ;+--+-- traversalMethod_min+-- : 'min' LPAREN RPAREN #traversalMethod_min_Empty+-- | 'min' LPAREN traversalScopeArgument RPAREN #traversalMethod_min_Scope+-- ;+--+-- traversalMethod_none+-- : 'none' LPAREN traversalPredicate RPAREN #traversalMethod_none_P+-- ;+--+-- traversalMethod_not+-- : 'not' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_option+-- : 'option' LPAREN traversalPredicate COMMA nestedTraversal RPAREN #traversalMethod_option_Predicate_Traversal+-- | 'option' LPAREN traversalMergeArgument COMMA genericLiteralMapNullableArgument RPAREN #traversalMethod_option_Merge_Map+-- | 'option' LPAREN traversalMergeArgument COMMA genericLiteralMapNullableArgument COMMA traversalCardinality RPAREN #traversalMethod_option_Merge_Map_Cardinality+-- | 'option' LPAREN traversalMergeArgument COMMA nestedTraversal RPAREN #traversalMethod_option_Merge_Traversal+-- | 'option' LPAREN genericLiteralArgument COMMA nestedTraversal RPAREN #traversalMethod_option_Object_Traversal+-- | 'option' LPAREN nestedTraversal RPAREN #traversalMethod_option_Traversal+-- ;++ def "OptionArgs" $ union [+ "predicateTraversal">: gremlin "TraversalPredicateAndNestedTraversal",+ "mergeMap">: gremlin "TraversalMergeArgumentAndGenericLiteralMapNullableArgument",+ "mergeTraversal">: gremlin "TraversalMergeArgumentAndNestedTraversal",+ "objectTraversal">: gremlin "GenericLiteralArgumentAndNestedTraversal",+ "traversal">: nestedTraversal],++ def "TraversalPredicateAndNestedTraversal" $ record [+ "predicate">: traversalPredicate,+ "traversal">: nestedTraversal],++ def "TraversalMergeArgumentAndGenericLiteralMapNullableArgument" $ record [+ "merge">: traversalMergeArgument,+ "map">: genericLiteralMapNullableArgument,+ "cardinality">: optional traversalCardinality],++ def "TraversalMergeArgumentAndNestedTraversal" $ record [+ "merge">: traversalMergeArgument,+ "traversal">: nestedTraversal],++ def "GenericLiteralArgumentAndNestedTraversal" $ record [+ "object">: genericLiteralArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_optional+-- : 'optional' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_or+-- : 'or' LPAREN nestedTraversalList RPAREN+-- ;+--+-- traversalMethod_order+-- : 'order' LPAREN RPAREN #traversalMethod_order_Empty+-- | 'order' LPAREN traversalScopeArgument RPAREN #traversalMethod_order_Scope+-- ;+--+-- traversalMethod_otherV+-- : 'otherV' LPAREN RPAREN+-- ;+--+-- traversalMethod_out+-- : 'out' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_outE+-- : 'outE' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_outV+-- : 'outV' LPAREN RPAREN+-- ;+--+-- traversalMethod_pageRank+-- : 'pageRank' LPAREN RPAREN #traversalMethod_pageRank_Empty+-- | 'pageRank' LPAREN floatArgument RPAREN #traversalMethod_pageRank_double+-- ;+--+-- traversalMethod_path+-- : 'path' LPAREN RPAREN+-- ;+--+-- traversalMethod_peerPressure+-- : 'peerPressure' LPAREN RPAREN+-- ;+--+-- traversalMethod_product+-- : 'product' LPAREN genericLiteralArgument RPAREN #traversalMethod_product_Object+-- ;+--+-- traversalMethod_profile+-- : 'profile' LPAREN RPAREN #traversalMethod_profile_Empty+-- | 'profile' LPAREN stringArgument RPAREN #traversalMethod_profile_String+-- ;+--+-- traversalMethod_project+-- : 'project' LPAREN stringArgument (COMMA stringLiteralVarargs)? RPAREN+-- ;++-- traversalMethod_properties+-- : 'properties' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_property+-- : 'property' LPAREN traversalCardinalityArgument COMMA genericLiteralArgument COMMA genericLiteralArgument (COMMA genericLiteralVarargs)? RPAREN #traversalMethod_property_Cardinality_Object_Object_Object+-- | 'property' LPAREN genericLiteralArgument COMMA genericLiteralArgument (COMMA genericLiteralVarargs)? RPAREN #traversalMethod_property_Object_Object_Object+-- | 'property' LPAREN genericLiteralMapNullableArgument RPAREN # traversalMethod_property_Object+-- | 'property' LPAREN traversalCardinalityArgument COMMA genericLiteralMapNullableArgument RPAREN # traversalMethod_property_Cardinality_Object+-- ;++ def "PropertyArgs" $ union [+ "cardinalityObjects">: gremlin "TraversalCardinalityArgumentAndObjects",+ "objects">: minLengthList 2 genericLiteralArgument,+ "object">: genericLiteralMapNullableArgument,+ "cardinalityObject">: gremlin "GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument"],++ def "TraversalCardinalityArgumentAndObjects" $ record [+ "cardinality">: traversalCardinalityArgument,+ "objects">: minLengthList 2 genericLiteralArgument],++ def "GenericLiteralMapNullableArgumentAndTraversalCardinalityArgument" $ record [+ "cardinality">: traversalCardinalityArgument,+ "object">: genericLiteralMapNullableArgument],++-- traversalMethod_propertyMap+-- : 'propertyMap' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_range+-- : 'range' LPAREN traversalScopeArgument COMMA integerArgument COMMA integerArgument RPAREN #traversalMethod_range_Scope_long_long+-- | 'range' LPAREN integerArgument COMMA integerArgument RPAREN #traversalMethod_range_long_long+-- ;++ def "RangeArgs" $ record [+ "scope">: optional traversalScopeArgument,+ "min">: integerArgument,+ "max">: integerArgument],++-- traversalMethod_read+-- : 'read' LPAREN RPAREN+-- ;+--+-- traversalMethod_repeat+-- : 'repeat' LPAREN stringArgument COMMA nestedTraversal RPAREN #traversalMethod_repeat_String_Traversal+-- | 'repeat' LPAREN nestedTraversal RPAREN #traversalMethod_repeat_Traversal+-- ;++ def "OptionalStringArgumentAndNestedTraversal" $ record [+ "string">: optional stringArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_reverse+-- : 'reverse' LPAREN RPAREN #traversalMethod_reverse_Empty+-- ;+--+-- traversalMethod_sack+-- : 'sack' LPAREN traversalBiFunctionArgument RPAREN #traversalMethod_sack_BiFunction+-- | 'sack' LPAREN RPAREN #traversalMethod_sack_Empty+-- ;+--+-- traversalMethod_sample+-- : 'sample' LPAREN traversalScopeArgument COMMA integerArgument RPAREN #traversalMethod_sample_Scope_int+-- | 'sample' LPAREN integerArgument RPAREN #traversalMethod_sample_int+-- ;++-- traversalMethod_select+-- : 'select' LPAREN traversalColumnArgument RPAREN #traversalMethod_select_Column+-- | 'select' LPAREN traversalPopArgument COMMA stringArgument RPAREN #traversalMethod_select_Pop_String+-- | 'select' LPAREN traversalPopArgument COMMA stringArgument COMMA stringArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_select_Pop_String_String_String+-- | 'select' LPAREN traversalPopArgument COMMA nestedTraversal RPAREN #traversalMethod_select_Pop_Traversal+-- | 'select' LPAREN stringArgument RPAREN #traversalMethod_select_String+-- | 'select' LPAREN stringArgument COMMA stringArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_select_String_String_String+-- | 'select' LPAREN nestedTraversal RPAREN #traversalMethod_select_Traversal+-- ;++ def "SelectArgs" $ union [+ "column">: traversalColumnArgument,+ "popStrings">: gremlin "PopStringsArgument",+ "popTraversal">: gremlin "TraversalPopArgumentAndNestedTraversal",+ "strings">: nonemptyList stringArgument,+ "traversal">: nestedTraversal],++ def "PopStringsArgument" $ record [+ "pop">: traversalPopArgument,+ "string">: nonemptyList stringArgument],++ def "TraversalPopArgumentAndNestedTraversal" $ record [+ "pop">: traversalPopArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_shortestPath+-- : 'shortestPath' LPAREN RPAREN+-- ;+--+-- traversalMethod_sideEffect+-- : 'sideEffect' LPAREN nestedTraversal RPAREN+-- ;+--+-- traversalMethod_simplePath+-- : 'simplePath' LPAREN RPAREN+-- ;+--+-- traversalMethod_skip+-- : 'skip' LPAREN traversalScopeArgument COMMA integerArgument RPAREN #traversalMethod_skip_Scope_long+-- | 'skip' LPAREN integerArgument RPAREN #traversalMethod_skip_long+-- ;++ def "OptionalTraversalScopeArgumentAndIntegerArgument" $ record [+ "scope">: optional traversalScopeArgument,+ "long">: integerArgument],++-- traversalMethod_store+-- : 'store' LPAREN stringArgument RPAREN+-- ;+--+-- traversalMethod_subgraph+-- : 'subgraph' LPAREN stringArgument RPAREN+-- ;+--+-- traversalMethod_sum+-- : 'sum' LPAREN RPAREN #traversalMethod_sum_Empty+-- | 'sum' LPAREN traversalScopeArgument RPAREN #traversalMethod_sum_Scope+-- ;+--+-- traversalMethod_tail+-- : 'tail' LPAREN RPAREN #traversalMethod_tail_Empty+-- | 'tail' LPAREN traversalScopeArgument RPAREN #traversalMethod_tail_Scope+-- | 'tail' LPAREN traversalScopeArgument COMMA integerArgument RPAREN #traversalMethod_tail_Scope_long+-- | 'tail' LPAREN integerArgument RPAREN #traversalMethod_tail_long+-- ;++ def "TailArgs" $ record [+ "scope">: optional traversalScopeArgument,+ "integer">: optional integerArgument],++-- traversalMethod_fail+-- : 'fail' LPAREN RPAREN #traversalMethod_fail_Empty+-- | 'fail' LPAREN stringArgument RPAREN #traversalMethod_fail_String+-- ;+--+-- traversalMethod_timeLimit+-- : 'timeLimit' LPAREN integerArgument RPAREN+-- ;+--+-- traversalMethod_times+-- : 'times' LPAREN integerArgument RPAREN+-- ;+--+-- traversalMethod_to+-- : 'to' LPAREN traversalDirectionArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_to_Direction_String+-- | 'to' LPAREN stringArgument RPAREN #traversalMethod_to_String+-- | 'to' LPAREN structureVertexArgument RPAREN #traversalMethod_to_Vertex+-- | 'to' LPAREN nestedTraversal RPAREN #traversalMethod_to_Traversal+-- ;++ def "ToArgs" $ union [+ "direction">: gremlin "DirectionAndVarargs",+ "string">: stringArgument,+ "vertex">: structureVertexArgument,+ "traversal">: nestedTraversal],++-- traversalMethod_toE+-- : 'toE' LPAREN traversalDirectionArgument (COMMA stringLiteralVarargs)? RPAREN+-- ;++ def "DirectionAndVarargs" $ record [+ "direction">: traversalDirectionArgument,+ "varargs">: optionalStringLiteralVarargs],++-- traversalMethod_toV+-- : 'toV' LPAREN traversalDirectionArgument RPAREN+-- ;+--+-- traversalMethod_tree+-- : 'tree' LPAREN RPAREN #traversalMethod_tree_Empty+-- | 'tree' LPAREN stringArgument RPAREN #traversalMethod_tree_String+-- ;+--+-- traversalMethod_unfold+-- : 'unfold' LPAREN RPAREN+-- ;+--+-- traversalMethod_union+-- : 'union' LPAREN nestedTraversalList RPAREN+-- ;+--+-- traversalMethod_until+-- : 'until' LPAREN traversalPredicate RPAREN #traversalMethod_until_Predicate+-- | 'until' LPAREN nestedTraversal RPAREN #traversalMethod_until_Traversal+-- ;+--+-- traversalMethod_value+-- : 'value' LPAREN RPAREN+-- ;+--+-- traversalMethod_valueMap+-- : 'valueMap' LPAREN stringLiteralVarargs RPAREN #traversalMethod_valueMap_String+-- | 'valueMap' LPAREN booleanArgument (COMMA stringLiteralVarargs)? RPAREN #traversalMethod_valueMap_boolean_String+-- ;++ def "ValueMapArgs" $ union [+ "string">: stringLiteralVarargs,+ "boolean">: gremlin "ValueMapBooleanArgs"],++ def "ValueMapBooleanArgs" $ record [+ "value">: booleanArgument,+ "keys">: optional stringLiteralVarargs],++-- traversalMethod_values+-- : 'values' LPAREN stringLiteralVarargs RPAREN+-- ;+--+-- traversalMethod_where+-- : 'where' LPAREN traversalPredicate RPAREN #traversalMethod_where_P+-- | 'where' LPAREN stringArgument COMMA traversalPredicate RPAREN #traversalMethod_where_String_P+-- | 'where' LPAREN nestedTraversal RPAREN #traversalMethod_where_Traversal+-- ;++ def "WhereArgs" $ union [+ "predicate">: gremlin "WhereWithPredicateArgs",+ "string">: stringArgument,+ "traversal">: nestedTraversal],++ def "WhereWithPredicateArgs" $ record [+ "leftArg">: optional stringArgument,+ "predicate">: traversalPredicate],++-- traversalMethod_with+-- : 'with' LPAREN (withOptionKeys | stringArgument) RPAREN #traversalMethod_with_String+-- | 'with' LPAREN (withOptionKeys | stringArgument) COMMA (withOptionsValues | ioOptionsValues | genericLiteralArgument) RPAREN #traversalMethod_with_String_Object+-- ;++ def "WithArgs" $ record [+ "keys">: gremlin "WithArgsKeys",+ "values">: optional $ gremlin "WithArgsValues"],++ def "WithArgsKeys" $ union [+ "withOption">: gremlin "WithOptionKeys",+ "string">: stringArgument],++ def "WithArgsValues" $ union [+ "withOptions">: gremlin "WithOptionsValues",+ "io">: gremlin "IoOptionsValues",+ "object">: genericLiteralArgument],++-- traversalMethod_write+-- : 'write' LPAREN RPAREN+-- ;+--+-- traversalMethod_element+-- : 'element' LPAREN RPAREN+-- ;+--+-- traversalMethod_call+-- : 'call' LPAREN stringArgument RPAREN #traversalMethod_call_string+-- | 'call' LPAREN stringArgument COMMA genericLiteralMapArgument RPAREN #traversalMethod_call_string_map+-- | 'call' LPAREN stringArgument COMMA nestedTraversal RPAREN #traversalMethod_call_string_traversal+-- | 'call' LPAREN stringArgument COMMA genericLiteralMapArgument COMMA nestedTraversal RPAREN #traversalMethod_call_string_map_traversal+-- ;++-- traversalMethod_concat+-- : 'concat' LPAREN nestedTraversal (COMMA nestedTraversalList)? RPAREN #traversalMethod_concat_Traversal_Traversal+-- | 'concat' LPAREN stringLiteralVarargs RPAREN #traversalMethod_concat_String+-- ;++ def "ConcatArgs" $ union [+ "traversal">: nonemptyList $ nestedTraversal,+ "string">: stringLiteralVarargs],++-- traversalMethod_asString+-- : 'asString' LPAREN RPAREN #traversalMethod_asString_Empty+-- | 'asString' LPAREN traversalScopeArgument RPAREN #traversalMethod_asString_Scope+-- ;+--+-- traversalMethod_format+-- : 'format' LPAREN stringArgument RPAREN #traversalMethod_format_String+-- ;+--+-- traversalMethod_toUpper+-- : 'toUpper' LPAREN RPAREN #traversalMethod_toUpper_Empty+-- | 'toUpper' LPAREN traversalScopeArgument RPAREN #traversalMethod_toUpper_Scope+-- ;+--+-- traversalMethod_toLower+-- : 'toLower' LPAREN RPAREN #traversalMethod_toLower_Empty+-- | 'toLower' LPAREN traversalScopeArgument RPAREN #traversalMethod_toLower_Scope+-- ;+--+-- traversalMethod_length+-- : 'length' LPAREN RPAREN #traversalMethod_length_Empty+-- | 'length' LPAREN traversalScopeArgument RPAREN #traversalMethod_length_Scope+-- ;+--+-- traversalMethod_trim+-- : 'trim' LPAREN RPAREN #traversalMethod_trim_Empty+-- | 'trim' LPAREN traversalScopeArgument RPAREN #traversalMethod_trim_Scope+-- ;+--+-- traversalMethod_lTrim+-- : 'lTrim' LPAREN RPAREN #traversalMethod_lTrim_Empty+-- | 'lTrim' LPAREN traversalScopeArgument RPAREN #traversalMethod_lTrim_Scope+-- ;+--+-- traversalMethod_rTrim+-- : 'rTrim' LPAREN RPAREN #traversalMethod_rTrim_Empty+-- | 'rTrim' LPAREN traversalScopeArgument RPAREN #traversalMethod_rTrim_Scope+-- ;+--+-- traversalMethod_replace+-- : 'replace' LPAREN stringNullableArgument COMMA stringNullableArgument RPAREN #traversalMethod_replace_String_String+-- | 'replace' LPAREN traversalScopeArgument COMMA stringNullableArgument COMMA stringNullableArgument RPAREN #traversalMethod_replace_Scope_String_String+-- ;++ def "ReplaceArgs" $ record [+ "scope">: optional traversalScopeArgument,+ "from">: stringNullableArgument,+ "to">: stringNullableArgument],++--+-- traversalMethod_split+-- : 'split' LPAREN stringNullableArgument RPAREN #traversalMethod_split_String+-- | 'split' LPAREN traversalScopeArgument COMMA stringNullableArgument RPAREN #traversalMethod_split_Scope_String+-- ;++ def "SplitArgs" $ record [+ "scope">: optional traversalScopeArgument,+ "delimiter">: stringNullableArgument],++--+-- traversalMethod_substring+-- : 'substring' LPAREN integerArgument RPAREN #traversalMethod_substring_int+-- | 'substring' LPAREN traversalScopeArgument COMMA integerArgument RPAREN #traversalMethod_substring_Scope_int+-- | 'substring' LPAREN integerArgument COMMA integerArgument RPAREN #traversalMethod_substring_int_int+-- | 'substring' LPAREN traversalScopeArgument COMMA integerArgument COMMA integerArgument RPAREN #traversalMethod_substring_Scope_int_int+-- ;++ def "SubstringArgs" $ record [+ "scope">: optional traversalScopeArgument,+ "start">: integerArgument,+ "end">: optional integerArgument],++-- traversalMethod_asDate+-- : 'asDate' LPAREN RPAREN+-- ;+--+-- traversalMethod_dateAdd+-- : 'dateAdd' LPAREN traversalDTArgument COMMA integerArgument RPAREN+-- ;++ def "DateAddArgs" $ record [+ "unit">: gremlin "TraversalDTArgument",+ "duration">: integerArgument],++-- traversalMethod_dateDiff+-- : 'dateDiff' LPAREN nestedTraversal RPAREN #traversalMethod_dateDiff_Traversal+-- | 'dateDiff' LPAREN dateArgument RPAREN #traversalMethod_dateDiff_Date+-- ;++ def "DateDiffArgs" $ union [+ "traversal">: nestedTraversal,+ "date">: dateArgument],++-- /*********************************************+-- ARGUMENT AND TERMINAL RULES+-- **********************************************/+--+-- // There is syntax available in the construction of a ReferenceVertex, that allows the label to not be specified.+-- // That use case is related to OLAP when the StarGraph does not preserve the label of adjacent vertices or other+-- // fail fast scenarios in that processing model. It is not relevant to the grammar however when a user is creating+-- // the Vertex to be used in a Traversal and therefore both id and label are required.+-- structureVertex+-- : NEW? ('Vertex'|'ReferenceVertex') LPAREN genericLiteralArgument COMMA stringArgument RPAREN+-- ;++ def "StructureVertex" $ record [+ "new">: boolean,+ "id">: genericLiteralArgument,+ "label">: stringArgument],++-- traversalStrategy+-- : NEW? classType (LPAREN (configuration (COMMA configuration)*)? RPAREN)?+-- ;++ def "TraversalStrategy" $ record [+ "new">: boolean,+ "class">: classType,+ "configurations">: list $ gremlin "Configuration"],++-- configuration+-- : keyword COLON genericLiteralArgument+-- | Identifier COLON genericLiteralArgument+-- ;++ def "Configuration" $ record [+ "key">: gremlin "KeywordOrIdentifier",+ "value">: genericLiteralArgument],++ def "KeywordOrIdentifier" $ union [+ "keyword">: gremlin "Keyword",+ "identifier">: identifier],++-- traversalScope+-- : 'local' | 'Scope.local'+-- | 'global' | 'Scope.global'+-- ;+ def "TraversalScope" $ enum [+ "local",+ "global"],++-- traversalBarrier+-- : 'normSack' | 'Barrier.normSack'+-- ;++-- traversalToken+-- : 'id' | 'T.id'+-- | 'label' | 'T.label'+-- | 'key' | 'T.key'+-- | 'value' | 'T.value'+-- ;++ def "TraversalToken" $ enum [+ "id",+ "label",+ "key",+ "value"],++-- traversalMerge+-- : 'onCreate' | 'Merge.onCreate'+-- | 'onMatch' | 'Merge.onMatch'+-- | 'outV' | 'Merge.outV'+-- | 'inV' | 'Merge.inV'+-- ;++ def "TraversalMerge" $ enum [+ "onCreate",+ "onMatch",+ "outV",+ "inV"],++-- traversalOrder+-- : 'incr' | 'Order.incr'+-- | 'decr' | 'Order.decr'+-- | 'asc' | 'Order.asc'+-- | 'desc' | 'Order.desc'+-- | 'shuffle' | 'Order.shuffle'+-- ;++ def "TraversalOrder" $ enum [+ "incr",+ "decr",+ "asc",+ "desc",+ "shuffle"],++-- traversalDirection+-- : 'IN' | 'Direction.IN' | 'Direction.from' | 'from'+-- | 'OUT' | 'Direction.OUT' | 'Direction.to' | 'to'+-- | 'BOTH' | 'Direction.BOTH'+-- ;++ def "TraversalDirection" $ enum [+ "in",+ "out",+ "both"],++-- traversalCardinality+-- : 'Cardinality.single' LPAREN genericLiteral RPAREN+-- | 'Cardinality.set' LPAREN genericLiteral RPAREN+-- | 'Cardinality.list' LPAREN genericLiteral RPAREN+-- | 'single' LPAREN genericLiteral RPAREN+-- | 'set' LPAREN genericLiteral RPAREN+-- | 'list' LPAREN genericLiteral RPAREN+-- | 'single' | 'Cardinality.single'+-- | 'set' | 'Cardinality.set'+-- | 'list' | 'Cardinality.list'+-- ;++ def "TraversalCardinality" $ union [+ "single">: genericLiteral,+ "set">: genericLiteral,+ "list">: genericLiteral],++-- traversalColumn+-- : KEYS | 'Column.keys'+-- | VALUES | 'Column.values'+-- ;++ def "TraversalColumn" $ enum [+ "keys",+ "values"],++-- traversalPop+-- : 'first' | 'Pop.first'+-- | 'last' | 'Pop.last'+-- | 'all' | 'Pop.all'+-- | 'mixed' | 'Pop.mixed'+-- ;++ def "TraversalPop" $ enum [+ "first",+ "last",+ "all",+ "mixed"],++-- traversalOperator+-- : 'addAll' | 'Operator.addAll'+-- | 'and' | 'Operator.and'+-- | 'assign' | 'Operator.assign'+-- | 'div' | 'Operator.div'+-- | 'max' | 'Operator.max'+-- | 'min' | 'Operator.min'+-- | 'minus' | 'Operator.minus'+-- | 'mult' | 'Operator.mult'+-- | 'or' | 'Operator.or'+-- | 'sum' | 'Operator.sum'+-- | 'sumLong' | 'Operator.sumLong'+-- ;++ def "TraversalOperator" $ enum [+ "addAll",+ "and",+ "assign",+ "div",+ "max",+ "min",+ "minus",+ "mult",+ "or",+ "sum",+ "sumLong"],++-- traversalPick+-- : 'any' | 'Pick.any'+-- | 'none' | 'Pick.none'+-- ;++ def "TraversalPick" $ enum [+ "any",+ "none"],++-- traversalDT+-- : 'second' | 'DT.second'+-- | 'minute' | 'DT.minute'+-- | 'hour' | 'DT.hour'+-- | 'day' | 'DT.day'+-- ;++ def "TraversalDT" $ enum [+ "second",+ "minute",+ "hour",+ "day"],++-- traversalPredicate+ def "TraversalPredicate" $ union [+-- : traversalPredicate_eq+ "eq">: genericLiteralArgument,+-- | traversalPredicate_neq+ "neq">: genericLiteralArgument,+-- | traversalPredicate_lt+ "lt">: genericLiteralArgument,+-- | traversalPredicate_lte+ "lte">: genericLiteralArgument,+-- | traversalPredicate_gt+ "gt">: genericLiteralArgument,+-- | traversalPredicate_gte+ "gte">: genericLiteralArgument,+-- | traversalPredicate_inside+ "inside">: gremlin "RangeArgument",+-- | traversalPredicate_outside+ "outside">: gremlin "RangeArgument",+-- | traversalPredicate_between+ "between">: gremlin "RangeArgument",+-- | traversalPredicate_within+ "within">: optional genericLiteralArgument,+-- | traversalPredicate_without+ "without">: optional genericLiteralArgument,+-- | traversalPredicate_not+ "not">: traversalPredicate,+-- | traversalPredicate_startingWith+ "startingWith">: stringArgument,+-- | traversalPredicate_notStartingWith+ "notStartingWith">: stringArgument,+-- | traversalPredicate_endingWith+ "endingWith">: stringArgument,+-- | traversalPredicate_notEndingWith+ "notEndingWith">: stringArgument,+-- | traversalPredicate_containing+ "containing">: stringArgument,+-- | traversalPredicate_notContaining+ "notContaining">: stringArgument,+-- | traversalPredicate_regex+ "regex">: stringArgument,+-- | traversalPredicate_notRegex+ "notRegex">: stringArgument,+-- | traversalPredicate DOT 'and' LPAREN traversalPredicate RPAREN+ "and">: gremlin "TwoTraversalPredicates",+-- | traversalPredicate DOT 'or' LPAREN traversalPredicate RPAREN+ "or">: gremlin "TwoTraversalPredicates",+-- | traversalPredicate DOT 'negate' LPAREN RPAREN+ "negate">: traversalPredicate],+-- ;++ def "TwoTraversalPredicates" $ record [+ "left">: traversalPredicate,+ "right">: traversalPredicate],++-- traversalTerminalMethod+ def "TraversalTerminalMethod" $ union [ -- TODO+-- : traversalTerminalMethod_explain+ "explain">: unit,+-- | traversalTerminalMethod_iterate+ "iterate">: unit,+-- | traversalTerminalMethod_hasNext+ "hasNext">: unit,+-- | traversalTerminalMethod_tryNext+ "tryNext">: unit,+-- | traversalTerminalMethod_next+ "next">: optional integerLiteral,+-- | traversalTerminalMethod_toList+ "toList">: unit,+-- | traversalTerminalMethod_toSet+ "toSet">: unit,+-- | traversalTerminalMethod_toBulkSet+ "toBulkSet">: unit],+-- ;++-- traversalSackMethod+-- : traversalBarrier+-- ;++-- traversalSelfMethod+ def "TraversalSelfMethod" $ enum [+-- : traversalSelfMethod_discard+ "discard"],+-- ;++-- // Additional special rules that are derived from above+-- // These are used to restrict broad method signatures that accept lambdas+-- // to a smaller set.+-- traversalComparator+-- : traversalOrder+-- ;++-- traversalFunction+-- : traversalToken+-- | traversalColumn+-- ;++ def "TraversalFunction" $ union [+ "token">: traversalToken,+ "column">: gremlin "TraversalColumn"],++-- traversalBiFunction+-- : traversalOperator+-- ;+--+-- traversalPredicate_eq+-- : ('P.eq' | 'eq') LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_neq+-- : ('P.neq' | 'neq') LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_lt+-- : ('P.lt' | 'lt') LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_lte+-- : ('P.lte' | 'lte') LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_gt+-- : ('P.gt' | 'gt') LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_gte+-- : ('P.gte' | 'gte') LPAREN genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_inside+-- : ('P.inside' | 'inside') LPAREN genericLiteralArgument COMMA genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_outside+-- : ('P.outside' | 'outside') LPAREN genericLiteralArgument COMMA genericLiteralArgument RPAREN+-- ;++ def "RangeArgument" $ record [+ "min">: genericLiteralArgument,+ "max">: genericLiteralArgument],++-- traversalPredicate_between+-- : ('P.between' | 'between') LPAREN genericLiteralArgument COMMA genericLiteralArgument RPAREN+-- ;+--+-- traversalPredicate_within+-- : ('P.within' | 'within') LPAREN RPAREN+-- | ('P.within' | 'within') LPAREN genericLiteralListArgument RPAREN+-- ;+--+-- traversalPredicate_without+-- : ('P.without' | 'without') LPAREN RPAREN+-- | ('P.without' | 'without') LPAREN genericLiteralListArgument RPAREN+-- ;+--+-- traversalPredicate_not+-- : ('P.not' | 'not') LPAREN traversalPredicate RPAREN+-- ;+--+-- traversalPredicate_containing+-- : ('TextP.containing' | 'containing') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_notContaining+-- : ('TextP.notContaining' | 'notContaining') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_startingWith+-- : ('TextP.startingWith' | 'startingWith') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_notStartingWith+-- : ('TextP.notStartingWith' | 'notStartingWith') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_endingWith+-- : ('TextP.endingWith' | 'endingWith') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_notEndingWith+-- : ('TextP.notEndingWith' | 'notEndingWith') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_regex+-- : ('TextP.regex' | 'regex') LPAREN stringArgument RPAREN+-- ;+--+-- traversalPredicate_notRegex+-- : ('TextP.notRegex' | 'notRegex') LPAREN stringArgument RPAREN+-- ;+--+-- traversalTerminalMethod_explain+-- : 'explain' LPAREN RPAREN+-- ;+--+-- traversalTerminalMethod_hasNext+-- : 'hasNext' LPAREN RPAREN+-- ;+--+-- traversalTerminalMethod_iterate+-- : 'iterate' LPAREN RPAREN+-- ;+--+-- traversalTerminalMethod_tryNext+-- : 'tryNext' LPAREN RPAREN+-- ;+--+-- traversalTerminalMethod_next+-- : 'next' LPAREN RPAREN+-- | 'next' LPAREN integerLiteral RPAREN+-- ;+--+-- traversalTerminalMethod_toList+-- : 'toList' LPAREN RPAREN+-- ;+--+-- traversalTerminalMethod_toSet+-- : 'toSet' LPAREN RPAREN+-- ;+--+-- traversalTerminalMethod_toBulkSet+-- : 'toBulkSet' LPAREN RPAREN+-- ;+--+-- traversalSelfMethod_discard+-- : 'discard' LPAREN RPAREN+-- ;+--+-- // Gremlin specific lexer rules+--+-- withOptionKeys+-- : shortestPathConstants+-- | connectedComponentConstants+-- | pageRankConstants+-- | peerPressureConstants+-- | ioOptionsKeys+-- | withOptionsConstants_tokens+-- | withOptionsConstants_indexer+-- ;++ def "WithOptionKeys" $ union [+ "shortestPath">: gremlin "ShortestPathConstants",+ "connectedComponent">: gremlin "ConnectedComponentConstants",+ "pageRank">: gremlin "PageRankConstants",+ "peerPressure">: gremlin "PeerPressureConstants",+ "io">: gremlin "IoOptionsKeys",+ "withOptionsTokens">: unit,+ "withOptionsIndexer">: unit],++-- connectedComponentConstants+-- : connectedComponentConstants_component+-- | connectedComponentConstants_edges+-- | connectedComponentConstants_propertyName+-- ;++ def "ConnectedComponentConstants" $ enum [+ "component",+ "edges",+ "propertyName"],++-- pageRankConstants+-- : pageRankConstants_edges+-- | pageRankConstants_times+-- | pageRankConstants_propertyName+-- ;++ def "PageRankConstants" $ enum [+ "edges",+ "times",+ "propertyName"],++-- peerPressureConstants+-- : peerPressureConstants_edges+-- | peerPressureConstants_times+-- | peerPressureConstants_propertyName+-- ;++ def "PeerPressureConstants" $ enum [+ "edges",+ "times",+ "propertyName"],++-- shortestPathConstants+-- : shortestPathConstants_target+-- | shortestPathConstants_edges+-- | shortestPathConstants_distance+-- | shortestPathConstants_maxDistance+-- | shortestPathConstants_includeEdges+-- ;++ def "ShortestPathConstants" $ enum [+ "target",+ "edges",+ "distance",+ "maxDistance",+ "includeEdges"],++-- withOptionsValues+-- : withOptionsConstants_tokens+-- | withOptionsConstants_none+-- | withOptionsConstants_ids+-- | withOptionsConstants_labels+-- | withOptionsConstants_keys+-- | withOptionsConstants_values+-- | withOptionsConstants_all+-- | withOptionsConstants_list+-- | withOptionsConstants_map+-- ;++ def "WithOptionsValues" $ enum [+ "tokens",+ "none",+ "ids",+ "labels",+ "keys",+ "values",+ "all",+ "list",+ "map"],++-- ioOptionsKeys+-- : ioOptionsConstants_reader+-- | ioOptionsConstants_writer+-- ;++ def "IoOptionsKeys" $ enum [+ "reader",+ "writer"],++-- ioOptionsValues+-- : ioOptionsConstants_gryo+-- | ioOptionsConstants_graphson+-- | ioOptionsConstants_graphml+-- ;++ def "IoOptionsValues" $ enum [+ "gryo",+ "graphson",+ "graphml"],++-- connectedComponentConstants_component+-- : connectedComponentStringConstant DOT 'component'+-- ;+--+-- connectedComponentConstants_edges+-- : connectedComponentStringConstant DOT EDGES+-- ;+--+-- connectedComponentConstants_propertyName+-- : connectedComponentStringConstant DOT 'propertyName'+-- ;+--+-- pageRankConstants_edges+-- : pageRankStringConstant DOT EDGES+-- ;+--+-- pageRankConstants_times+-- : pageRankStringConstant DOT 'times'+-- ;+--+-- pageRankConstants_propertyName+-- : pageRankStringConstant DOT 'propertyName'+-- ;+--+-- peerPressureConstants_edges+-- : peerPressureStringConstant DOT EDGES+-- ;+--+-- peerPressureConstants_times+-- : peerPressureStringConstant DOT 'times'+-- ;+--+-- peerPressureConstants_propertyName+-- : peerPressureStringConstant DOT 'propertyName'+-- ;+--+-- shortestPathConstants_target+-- : shortestPathStringConstant DOT 'target'+-- ;+--+-- shortestPathConstants_edges+-- : shortestPathStringConstant DOT EDGES+-- ;+--+-- shortestPathConstants_distance+-- : shortestPathStringConstant DOT 'distance'+-- ;+--+-- shortestPathConstants_maxDistance+-- : shortestPathStringConstant DOT 'maxDistance'+-- ;+--+-- shortestPathConstants_includeEdges+-- : shortestPathStringConstant DOT 'includeEdges'+-- ;+--+-- withOptionsConstants_tokens+-- : withOptionsStringConstant DOT 'tokens'+-- ;+--+-- withOptionsConstants_none+-- : withOptionsStringConstant DOT 'none'+-- ;+--+-- withOptionsConstants_ids+-- : withOptionsStringConstant DOT 'ids'+-- ;+--+-- withOptionsConstants_labels+-- : withOptionsStringConstant DOT 'labels'+-- ;+--+-- withOptionsConstants_keys+-- : withOptionsStringConstant DOT 'keys'+-- ;+--+-- withOptionsConstants_values+-- : withOptionsStringConstant DOT 'values'+-- ;+--+-- withOptionsConstants_all+-- : withOptionsStringConstant DOT 'all'+-- ;+--+-- withOptionsConstants_indexer+-- : withOptionsStringConstant DOT 'indexer'+-- ;+--+-- withOptionsConstants_list+-- : withOptionsStringConstant DOT 'list'+-- ;+--+-- withOptionsConstants_map+-- : withOptionsStringConstant DOT 'map'+-- ;+--+-- ioOptionsConstants_reader+-- : ioOptionsStringConstant DOT 'reader'+-- ;+--+-- ioOptionsConstants_writer+-- : ioOptionsStringConstant DOT 'writer'+-- ;+--+-- ioOptionsConstants_gryo+-- : ioOptionsStringConstant DOT 'gryo'+-- ;+--+-- ioOptionsConstants_graphson+-- : ioOptionsStringConstant DOT 'graphson'+-- ;+--+-- ioOptionsConstants_graphml+-- : ioOptionsStringConstant DOT 'graphml'+-- ;+--+-- connectedComponentStringConstant+-- : 'ConnectedComponent'+-- ;+--+-- pageRankStringConstant+-- : 'PageRank'+-- ;+--+-- peerPressureStringConstant+-- : 'PeerPressure'+-- ;+--+-- shortestPathStringConstant+-- : 'ShortestPath'+-- ;+--+-- withOptionsStringConstant+-- : 'WithOptions'+-- ;+--+-- ioOptionsStringConstant+-- : 'IO'+-- ;+--+-- booleanArgument+-- : booleanLiteral+-- | variable+-- ;++ defArgument "BooleanArgument" booleanLiteral,++-- integerArgument+-- : integerLiteral+-- | variable+-- ;++ defArgument "IntegerArgument" integerLiteral,++--+-- floatArgument+-- : floatLiteral+-- | variable+-- ;++ defArgument "FloatArgument" floatLiteral,++-- stringArgument+-- : stringLiteral+-- | variable+-- ;++ defArgument "StringArgument" stringLiteral,++-- stringNullableArgument+-- : stringNullableLiteral+-- | variable+-- ;++ defArgument "StringNullableArgument" stringNullableLiteral,++-- dateArgument+-- : dateLiteral+-- | variable+-- ;++ defArgument "DateArgument" dateLiteral,++-- genericLiteralArgument+-- : genericLiteral+-- | variable+-- ;++ defArgument "GenericLiteralArgument" genericLiteral,++-- genericLiteralListArgument+-- : genericLiteralList+-- | variable+-- ;++ defArgument "GenericLiteralListArgument" genericLiteralList,++-- genericLiteralMapArgument+-- : genericLiteralMap+-- | variable+-- ;++ defArgument "GenericLiteralMapArgument" genericLiteralMap,++-- genericLiteralMapNullableArgument+-- : genericLiteralMap+-- | nullLiteral+-- | variable+-- ;++ defArgument "GenericLiteralMapNullableArgument" (optional genericLiteralMap),++-- structureVertexArgument+-- : structureVertex+-- | variable+-- ;++ defArgument "StructureVertexArgument" structureVertex,++-- traversalCardinalityArgument+-- : traversalCardinality+-- | variable+-- ;++ defArgument "TraversalCardinalityArgument" traversalCardinality,++-- traversalColumnArgument+-- : traversalColumn+-- | variable+-- ;++ defArgument "TraversalColumnArgument" traversalColumn,++-- traversalDirectionArgument+-- : traversalDirection+-- | variable+-- ;++ defArgument "TraversalDirectionArgument" traversalDirection,++-- traversalMergeArgument+-- : traversalMerge+-- | variable+-- ;++ defArgument "TraversalMergeArgument" traversalMerge,++-- traversalOrderArgument+-- : traversalOrder+-- | variable+-- ;++ defArgument "TraversalOrderArgument" traversalOrder,++-- traversalPopArgument+-- : traversalPop+-- | variable+-- ;++ defArgument "TraversalPopArgument" traversalPop,++-- traversalSackMethodArgument+-- : traversalSackMethod+-- | variable+-- ;++ defArgument "TraversalSackMethodArgument" traversalSackMethod,++-- traversalScopeArgument+-- : traversalScope+-- | variable+-- ;++ defArgument "TraversalScopeArgument" traversalScope,++-- traversalTokenArgument+-- : traversalToken+-- | variable+-- ;++ defArgument "TraversalTokenArgument" traversalToken,++-- traversalComparatorArgument+-- : traversalComparator+-- | variable+-- ;++ defArgument "TraversalComparatorArgument" traversalComparator,++-- traversalFunctionArgument+-- : traversalFunction+-- | variable+-- ;++ defArgument "TraversalFunctionArgument" traversalFunction,++-- traversalBiFunctionArgument+-- : traversalBiFunction+-- | variable+-- ;++ defArgument "TraversalBiFunctionArgument" traversalOperator,++-- traversalDTArgument+-- : traversalDT+-- | variable+-- ;++ defArgument "TraversalDTArgument" traversalDT,++-- traversalStrategyList+-- : traversalStrategyExpr?+-- ;+--+-- traversalStrategyExpr+-- : traversalStrategy (COMMA traversalStrategy)*+-- ;+--+-- classTypeList+-- : classTypeExpr?+-- ;+--+-- classTypeExpr+-- : classType (COMMA classType)*+-- ;+--+-- nestedTraversalList+-- : nestedTraversalExpr?+-- ;++ -- Use: nestedTraversalList++-- nestedTraversalExpr+-- : nestedTraversal (COMMA nestedTraversal)*+-- ;+--+-- genericLiteralVarargs+-- : (genericLiteralArgument (COMMA genericLiteralArgument)*)?+-- ;++-- genericLiteralList+-- : genericLiteralExpr?+-- ;++ def "GenericLiteralList" $ list genericLiteral,++-- genericLiteralExpr+-- : genericLiteral (COMMA genericLiteral)*+-- ;+--+-- genericLiteralRange+-- : integerLiteral DOT DOT integerLiteral+-- | stringLiteral DOT DOT stringLiteral+-- ;++ def "GenericLiteralRange" $ union [+ "integer">: gremlin "IntegerRange",+ "string">: gremlin "StringRange"],++ def "IntegerRange" $ record [+ "left">: integerLiteral,+ "right">: integerLiteral],++ def "StringRange" $ record [+ "left">: stringLiteral,+ "right">: stringLiteral],++-- genericLiteralSet+-- : LBRACE (genericLiteral (COMMA genericLiteral)*)? RBRACE+-- ;++ def "GenericLiteralSet" $ list genericLiteral,++-- genericLiteralCollection+-- : LBRACK (genericLiteral (COMMA genericLiteral)*)? RBRACK+-- ;++ def "GenericLiteralCollection" $ list genericLiteral,++-- stringLiteralVarargs+-- : (stringNullableArgument (COMMA stringNullableArgument)*)?+-- ;++ -- Use: stringLiteralVarargs++-- stringLiteralList+-- : stringLiteralExpr?+-- | LBRACK stringLiteralExpr? RBRACK+-- ;+--+-- stringLiteralExpr+-- : stringNullableLiteral (COMMA stringNullableLiteral)*+-- ;+--+-- genericLiteral+ def "GenericLiteral" $ union [+-- : numericLiteral+ "numeric">: numericLiteral,+-- | booleanLiteral+ "boolean">: booleanLiteral,+-- | stringLiteral+ "string">: stringLiteral,+-- | dateLiteral+ "date">: dateLiteral,+-- | nullLiteral+ "null">: unit,+-- | nanLiteral+ "nan">: unit,+-- | infLiteral+ "inf">: unit,+-- // Allow the generic literal to match specific gremlin tokens also+-- | traversalToken+ "traversalToken">: traversalToken,+-- | traversalCardinality+ "traversalCardinality">: traversalCardinality,+-- | traversalDirection+ "traversalDirection">: traversalDirection,+-- | traversalMerge+ "traversalMerge">: traversalMerge,+-- | traversalPick+ "traversalPick">: traversalPick,+-- | traversalDT+ "traversalDT">: traversalDT,+-- | structureVertex+ "structureVertex">: structureVertex,+-- | genericLiteralSet+ "genericLiteralSet">: genericLiteralSet,+-- | genericLiteralCollection+ "genericLiteralCollection">: genericLiteralCollection,+-- | genericLiteralRange+ "genericLiteralRange">: genericLiteralRange,+-- | nestedTraversal+ "nestedTraversal">: nestedTraversal,+-- | terminatedTraversal+ "terminatedTraversal">: terminatedTraversal,+-- | genericLiteralMap+ "genericLiteralMap">: genericLiteralMap],+-- ;++-- genericLiteralMap+-- : LBRACK COLON RBRACK+-- | LBRACK mapEntry (COMMA mapEntry)* RBRACK+-- ;++ def "GenericLiteralMap" $ list $ gremlin "MapEntry",++-- // allow builds of Map that sorta make sense in the Gremlin context.+-- mapEntry+-- : (LPAREN stringLiteral RPAREN | stringLiteral) COLON genericLiteral+-- | (LPAREN numericLiteral RPAREN | numericLiteral) COLON genericLiteral+-- | (LPAREN traversalToken RPAREN | traversalToken) COLON genericLiteral+-- | (LPAREN traversalDirection RPAREN | traversalDirection) COLON genericLiteral+-- | (LPAREN genericLiteralSet RPAREN | genericLiteralSet) COLON genericLiteral+-- | (LPAREN genericLiteralCollection RPAREN | genericLiteralCollection) COLON genericLiteral+-- | (LPAREN genericLiteralMap RPAREN | genericLiteralMap) COLON genericLiteral+-- | keyword COLON genericLiteral+-- | Identifier COLON genericLiteral+-- ;++ def "MapEntry" $ union [+ "key">: gremlin "MapKey",+ "value">: genericLiteral],++ def "MapKey" $ union [+ "string">: stringLiteral,+ "numeric">: numericLiteral,+ "traversalToken">: traversalToken,+ "traversalDirection">: traversalDirection,+ "set">: genericLiteralSet,+ "collection">: genericLiteralCollection,+ "map">: genericLiteralMap,+ "keyword">: keyword,+ "identifier">: identifier],++-- stringLiteral+-- : EmptyStringLiteral+-- | NonEmptyStringLiteral+-- ;++ -- Use: stringLiteral++-- stringNullableLiteral+-- : EmptyStringLiteral+-- | NonEmptyStringLiteral+-- | NullLiteral+-- ;++ -- Use: stringNullableLiteral++-- integerLiteral+-- : IntegerLiteral+-- ;++ def "IntegerLiteral" bigint,++--+-- floatLiteral+-- : FloatingPointLiteral+-- ;++ def "FloatLiteral" bigfloat,++-- numericLiteral+-- : integerLiteral+-- | floatLiteral+-- ;++ def "NumericLiteral" $ union [+ "integer">: integerLiteral,+ "float">: floatLiteral],++-- booleanLiteral+-- : BooleanLiteral+-- ;++ -- Use: booleanLiteral++-- dateLiteral+-- : 'datetime' LPAREN stringArgument RPAREN+-- | 'datetime' LPAREN RPAREN+-- ;++ def "DateLiteral" $ optional stringArgument,++-- nullLiteral+-- : NullLiteral+-- ;+--+-- nanLiteral+-- : NaNLiteral+-- ;+--+-- infLiteral+-- : SignedInfLiteral+-- ;+--+-- classType+-- : Identifier+-- ;++ -- Use: classType++-- variable+-- : Identifier+-- ;++ -- Use: variable++-- // need to complete this list to fix https://issues.apache.org/jira/browse/TINKERPOP-3047 but this much proves the+-- // approach works and allows the TraversalStrategy work to be complete.+-- keyword+-- : EDGES+-- | KEYS+-- | NEW+-- | VALUES+-- ;++ def "Keyword" $ enum [+ "edges",+ "keys",+ "new",+ "values"],++-- /*********************************************+-- LEXER RULES+-- **********************************************/+--+-- // Lexer rules+-- // These rules are extracted from Java ANTLRv4 Grammar.+-- // Source: https://github.com/antlr/grammars-v4/blob/master/java8/Java8.g4+--+-- // §3.9 Keywords+--+-- EDGES: 'edges';+-- KEYS: 'keys';+-- NEW : 'new';+-- VALUES: 'values';+--+-- // Integer Literals+--+-- IntegerLiteral+-- : Sign? DecimalIntegerLiteral+-- | Sign? HexIntegerLiteral+-- | Sign? OctalIntegerLiteral+-- ;+--+-- fragment+-- DecimalIntegerLiteral+-- : DecimalNumeral IntegerTypeSuffix?+-- ;+--+-- fragment+-- HexIntegerLiteral+-- : HexNumeral IntegerTypeSuffix?+-- ;+--+-- fragment+-- OctalIntegerLiteral+-- : OctalNumeral IntegerTypeSuffix?+-- ;+--+-- fragment+-- IntegerTypeSuffix+-- : [bBsSnNiIlL]+-- ;+--+-- fragment+-- DecimalNumeral+-- : '0'+-- | NonZeroDigit (Digits? | Underscores Digits)+-- ;+--+-- fragment+-- Digits+-- : Digit (DigitsAndUnderscores? Digit)?+-- ;+--+-- fragment+-- Digit+-- : '0'+-- | NonZeroDigit+-- ;+--+-- fragment+-- NonZeroDigit+-- : [1-9]+-- ;+--+-- fragment+-- DigitsAndUnderscores+-- : DigitOrUnderscore++-- ;+--+-- fragment+-- DigitOrUnderscore+-- : Digit+-- | '_'+-- ;+--+-- fragment+-- Underscores+-- : '_'++-- ;+--+-- fragment+-- HexNumeral+-- : '0' [xX] HexDigits+-- ;+--+-- fragment+-- HexDigits+-- : HexDigit (HexDigitsAndUnderscores? HexDigit)?+-- ;+--+-- fragment+-- HexDigit+-- : [0-9a-fA-F]+-- ;+--+-- fragment+-- HexDigitsAndUnderscores+-- : HexDigitOrUnderscore++-- ;+--+-- fragment+-- HexDigitOrUnderscore+-- : HexDigit+-- | '_'+-- ;+--+-- fragment+-- OctalNumeral+-- : '0' Underscores? OctalDigits+-- ;+--+-- fragment+-- OctalDigits+-- : OctalDigit (OctalDigitsAndUnderscores? OctalDigit)?+-- ;+--+-- fragment+-- OctalDigit+-- : [0-7]+-- ;+--+-- fragment+-- OctalDigitsAndUnderscores+-- : OctalDigitOrUnderscore++-- ;+--+-- fragment+-- OctalDigitOrUnderscore+-- : OctalDigit+-- | '_'+-- ;+--+-- // Floating-Point Literals+--+-- FloatingPointLiteral+-- : Sign? DecimalFloatingPointLiteral+-- ;+--+-- fragment+-- DecimalFloatingPointLiteral+-- : Digits ('.' Digits ExponentPart? | ExponentPart) FloatTypeSuffix?+-- | Digits FloatTypeSuffix+-- ;+--+-- fragment+-- ExponentPart+-- : ExponentIndicator SignedInteger+-- ;+--+-- fragment+-- ExponentIndicator+-- : [eE]+-- ;+--+-- fragment+-- SignedInteger+-- : Sign? Digits+-- ;+--+-- fragment+-- Sign+-- : [+-]+-- ;+--+-- fragment+-- FloatTypeSuffix+-- : [fFdDmM]+-- ;+--+-- // Boolean Literals+--+-- BooleanLiteral+-- : 'true'+-- | 'false'+-- ;+--+-- // Null Literal+--+-- NullLiteral+-- : 'null'+-- ;+--+-- // NaN Literal+--+-- NaNLiteral+-- : 'NaN'+-- ;+--+-- // Inf Literal+--+-- SignedInfLiteral+-- : Sign? InfLiteral+-- ;+--+-- InfLiteral+-- : 'Infinity'+-- ;+--+-- // String Literals+--+-- // String literal is customized since Java only allows double quoted strings where Groovy supports single quoted+-- // literals also. A side effect of this is ANTLR will not be able to parse single character string literals with+-- // single quoted so we instead remove char literal altogether and only have string literal in lexer tokens.+-- NonEmptyStringLiteral+-- : '"' DoubleQuotedStringCharacters '"'+-- | '\'' SingleQuotedStringCharacters '\''+-- ;+--+-- // We define NonEmptyStringLiteral and EmptyStringLiteral separately so that we can unambiguously handle empty queries+-- EmptyStringLiteral+-- : '""'+-- | '\'\''+-- ;+--+-- fragment+-- DoubleQuotedStringCharacters+-- : DoubleQuotedStringCharacter++-- ;+--+-- fragment+-- DoubleQuotedStringCharacter+-- : ~('"' | '\\')+-- | JoinLineEscape+-- | EscapeSequence+-- ;+--+-- fragment+-- SingleQuotedStringCharacters+-- : SingleQuotedStringCharacter++-- ;+--+-- fragment+-- SingleQuotedStringCharacter+-- : ~('\'' | '\\')+-- | JoinLineEscape+-- | EscapeSequence+-- ;+--+-- // Escape Sequences for Character and String Literals+-- fragment JoinLineEscape+-- : '\\' '\r'? '\n'+-- ;+--+-- fragment+-- EscapeSequence+-- : '\\' [btnfr"'\\]+-- | OctalEscape+-- | UnicodeEscape // This is not in the spec but prevents having to preprocess the input+-- ;+--+-- fragment+-- OctalEscape+-- : '\\' OctalDigit+-- | '\\' OctalDigit OctalDigit+-- | '\\' ZeroToThree OctalDigit OctalDigit+-- ;+--+-- fragment+-- ZeroToThree+-- : [0-3]+-- ;+--+-- // This is not in the spec but prevents having to preprocess the input+-- fragment+-- UnicodeEscape+-- : '\\' 'u'+ HexDigit HexDigit HexDigit HexDigit+-- ;+--+-- // Separators+--+-- LPAREN : '(';+-- RPAREN : ')';+-- LBRACE : '{';+-- RBRACE : '}';+-- LBRACK : '[';+-- RBRACK : ']';+-- SEMI : ';';+-- COMMA : ',';+-- DOT : '.';+-- COLON : ':';+--+-- TRAVERSAL_ROOT: 'g';+-- ANON_TRAVERSAL_ROOT: '__';+--+-- // Trim whitespace and comments if present+--+-- WS : [ \t\r\n\u000C]+ -> skip+-- ;+--+-- LINE_COMMENT+-- : '//' ~[\r\n]* -> skip+-- ;+--+-- Identifier+-- : IdentifierStart IdentifierPart*+-- ;++ def "Identifier" string]++-- // REFERENCE: https://github.com/antlr/grammars-v4/blob/master/java/java8/Java8Lexer.g4+-- fragment+-- IdentifierStart+-- : [\u0024]+-- | [\u0041-\u005A]+-- | [\u005F]+-- | [\u0061-\u007A]+-- | [\u00A2-\u00A5]+-- | [\u00AA]+-- | [\u00B5]+-- | [\u00BA]+-- | [\u00C0-\u00D6]+-- | [\u00D8-\u00F6]+-- | [\u00F8-\u02C1]+-- | [\u02C6-\u02D1]+-- | [\u02E0-\u02E4]+-- | [\u02EC]+-- | [\u02EE]+-- | [\u0370-\u0374]+-- | [\u0376-\u0377]+-- | [\u037A-\u037D]+-- | [\u037F]+-- | [\u0386]+-- | [\u0388-\u038A]+-- | [\u038C]+-- | [\u038E-\u03A1]+-- | [\u03A3-\u03F5]+-- | [\u03F7-\u0481]+-- | [\u048A-\u052F]+-- | [\u0531-\u0556]+-- | [\u0559]+-- | [\u0561-\u0587]+-- | [\u058F]+-- | [\u05D0-\u05EA]+-- | [\u05F0-\u05F2]+-- | [\u060B]+-- | [\u0620-\u064A]+-- | [\u066E-\u066F]+-- | [\u0671-\u06D3]+-- | [\u06D5]+-- | [\u06E5-\u06E6]+-- | [\u06EE-\u06EF]+-- | [\u06FA-\u06FC]+-- | [\u06FF]+-- | [\u0710]+-- | [\u0712-\u072F]+-- | [\u074D-\u07A5]+-- | [\u07B1]+-- | [\u07CA-\u07EA]+-- | [\u07F4-\u07F5]+-- | [\u07FA]+-- | [\u0800-\u0815]+-- | [\u081A]+-- | [\u0824]+-- | [\u0828]+-- | [\u0840-\u0858]+-- | [\u0860-\u086A]+-- | [\u08A0-\u08B4]+-- | [\u08B6-\u08BD]+-- | [\u0904-\u0939]+-- | [\u093D]+-- | [\u0950]+-- | [\u0958-\u0961]+-- | [\u0971-\u0980]+-- | [\u0985-\u098C]+-- | [\u098F-\u0990]+-- | [\u0993-\u09A8]+-- | [\u09AA-\u09B0]+-- | [\u09B2]+-- | [\u09B6-\u09B9]+-- | [\u09BD]+-- | [\u09CE]+-- | [\u09DC-\u09DD]+-- | [\u09DF-\u09E1]+-- | [\u09F0-\u09F3]+-- | [\u09FB-\u09FC]+-- | [\u0A05-\u0A0A]+-- | [\u0A0F-\u0A10]+-- | [\u0A13-\u0A28]+-- | [\u0A2A-\u0A30]+-- | [\u0A32-\u0A33]+-- | [\u0A35-\u0A36]+-- | [\u0A38-\u0A39]+-- | [\u0A59-\u0A5C]+-- | [\u0A5E]+-- | [\u0A72-\u0A74]+-- | [\u0A85-\u0A8D]+-- | [\u0A8F-\u0A91]+-- | [\u0A93-\u0AA8]+-- | [\u0AAA-\u0AB0]+-- | [\u0AB2-\u0AB3]+-- | [\u0AB5-\u0AB9]+-- | [\u0ABD]+-- | [\u0AD0]+-- | [\u0AE0-\u0AE1]+-- | [\u0AF1]+-- | [\u0AF9]+-- | [\u0B05-\u0B0C]+-- | [\u0B0F-\u0B10]+-- | [\u0B13-\u0B28]+-- | [\u0B2A-\u0B30]+-- | [\u0B32-\u0B33]+-- | [\u0B35-\u0B39]+-- | [\u0B3D]+-- | [\u0B5C-\u0B5D]+-- | [\u0B5F-\u0B61]+-- | [\u0B71]+-- | [\u0B83]+-- | [\u0B85-\u0B8A]+-- | [\u0B8E-\u0B90]+-- | [\u0B92-\u0B95]+-- | [\u0B99-\u0B9A]+-- | [\u0B9C]+-- | [\u0B9E-\u0B9F]+-- | [\u0BA3-\u0BA4]+-- | [\u0BA8-\u0BAA]+-- | [\u0BAE-\u0BB9]+-- | [\u0BD0]+-- | [\u0BF9]+-- | [\u0C05-\u0C0C]+-- | [\u0C0E-\u0C10]+-- | [\u0C12-\u0C28]+-- | [\u0C2A-\u0C39]+-- | [\u0C3D]+-- | [\u0C58-\u0C5A]+-- | [\u0C60-\u0C61]+-- | [\u0C80]+-- | [\u0C85-\u0C8C]+-- | [\u0C8E-\u0C90]+-- | [\u0C92-\u0CA8]+-- | [\u0CAA-\u0CB3]+-- | [\u0CB5-\u0CB9]+-- | [\u0CBD]+-- | [\u0CDE]+-- | [\u0CE0-\u0CE1]+-- | [\u0CF1-\u0CF2]+-- | [\u0D05-\u0D0C]+-- | [\u0D0E-\u0D10]+-- | [\u0D12-\u0D3A]+-- | [\u0D3D]+-- | [\u0D4E]+-- | [\u0D54-\u0D56]+-- | [\u0D5F-\u0D61]+-- | [\u0D7A-\u0D7F]+-- | [\u0D85-\u0D96]+-- | [\u0D9A-\u0DB1]+-- | [\u0DB3-\u0DBB]+-- | [\u0DBD]+-- | [\u0DC0-\u0DC6]+-- | [\u0E01-\u0E30]+-- | [\u0E32-\u0E33]+-- | [\u0E3F-\u0E46]+-- | [\u0E81-\u0E82]+-- | [\u0E84]+-- | [\u0E87-\u0E88]+-- | [\u0E8A]+-- | [\u0E8D]+-- | [\u0E94-\u0E97]+-- | [\u0E99-\u0E9F]+-- | [\u0EA1-\u0EA3]+-- | [\u0EA5]+-- | [\u0EA7]+-- | [\u0EAA-\u0EAB]+-- | [\u0EAD-\u0EB0]+-- | [\u0EB2-\u0EB3]+-- | [\u0EBD]+-- | [\u0EC0-\u0EC4]+-- | [\u0EC6]+-- | [\u0EDC-\u0EDF]+-- | [\u0F00]+-- | [\u0F40-\u0F47]+-- | [\u0F49-\u0F6C]+-- | [\u0F88-\u0F8C]+-- | [\u1000-\u102A]+-- | [\u103F]+-- | [\u1050-\u1055]+-- | [\u105A-\u105D]+-- | [\u1061]+-- | [\u1065-\u1066]+-- | [\u106E-\u1070]+-- | [\u1075-\u1081]+-- | [\u108E]+-- | [\u10A0-\u10C5]+-- | [\u10C7]+-- | [\u10CD]+-- | [\u10D0-\u10FA]+-- | [\u10FC-\u1248]+-- | [\u124A-\u124D]+-- | [\u1250-\u1256]+-- | [\u1258]+-- | [\u125A-\u125D]+-- | [\u1260-\u1288]+-- | [\u128A-\u128D]+-- | [\u1290-\u12B0]+-- | [\u12B2-\u12B5]+-- | [\u12B8-\u12BE]+-- | [\u12C0]+-- | [\u12C2-\u12C5]+-- | [\u12C8-\u12D6]+-- | [\u12D8-\u1310]+-- | [\u1312-\u1315]+-- | [\u1318-\u135A]+-- | [\u1380-\u138F]+-- | [\u13A0-\u13F5]+-- | [\u13F8-\u13FD]+-- | [\u1401-\u166C]+-- | [\u166F-\u167F]+-- | [\u1681-\u169A]+-- | [\u16A0-\u16EA]+-- | [\u16EE-\u16F8]+-- | [\u1700-\u170C]+-- | [\u170E-\u1711]+-- | [\u1720-\u1731]+-- | [\u1740-\u1751]+-- | [\u1760-\u176C]+-- | [\u176E-\u1770]+-- | [\u1780-\u17B3]+-- | [\u17D7]+-- | [\u17DB-\u17DC]+-- | [\u1820-\u1877]+-- | [\u1880-\u1884]+-- | [\u1887-\u18A8]+-- | [\u18AA]+-- | [\u18B0-\u18F5]+-- | [\u1900-\u191E]+-- | [\u1950-\u196D]+-- | [\u1970-\u1974]+-- | [\u1980-\u19AB]+-- | [\u19B0-\u19C9]+-- | [\u1A00-\u1A16]+-- | [\u1A20-\u1A54]+-- | [\u1AA7]+-- | [\u1B05-\u1B33]+-- | [\u1B45-\u1B4B]+-- | [\u1B83-\u1BA0]+-- | [\u1BAE-\u1BAF]+-- | [\u1BBA-\u1BE5]+-- | [\u1C00-\u1C23]+-- | [\u1C4D-\u1C4F]+-- | [\u1C5A-\u1C7D]+-- | [\u1C80-\u1C88]+-- | [\u1CE9-\u1CEC]+-- | [\u1CEE-\u1CF1]+-- | [\u1CF5-\u1CF6]+-- | [\u1D00-\u1DBF]+-- | [\u1E00-\u1F15]+-- | [\u1F18-\u1F1D]+-- | [\u1F20-\u1F45]+-- | [\u1F48-\u1F4D]+-- | [\u1F50-\u1F57]+-- | [\u1F59]+-- | [\u1F5B]+-- | [\u1F5D]+-- | [\u1F5F-\u1F7D]+-- | [\u1F80-\u1FB4]+-- | [\u1FB6-\u1FBC]+-- | [\u1FBE]+-- | [\u1FC2-\u1FC4]+-- | [\u1FC6-\u1FCC]+-- | [\u1FD0-\u1FD3]+-- | [\u1FD6-\u1FDB]+-- | [\u1FE0-\u1FEC]+-- | [\u1FF2-\u1FF4]+-- | [\u1FF6-\u1FFC]+-- | [\u203F-\u2040]+-- | [\u2054]+-- | [\u2071]+-- | [\u207F]+-- | [\u2090-\u209C]+-- | [\u20A0-\u20BF]+-- | [\u2102]+-- | [\u2107]+-- | [\u210A-\u2113]+-- | [\u2115]+-- | [\u2119-\u211D]+-- | [\u2124]+-- | [\u2126]+-- | [\u2128]+-- | [\u212A-\u212D]+-- | [\u212F-\u2139]+-- | [\u213C-\u213F]+-- | [\u2145-\u2149]+-- | [\u214E]+-- | [\u2160-\u2188]+-- | [\u2C00-\u2C2E]+-- | [\u2C30-\u2C5E]+-- | [\u2C60-\u2CE4]+-- | [\u2CEB-\u2CEE]+-- | [\u2CF2-\u2CF3]+-- | [\u2D00-\u2D25]+-- | [\u2D27]+-- | [\u2D2D]+-- | [\u2D30-\u2D67]+-- | [\u2D6F]+-- | [\u2D80-\u2D96]+-- | [\u2DA0-\u2DA6]+-- | [\u2DA8-\u2DAE]+-- | [\u2DB0-\u2DB6]+-- | [\u2DB8-\u2DBE]+-- | [\u2DC0-\u2DC6]+-- | [\u2DC8-\u2DCE]+-- | [\u2DD0-\u2DD6]+-- | [\u2DD8-\u2DDE]+-- | [\u2E2F]+-- | [\u3005-\u3007]+-- | [\u3021-\u3029]+-- | [\u3031-\u3035]+-- | [\u3038-\u303C]+-- | [\u3041-\u3096]+-- | [\u309D-\u309F]+-- | [\u30A1-\u30FA]+-- | [\u30FC-\u30FF]+-- | [\u3105-\u312E]+-- | [\u3131-\u318E]+-- | [\u31A0-\u31BA]+-- | [\u31F0-\u31FF]+-- | [\u3400-\u4DB5]+-- | [\u4E00-\u9FEA]+-- | [\uA000-\uA48C]+-- | [\uA4D0-\uA4FD]+-- | [\uA500-\uA60C]+-- | [\uA610-\uA61F]+-- | [\uA62A-\uA62B]+-- | [\uA640-\uA66E]+-- | [\uA67F-\uA69D]+-- | [\uA6A0-\uA6EF]+-- | [\uA717-\uA71F]+-- | [\uA722-\uA788]+-- | [\uA78B-\uA7AE]+-- | [\uA7B0-\uA7B7]+-- | [\uA7F7-\uA801]+-- | [\uA803-\uA805]+-- | [\uA807-\uA80A]+-- | [\uA80C-\uA822]+-- | [\uA838]+-- | [\uA840-\uA873]+-- | [\uA882-\uA8B3]+-- | [\uA8F2-\uA8F7]+-- | [\uA8FB]+-- | [\uA8FD]+-- | [\uA90A-\uA925]+-- | [\uA930-\uA946]+-- | [\uA960-\uA97C]+-- | [\uA984-\uA9B2]+-- | [\uA9CF]+-- | [\uA9E0-\uA9E4]+-- | [\uA9E6-\uA9EF]+-- | [\uA9FA-\uA9FE]+-- | [\uAA00-\uAA28]+-- | [\uAA40-\uAA42]+-- | [\uAA44-\uAA4B]+-- | [\uAA60-\uAA76]+-- | [\uAA7A]+-- | [\uAA7E-\uAAAF]+-- | [\uAAB1]+-- | [\uAAB5-\uAAB6]+-- | [\uAAB9-\uAABD]+-- | [\uAAC0]+-- | [\uAAC2]+-- | [\uAADB-\uAADD]+-- | [\uAAE0-\uAAEA]+-- | [\uAAF2-\uAAF4]+-- | [\uAB01-\uAB06]+-- | [\uAB09-\uAB0E]+-- | [\uAB11-\uAB16]+-- | [\uAB20-\uAB26]+-- | [\uAB28-\uAB2E]+-- | [\uAB30-\uAB5A]+-- | [\uAB5C-\uAB65]+-- | [\uAB70-\uABE2]+-- | [\uAC00-\uD7A3]+-- | [\uD7B0-\uD7C6]+-- | [\uD7CB-\uD7FB]+-- | [\uF900-\uFA6D]+-- | [\uFA70-\uFAD9]+-- | [\uFB00-\uFB06]+-- | [\uFB13-\uFB17]+-- | [\uFB1D]+-- | [\uFB1F-\uFB28]+-- | [\uFB2A-\uFB36]+-- | [\uFB38-\uFB3C]+-- | [\uFB3E]+-- | [\uFB40-\uFB41]+-- | [\uFB43-\uFB44]+-- | [\uFB46-\uFBB1]+-- | [\uFBD3-\uFD3D]+-- | [\uFD50-\uFD8F]+-- | [\uFD92-\uFDC7]+-- | [\uFDF0-\uFDFC]+-- | [\uFE33-\uFE34]+-- | [\uFE4D-\uFE4F]+-- | [\uFE69]+-- | [\uFE70-\uFE74]+-- | [\uFE76-\uFEFC]+-- | [\uFF04]+-- | [\uFF21-\uFF3A]+-- | [\uFF3F]+-- | [\uFF41-\uFF5A]+-- | [\uFF66-\uFFBE]+-- | [\uFFC2-\uFFC7]+-- | [\uFFCA-\uFFCF]+-- | [\uFFD2-\uFFD7]+-- | [\uFFDA-\uFFDC]+-- | [\uFFE0-\uFFE1]+-- | [\uFFE5-\uFFE6]+-- ;+--+-- fragment+-- IdentifierPart+-- : IdentifierStart+-- | [\u0030-\u0039]+-- | [\u007F-\u009F]+-- | [\u00AD]+-- | [\u0300-\u036F]+-- | [\u0483-\u0487]+-- | [\u0591-\u05BD]+-- | [\u05BF]+-- | [\u05C1-\u05C2]+-- | [\u05C4-\u05C5]+-- | [\u05C7]+-- | [\u0600-\u0605]+-- | [\u0610-\u061A]+-- | [\u061C]+-- | [\u064B-\u0669]+-- | [\u0670]+-- | [\u06D6-\u06DD]+-- | [\u06DF-\u06E4]+-- | [\u06E7-\u06E8]+-- | [\u06EA-\u06ED]+-- | [\u06F0-\u06F9]+-- | [\u070F]+-- | [\u0711]+-- | [\u0730-\u074A]+-- | [\u07A6-\u07B0]+-- | [\u07C0-\u07C9]+-- | [\u07EB-\u07F3]+-- | [\u0816-\u0819]+-- | [\u081B-\u0823]+-- | [\u0825-\u0827]+-- | [\u0829-\u082D]+-- | [\u0859-\u085B]+-- | [\u08D4-\u0903]+-- | [\u093A-\u093C]+-- | [\u093E-\u094F]+-- | [\u0951-\u0957]+-- | [\u0962-\u0963]+-- | [\u0966-\u096F]+-- | [\u0981-\u0983]+-- | [\u09BC]+-- | [\u09BE-\u09C4]+-- | [\u09C7-\u09C8]+-- | [\u09CB-\u09CD]+-- | [\u09D7]+-- | [\u09E2-\u09E3]+-- | [\u09E6-\u09EF]+-- | [\u0A01-\u0A03]+-- | [\u0A3C]+-- | [\u0A3E-\u0A42]+-- | [\u0A47-\u0A48]+-- | [\u0A4B-\u0A4D]+-- | [\u0A51]+-- | [\u0A66-\u0A71]+-- | [\u0A75]+-- | [\u0A81-\u0A83]+-- | [\u0ABC]+-- | [\u0ABE-\u0AC5]+-- | [\u0AC7-\u0AC9]+-- | [\u0ACB-\u0ACD]+-- | [\u0AE2-\u0AE3]+-- | [\u0AE6-\u0AEF]+-- | [\u0AFA-\u0AFF]+-- | [\u0B01-\u0B03]+-- | [\u0B3C]+-- | [\u0B3E-\u0B44]+-- | [\u0B47-\u0B48]+-- | [\u0B4B-\u0B4D]+-- | [\u0B56-\u0B57]+-- | [\u0B62-\u0B63]+-- | [\u0B66-\u0B6F]+-- | [\u0B82]+-- | [\u0BBE-\u0BC2]+-- | [\u0BC6-\u0BC8]+-- | [\u0BCA-\u0BCD]+-- | [\u0BD7]+-- | [\u0BE6-\u0BEF]+-- | [\u0C00-\u0C03]+-- | [\u0C3E-\u0C44]+-- | [\u0C46-\u0C48]+-- | [\u0C4A-\u0C4D]+-- | [\u0C55-\u0C56]+-- | [\u0C62-\u0C63]+-- | [\u0C66-\u0C6F]+-- | [\u0C81-\u0C83]+-- | [\u0CBC]+-- | [\u0CBE-\u0CC4]+-- | [\u0CC6-\u0CC8]+-- | [\u0CCA-\u0CCD]+-- | [\u0CD5-\u0CD6]+-- | [\u0CE2-\u0CE3]+-- | [\u0CE6-\u0CEF]+-- | [\u0D00-\u0D03]+-- | [\u0D3B-\u0D3C]+-- | [\u0D3E-\u0D44]+-- | [\u0D46-\u0D48]+-- | [\u0D4A-\u0D4D]+-- | [\u0D57]+-- | [\u0D62-\u0D63]+-- | [\u0D66-\u0D6F]+-- | [\u0D82-\u0D83]+-- | [\u0DCA]+-- | [\u0DCF-\u0DD4]+-- | [\u0DD6]+-- | [\u0DD8-\u0DDF]+-- | [\u0DE6-\u0DEF]+-- | [\u0DF2-\u0DF3]+-- | [\u0E31]+-- | [\u0E34-\u0E3A]+-- | [\u0E47-\u0E4E]+-- | [\u0E50-\u0E59]+-- | [\u0EB1]+-- | [\u0EB4-\u0EB9]+-- | [\u0EBB-\u0EBC]+-- | [\u0EC8-\u0ECD]+-- | [\u0ED0-\u0ED9]+-- | [\u0F18-\u0F19]+-- | [\u0F20-\u0F29]+-- | [\u0F35]+-- | [\u0F37]+-- | [\u0F39]+-- | [\u0F3E-\u0F3F]+-- | [\u0F71-\u0F84]+-- | [\u0F86-\u0F87]+-- | [\u0F8D-\u0F97]+-- | [\u0F99-\u0FBC]+-- | [\u0FC6]+-- | [\u102B-\u103E]+-- | [\u1040-\u1049]+-- | [\u1056-\u1059]+-- | [\u105E-\u1060]+-- | [\u1062-\u1064]+-- | [\u1067-\u106D]+-- | [\u1071-\u1074]+-- | [\u1082-\u108D]+-- | [\u108F-\u109D]+-- | [\u135D-\u135F]+-- | [\u1712-\u1714]+-- | [\u1732-\u1734]+-- | [\u1752-\u1753]+-- | [\u1772-\u1773]+-- | [\u17B4-\u17D3]+-- | [\u17DD]+-- | [\u17E0-\u17E9]+-- | [\u180B-\u180E]+-- | [\u1810-\u1819]+-- | [\u1885-\u1886]+-- | [\u18A9]+-- | [\u1920-\u192B]+-- | [\u1930-\u193B]+-- | [\u1946-\u194F]+-- | [\u19D0-\u19D9]+-- | [\u1A17-\u1A1B]+-- | [\u1A55-\u1A5E]+-- | [\u1A60-\u1A7C]+-- | [\u1A7F-\u1A89]+-- | [\u1A90-\u1A99]+-- | [\u1AB0-\u1ABD]+-- | [\u1B00-\u1B04]+-- | [\u1B34-\u1B44]+-- | [\u1B50-\u1B59]+-- | [\u1B6B-\u1B73]+-- | [\u1B80-\u1B82]+-- | [\u1BA1-\u1BAD]+-- | [\u1BB0-\u1BB9]+-- | [\u1BE6-\u1BF3]+-- | [\u1C24-\u1C37]+-- | [\u1C40-\u1C49]+-- | [\u1C50-\u1C59]+-- | [\u1CD0-\u1CD2]+-- | [\u1CD4-\u1CE8]+-- | [\u1CED]+-- | [\u1CF2-\u1CF4]+-- | [\u1CF7-\u1CF9]+-- | [\u1DC0-\u1DF9]+-- | [\u1DFB-\u1DFF]+-- | [\u200B-\u200F]+-- | [\u202A-\u202E]+-- | [\u2060-\u2064]+-- | [\u2066-\u206F]+-- | [\u20D0-\u20DC]+-- | [\u20E1]+-- | [\u20E5-\u20F0]+-- | [\u2CEF-\u2CF1]+-- | [\u2D7F]+-- | [\u2DE0-\u2DFF]+-- | [\u302A-\u302F]+-- | [\u3099-\u309A]+-- | [\uA620-\uA629]+-- | [\uA66F]+-- | [\uA674-\uA67D]+-- | [\uA69E-\uA69F]+-- | [\uA6F0-\uA6F1]+-- | [\uA802]+-- | [\uA806]+-- | [\uA80B]+-- | [\uA823-\uA827]+-- | [\uA880-\uA881]+-- | [\uA8B4-\uA8C5]+-- | [\uA8D0-\uA8D9]+-- | [\uA8E0-\uA8F1]+-- | [\uA900-\uA909]+-- | [\uA926-\uA92D]+-- | [\uA947-\uA953]+-- | [\uA980-\uA983]+-- | [\uA9B3-\uA9C0]+-- | [\uA9D0-\uA9D9]+-- | [\uA9E5]+-- | [\uA9F0-\uA9F9]+-- | [\uAA29-\uAA36]+-- | [\uAA43]+-- | [\uAA4C-\uAA4D]+-- | [\uAA50-\uAA59]+-- | [\uAA7B-\uAA7D]+-- | [\uAAB0]+-- | [\uAAB2-\uAAB4]+-- | [\uAAB7-\uAAB8]+-- | [\uAABE-\uAABF]+-- | [\uAAC1]+-- | [\uAAEB-\uAAEF]+-- | [\uAAF5-\uAAF6]+-- | [\uABE3-\uABEA]+-- | [\uABEC-\uABED]+-- | [\uABF0-\uABF9]+-- | [\uFB1E]+-- | [\uFE00-\uFE0F]+-- | [\uFE20-\uFE2F]+-- | [\uFEFF]+-- | [\uFF10-\uFF19]+-- | [\uFFF9-\uFFFB]+-- ;
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Mappings.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.Tinkerpop.Mappings where++import Hydra.Sources.Tier3.All+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Langs.Tinkerpop.Mappings+import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Types as Types+import Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph+++tinkerpopMappingsModule :: Module+tinkerpopMappingsModule = Module ns elements+ [tinkerpopPropertyGraphModule, hydraCoreModule, hydraComputeModule] tier0Modules $+ Just "A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs"+ where+ ns = Namespace "hydra/langs/tinkerpop/mappings"+ mappings = typeref ns+ compute = typeref $ moduleNamespace hydraComputeModule+ core = typeref $ moduleNamespace hydraCoreModule+ v3 = typeref $ moduleNamespace tinkerpopPropertyGraphModule+ 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/PropertyGraph.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph where++import Hydra.Sources.Tier3.All+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types++import Hydra.Sources.Core+++tinkerpopPropertyGraphModule :: Module+tinkerpopPropertyGraphModule = 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/langs/tinkerpop/propertyGraph"+ 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")]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Queries.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.Tinkerpop.Queries 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.Langs.Tinkerpop.PropertyGraph+++propertyGraphQueriesModule :: Module+propertyGraphQueriesModule = Module ns elements [tinkerpopPropertyGraphModule] tier0Modules $+ Just ("A common model for pattern-matching queries over property graphs")+ where+ ns = Namespace "hydra/langs/tinkerpop/queries"+ pg = typeref $ moduleNamespace tinkerpopPropertyGraphModule+ 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"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Tinkerpop/Validate.hs view
@@ -0,0 +1,331 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Tier4.Langs.Tinkerpop.Validate 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.Langs.Tinkerpop.PropertyGraph as PG+import Hydra.Sources.Tier4.Langs.Tinkerpop.PropertyGraph+++validateDefinition :: String -> Datum a -> Definition a+validateDefinition = definitionInModule tinkerpopValidateModule++tinkerpopValidateModule :: Module+tinkerpopValidateModule = Module (Namespace "hydra/langs/tinkerpop/validate") elements+ [] [tinkerpopPropertyGraphModule] $+ 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 :: Definition (+ (t -> v -> Maybe String)+ -> (v -> String)+ -> Y.Maybe (v -> Y.Maybe PG.VertexLabel)+ -> PG.EdgeType t+ -> PG.Edge v+ -> Y.Maybe String)+validateEdgeDef = validateDefinition "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 :: Definition (+ (t -> v -> Maybe String)+ -> (v -> String)+ -> Y.Maybe (v -> Y.Maybe PG.VertexLabel)+ -> PG.ElementType t+ -> PG.Element v+ -> Y.Maybe String)+validateElementDef = validateDefinition "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 :: Definition (+ (t -> v -> Maybe String)+ -> (v -> String)+ -> PG.GraphSchema t+ -> PG.Graph v+ -> Y.Maybe String)+validateGraphDef = validateDefinition "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 :: Definition (+ (t -> v -> Maybe String)+ -> [PG.PropertyType t]+ -> M.Map PG.PropertyKey v+ -> Y.Maybe String)+validatePropertiesDef = validateDefinition "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 :: Definition (+ (t -> v -> Maybe String)+ -> (v -> String)+ -> PG.VertexType t+ -> PG.Vertex v+ -> Y.Maybe String)+validateVertexDef = validateDefinition "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 :: Definition ([Y.Maybe a] -> Y.Maybe a)+checkAllDef = validateDefinition "checkAll" $+ function (listT $ optionalT aT) (optionalT aT) $+ lambda "checks" (+ (Lists.safeHead @@ var "errors")+ `with` [+ "errors">: Optionals.cat @@ var "checks"])++edgeErrorDef :: Definition ((v -> String) -> PG.Edge v -> String -> String)+edgeErrorDef = validateDefinition "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 :: Definition (PG.EdgeLabel -> PG.EdgeLabel -> String)+edgeLabelMismatchDef = validateDefinition "edgeLabelMismatch" $+ functionN [edgeLabelT, edgeLabelT, stringT] $+ lambda "expected" $ lambda "actual" $+ "expected " ++ (unwrap _EdgeLabel @@ var "expected") ++ ", found " ++ (unwrap _EdgeLabel @@ var "actual")++prependDef :: Definition (String -> String -> String)+prependDef = validateDefinition "prepend" $+ functionN [stringT, stringT, stringT] $+ lambda "prefix" $ lambda "msg" $+ (var "prefix") ++ ": " ++ (var "msg")++verifyDef :: Definition (Bool -> String -> Maybe String)+verifyDef = validateDefinition "verify" $+ functionN [booleanT, stringT, optionalT stringT] $+ lambda "b" $ lambda "err" $+ ifElse (var "b")+ nothing+ (just $ var "err")++vertexErrorDef :: Definition ((v -> String) -> PG.Vertex v -> String -> String)+vertexErrorDef = validateDefinition "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 :: Definition (PG.VertexLabel -> PG.VertexLabel -> String)+vertexLabelMismatchDef = validateDefinition "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"
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Xml/Schema.hs view
@@ -0,0 +1,117 @@+module Hydra.Sources.Tier4.Langs.Xml.Schema where++import Hydra.Sources.Tier3.All+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types+++xmlSchemaModule :: Module+xmlSchemaModule = Module ns elements [hydraCoreModule] tier0Modules $+ Just ("A partial XML Schema model, focusing on datatypes. All simple datatypes (i.e. xsd:anySimpleType and below) are included.\n" +++ "See: https://www.w3.org/TR/xmlschema-2\n" +++ "Note: for most of the XML Schema datatype definitions included here, the associated Hydra type is simply\n" +++ " the string type. Exceptions are made for xsd:boolean and most of the numeric types, where there is a clearly\n" +++ " corresponding Hydra literal type.")+ where+ ns = Namespace "hydra/langs/xml/schema"+ def = datatype ns++ elements = datatypes ++ others++ datatypes = [+ def "AnySimpleType" string,+ def "AnyType" string,+ def "AnyURI" string,+ def "Base64Binary" string,+ def "Boolean" boolean,+ def "Byte" int8,+ def "Date" string,+ def "DateTime" string,+ def "Decimal" string,+ def "Double" float64,+ def "Duration" string,+ def "ENTITIES" string,+ def "ENTITY" string,+ def "Float" float32,+ def "GDay" string,+ def "GMonth" string,+ def "GMonthDay" string,+ def "GYear" string,+ def "GYearMonth" string,+ def "HexBinary" string,+ def "ID" string,+ def "IDREF" string,+ def "IDREFS" string,+ def "Int" int32,+ def "Integer" bigint,+ def "Language" string,+ def "Long" int64,+ def "NMTOKEN" string,+ def "NOTATION" string,+ def "Name" string,+ def "NegativeInteger" bigint,+ def "NonNegativeInteger" bigint,+ def "NonPositiveInteger" bigint,+ def "NormalizedString" string,+ def "PositiveInteger" bigint,+ def "QName" string,+ def "Short" int16,+ def "String" string,+ def "Time" string,+ def "Token" string,+ def "UnsignedByte" uint8,+ def "UnsignedInt" uint32,+ def "UnsignedLong" uint64,+ def "UnsignedShort" uint16]++ others = [+ def "ConstrainingFacet" $+ see "https://www.w3.org/TR/xmlschema-2/#non-fundamental" $+ unit, -- TODO: concrete facets++ def "Datatype" $ enum [+ "anySimpleType",+ "anyType",+ "anyURI",+ "base64Binary",+ "boolean",+ "byte",+ "date",+ "dateTime",+ "decimal",+ "double",+ "duration",+ "ENTITIES",+ "ENTITY",+ "float",+ "gDay",+ "gMonth",+ "gMonthDay",+ "gYear",+ "gYearMonth",+ "hexBinary",+ "ID",+ "IDREF",+ "IDREFS",+ "int",+ "integer",+ "language",+ "long",+ "NMTOKEN",+ "NOTATION",+ "name",+ "negativeInteger",+ "nonNegativeInteger",+ "nonPositiveInteger",+ "normalizedString",+ "positiveInteger",+ "qName",+ "short",+ "string",+ "time",+ "token",+ "unsignedByte",+ "unsignedInt",+ "unsignedLong",+ "unsignedShort"]]
+ src/main/haskell/Hydra/Sources/Tier4/Langs/Yaml/Model.hs view
@@ -0,0 +1,76 @@+module Hydra.Sources.Tier4.Langs.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/langs/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]]
+ src/main/haskell/Hydra/Sources/Tier4/Test/Lib/Lists.hs view
@@ -0,0 +1,80 @@+module Hydra.Sources.Tier4.Test.Lib.Lists (listPrimitiveTests) where++import Hydra.Dsl.Tests+import Hydra.Dsl.Terms+++listPrimitiveTests :: TestGroup+listPrimitiveTests = TestGroup "hydra/lib/lists primitives" Nothing groups []+ where+ groups = [+ listsApply,+ listsBind,+ listsConcat,+ listsHead,+ listsIntercalate,+ listsIntersperse,+ listsLast,+ listsLength,+ listsMap,+ listsPure]++listsApply :: TestGroup+listsApply = TestGroup "apply" Nothing [] [+ test [primitive _strings_toUpper, primitive _strings_toLower] ["One", "Two", "Three"] ["ONE", "TWO", "THREE", "one", "two", "three"]]+ where+ test funs lst result = primCase _lists_apply [list funs, stringList lst] (stringList result)++listsBind :: TestGroup+listsBind = TestGroup "bind" Nothing [] [+ test [1, 2, 3, 4] (primitive _lists_pure <.> primitive _math_neg) (negate <$> [1, 2, 3, 4])]+ where+ test lst fun result = primCase _lists_bind [intList lst, fun] (intList result)++listsConcat :: TestGroup+listsConcat = TestGroup "concat" Nothing [] [+ test [[1, 2, 3], [4, 5], [6, 7, 8]] [1, 2, 3, 4, 5, 6, 7, 8]]+ where+ test lists result = primCase _lists_concat [intListList lists] (intList result)++listsHead :: TestGroup+listsHead = TestGroup "head" Nothing [] [+ test [1, 2, 3] 1]+ where+ test lst result = primCase _lists_head [intList lst] (int32 result)++listsIntercalate :: TestGroup+listsIntercalate = TestGroup "intercalate" Nothing [] [+ test [0, 0] [[1, 2, 3], [4, 5], [6, 7, 8]] [1, 2, 3, 0, 0, 4, 5, 0, 0, 6, 7, 8]]+ where+ test ifx lists result = primCase _lists_intercalate [intList ifx, intListList lists] (intList result)++listsIntersperse :: TestGroup+listsIntersperse = TestGroup "intersperse" Nothing [] [+ test "and" ["one", "two", "three"] ["one", "and", "two", "and", "three"]]+ where+ test ifx lst result = primCase _lists_intersperse [string ifx, stringList lst] (stringList result)++listsLast :: TestGroup+listsLast = TestGroup "last" Nothing [] [+ test [1, 2, 3] 3]+ where+ test lst result = primCase _lists_last [intList lst] (int32 result)++listsLength :: TestGroup+listsLength = TestGroup "length" Nothing [] [+ test [1, 2, 3] 3]+ where+ test lst result = primCase _lists_length [intList lst] (int32 result)++listsMap :: TestGroup+listsMap = TestGroup "map" Nothing [] [+ test (primitive _strings_toUpper) ["one", "two"] ["ONE", "TWO"]]+ where+ test fun lst result = primCase _lists_map [fun, stringList lst] (stringList result)++listsPure :: TestGroup+listsPure = TestGroup "pure" Nothing [] [+ test "one"]+ where+ test arg = primCase _lists_pure [string arg] (stringList [arg])
+ src/main/haskell/Hydra/Sources/Tier4/Test/Lib/Strings.hs view
@@ -0,0 +1,58 @@+module Hydra.Sources.Tier4.Test.Lib.Strings (stringPrimitiveTests) where++import Hydra.Dsl.Tests+++stringPrimitiveTests :: TestGroup+stringPrimitiveTests = TestGroup "hydra/lib/strings primitives" Nothing groups []+ where+ groups = [stringsCat, stringsLength, stringsSplitOn, stringsToLower, stringsToUpper]++stringsCat :: TestGroup+stringsCat = TestGroup "cat" Nothing [] [+ test ["one", "two", "three"] "onetwothree",+ test ["", "one", "", ""] "one",+ test [] ""]+ where+ test ls result = primCase _strings_cat [list (string <$> ls)] (string result)++stringsLength :: TestGroup+stringsLength = TestGroup "length" Nothing [] [+ test "" 0,+ test "a" 1,+ test "one" 3]+ where+ test s result = primCase _strings_length [string s] (int32 result)++stringsSplitOn :: TestGroup+stringsSplitOn = TestGroup "splitOn" Nothing [] [+ test "ss" "Mississippi" ["Mi", "i", "ippi"],+ test "Mississippi" "Mississippi" ["", ""],++ test " " "one two three" ["one", "two", "three"],+ test " " " one two three " ["", "one", "two", "three", ""],+ test " " " one two three" ["", "", "one", "two", "three"],+ test " " " one two three" ["", "one two three"],++ test "aa" "aaa" ["", "a"],++ test "a" "" [""],++ test "" "abc" ["", "a", "b", "c"],+ test "" "" [""]]+ where+ test s0 s1 result = primCase _strings_splitOn [string s0, string s1] (list (string <$> result))++stringsToLower :: TestGroup+stringsToLower = TestGroup "toLower" Nothing [] [+ test "One TWO threE" "one two three",+ test "Abc123" "abc123"]+ where+ test s result = primCase _strings_toLower [string s] (string result)++stringsToUpper :: TestGroup+stringsToUpper = TestGroup "toUpper" Nothing [] [+ test "One TWO threE" "ONE TWO THREE",+ test "Abc123" "ABC123"]+ where+ test s result = primCase _strings_toUpper [string s] (string result)
+ src/main/haskell/Hydra/Sources/Tier4/Test/TestSuite.hs view
@@ -0,0 +1,44 @@+module Hydra.Sources.Tier4.Test.TestSuite (testSuiteModule) where++import Hydra.Testing+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Tier3.All++import Hydra.Sources.Tier4.Test.Lib.Lists+import Hydra.Sources.Tier4.Test.Lib.Strings+++testSuiteNs = Namespace "hydra/test/testSuite"++testSuiteModule :: Module+testSuiteModule = Module testSuiteNs elements [] tier0Modules $+ Just "Test cases for primitive functions"+ where+ elements = [+ groupElement "allTests" allTests]++groupElement :: String -> TestGroup -> Element+groupElement lname group = Element name $ setTermType (Just typ) $ encodeGroup group+ where+ encodeGroup (TestGroup name desc groups cases) = Terms.record _TestGroup [+ Field _TestGroup_name $ Terms.string name,+ Field _TestGroup_description $ Terms.optional (Terms.string <$> desc),+ Field _TestGroup_subgroups $ Terms.list (encodeGroup <$> groups),+ Field _TestGroup_cases $ Terms.list (encodeCase <$> cases)]+ encodeCase (TestCase desc style input output) = Terms.record _TestCase [+ Field _TestCase_description $ Terms.optional (Terms.string <$> desc),+ Field _TestCase_evaluationStyle $ Terms.variant _EvaluationStyle (case style of+ EvaluationStyleEager -> _EvaluationStyle_eager+ EvaluationStyleLazy -> _EvaluationStyle_lazy) Terms.unit,+ Field _TestCase_input $ coreEncodeTerm input,+ Field _TestCase_output $ coreEncodeTerm output]+ name = unqualifyName $ QualifiedName (Just testSuiteNs) lname+ typ = TypeVariable _TestGroup++allTests :: TestGroup+allTests = TestGroup "All tests" Nothing primTests []+ where+ primTests = [+ listPrimitiveTests,+ stringPrimitiveTests]
+ src/main/haskell/Hydra/Substitution.hs view
@@ -0,0 +1,80 @@+-- | Variable substitution and normalization of type expressions+module Hydra.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 e fields) -> TypeRecord $ RowType n e (normalizeFieldType <$> fields)+ TypeSet t -> set $ normalizeType t+ TypeSum types -> TypeSum (normalizeType <$> types)+ TypeUnion (RowType n e fields) -> TypeUnion $ RowType n e (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 e fields) -> TypeRecord $ RowType n e (substField <$> fields)+ TypeSet t -> set $ subst t+ TypeSum types -> TypeSum (subst <$> types)+ TypeUnion (RowType n e fields) -> TypeUnion $ RowType n e (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
+ src/main/haskell/Hydra/TermAdapters.hs view
@@ -0,0 +1,405 @@+-- | Adapter framework for types and terms++module Hydra.TermAdapters (+ fieldAdapter,+ functionProxyName,+ functionProxyType,+ termAdapter,+) where++import Hydra.Printing+import Hydra.AdapterUtils+import Hydra.Basics+import Hydra.Strip+import Hydra.Coders+import Hydra.Compute+import Hydra.Core+import Hydra.CoreDecoding+import Hydra.Graph+import Hydra.Lexical+import Hydra.Mantle+import Hydra.Reduction+import Hydra.Rewriting+import Hydra.LiteralAdapters+import Hydra.Dsl.Terms+import Hydra.Reduction+import Hydra.Tier1+import Hydra.Tier2+import qualified Hydra.Dsl.Expect as Expect+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 Text.Read as TR+import qualified Data.Maybe as Y+++_context :: Name+_context = Name "context"++_record :: Name+_record = Name "record"++fieldAdapter :: FieldType -> Flow (AdapterContext) (SymmetricAdapter (AdapterContext) (FieldType) (Field))+fieldAdapter ftyp = do+ ad <- termAdapter $ fieldTypeType ftyp+ return $ Adapter (adapterIsLossy ad) ftyp (ftyp { fieldTypeType = adapterTarget ad })+ $ bidirectional $ \dir (Field name term) -> Field name <$> encodeDecode dir (adapterCoder ad) term++-- | This function accounts for recursive type definitions+forTypeReference :: Name -> Flow (AdapterContext) (SymmetricAdapter (AdapterContext) (Type) (Term))+forTypeReference name = withTrace ("adapt named type " ++ unName name) $ do+ let lossy = False -- Note: we cannot know in advance whether the adapter is lossy or not+ let placeholder = Adapter lossy (TypeVariable name) (TypeVariable name) $ bidirectional $+ \dir term -> do+ cx <- getState+ case M.lookup name (adapterContextAdapters cx) of+ Nothing -> fail $ "no adapter for reference type " ++ unName name+ Just ad -> encodeDecode dir (adapterCoder ad) term+ cx <- getState+ let adapters = adapterContextAdapters cx+ case M.lookup name adapters of+ Nothing -> do+ -- Insert a placeholder until the actual adapter has been constructed+ putState (cx {adapterContextAdapters = M.insert name placeholder adapters})+ mt <- withGraphContext $ resolveType $ TypeVariable name+ case mt of+ Nothing -> pure $ Adapter lossy (TypeVariable name) (TypeVariable name) $ bidirectional $ const pure+ Just t -> do+ actual <- termAdapter t+ putState (cx {adapterContextAdapters = M.insert name actual adapters})+ return actual+ Just ad -> pure ad++functionProxyName :: Name+functionProxyName = Name "hydra/core.FunctionProxy"++functionProxyType :: Type -> Type+functionProxyType dom = TypeUnion $ RowType functionProxyName Nothing [+ FieldType _Elimination_wrap Types.string,+ FieldType _Elimination_optional Types.string,+ FieldType _Elimination_record Types.string,+ FieldType _Elimination_union Types.string, -- TODO (TypeRecord cases)+ FieldType _Function_lambda Types.string, -- TODO (TypeRecord [FieldType _Lambda_parameter Types.string, FieldType _Lambda_body cod]),+ FieldType _Function_primitive Types.string,+ FieldType _Term_variable Types.string]++functionToUnion :: TypeAdapter+functionToUnion t@(TypeFunction (FunctionType dom _)) = do+ ut <- unionType+ ad <- termAdapter ut+ return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder (encode ad) (decode ad)+ where+ encode ad term = coderEncode (adapterCoder ad) $ case fullyStripTerm term of+ TermFunction f -> case f of+ FunctionElimination e -> case e of+ EliminationWrap (Name name) -> variant functionProxyName _Elimination_wrap $ string name+ EliminationOptional _ -> variant functionProxyName _Elimination_optional $ string $ show term -- TODO+ EliminationRecord _ -> variant functionProxyName _Elimination_record $ string $ show term -- TODO+ EliminationUnion _ -> variant functionProxyName _Elimination_union $ string $ show term -- TODO+ FunctionLambda _ -> variant functionProxyName _Function_lambda $ string $ show term -- TODO+ FunctionPrimitive (Name name) -> variant functionProxyName _Function_primitive $ string name+ TermVariable (Name var) -> variant functionProxyName _Term_variable $ string var++ decode ad term = do+ (Field fname fterm) <- coderDecode (adapterCoder ad) term >>= Expect.injection+ Y.fromMaybe (notFound fname) $ M.lookup fname $ M.fromList [+ (_Elimination_wrap, forWrapped fterm),+ (_Elimination_optional, forOptionalCases fterm),+ (_Elimination_record, forProjection fterm),+ (_Elimination_union, forCases fterm),+ (_Function_lambda, forLambda fterm),+ (_Function_primitive, forPrimitive fterm),+ (_Term_variable, forVariable fterm)]+ where+ notFound fname = fail $ "unexpected field: " ++ unName fname+ forCases fterm = read <$> Expect.string fterm -- TODO+ forLambda fterm = read <$> Expect.string fterm -- TODO+ forWrapped fterm = unwrap . Name <$> Expect.string fterm+ forOptionalCases fterm = read <$> Expect.string fterm -- TODO+ forPrimitive fterm = primitive . Name <$> Expect.string fterm+ forProjection fterm = read <$> Expect.string fterm -- TODO+ forVariable fterm = var <$> Expect.string fterm++ unionType = do+ domAd <- termAdapter dom+ return $ TypeUnion $ RowType functionProxyName Nothing [+ FieldType _Elimination_wrap Types.string,+ FieldType _Elimination_optional Types.string,+ FieldType _Elimination_record Types.string,+ FieldType _Elimination_union Types.string, -- TODO (TypeRecord cases)+ FieldType _Function_lambda Types.string, -- TODO (TypeRecord [FieldType _Lambda_parameter Types.string, FieldType _Lambda_body cod]),+ FieldType _Function_primitive Types.string,+ FieldType _Term_variable Types.string]++lambdaToMonotype :: TypeAdapter+lambdaToMonotype t@(TypeLambda (LambdaType _ body)) = do+ ad <- termAdapter body+ return ad {adapterSource = t}++listToSet :: TypeAdapter+listToSet t@(TypeSet st) = do+ ad <- termAdapter $ Types.list st+ return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder (encode ad) (decode ad)+ where+ encode ad (TermSet s) = coderEncode (adapterCoder ad) $ TermList $ S.toList s+ decode ad term = TermSet . S.fromList . (\(TermList l') -> l') <$> coderDecode (adapterCoder ad) term++optionalToList :: TypeAdapter+optionalToList t@(TypeOptional ot) = do+ ad <- termAdapter ot+ return $ Adapter False t (Types.list $ adapterTarget ad) $ Coder {+ coderEncode = \(TermOptional m) -> Y.maybe+ (pure $ list [])+ (fmap (\ r -> list [r]) . coderEncode (adapterCoder ad)) m,+ coderDecode = \(TermList l) -> optional <$> if L.null l then+ pure Nothing+ else Just <$> coderDecode (adapterCoder ad) (L.head l)}++passAnnotated :: TypeAdapter+passAnnotated t@(TypeAnnotated (AnnotatedType at ann)) = do+ ad <- termAdapter at+ return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ bidirectional $+ \dir term -> encodeDecode dir (adapterCoder ad) term++-- TODO: only tested for type mappings; not yet for types+terms+passApplication :: TypeAdapter+passApplication t = do+ reduced <- withGraphContext $ betaReduceType t+ ad <- termAdapter reduced+ return $ Adapter (adapterIsLossy ad) t reduced $ bidirectional $+ \dir term -> encodeDecode dir (adapterCoder ad) term++passFunction :: TypeAdapter+passFunction t@(TypeFunction (FunctionType dom cod)) = do+ domAd <- termAdapter dom+ codAd <- termAdapter cod+ caseAds <- case stripType dom of+ TypeUnion rt -> M.fromList . L.zip (fieldTypeName <$> rowTypeFields rt)+ <$> CM.mapM (\f -> fieldAdapter $ FieldType (fieldTypeName f) (TypeFunction $ FunctionType (fieldTypeType f) cod)) (rowTypeFields rt)+ _ -> pure M.empty+ optionAd <- case stripType dom of+ TypeOptional ot -> Just <$> termAdapter (Types.function ot cod)+ _ -> pure Nothing+ let lossy = adapterIsLossy codAd || or (adapterIsLossy . snd <$> M.toList caseAds)+ let target = Types.function (adapterTarget domAd) (adapterTarget codAd)+ return $ Adapter lossy t target+ $ bidirectional $ \dir term -> case fullyStripTerm term of+ TermFunction f -> TermFunction <$> case f of+ FunctionElimination e -> FunctionElimination <$> case e of+ EliminationOptional (OptionalCases nothing just) -> EliminationOptional <$> (+ OptionalCases+ <$> encodeDecode dir (adapterCoder codAd) nothing+ <*> (encodeDecode dir (adapterCoder $ Y.fromJust optionAd) just))+ EliminationUnion (CaseStatement n def cases) -> do+ rcases <- CM.mapM (\f -> encodeDecode dir (getCoder $ fieldName f) f) cases+ rdef <- case def of+ Nothing -> pure Nothing+ Just d -> Just <$> encodeDecode dir (adapterCoder codAd) d+ return $ EliminationUnion $ CaseStatement n rdef rcases+ where+ -- Note: this causes unrecognized cases to simply be passed through;+ -- it is not the job of this adapter to catch validation issues.+ getCoder fname = Y.maybe idCoder adapterCoder $ M.lookup fname caseAds+ FunctionLambda (Lambda var body) -> FunctionLambda <$> (Lambda var <$> encodeDecode dir (adapterCoder codAd) body)+ FunctionPrimitive name -> pure $ FunctionPrimitive name+ _ -> unexpected "function term" $ show term++passLambda :: TypeAdapter+passLambda t@(TypeLambda (LambdaType (Name v) body)) = do+ ad <- termAdapter body+ return $ Adapter (adapterIsLossy ad) t (Types.lambda v $ adapterTarget ad)+ $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term++passLiteral :: TypeAdapter+passLiteral (TypeLiteral at) = do+ ad <- literalAdapter at+ let step = bidirectional $ \dir term -> do+ l <- Expect.literal term+ literal <$> encodeDecode dir (adapterCoder ad) l+ return $ Adapter (adapterIsLossy ad) (Types.literal $ adapterSource ad) (Types.literal $ adapterTarget ad) step++passList :: TypeAdapter+passList t@(TypeList lt) = do+ ad <- termAdapter lt+ return $ Adapter (adapterIsLossy ad) t (Types.list $ adapterTarget ad)+ $ bidirectional $ \dir (TermList terms) -> list <$> CM.mapM (encodeDecode dir $ adapterCoder ad) terms++passMap :: TypeAdapter+passMap t@(TypeMap (MapType kt vt)) = do+ kad <- termAdapter kt+ vad <- termAdapter vt+ return $ Adapter (adapterIsLossy kad || adapterIsLossy vad)+ t (Types.map (adapterTarget kad) (adapterTarget vad))+ $ bidirectional $ \dir (TermMap m) -> TermMap . M.fromList+ <$> CM.mapM (\(k, v) -> (,) <$> encodeDecode dir (adapterCoder kad) k <*> encodeDecode dir (adapterCoder vad) v)+ (M.toList m)++passOptional :: TypeAdapter+passOptional t@(TypeOptional ot) = do+ ad <- termAdapter ot+ return $ Adapter (adapterIsLossy ad) t (Types.optional $ adapterTarget ad) $+ bidirectional $ \dir term -> case term of+ (TermOptional m) -> TermOptional <$> case m of+ Nothing -> pure Nothing+ Just term' -> Just <$> encodeDecode dir (adapterCoder ad) term'+ _ -> fail $ "expected optional term, found: " ++ show term++passProduct :: TypeAdapter+passProduct t@(TypeProduct types) = do+ ads <- CM.mapM termAdapter types+ let lossy = L.foldl (\b ad -> b || adapterIsLossy ad) False ads+ return $ Adapter lossy t (Types.product (adapterTarget <$> ads))+ $ bidirectional $ \dir (TermProduct tuple) -> TermProduct <$> (CM.zipWithM (\term ad -> encodeDecode dir (adapterCoder ad) term) tuple ads)++passRecord :: TypeAdapter+passRecord t@(TypeRecord rt) = do+ adapters <- CM.mapM fieldAdapter (rowTypeFields rt)+ let lossy = or $ adapterIsLossy <$> adapters+ let sfields' = adapterTarget <$> adapters+ return $ Adapter lossy t (TypeRecord $ rt {rowTypeFields = sfields'}) $ bidirectional+ $ \dir (TermRecord (Record _ dfields)) -> record (rowTypeTypeName rt) <$> CM.zipWithM (encodeDecode dir . adapterCoder) adapters dfields++passSet :: TypeAdapter+passSet t@(TypeSet st) = do+ ad <- termAdapter st+ return $ Adapter (adapterIsLossy ad) t (Types.set $ adapterTarget ad)+ $ bidirectional $ \dir (TermSet terms) -> set . S.fromList+ <$> CM.mapM (encodeDecode dir (adapterCoder ad)) (S.toList terms)++passSum :: TypeAdapter+passSum t@(TypeSum types) = do+ ads <- CM.mapM termAdapter types+ let lossy = L.foldl (\b ad -> b || adapterIsLossy ad) False ads+ return $ Adapter lossy t (Types.sum (adapterTarget <$> ads))+ $ bidirectional $ \dir (TermSum (Sum i n term)) -> TermSum . Sum i n <$> encodeDecode dir (adapterCoder $ ads !! i) term++passUnion :: TypeAdapter+passUnion t@(TypeUnion rt) = do+ adapters <- M.fromList <$> CM.mapM (\f -> pure ((,) (fieldTypeName f)) <*> fieldAdapter f) sfields+ let lossy = or $ adapterIsLossy <$> adapters+ let sfields' = adapterTarget . snd <$> M.toList adapters+ return $ Adapter lossy t (TypeUnion $ rt {rowTypeFields = sfields'})+ $ bidirectional $ \dir term -> do+ dfield <- Expect.injection term+ ad <- getAdapter adapters dfield+ TermUnion . Injection nm <$> encodeDecode dir (adapterCoder ad) dfield+ where+ getAdapter adapters f = Y.maybe (fail $ "no such field: " ++ unName (fieldName f)) pure $ M.lookup (fieldName f) adapters+ sfields = rowTypeFields rt+ nm = rowTypeTypeName rt++passWrapped :: TypeAdapter+passWrapped wt@(TypeWrap (WrappedType tname t)) = do+ adapter <- termAdapter t+ return $ Adapter (adapterIsLossy adapter) wt (Types.wrapWithName tname $ adapterTarget adapter)+ $ bidirectional $ \dir (TermWrap (WrappedTerm _ term)) -> TermWrap . WrappedTerm tname <$> encodeDecode dir (adapterCoder adapter) term++simplifyApplication :: TypeAdapter+simplifyApplication t@(TypeApplication (ApplicationType lhs _)) = do+ ad <- termAdapter lhs+ return $ Adapter False t (adapterTarget ad) $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term++-- Note: those constructors which cannot be mapped meaningfully at this time are simply+-- preserved as strings using Haskell's derived show/read format.+termAdapter :: TypeAdapter+termAdapter typ = withTrace ("adapter for " ++ describeType typ ) $ do+ case typ of+ -- Account for let-bound variables+ TypeVariable name -> forTypeReference name+ _ -> do+ g <- getState+ chooseAdapter (alts g) (supported g) describeType typ+ where+ alts g t = (\c -> c t) <$>+ if supportedAtTopLevel g t+ then pass t+ else trySubstitution t+ where+ supportedAtTopLevel g t = variantIsSupported g t && languageConstraintsTypes (constraints g) t+ pass t = case typeVariant t of+ TypeVariantAnnotated -> [passAnnotated]+ TypeVariantApplication -> [passApplication]+ TypeVariantFunction -> [passFunction]+ TypeVariantLambda -> [passLambda]+ TypeVariantList -> [passList]+ TypeVariantLiteral -> [passLiteral]+ TypeVariantMap -> [passMap]+ TypeVariantOptional -> [passOptional, optionalToList]+ TypeVariantProduct -> [passProduct]+ TypeVariantRecord -> [passRecord]+ TypeVariantSet -> [passSet]+ TypeVariantSum -> [passSum]+ TypeVariantUnion -> [passUnion]+ TypeVariantWrap -> [passWrapped]+ _ -> []+ trySubstitution t = case typeVariant t of+ TypeVariantAnnotated -> [passAnnotated]+ TypeVariantApplication -> [simplifyApplication]+ TypeVariantFunction -> [functionToUnion]+ TypeVariantLambda -> [lambdaToMonotype]+ TypeVariantOptional -> [optionalToList]+ TypeVariantSet -> [listToSet]+ TypeVariantUnion -> [unionToRecord]+ TypeVariantWrap -> [wrapToUnwrapped]+ _ -> [unsupportedToString]+ where+ constraints = languageConstraints . adapterContextLanguage+ supported = typeIsSupported . constraints+ variantIsSupported g t = S.member (typeVariant t) $ languageConstraintsTypeVariants (constraints g)++---- Caution: possibility of an infinite loop if neither unions, optionals, nor lists are supported+unionToRecord :: TypeAdapter+unionToRecord t@(TypeUnion rt) = do+ let target = TypeRecord $ rt {rowTypeFields = makeOptional <$> sfields}+ ad <- termAdapter target+ return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder {+ coderEncode = \term' -> do+ (Field fn term) <- Expect.injectionWithName (rowTypeTypeName rt) term'+ coderEncode (adapterCoder ad) $ record nm (toRecordField term fn <$> sfields),+ coderDecode = \term -> do+ TermRecord (Record _ fields) <- coderDecode (adapterCoder ad) term+ inject nm <$> fromRecordFields term (TermRecord (Record nm fields)) (adapterTarget ad) fields}+ where+ nm = rowTypeTypeName rt+ sfields = rowTypeFields rt++ makeOptional (FieldType fn ft) = FieldType fn $ Types.optional ft++ toRecordField term fn (FieldType fn' _) = Field fn' $+ TermOptional $ if fn' == fn then Just term else Nothing++ fromRecordFields term term' t' fields = if L.null matches+ then fail $ "cannot convert term back to union: " ++ show term+ ++ " where type = " ++ show t ++ " and target type = " ++ show t'+ else pure $ L.head matches+ where+ matches = Y.mapMaybe (\(Field fn (TermOptional opt)) -> (Just . Field fn) =<< opt) fields++unsupportedToString :: TypeAdapter+unsupportedToString t = pure $ Adapter False t Types.string $ Coder encode decode+ where+ -- TODO: use JSON for encoding and decoding unsupported terms, rather than Haskell's read/show+ encode term = pure $ string $ "unsupported: " ++ show term+ decode term = do+ s <- Expect.string term+ case TR.readEither s of+ Left msg -> fail $ "could not decode unsupported term: " ++ s+ Right t -> pure t++wrapToUnwrapped :: TypeAdapter+wrapToUnwrapped t@(TypeWrap (WrappedType tname typ)) = do+ ad <- termAdapter typ+ return $ Adapter False t (adapterTarget ad) $ Coder (encode ad) (decode ad)+ where+ encode ad term = Expect.wrap tname term >>= coderEncode (adapterCoder ad)+ decode ad term = do+ decoded <- coderDecode (adapterCoder ad) term+ return $ TermWrap $ WrappedTerm tname decoded++withGraphContext :: Flow (Graph) x -> Flow (AdapterContext) x+withGraphContext f = do+ cx <- getState+ withState (adapterContextGraph cx) f
+ src/main/haskell/Hydra/Tools/Bytestrings.hs view
@@ -0,0 +1,12 @@+module Hydra.Tools.Bytestrings where++import qualified Data.ByteString.Lazy as BS+import qualified Data.Text.Lazy.Encoding as DTE+import qualified Data.Text.Lazy as TL+++bytesToString :: BS.ByteString -> String+bytesToString = TL.unpack . DTE.decodeUtf8++stringToBytes :: String -> BS.ByteString+stringToBytes = DTE.encodeUtf8 . TL.pack
+ src/main/haskell/Hydra/Tools/Debug.hs view
@@ -0,0 +1,14 @@+-- | Debugging utilities++module Hydra.Tools.Debug where++import Control.Exception++newtype DebugException = DebugException String deriving Show++instance Exception DebugException++debug = True :: Bool++throwDebugException :: String -> c+throwDebugException = throw . DebugException
+ src/main/haskell/Hydra/Tools/Formatting.hs view
@@ -0,0 +1,122 @@+-- | String formatting utilities++module Hydra.Tools.Formatting where++import Hydra.Basics+import qualified Hydra.Lib.Strings as Strings++import qualified Data.Char as C+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 CaseConvention = CaseConventionCamel | CaseConventionPascal | CaseConventionLowerSnake | CaseConventionUpperSnake++convertCase :: CaseConvention -> CaseConvention -> String -> String+convertCase from to original = case to of+ CaseConventionCamel -> decapitalize $ L.concat (capitalize . Strings.toLower <$> parts)+ CaseConventionPascal -> L.concat (capitalize . Strings.toLower <$> parts)+ CaseConventionLowerSnake -> L.intercalate "_" (Strings.toLower <$> parts)+ CaseConventionUpperSnake -> L.intercalate "_" (Strings.toUpper <$> parts)+ where+ parts = case from of+ CaseConventionCamel -> byCaps+ CaseConventionPascal -> byCaps+ CaseConventionLowerSnake -> byUnderscores+ CaseConventionUpperSnake -> byUnderscores+ byUnderscores = Strings.splitOn "_" original+ byCaps = L.foldl helper [""] $ L.reverse $ decapitalize original+ where+ helper (h:r) c = ["" | C.isUpper c] ++ ((c:h):r)++convertCaseCamelToLowerSnake :: String -> String+convertCaseCamelToLowerSnake = convertCase CaseConventionCamel CaseConventionLowerSnake++convertCaseCamelToUpperSnake :: String -> String+convertCaseCamelToUpperSnake = convertCase CaseConventionCamel CaseConventionUpperSnake++convertCasePascalToUpperSnake :: String -> String+convertCasePascalToUpperSnake = convertCase CaseConventionPascal CaseConventionUpperSnake++escapeWithUnderscore :: S.Set String -> String -> String+escapeWithUnderscore reserved s = if S.member s reserved then s ++ "_" else s++indentLines :: String -> String+indentLines s = unlines (indent <$> lines s)+ where+ indent l = " " ++ l++javaStyleComment :: String -> String+javaStyleComment s = "/**\n" ++ " * " ++ s ++ "\n */"++nonAlnumToUnderscores :: String -> String+nonAlnumToUnderscores = L.reverse . fst . L.foldl replace ([], False)+ where+ replace (s, b) c = if isAlnum c+ then (c:s, False)+ else if b+ then (s, True)+ else ('_':s, True)+ isAlnum c = (c >= 'A' && c <= 'Z')+ || (c >= 'a' && c <= 'z')+ || (c >= '0' && c <= '9')++sanitizeWithUnderscores :: S.Set String -> String -> String+sanitizeWithUnderscores reserved = escapeWithUnderscore reserved . nonAlnumToUnderscores++withCharacterAliases :: String -> String+withCharacterAliases original = L.filter C.isAlphaNum $ L.concat $ alias <$> original+ where+ alias c = Y.maybe [c] capitalize $ M.lookup (C.ord c) aliases++ -- Taken from: https://cs.stanford.edu/people/miles/iso8859.html+ aliases = M.fromList [+ (32, "sp"),+ (33, "excl"),+ (34, "quot"),+ (35, "num"),+ (36, "dollar"),+ (37, "percnt"),+ (38, "amp"),+ (39, "apos"),+ (40, "lpar"),+ (41, "rpar"),+ (42, "ast"),+ (43, "plus"),+ (44, "comma"),+ (45, "minus"),+ (46, "period"),+ (47, "sol"),+ (58, "colon"),+ (59, "semi"),+ (60, "lt"),+ (61, "equals"),+ (62, "gt"),+ (63, "quest"),+ (64, "commat"),+ (91, "lsqb"),+ (92, "bsol"),+ (93, "rsqb"),+ (94, "circ"),+ (95, "lowbar"),+ (96, "grave"),+ (123, "lcub"),+ (124, "verbar"),+ (125, "rcub"),+ (126, "tilde")]++-- A simple soft line wrap which is suitable for code comments+wrapLine :: Int -> String -> String+wrapLine maxlen = L.intercalate "\n" . helper []+ where+ helper prev rem = if L.length rem <= maxlen+ then L.reverse (rem:prev)+ else if L.null prefix+ then helper (trunc:prev) $ L.drop maxlen rem+ else helper ((init prefix):prev) $ suffix ++ L.drop maxlen rem+ where+ trunc = L.take maxlen rem+ (prefix, suffix) = case span (\c -> c /= ' ' && c /= '\t') (reverse trunc) of+ (restRev, firstRev) -> (reverse firstRev, reverse restRev)
+ src/main/haskell/Hydra/Tools/GrammarToModule.hs view
@@ -0,0 +1,115 @@+-- | A utility for converting a BNF grammar to a Hydra module++module Hydra.Tools.GrammarToModule where++import Hydra.Kernel+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap as Bootstrap+import Hydra.Dsl.Types as Types+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Grammar as G++import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Maybe as Y++import Hydra.Sources.Core+++grammarToModule :: Namespace -> G.Grammar -> Maybe String -> Module+grammarToModule ns (G.Grammar prods) desc = Module ns elements [hydraCoreModule] [hydraCoreModule] desc+ where+ elements = pairToElement <$> L.concat (L.zipWith (makeElements False) (capitalize . fst <$> prodPairs) (snd <$> prodPairs))+ where+ prodPairs = (\(G.Production (G.Symbol s) pat) -> (s, pat)) <$> prods+ pairToElement (lname, typ) = Bootstrap.typeElement (toName lname) typ++ toName local = unqualifyName $ QualifiedName (Just ns) local++ findNames pats = L.reverse $ fst (L.foldl nextName ([], M.empty) pats)+ where+ nextName (names, nameMap) pat = (nn:names, M.insert rn ni nameMap)+ where+ rn = rawName pat+ (nn, ni) = case M.lookup rn nameMap of+ Nothing -> (rn, 1)+ Just i -> (rn ++ show (i+1), i+1)++ rawName pat = case pat of+ G.PatternNil -> "none"+ G.PatternIgnored _ -> "ignored"+ G.PatternLabeled (G.LabeledPattern (G.Label l) _) -> l+ G.PatternConstant (G.Constant c) -> decapitalize $ withCharacterAliases c+ G.PatternRegex _ -> "regex"+ G.PatternNonterminal (G.Symbol s) -> decapitalize s+ G.PatternSequence _ -> "sequence"+ G.PatternAlternatives _ -> "alts"+ G.PatternOption p -> decapitalize (rawName p)+ G.PatternStar p -> "listOf" ++ capitalize (rawName p)+ G.PatternPlus p -> "listOf" ++ capitalize (rawName p)++ isComplex pat = case pat of+ G.PatternLabeled (G.LabeledPattern _ p) -> isComplex p+ G.PatternSequence pats -> isNontrivial True pats+ G.PatternAlternatives pats -> isNontrivial False pats+ _ -> False++ isNontrivial isRecord pats = if L.length minPats == 1+ then case L.head minPats of+ G.PatternLabeled _ -> True+ _ -> False+ else True+ where+ minPats = simplify isRecord pats++ -- Remove trivial patterns from records+ simplify isRecord pats = if isRecord then L.filter (not . isConstant) pats else pats+ where+ isConstant p = case p of+ G.PatternConstant _ -> True+ _ -> False++ makeElements omitTrivial lname pat = forPat pat+ where+ forPat pat = case pat of+ G.PatternNil -> trivial+ G.PatternIgnored _ -> []+ G.PatternLabeled (G.LabeledPattern (G.Label l) p) -> forPat p+ G.PatternConstant _ -> trivial+ G.PatternRegex _ -> [(lname, Types.string)]+ G.PatternNonterminal (G.Symbol other) -> [(lname, TypeVariable $ toName other)]+ G.PatternSequence pats -> forRecordOrUnion True Types.record pats+ G.PatternAlternatives pats -> forRecordOrUnion False Types.union pats+ G.PatternOption p -> mod "Option" Types.optional p+ G.PatternStar p -> mod "Elmt" Types.list p+ G.PatternPlus p -> mod "Elmt" nonemptyList p++ trivial = if omitTrivial then [] else [(lname, Types.unit)]++ forRecordOrUnion isRecord construct pats = if isNontrivial isRecord pats+ then (lname, construct fields):els+ -- Eliminate single-field record and union types, unless the field has a user-defined name+ else forPat $ L.head minPats+ where+ fieldPairs = L.zipWith toField (findNames minPats) minPats+ fields = fst <$> fieldPairs+ els = L.concat (snd <$> fieldPairs)+ minPats = simplify isRecord pats++ toField n p = descend n f2 p+ where+ f2 ((lname, typ):rest) = (FieldType (Name n) typ, rest)++ mod n f p = descend n f2 p+ where+ f2 ((lname, typ):rest) = (lname, f typ):rest++ descend n f p = f $ if isComplex p+ then (lname, TypeVariable (toName $ fst $ L.head cpairs)):cpairs+ else if L.null cpairs+ then [(lname, Types.unit)]+ else (lname, snd (L.head cpairs)):L.tail cpairs+ where+ cpairs = makeElements False (childName lname n) p++ childName lname n = lname ++ "." ++ capitalize n
+ src/main/haskell/Hydra/Tools/Serialization.hs view
@@ -0,0 +1,229 @@+-- | Utilities for constructing Hydra code trees++module Hydra.Tools.Serialization where++import Hydra.Ast++import qualified Data.List as L+import qualified Data.Maybe as Y+++angleBraces :: Brackets+angleBraces = Brackets (sym "<") (sym ">")++angleBracesList :: BlockStyle -> [Expr] -> Expr+angleBracesList style els = case els of+ [] -> cst "<>"+ _ -> brackets angleBraces style $ commaSep style els++bracketList :: BlockStyle -> [Expr] -> Expr+bracketList style els = case els of+ [] -> cst "[]"+ _ -> brackets squareBrackets style $ commaSep style els++brackets :: Brackets -> BlockStyle -> Expr -> Expr+brackets br style e = ExprBrackets $ BracketExpr br e style++commaSep :: BlockStyle -> [Expr] -> Expr+commaSep = symbolSep ","++curlyBlock :: BlockStyle -> Expr -> Expr+curlyBlock style e = curlyBracesList Nothing style [e]++curlyBraces :: Brackets+curlyBraces = Brackets (sym "{") (sym "}")++curlyBracesList :: Maybe String -> BlockStyle -> [Expr] -> Expr+curlyBracesList msymb style els = case els of+ [] -> cst "{}"+ _ -> brackets curlyBraces style $ symbolSep (Y.fromMaybe "," msymb) style els++cst :: String -> Expr+cst = ExprConst . Symbol++customIndent :: String -> String -> String+customIndent idt s = L.intercalate "\n" $ (idt ++) <$> lines s++customIndentBlock :: String -> [Expr] -> Expr+customIndentBlock idt els = case els of+ [x] -> x+-- (head:rest) -> ifx idtOp head $ indentSep idt rest+ (head:rest) -> ifx idtOp head $ newlineSep rest+ where+ idtOp = Op (sym "") (Padding WsSpace $ WsBreakAndIndent idt) (Precedence 0) AssociativityNone++dotSep :: [Expr] -> Expr+dotSep = sep $ Op (sym ".") (Padding WsNone WsNone) (Precedence 0) AssociativityNone++doubleNewlineSep :: [Expr] -> Expr+doubleNewlineSep = sep $ Op (sym "") (Padding WsBreak WsBreak) (Precedence 0) AssociativityNone++doubleSpace :: String+doubleSpace = " "++fullBlockStyle :: BlockStyle+fullBlockStyle = BlockStyle (Just doubleSpace) True True++halfBlockStyle :: BlockStyle+halfBlockStyle = BlockStyle (Just doubleSpace) True False++ifx :: Op -> Expr -> Expr -> Expr+ifx op lhs rhs = ExprOp $ OpExpr op lhs rhs++indent :: String -> String+indent = customIndent doubleSpace++indentBlock :: [Expr] -> Expr+indentBlock = customIndentBlock doubleSpace++indentLines :: [Expr] -> Expr+indentLines els = ifx topOp (cst "") (newlineSep els)+ where+ topOp = Op (sym "") (Padding WsNone (WsBreakAndIndent doubleSpace)) (Precedence 0) AssociativityNone++indentSubsequentLines :: String -> Expr -> Expr+indentSubsequentLines idt e = ExprIndent $ IndentedExpression (IndentStyleSubsequentLines idt) e++infixWs :: String -> Expr -> Expr -> Expr+infixWs op l r = spaceSep [l, cst op, r]++infixWsList :: String -> [Expr] -> Expr+infixWsList op opers = spaceSep $ L.foldl (\e r -> if L.null e then [r] else r:opExpr:e) [] $ L.reverse opers+ where+ opExpr = cst op++inlineStyle :: BlockStyle+inlineStyle = BlockStyle Nothing False False++newlineSep :: [Expr] -> Expr+newlineSep = sep $ Op (sym "") (Padding WsNone WsBreak) (Precedence 0) AssociativityNone++noPadding :: Padding+noPadding = Padding WsNone WsNone++noSep :: [Expr] -> Expr+noSep = sep $ Op (sym "") (Padding WsNone WsNone) (Precedence 0) AssociativityNone++num :: Int -> Expr+num = cst . show++op :: String -> Int -> Associativity -> Op+op s p = Op (Symbol s) (Padding WsSpace WsSpace) (Precedence p)++orOp :: Bool -> Op+orOp newlines = Op (sym "|") (Padding WsSpace (if newlines then WsBreak else WsSpace)) (Precedence 0) AssociativityNone -- No source++orSep :: BlockStyle -> [Expr] -> Expr+orSep style l = case l of+ [] -> cst ""+ [x] -> x+ (h:r) -> ifx (orOp newlines) h $ orSep style r+ where+ newlines = blockStyleNewlineBeforeContent style++parenList :: Bool -> [Expr] -> Expr+parenList newlines els = case els of+ [] -> cst "()"+ _ -> brackets parentheses style $ commaSep style els+ where+ style = if newlines && L.length els > 1 then halfBlockStyle else inlineStyle++parens :: Expr -> Expr+parens = brackets parentheses inlineStyle++parentheses :: Brackets+parentheses = Brackets (sym "(") (sym ")")++parenthesize :: Expr -> Expr+parenthesize exp = case exp of+ ExprBrackets (BracketExpr br e newlines) -> ExprBrackets (BracketExpr br (parenthesize e) newlines)+ ExprConst _ -> exp+ ExprIndent (IndentedExpression style e) -> ExprIndent (IndentedExpression style (parenthesize e))+ ExprOp (OpExpr op@(Op _ _ prec assoc) lhs rhs) -> ExprOp (OpExpr op lhs2 rhs2)+ where+ lhs' = parenthesize lhs+ rhs' = parenthesize rhs+ lhs2 = case lhs' of+ ExprOp (OpExpr (Op _ _ lprec lassoc) _ _) -> case prec `compare` lprec of+ LT -> lhs'+ GT -> parens lhs'+ EQ -> if assocLeft assoc && assocLeft lassoc+ then lhs'+ else parens lhs'+ _ -> lhs'+ rhs2 = case rhs' of+ ExprOp (OpExpr (Op _ _ rprec rassoc) _ _) -> case prec `compare` rprec of+ LT -> rhs'+ GT -> parens rhs'+ EQ -> if assocRight assoc && assocRight rassoc+ then rhs'+ else parens rhs'+ _ -> rhs'+ assocLeft a = a == AssociativityLeft || a == AssociativityNone || a == AssociativityBoth+ assocRight a = a == AssociativityRight || a == AssociativityNone || a == AssociativityBoth++prefix :: String -> Expr -> Expr+prefix p = ifx preOp (cst "")+ where+ preOp = Op (sym p) (Padding WsNone WsNone) (Precedence 0) AssociativityNone++printExpr :: Expr -> String+printExpr e = case e of+ ExprConst (Symbol s) -> s+ ExprIndent (IndentedExpression style expr) -> L.intercalate "\n" $ case style of+ IndentStyleAllLines idt -> (idt ++) <$> lns+ IndentStyleSubsequentLines idt -> case lns of+ [x] -> [x]+ (head:rest) -> head:((idt ++) <$> rest)+ where+ lns = lines $ printExpr expr+ ExprOp (OpExpr (Op (Symbol sym) (Padding padl padr) _ _) l r) -> lhs ++ pad padl ++ sym ++ pad padr ++ rhs+ where+ lhs = idt padl $ printExpr l+ rhs = idt padr $ printExpr r+ idt ws s = case ws of+ WsBreakAndIndent idt -> customIndent idt s+ _ -> s+ pad ws = case ws of+ WsNone -> ""+ WsSpace -> " "+ WsBreak -> "\n"+ WsBreakAndIndent _ -> "\n"+ WsDoubleBreak -> "\n\n"+ ExprBrackets (BracketExpr (Brackets (Symbol l) (Symbol r)) e style) ->+ l ++ pre ++ ibody ++ suf ++ r+ where+ body = printExpr e+ ibody = case doIndent of+ Nothing -> body+ Just idt -> customIndent idt body+ pre = if nlBefore then "\n" else ""+ suf = if nlAfter then "\n" else ""+ BlockStyle doIndent nlBefore nlAfter = style++sep :: Op -> [Expr] -> Expr+sep op els = case els of+ [] -> cst ""+ [x] -> x+ (h:r) -> ifx op h $ sep op r++spaceSep :: [Expr] -> Expr+spaceSep = sep $ Op (sym "") (Padding WsSpace WsNone) (Precedence 0) AssociativityNone++squareBrackets :: Brackets+squareBrackets = Brackets (sym "[") (sym "]")++sym :: String -> Symbol+sym = Symbol++symbolSep :: String -> BlockStyle -> [Expr] -> Expr+symbolSep symb style l = case l of+ [] -> cst ""+ [x] -> x+ (h:r) -> ifx commaOp h $ commaSep style r+ where+ break = case L.length $ L.filter id [blockStyleNewlineBeforeContent style, blockStyleNewlineAfterContent style] of+ 0 -> WsSpace+ 1 -> WsBreak+ 2 -> WsDoubleBreak+ commaOp = Op (sym symb) (Padding WsNone break) (Precedence 0) AssociativityNone -- No source
+ src/main/haskell/Hydra/Tools/Sorting.hs view
@@ -0,0 +1,44 @@+-- | Utilities for sorting++module Hydra.Tools.Sorting (+ topologicalSort,+ topologicalSortComponents,+ initGraph+) where++import qualified Data.List as L+import qualified Data.Bifunctor as BF++import qualified Data.Graph as G+++-- | Sort a directed acyclic graph (DAG) based on an adjacency list+-- Yields a list of nontrivial strongly connected components if the graph has cycles+topologicalSort :: Ord a => [(a, [a])] -> Either [[a]] [a]+topologicalSort pairs = if L.null withCycles+ then Right $ L.concat sccs+ else Left withCycles+ where+ sccs = topologicalSortComponents pairs+ withCycles = L.filter isCycle sccs+ isCycle = not . L.null . L.tail++-- | Find the strongly connected components (including cycles and isolated vertices) of a graph, in (reverse) topological order+topologicalSortComponents :: Ord a => [(a, [a])] -> [[a]]+topologicalSortComponents pairs = L.sort <$> (fmap (getKey nodeFromVertex) . treeToList) <$> G.scc g+ where+ (g, nodeFromVertex) = initGraph pairs++treeToList :: G.Tree a -> [a]+treeToList (G.Node root subforest) = root:(L.concat (treeToList <$> subforest))++getKey :: (G.Vertex -> ((), a, [a])) -> G.Vertex -> a+getKey nodeFromVertex v = n+ where+ (_, n, _) = nodeFromVertex v++initGraph :: Ord a => [(a, [a])] -> (G.Graph, G.Vertex -> ((), a, [a]))+initGraph pairs = (g, nodeFromVertex)+ where+ (g, nodeFromVertex, _) = G.graphFromEdges (toEdge <$> pairs)+ toEdge (key, keys) = ((), key, keys)
+ src/main/haskell/Hydra/Tools/Templating.hs view
@@ -0,0 +1,111 @@+-- | A utility which instantiates a nonrecursive type with default values.++module Hydra.Tools.Templating where++import Hydra.Kernel++import qualified Data.Map as M+import qualified Data.Set as S+++-- | Create a graph schema from a graph which contains nothing but encoded type definitions.+graphToSchema :: Graph -> Flow Graph (M.Map Name Type)+graphToSchema g = M.fromList <$> (mapM toPair $ M.toList $ graphElements g)+ where+ toPair (name, el) = do+ t <- coreDecodeType $ elementData el+ return (name, t)++-- | Given a graph schema and a nonrecursive type, instantiate it with default values.+-- If the minimal flag is set, the smallest possible term is produced; otherwise,+-- exactly one subterm is produced for constructors which do not otherwise require one, e.g. in lists and optionals.+insantiateTemplate :: Bool -> M.Map Name Type -> Type -> Flow s Term+insantiateTemplate minimal schema t = case t of+ TypeAnnotated (AnnotatedType t _) -> inst t+ TypeApplication _ -> noPoly+ TypeFunction _ -> noPoly+ TypeLambda _ -> noPoly+ TypeList et -> if minimal+ then pure $ TermList []+ else do+ e <- inst et+ return $ TermList [e]+ TypeLiteral lt -> pure $ TermLiteral $ case lt of+ LiteralTypeBinary -> LiteralString ""+ LiteralTypeBoolean -> LiteralBoolean False+ LiteralTypeInteger it -> LiteralInteger $ case it of+ IntegerTypeBigint -> IntegerValueBigint 0+ IntegerTypeInt8 -> IntegerValueInt8 0+ IntegerTypeInt16 -> IntegerValueInt16 0+ IntegerTypeInt32 -> IntegerValueInt32 0+ IntegerTypeInt64 -> IntegerValueInt64 0+ IntegerTypeUint8 -> IntegerValueUint8 0+ IntegerTypeUint16 -> IntegerValueUint16 0+ IntegerTypeUint32 -> IntegerValueUint32 0+ IntegerTypeUint64 -> IntegerValueUint64 0+ LiteralTypeFloat ft -> LiteralFloat $ case ft of+ FloatTypeBigfloat -> FloatValueBigfloat 0+ FloatTypeFloat32 -> FloatValueFloat32 0+ FloatTypeFloat64 -> FloatValueFloat64 0+ LiteralTypeString -> LiteralString ""+ TypeMap (MapType kt vt) -> if minimal+ then return $ TermMap M.empty+ else do+ ke <- inst kt+ ve <- inst vt+ return $ TermMap $ M.singleton ke ve+ TypeOptional ot -> if minimal+ then return $ TermOptional Nothing+ else do+ e <- inst ot+ return $ TermOptional $ Just e+ TypeProduct types -> do+ es <- mapM inst types+ return $ TermProduct es+ TypeRecord (RowType tname _ fields) -> do+ dfields <- mapM toField fields+ return $ TermRecord $ Record tname dfields+ where+ toField ft = do+ e <- inst $ fieldTypeType ft+ return $ Field (fieldTypeName ft) e+ TypeSet et -> if minimal+ then return $ TermSet S.empty+ else do+ e <- inst et+ return $ TermSet $ S.fromList [e]+-- TypeStream et -> ...+-- TypeSum types -> ...+-- TypeUnion (RowType tname _ fields) -> ...+ TypeVariable tname -> case M.lookup tname schema of+ Just t' -> inst t'+ Nothing -> fail $ "Type variable " ++ show tname ++ " not found in schema"+ TypeWrap (WrappedType tname t') -> do+ e <- inst t'+ return $ TermWrap $ WrappedTerm tname e+ where+ inst = insantiateTemplate minimal schema+ noPoly = fail "Polymorphic and function types are not currently supported"+++{-++-- Example of type-to-term instantiation which creates a YAML-based template out of the OpenCypher feature model.++import Hydra.Langs.Yaml.Model as Yaml+import Hydra.Flows+import Data.Map as M+import Data.Maybe as Y++ff = fromFlowIo bootstrapGraph++schema <- ff $ graphToSchema $ modulesToGraph [openCypherFeaturesModule]++typ <- ff $ inlineType schema $ Y.fromJust $ M.lookup _CypherFeatures schema+term <- ff $ insantiateTemplate False schema typ++encoder <- ff (coderEncode <$> yamlCoder typ)+yaml <- ff $ encoder term+putStrLn $ hydraYamlToString yaml++-}
− src/main/haskell/Hydra/Types/Inference.hs
@@ -1,353 +0,0 @@--- | Entry point for Hydra's variation on Hindley-Milner type inference--module Hydra.Types.Inference (- annotateElementWithTypes,- annotateTermWithTypes,- inferType,- Constraint,-) where--import Hydra.Kernel-import Hydra.CoreDecoding-import Hydra.CoreEncoding-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Types.Substitution-import Hydra.Types.Unification--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 InferenceContext m = (Context m, Int, TypingEnvironment m)--type TypingEnvironment m = M.Map Variable (TypeScheme m)--annotateElementWithTypes :: (Ord m, Show m) => Element m -> GraphFlow m (Element m)-annotateElementWithTypes el = do- withTrace ("annotate element " ++ unName (elementName el)) $ do- term <- annotateTermWithTypes $ elementData el- typ <- findType term- return $ el {- elementData = term,- elementSchema = encodeType typ}- where- findType term = do- cx <- getState- mt <- annotationClassTermType (contextAnnotations cx) term- case mt of- Just t -> return t- Nothing -> fail "expected a type annotation"--annotateTermWithTypes :: (Ord m, Show m) => Term m -> GraphFlow m (Term m)-annotateTermWithTypes term0 = do- (term1, _) <- inferType term0- anns <- contextAnnotations <$> getState- mt <- annotationClassTermType anns term0 -- Use a provided type, if available, rather than the inferred type- let annotType (ann, typ, _) = annotationClassSetTypeOf anns (Just $ Y.fromMaybe typ mt) ann- return $ rewriteTermMeta annotType term1---- Decode a type, eliminating nominal types for the sake of unification-decodeStructuralType :: Show m => Term m -> GraphFlow m (Type m)-decodeStructuralType term = do- typ <- decodeType term- let typ' = stripType typ- case typ' of- TypeNominal name -> withSchemaContext $ withTrace "decode structural type" $ do- el <- requireElement name- decodeStructuralType $ elementData el- _ -> pure typ--freshVariableType :: Flow (InferenceContext m) (Type m)-freshVariableType = do- (cx, s, e) <- getState- putState (cx, s + 1, e)- return $ Types.variable (unVariableType $ normalVariables !! s)--generalize :: Show m => TypingEnvironment m -> Type m -> TypeScheme m-generalize env t = TypeScheme vars t- where- vars = S.toList $ S.difference- (freeVariablesInType t)- (L.foldr (S.union . freeVariablesInScheme) S.empty $ M.elems env)--extendEnvironment :: Variable -> TypeScheme m -> Flow (InferenceContext m) a -> Flow (InferenceContext m) a-extendEnvironment x sc = withEnvironment (\e -> M.insert x sc $ M.delete x e)--findMatchingField :: Show m => FieldName -> [FieldType m] -> Flow (InferenceContext m) (FieldType m)-findMatchingField fname sfields = case L.filter (\f -> fieldTypeName f == fname) sfields of- [] -> fail $ "no such field: " ++ unFieldName fname- (h:_) -> return h--infer :: (Ord m, Show m) => Term m -> Flow (InferenceContext m) (Term (m, Type m, [Constraint m]))-infer term = do- (cx, _, _) <- getState- mt <- withGraphContext $ annotationClassTermType (contextAnnotations cx) term- case mt of- Just typ -> do- i <- inferInternal term- return $ TermAnnotated $ Annotated i (termMeta cx term, typ, []) -- TODO: unify "suggested" types with inferred types- Nothing -> inferInternal term--inferInternal :: (Ord m, Show m) => Term m -> Flow (InferenceContext m) (Term (m, Type m, [Constraint m]))-inferInternal term = case term of- TermAnnotated (Annotated term1 ann) -> do- iterm <- infer term1- return $ case iterm of- -- `yield` produces the default annotation, which can just be replaced- TermAnnotated (Annotated trm (_, t, c)) -> TermAnnotated (Annotated trm (ann, t, c))-- TermApplication (Application fun arg) -> do- ifun <- infer fun- iarg <- infer arg- v <- freshVariableType- let c = (termConstraints ifun) ++ (termConstraints iarg) ++ [(termType ifun, Types.function (termType iarg) v)]- let app = TermApplication $ Application ifun iarg- yield app v c-- TermElement name -> do- et <- withGraphContext $ typeOfElement name- yield (TermElement name) (Types.element et) []-- TermFunction f -> case f of-- -- Note: here we assume that compareTo evaluates to an integer, not a Comparison value.- -- For the latter, Comparison would have to be added to the literal type grammar.- FunctionCompareTo other -> do- i <- infer other- yieldFunction (FunctionCompareTo i) (Types.function (termType i) Types.int8) (termConstraints i)-- FunctionElimination e -> case e of-- EliminationElement -> do- et <- freshVariableType- yieldElimination EliminationElement (Types.function (Types.element et) et) []-- EliminationList fun -> do- a <- freshVariableType- b <- freshVariableType- let expected = Types.functionN [b, a] b- i <- infer fun- let elim = Types.functionN [b, Types.list a] b- yieldElimination (EliminationList i) elim [(expected, termType i)]-- EliminationNominal name -> do- typ <- withGraphContext $ namedType "eliminate nominal" name- yieldElimination (EliminationNominal name) (Types.function (Types.nominal name) typ) []-- EliminationOptional (OptionalCases n j) -> do- dom <- freshVariableType- cod <- freshVariableType- ni <- infer n- ji <- infer j- let t = Types.function (Types.optional dom) cod- let constraints = [(cod, termType ni), (Types.function dom cod, termType ji)]- yieldElimination (EliminationOptional $ OptionalCases ni ji) t constraints-- -- Note: type inference cannot recover complete record types from projections; type annotations are needed- 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 name cases) -> do- rt <- withGraphContext $ requireUnionType True name- let sfields = rowTypeFields rt-- icases <- CM.mapM inferFieldType cases- let innerConstraints = L.concat (termConstraints . fieldTerm <$> icases)-- let idoms = termType . fieldTerm <$> icases- let sdoms = fieldTypeType <$> sfields- cod <- freshVariableType- let outerConstraints = L.zipWith (\t d -> (t, Types.function d cod)) idoms sdoms-- yieldElimination (EliminationUnion (CaseStatement name icases))- (Types.function (TypeUnion rt) cod)- (innerConstraints ++ outerConstraints)-- FunctionLambda (Lambda v body) -> do- tv <- freshVariableType- i <- extendEnvironment v (TypeScheme [] tv) $ infer body- yieldFunction (FunctionLambda $ Lambda v i) (Types.function tv (termType i)) (termConstraints i)-- FunctionPrimitive name -> do- FunctionType dom cod <- withGraphContext $ typeOfPrimitiveFunction name- yieldFunction (FunctionPrimitive name) (Types.function dom cod) []-- TermLet (Let x e1 e2) -> do- (_, _, env) <- getState- i1 <- infer e1- let t1 = termType i1- let c1 = termConstraints i1- sub <- withGraphContext $ solveConstraints c1- let t1' = reduceType $ substituteInType sub t1- let sc = generalize (M.map (substituteInScheme sub) env) t1'- i2 <- extendEnvironment x sc $ withEnvironment (M.map (substituteInScheme sub)) $ infer e2- let t2 = termType i2- let c2 = termConstraints i2- yield (TermLet $ Let x i1 i2) t2 (c1 ++ c2) -- TODO: is x constant?-- TermList els -> do- v <- freshVariableType- iels <- CM.mapM infer els- let co = (\e -> (v, termType e)) <$> iels- let ci = L.concat (termConstraints <$> iels)- yield (TermList iels) (Types.list v) (co ++ ci)-- TermLiteral l -> yield (TermLiteral l) (Types.literal $ literalType l) []-- TermMap m -> do- kv <- freshVariableType- vv <- freshVariableType- pairs <- CM.mapM toPair $ M.toList m- let co = L.concat ((\(k, v) -> [(kv, termType k), (vv, termType v)]) <$> pairs)- let ci = L.concat ((\(k, v) -> termConstraints k ++ termConstraints v) <$> pairs)- yield (TermMap $ M.fromList pairs) (Types.map kv vv) (co ++ ci)- where- toPair (k, v) = do- ik <- infer k- iv <- infer v- return (ik, iv)-- TermNominal (Named name term1) -> do- typ <- withGraphContext $ namedType "nominal" name- i <- infer term1- yield (TermNominal $ Named name i) (Types.nominal name) (termConstraints i ++ [(typ, termType i)])-- TermOptional m -> do- v <- freshVariableType- case m of- Nothing -> yield (TermOptional Nothing) (Types.optional v) []- Just e -> do- i <- infer e- yield (TermOptional $ Just i) (Types.optional v) ((v, termType i):(termConstraints i))-- TermProduct tuple -> do- is <- CM.mapM infer tuple- yield (TermProduct is) (TypeProduct $ fmap termType is) (L.concat $ fmap termConstraints is)-- TermRecord (Record n fields) -> do- rt <- withGraphContext $ requireRecordType True n- let sfields = rowTypeFields rt- (fields0, ftypes0, c1) <- CM.foldM forField ([], [], []) $ L.zip fields sfields- yield (TermRecord $ Record n $ L.reverse fields0) (TypeRecord $ RowType n (rowTypeExtends rt) $ L.reverse ftypes0) c1- where- forField (typed, ftypes, c) (field, sfield) = do- i <- inferFieldType field- let ft = termType $ fieldTerm i- let cinternal = termConstraints $ fieldTerm i- let cnominal = (ft, fieldTypeType sfield)- return (i:typed, (FieldType (fieldName field) ft):ftypes, cnominal:(cinternal ++ c))-- TermSet els -> do- v <- freshVariableType- iels <- CM.mapM infer $ S.toList els- let co = (\e -> (v, termType e)) <$> iels- let ci = L.concat (termConstraints <$> iels)- yield (TermSet $ S.fromList iels) (Types.set v) (co ++ ci)-- TermSum (Sum i s trm) -> do- it <- infer trm- types <- CM.sequence (varOrTerm it <$> [0..(s-1)])- yield (TermSum $ Sum i s it) (TypeSum types) (termConstraints it)- where- varOrTerm it j = if i == j- then pure $ termType it- else freshVariableType-- -- Note: type inference cannot recover complete union types from union values; type annotations are needed- TermUnion (Union n field) -> do- rt <- withGraphContext $ requireUnionType True n- sfield <- findMatchingField (fieldName field) (rowTypeFields rt)- ifield <- inferFieldType field- let cinternal = termConstraints $ fieldTerm ifield- let cnominal = (termType $ fieldTerm ifield, fieldTypeType sfield)- let constraints = cnominal:cinternal- yield (TermUnion $ Union n ifield) (TypeUnion rt) constraints-- TermVariable x -> do- t <- lookupTypeInEnvironment x- yield (TermVariable x) t []- where- yieldFunction fun = yield (TermFunction fun)-- yieldElimination e = yield (TermFunction $ FunctionElimination e)-- yield term typ constraints = do- (cx, _, _) <- getState- return $ TermAnnotated $ Annotated term (annotationClassDefault $ contextAnnotations cx, typ, constraints)--inferFieldType :: (Ord m, Show m) => Field m -> Flow (InferenceContext m) (Field (m, Type m, [Constraint m]))-inferFieldType (Field fname term) = Field fname <$> infer term---- | Solve for the top-level type of an expression in a given environment-inferType :: (Ord m, Show m) => Term m -> GraphFlow m (Term (m, Type m, [Constraint m]), TypeScheme m)-inferType term = do- withTrace ("infer type") $ do- cx <- getState- withState (startContext cx) $ do- term1 <- infer term- subst <- withGraphContext $ withSchemaContext $ solveConstraints (termConstraints term1)- let term2 = rewriteDataType (substituteInType subst) term1- return (term2, closeOver $ termType term2)- where- -- | Canonicalize and return the polymorphic toplevel type.- closeOver = normalizeScheme . generalize M.empty . reduceType--instantiate :: TypeScheme m -> Flow (InferenceContext m) (Type m)-instantiate (TypeScheme vars t) = do- vars1 <- mapM (const freshVariableType) vars- return $ substituteInType (M.fromList $ zip vars vars1) t--lookupTypeInEnvironment :: Show m => Variable -> Flow (InferenceContext m) (Type m)-lookupTypeInEnvironment v = do- (_, _, env) <- getState- case M.lookup v env of- Nothing -> fail $ "unbound variable: " ++ unVariable v- Just s -> instantiate s--namedType :: Show m => String -> Name -> GraphFlow m (Type m)-namedType debug name = do- withTrace (debug ++ ": " ++ unName name) $ do- withSchemaContext $ do- el <- requireElement name- decodeStructuralType $ elementData el--reduceType :: (Ord m, Show m) => Type m -> Type m-reduceType t = t -- betaReduceType cx t--rewriteDataType :: Ord m => (Type m -> Type m) -> Term (m, Type m, [Constraint m]) -> Term (m, Type m, [Constraint m])-rewriteDataType f = rewriteTermMeta rewrite- where- rewrite (x, typ, c) = (x, f typ, c)--startContext :: Context m -> InferenceContext m-startContext cx = (cx, 0, M.empty)--termConstraints :: Term (m, Type m, [Constraint m]) -> [Constraint m]-termConstraints (TermAnnotated (Annotated _ (_, _, constraints))) = constraints--termType :: Term (m, Type m, [Constraint m]) -> Type m-termType (TermAnnotated (Annotated _ (_, typ, _))) = typ--typeOfElement :: Show m => Name -> GraphFlow m (Type m)-typeOfElement name = withTrace "type of element" $ do- el <- requireElement name- decodeStructuralType $ elementSchema el--typeOfPrimitiveFunction :: Name -> GraphFlow m (FunctionType m)-typeOfPrimitiveFunction name = primitiveFunctionType <$> requirePrimitiveFunction name--withEnvironment :: (TypingEnvironment m -> TypingEnvironment m) -> Flow (InferenceContext m) a -> Flow (InferenceContext m) a-withEnvironment m f = do- (cx, i, e) <- getState- withState (cx, i, m e) f--withGraphContext :: GraphFlow m a -> Flow (InferenceContext m) a-withGraphContext f = do- (cx, _, _) <- getState- withState cx f
− src/main/haskell/Hydra/Types/Substitution.hs
@@ -1,78 +0,0 @@--- | Variable substitution and normalization of type expressions--module Hydra.Types.Substitution where--import Hydra.Kernel-import Hydra.Impl.Haskell.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--import Hydra.Util.Debug---type Subst m = M.Map VariableType (Type m)--composeSubst :: Subst m -> Subst m -> Subst m-composeSubst s1 s2 = M.union s1 $ M.map (substituteInType s1) s2--normalVariables :: [VariableType]-normalVariables = (\n -> VariableType $ "v" ++ show n) <$> [1..]--normalizeScheme :: Show m => TypeScheme m -> TypeScheme m-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 (Annotated t ann) -> TypeAnnotated (Annotated (normalizeType t) ann)- TypeElement t -> element $ normalizeType t- 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)- TypeNominal _ -> typ- TypeOptional t -> optional $ normalizeType t- TypeProduct types -> TypeProduct (normalizeType <$> types)- TypeRecord (RowType n e fields) -> TypeRecord $ RowType n e (normalizeFieldType <$> fields)- TypeSet t -> set $ normalizeType t- TypeSum types -> TypeSum (normalizeType <$> types)- TypeUnion (RowType n e fields) -> TypeUnion $ RowType n e (normalizeFieldType <$> fields)- TypeLambda (LambdaType (VariableType v) t) -> TypeLambda (LambdaType (VariableType v) $ normalizeType t)- TypeVariable v -> case Prelude.lookup v ord of- Just (VariableType v1) -> variable v1- Nothing -> error $ "type variable " ++ show v ++ " not in signature of type scheme: " ++ show ts--substituteInScheme :: M.Map VariableType (Type m) -> TypeScheme m -> TypeScheme m-substituteInScheme s (TypeScheme as t) = TypeScheme as $ substituteInType s' t- where- s' = L.foldr M.delete s as--substituteInType :: M.Map VariableType (Type m) -> Type m -> Type m-substituteInType s typ = case typ of- TypeApplication (ApplicationType lhs rhs) -> TypeApplication (ApplicationType (subst lhs) (subst rhs))- TypeAnnotated (Annotated t ann) -> TypeAnnotated (Annotated (subst t) ann)- TypeElement t -> element $ subst t- 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)- TypeNominal _ -> typ -- because we do not allow names to be bound to types with free variables- TypeOptional t -> optional $ subst t- TypeProduct types -> TypeProduct (subst <$> types)- TypeRecord (RowType n e fields) -> TypeRecord $ RowType n e (substField <$> fields)- TypeSet t -> set $ subst t- TypeSum types -> TypeSum (subst <$> types)- TypeUnion (RowType n e fields) -> TypeUnion $ RowType n e (substField <$> fields)- TypeLambda (LambdaType var@(VariableType v) body) -> if Y.isNothing (M.lookup var s)- then TypeLambda (LambdaType (VariableType v) (subst body))- else typ- TypeVariable a -> M.findWithDefault typ a s- where- subst = substituteInType s- substField (FieldType fname t) = FieldType fname $ subst t
− src/main/haskell/Hydra/Types/Unification.hs
@@ -1,81 +0,0 @@--- | Hindley-Milner style type unification--module Hydra.Types.Unification (- Constraint,- solveConstraints,-) where--import Hydra.Kernel-import Hydra.Types.Substitution-import Hydra.Impl.Haskell.Dsl.Types as Types--import qualified Data.Map as M-import qualified Data.Set as S---type Constraint m = (Type m, Type m)--type Unifier m = (Subst m, [Constraint m])--bind :: (Eq m, Show m) => VariableType -> Type m -> GraphFlow m (Subst m)-bind a t | t == TypeVariable a = return M.empty- | variableOccursInType a t = fail $ "infinite type for ?" ++ unVariableType a ++ ": " ++ show t- | otherwise = return $ M.singleton a t--solveConstraints :: (Eq m, Show m) => [Constraint m] -> GraphFlow m (Subst m)-solveConstraints cs = unificationSolver (M.empty, cs)--unificationSolver :: (Eq m, Show m) => Unifier m -> GraphFlow m (Subst m)-unificationSolver (su, cs) = case cs of- [] -> return su- ((t1, t2): cs0) -> do- su1 <- unify t1 t2- unificationSolver (- composeSubst su1 su,- (\(t1, t2) -> (substituteInType su1 t1, substituteInType su1 t2)) <$> cs0)--unify :: (Eq m, Show m) => Type m -> Type m -> GraphFlow m (Subst m)-unify t1 t2 = if t1 == t2- then return M.empty- else case (t1, t2) of- -- Temporary; type parameters are ignored- (TypeApplication (ApplicationType lhs rhs), t2) -> unify lhs t2- (t1, TypeApplication (ApplicationType lhs rhs)) -> unify t1 lhs-- (TypeAnnotated (Annotated at _), _) -> unify at t2- (_, TypeAnnotated (Annotated at _)) -> unify t1 at- (TypeElement et1, TypeElement et2) -> unify et1 et2- (TypeFunction (FunctionType dom cod), TypeFunction (FunctionType t3 t4)) -> unifyMany [dom, cod] [t3, t4]- (TypeList lt1, TypeList lt2) -> unify lt1 lt2- (TypeMap (MapType k1 v1), TypeMap (MapType k2 v2)) -> unifyMany [k1, v1] [k2, v2]- (TypeOptional ot1, TypeOptional ot2) -> unify ot1 ot2- (TypeProduct types1, TypeProduct types2) -> unifyMany types1 types2- (TypeRecord rt1, TypeRecord rt2) -> verify (rowTypeTypeName rt1 == rowTypeTypeName rt2)- (TypeSet st1, TypeSet st2) -> unify st1 st2- (TypeUnion rt1, TypeUnion rt2) -> verify (rowTypeTypeName rt1 == rowTypeTypeName rt2)- (TypeLambda (LambdaType (VariableType v1) body1), TypeLambda (LambdaType (VariableType v2) body2)) -> unifyMany- [Types.variable v1, body1] [Types.variable v2, body2]- (TypeSum types1, TypeSum types2) -> unifyMany types1 types2- (TypeVariable v, _) -> bind v t2- (_, TypeVariable v) -> bind v t1- (TypeNominal n1, TypeNominal n2) -> if n1 == n2- then return M.empty- else failUnification- (TypeNominal _, _) -> return M.empty -- TODO- (_, TypeNominal name) -> unify (Types.nominal name) t1- (l, r) -> fail $ "unexpected unification of " ++ show (typeVariant l) ++ " with " ++ show (typeVariant r) ++- ":\n " ++ show l ++ "\n " ++ show r- where- verify b = if b then return M.empty else failUnification- failUnification = fail $ "could not unify type " ++ show t1 ++ " with " ++ show t2--unifyMany :: (Eq m, Show m) => [Type m] -> [Type m] -> GraphFlow m (Subst m)-unifyMany [] [] = return M.empty-unifyMany (t1 : ts1) (t2 : ts2) =- do su1 <- unify t1 t2- su2 <- unifyMany (substituteInType su1 <$> ts1) (substituteInType su1 <$> ts2)- return (composeSubst su2 su1)-unifyMany t1 t2 = fail $ "unification mismatch between " ++ show t1 ++ " and " ++ show t2--variableOccursInType :: Show m => VariableType -> Type m -> Bool-variableOccursInType a t = S.member a $ freeVariablesInType t
+ src/main/haskell/Hydra/Unification.hs view
@@ -0,0 +1,115 @@+-- | Hindley-Milner style type unification++module Hydra.Unification (+ Constraint,+ solveConstraints,+) where++import Hydra.Basics+import Hydra.Strip+import Hydra.Compute+import Hydra.Core+import Hydra.Lexical+import Hydra.Printing+import Hydra.Rewriting+import Hydra.Substitution+import Hydra.Tier1+import Hydra.Dsl.Types as Types+import Hydra.Lib.Io++import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+++type Constraint = (Type, Type)++type Unifier = (Subst, [Constraint])++-- Note: type variables in Hydra are allowed to bind to type expressions which contain the variable;+-- i.e. type recursion by name is allowed.+bind :: Name -> Type -> Flow s Subst+bind name typ = do+ if typ == TypeVariable name+ then return M.empty+ else if variableOccursInType name typ+-- then fail $ "infinite type for " ++ unName name ++ ": " ++ show typ+ then return M.empty+ else return $ M.singleton name typ++solveConstraints :: [Constraint] -> Flow s Subst+solveConstraints cs = unificationSolver (M.empty, cs)++unificationSolver :: Unifier -> Flow s Subst+unificationSolver (su, cs) = case cs of+ [] -> return su+ ((t1, t2):rest) -> do+ su1 <- unify t1 t2+ unificationSolver (+ composeSubst su1 su,+ (\(t1, t2) -> (substituteInType su1 t1, substituteInType su1 t2)) <$> rest)++unify :: Type -> Type -> Flow s Subst+unify ltyp rtyp = do+-- withTrace ("unify " ++ show ltyp ++ " with " ++ show rtyp) $+ case (stripType ltyp, stripType rtyp) of+ -- Symmetric patterns+ (TypeApplication (ApplicationType lhs1 rhs1), TypeApplication (ApplicationType lhs2 rhs2)) ->+ unifyMany [lhs1, rhs1] [lhs2, rhs2]+ (TypeFunction (FunctionType dom1 cod1), TypeFunction (FunctionType dom2 cod2)) ->+ unifyMany [dom1, cod1] [dom2, cod2]+ (TypeList lt1, TypeList lt2) -> unify lt1 lt2+ (TypeLiteral lt1, TypeLiteral lt2) -> verify "different literal types" $ lt1 == lt2+ (TypeMap (MapType k1 v1), TypeMap (MapType k2 v2)) -> unifyMany [k1, v1] [k2, v2]+ (TypeOptional ot1, TypeOptional ot2) -> unify ot1 ot2+ (TypeProduct types1, TypeProduct types2) -> unifyMany types1 types2+ (TypeRecord rt1, TypeRecord rt2) -> do+ verify "different record type names" (rowTypeTypeName rt1 == rowTypeTypeName rt2)+ verify "different number of record fields" (L.length (rowTypeFields rt1) == L.length (rowTypeFields rt2))+ unifyMany (fieldTypeType <$> rowTypeFields rt1) (fieldTypeType <$> rowTypeFields rt2)+ (TypeSet st1, TypeSet st2) -> unify st1 st2+ (TypeUnion rt1, TypeUnion rt2) -> verify "different union type names" (rowTypeTypeName rt1 == rowTypeTypeName rt2)+ (TypeLambda (LambdaType (Name v1) body1), TypeLambda (LambdaType (Name v2) body2)) ->+ unifyMany [Types.var v1, body1] [Types.var v2, body2]+ (TypeSum types1, TypeSum types2) -> unifyMany types1 types2+ (TypeWrap n1, TypeWrap n2) -> verify "different wrapper type names" $ n1 == n2++ -- Asymmetric patterns+ (TypeVariable v1, TypeVariable v2) -> bindWeakest v1 v2+ (TypeVariable v, t2) -> bind v t2+ (t1, TypeVariable v) -> bind v t1++ -- TODO; temporary "slop", e.g. (record "RowType" ...) is allowed to unify with (wrap "RowType" @ "a")+ (TypeApplication (ApplicationType lhs rhs), t2) -> unify lhs t2+ (t1, TypeApplication (ApplicationType lhs rhs)) -> unify t1 lhs+ (TypeLambda (LambdaType _ body), t2) -> unify body t2+ (t1, TypeLambda (LambdaType _ body)) -> unify t1 body+ -- TODO; temporary "slop", e.g. (record "RowType" ...) is allowed to unify with (wrap "RowType")+ (TypeWrap _, _) -> return M.empty -- TODO+ (_, TypeWrap name) -> return M.empty -- TODO++ (l, r) -> fail $ "unification of " ++ show (typeVariant l) ++ " with " ++ show (typeVariant r) +++ ":\n " ++ showType l +++ "\n " ++ showType r+ where+ verify reason b = if b then return M.empty else failUnification reason+ failUnification reason = fail $ "could not unify types (reason: " ++ reason ++ "):\n\t"+ ++ showType (stripType ltyp) ++ "\n\t"+ ++ showType (stripType rtyp) ++ "\n"+-- failUnification = fail $ "could not unify type " ++ describeType (stripType ltyp) ++ " with " ++ describeType (stripType rtyp)+ bindWeakest v1 v2 = if isWeak v1+ then bind v1 (TypeVariable v2)+ else bind v2 (TypeVariable v1)+ where+ isWeak v = L.head (unName v) == 't' -- TODO: use a convention like _xxx for temporarily variables, then normalize and replace them++unifyMany :: [Type] -> [Type] -> Flow s Subst+unifyMany [] [] = return M.empty+unifyMany (t1 : ts1) (t2 : ts2) =+ do su1 <- unify t1 t2+ su2 <- unifyMany (substituteInType su1 <$> ts1) (substituteInType su1 <$> ts2)+ return (composeSubst su2 su1)+unifyMany t1 t2 = fail $ "unification mismatch between " ++ show t1 ++ " and " ++ show t2++variableOccursInType :: Name -> Type -> Bool+variableOccursInType a t = S.member a $ freeVariablesInType t
− src/main/haskell/Hydra/Util/Codetree/Script.hs
@@ -1,206 +0,0 @@--- | Utilities for constructing Hydra code trees--module Hydra.Util.Codetree.Script where--import Hydra.Util.Codetree.Ast--import qualified Data.List as L---angleBraces :: Brackets-angleBraces = Brackets (sym "<") (sym ">")--angleBracesList :: BlockStyle -> [Expr] -> Expr-angleBracesList style els = case els of- [] -> cst "<>"- _ -> brackets angleBraces style $ commaSep style els--bracketList :: BlockStyle -> [Expr] -> Expr-bracketList style els = case els of- [] -> cst "[]"- _ -> brackets squareBrackets style $ commaSep style els--brackets :: Brackets -> BlockStyle -> Expr -> Expr-brackets br style e = ExprBrackets $ BracketExpr br e style--commaSep :: BlockStyle -> [Expr] -> Expr-commaSep style l = case l of- [] -> cst ""- [x] -> x- (h:r) -> ifx commaOp h $ commaSep style r- where- break = case L.length $ L.filter id [blockStyleNewlineBeforeContent style, blockStyleNewlineAfterContent style] of- 0 -> WsSpace- 1 -> WsBreak- 2 -> WsDoubleBreak- commaOp = Op (sym ",") (Padding WsNone break) (Precedence 0) AssociativityNone -- No source--curlyBlock :: BlockStyle -> Expr -> Expr-curlyBlock style e = curlyBracesList style [e]--curlyBraces :: Brackets-curlyBraces = Brackets (sym "{") (sym "}")--curlyBracesList :: BlockStyle -> [Expr] -> Expr-curlyBracesList style els = case els of- [] -> cst "{}"- _ -> brackets curlyBraces style $ commaSep style els--cst :: String -> Expr-cst = ExprConst . Symbol--dotSep :: [Expr] -> Expr-dotSep = sep $ Op (sym ".") (Padding WsNone WsNone) (Precedence 0) AssociativityNone--doubleNewlineSep :: [Expr] -> Expr-doubleNewlineSep = sep $ Op (sym "") (Padding WsBreak WsBreak) (Precedence 0) AssociativityNone--fullBlockStyle :: BlockStyle-fullBlockStyle = BlockStyle True True True--halfBlockStyle :: BlockStyle-halfBlockStyle = BlockStyle True True False--ifx :: Op -> Expr -> Expr -> Expr-ifx op lhs rhs = ExprOp $ OpExpr op lhs rhs--indent :: String -> String-indent s = L.intercalate "\n" $ (" " ++) <$> lines s--indentBlock :: Expr -> [Expr] -> Expr-indentBlock head els = ifx idtOp head $ newlineSep els- where- idtOp = Op (sym "") (Padding WsSpace WsBreakAndIndent) (Precedence 0) AssociativityNone--indentLines :: [Expr] -> Expr-indentLines els = ifx topOp (cst "") (newlineSep els)- where- topOp = Op (sym "") (Padding WsNone WsBreakAndIndent) (Precedence 0) AssociativityNone--infixWs :: String -> Expr -> Expr -> Expr-infixWs op l r = spaceSep [l, cst op, r]--infixWsList :: String -> [Expr] -> Expr-infixWsList op opers = spaceSep $ L.foldl (\e r -> if L.null e then [r] else r:opExpr:e) [] $ L.reverse opers- where- opExpr = cst op--inlineStyle :: BlockStyle-inlineStyle = BlockStyle False False False--newlineSep :: [Expr] -> Expr-newlineSep = sep $ Op (sym "") (Padding WsNone WsBreak) (Precedence 0) AssociativityNone--noPadding :: Padding-noPadding = Padding WsNone WsNone--noSep :: [Expr] -> Expr-noSep = sep $ Op (sym "") (Padding WsNone WsNone) (Precedence 0) AssociativityNone--num :: Int -> Expr-num = cst . show--op :: String -> Int -> Associativity -> Op-op s p = Op (Symbol s) (Padding WsSpace WsSpace) (Precedence p)--orOp :: Bool -> Op-orOp newlines = Op (sym "|") (Padding WsSpace (if newlines then WsBreak else WsSpace)) (Precedence 0) AssociativityNone -- No source--orSep :: BlockStyle -> [Expr] -> Expr-orSep style l = case l of- [] -> cst ""- [x] -> x- (h:r) -> ifx (orOp newlines) h $ orSep style r- where- newlines = blockStyleNewlineBeforeContent style--parenList :: Bool -> [Expr] -> Expr-parenList newlines els = case els of- [] -> cst "()"- _ -> brackets parentheses style $ commaSep style els- where- style = if newlines && L.length els > 1 then halfBlockStyle else inlineStyle--parens :: Expr -> Expr-parens = brackets parentheses inlineStyle--parentheses :: Brackets-parentheses = Brackets (sym "(") (sym ")")--parenthesize :: Expr -> Expr-parenthesize exp = case exp of- ExprOp (OpExpr op@(Op _ _ prec assoc) lhs rhs) -> ExprOp (OpExpr op lhs2 rhs2)- where- lhs' = parenthesize lhs- rhs' = parenthesize rhs- lhs2 = case lhs' of- ExprOp (OpExpr (Op _ _ lprec lassoc) _ _) -> case prec `compare` lprec of- LT -> lhs'- GT -> parens lhs'- EQ -> if assocLeft assoc && assocLeft lassoc- then lhs'- else parens lhs'- _ -> lhs'- rhs2 = case rhs' of- ExprOp (OpExpr (Op _ _ rprec rassoc) _ _) -> case prec `compare` rprec of- LT -> rhs'- GT -> parens rhs'- EQ -> if assocRight assoc && assocRight rassoc- then rhs'- else parens rhs'- _ -> rhs'- assocLeft a = a == AssociativityLeft || a == AssociativityNone || a == AssociativityBoth- assocRight a = a == AssociativityRight || a == AssociativityNone || a == AssociativityBoth- ExprBrackets (BracketExpr br e newlines) -> ExprBrackets (BracketExpr br (parenthesize e) newlines)- _ -> exp--prefix :: String -> Expr -> Expr-prefix p = ifx preOp (cst "")- where- preOp = Op (sym p) (Padding WsNone WsNone) (Precedence 0) AssociativityNone--printExpr :: Expr -> String-printExpr e = case e of- ExprConst (Symbol s) -> s- ExprOp (OpExpr (Op (Symbol sym) (Padding padl padr) _ _) l r) -> lhs ++ pad padl ++ sym ++ pad padr ++ rhs- where- lhs = idt padl $ printExpr l- rhs = idt padr $ printExpr r- idt ws s = if ws == WsBreakAndIndent then indent s else s- pad ws = case ws of- WsNone -> ""- WsSpace -> " "- WsBreak -> "\n"- WsBreakAndIndent -> "\n"- WsDoubleBreak -> "\n\n"- ExprBrackets (BracketExpr (Brackets (Symbol l) (Symbol r)) e style) ->- l ++ pre ++ ibody ++ suf ++ r- where- body = printExpr e- ibody = if doIndent then indent body else body- pre = if nlBefore then "\n" else ""- suf = if nlAfter then "\n" else ""- BlockStyle doIndent nlBefore nlAfter = style--printExprAsTree :: Expr -> String-printExprAsTree expr = case expr of- ExprConst (Symbol s) -> s- ExprBrackets (BracketExpr (Brackets (Symbol l) (Symbol r)) e _) -> l ++ r ++ ":\n" ++ indent (printExprAsTree e)- ExprOp (OpExpr op l r) -> h (opSymbol op) ++ ":\n" ++ indent (printExprAsTree l) ++ "\n" ++ indent (printExprAsTree r)- where- h (Symbol s) = s--sep :: Op -> [Expr] -> Expr-sep op els = case els of- [] -> cst ""- [x] -> x- (h:r) -> ifx op h $ sep op r--spaceSep :: [Expr] -> Expr-spaceSep = sep $ Op (sym "") (Padding WsSpace WsNone) (Precedence 0) AssociativityNone--squareBrackets :: Brackets-squareBrackets = Brackets (sym "[") (sym "]")--sym :: String -> Symbol-sym = Symbol
− src/main/haskell/Hydra/Util/Debug.hs
@@ -1,12 +0,0 @@--- | Debugging utilities--module Hydra.Util.Debug where--import Control.Exception--newtype DebugException = DebugException String deriving Show--instance Exception DebugException--throwDebugException :: String -> c-throwDebugException = throw . DebugException
− src/main/haskell/Hydra/Util/Formatting.hs
@@ -1,114 +0,0 @@--- | String formatting utilities--module Hydra.Util.Formatting where--import qualified Hydra.Lib.Strings as Strings--import qualified Data.Char as C-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 CaseConvention = CaseConventionCamel | CaseConventionPascal | CaseConventionLowerSnake | CaseConventionUpperSnake--capitalize :: String -> String-capitalize s = case s of- [] -> []- (h:r) -> C.toUpper h : r--convertCase :: CaseConvention -> CaseConvention -> String -> String-convertCase from to original = case to of- CaseConventionCamel -> decapitalize $ L.concat (capitalize . fmap C.toLower <$> parts)- CaseConventionPascal -> L.concat (capitalize . fmap C.toLower <$> parts)- CaseConventionLowerSnake -> L.intercalate "_" (fmap C.toLower <$> parts)- CaseConventionUpperSnake -> L.intercalate "_" (fmap C.toUpper <$> parts)- where- parts = case from of- CaseConventionCamel -> byCaps- CaseConventionPascal -> byCaps- CaseConventionLowerSnake -> byUnderscores- CaseConventionUpperSnake -> byUnderscores- byUnderscores = Strings.splitOn "_" original- byCaps = L.foldl helper [""] $ L.reverse $ decapitalize original- where- helper (h:r) c = ["" | C.isUpper c] ++ ((c:h):r)--decapitalize :: String -> String-decapitalize s = case s of- [] -> []- (h:r) -> C.toLower h : r--escapeWithUnderscore :: S.Set String -> String -> String-escapeWithUnderscore reserved s = if S.member s reserved then s ++ "_" else s--indentLines :: String -> String-indentLines s = unlines (indent <$> lines s)- where- indent l = " " ++ l--javaStyleComment :: String -> String-javaStyleComment s = "/**\n" ++ " * " ++ s ++ "\n */"--nonAlnumToUnderscores :: String -> String-nonAlnumToUnderscores = L.reverse . fst . L.foldl replace ([], False)- where- replace (s, b) c = if isAlnum c- then (c:s, False)- else if b- then (s, True)- else ('_':s, True)- isAlnum c = (c >= 'A' && c <= 'Z')- || (c >= 'a' && c <= 'z')- || (c >= '0' && c <= '9')--sanitizeWithUnderscores :: S.Set String -> String -> String-sanitizeWithUnderscores reserved = escapeWithUnderscore reserved . nonAlnumToUnderscores--toLower :: String -> String-toLower = fmap C.toLower--toUpper :: String -> String-toUpper = fmap C.toLower--withCharacterAliases :: String -> String-withCharacterAliases original = L.filter C.isAlphaNum $ L.concat $ alias <$> original- where- alias c = Y.maybe [c] capitalize $ M.lookup (C.ord c) aliases-- -- Taken from: https://cs.stanford.edu/people/miles/iso8859.html- aliases = M.fromList [- (32, "sp"),- (33, "excl"),- (34, "quot"),- (35, "num"),- (36, "dollar"),- (37, "percnt"),- (38, "amp"),- (39, "apos"),- (40, "lpar"),- (41, "rpar"),- (42, "ast"),- (43, "plus"),- (44, "comma"),- (45, "minus"),- (46, "period"),- (47, "sol"),- (58, "colon"),- (59, "semi"),- (60, "lt"),- (61, "equals"),- (62, "gt"),- (63, "quest"),- (64, "commat"),- (91, "lsqb"),- (92, "bsol"),- (93, "rsqb"),- (94, "circ"),- (95, "lowbar"),- (96, "grave"),- (123, "lcub"),- (124, "verbar"),- (125, "rcub"),- (126, "tilde")]
− src/main/haskell/Hydra/Util/GrammarToModule.hs
@@ -1,100 +0,0 @@--- | A utility for converting a BNF grammar to a Hydra module--module Hydra.Util.GrammarToModule where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Impl.Haskell.Dsl.Standard-import Hydra.CoreEncoding--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y---grammarToModule :: Namespace -> Grammar -> Maybe String -> Module Meta-grammarToModule ns (Grammar prods) desc = Module ns elements [] desc- where- elements = pairToElement <$> L.concat (L.zipWith (makeElements False) (capitalize . fst <$> prodPairs) (snd <$> prodPairs))- where- prodPairs = (\(Production (Symbol s) pat) -> (s, pat)) <$> prods- pairToElement (lname, typ) = Element (toName lname) (Terms.element _Type) (encodeType typ)-- toName lname = fromQname ns lname-- findNames pats = L.reverse $ fst (L.foldl nextName ([], M.empty) pats)- where- nextName (names, nameMap) pat = (nn:names, M.insert rn ni nameMap)- where- rn = rawName pat- (nn, ni) = case M.lookup rn nameMap of- Nothing -> (rn, 1)- Just i -> (rn ++ show (i+1), i+1)-- rawName pat = case pat of- PatternNil -> "none"- PatternIgnored _ -> "ignored"- PatternLabeled (LabeledPattern (Label l) _) -> l- PatternConstant (Constant c) -> decapitalize $ withCharacterAliases c- PatternRegex _ -> "regex"- PatternNonterminal (Symbol s) -> decapitalize s- PatternSequence _ -> "sequence"- PatternAlternatives _ -> "alts"- PatternOption p -> decapitalize (rawName p)- PatternStar p -> "listOf" ++ capitalize (rawName p)- PatternPlus p -> "listOf" ++ capitalize (rawName p)-- isComplex pat = case pat of- PatternLabeled (LabeledPattern _ p) -> isComplex p- PatternSequence _ -> True- PatternAlternatives _ -> True- _ -> False-- makeElements omitTrivial lname pat = forPat pat- where- forPat pat = case pat of- PatternNil -> trivial- PatternIgnored _ -> []- PatternLabeled (LabeledPattern (Label _) p) -> forPat p- PatternConstant _ -> trivial- PatternRegex _ -> [(lname, Types.string)]- PatternNonterminal (Symbol other) -> [(lname, Types.nominal $ toName other)]- PatternSequence pats -> forRecordOrUnion True Types.record pats- PatternAlternatives pats -> forRecordOrUnion False Types.union pats- PatternOption p -> mod "Option" Types.optional p- PatternStar p -> mod "Elmt" Types.list p- PatternPlus p -> mod "Elmt" nonemptyList p-- trivial = if omitTrivial then [] else [(lname, Types.unit)]-- forRecordOrUnion isRecord c pats = (lname, c fields):els- where- fieldPairs = Y.catMaybes $ L.zipWith (toField isRecord) (findNames pats) pats- fields = fst <$> fieldPairs- els = L.concat (snd <$> fieldPairs)-- toField isRecord n p = if ignore- then Nothing- else Just $ descend n f2 p- where- f2 ((lname, typ):rest) = (FieldType (FieldName n) typ, rest)- ignore = if isRecord- then case p of- PatternConstant _ -> True- _ -> False- else False-- mod n f p = descend n f2 p- where- f2 ((lname, typ):rest) = (lname, f typ):rest-- descend n f p = f $ if isComplex p- then (lname, Types.nominal (toName $ fst $ L.head cpairs)):cpairs- else if L.null cpairs- then [(lname, Types.unit)]- else (lname, snd (L.head cpairs)):L.tail cpairs- where- cpairs = makeElements False (childName lname n) p-- childName lname n = lname ++ "." ++ capitalize n
− src/main/haskell/Hydra/Util/Sorting.hs
@@ -1,20 +0,0 @@--- | Utilities for sorting--module Hydra.Util.Sorting where--import qualified Data.List as L-import qualified Data.Bifunctor as BF----- | Sort a directed acyclic graph (DAG) based on an adjacency list--- Note: assumes that the input is in fact a DAG; the ordering is incomplete in the presence of cycles.-topologicalSort :: Eq a => [(a, [a])] -> Maybe [a]-topologicalSort pairs = if L.length result < L.length pairs- then Nothing- else Just result- where- result = foldl makePrecede [] pairs- makePrecede ts (x, xs) = L.nub $- case L.elemIndex x ts of- Just i -> uncurry (++) $ BF.first (++ xs) $ splitAt i ts- _ -> ts ++ xs ++ [x]
− src/test/haskell/Hydra/Adapters/LiteralSpec.hs
@@ -1,126 +0,0 @@-module Hydra.Adapters.LiteralSpec where--import Hydra.Kernel--import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC---testFloatAdapter :: H.SpecWith ()-testFloatAdapter = H.describe "Test floating-point adapter" $ do-- H.it "upgrade float32 to bigfloat, since float32 and float64 are unsupported" $- QC.property $ \f -> checkFloatAdapter- [FloatTypeBigfloat]- FloatTypeFloat32 FloatTypeBigfloat False- (FloatValueFloat32 f) (FloatValueBigfloat $ realToFrac f)-- H.it "downgrade bigfloat to float64" $- QC.property $ \d -> checkFloatAdapter- [FloatTypeFloat32, FloatTypeFloat64]- FloatTypeBigfloat FloatTypeFloat64 True- (FloatValueBigfloat d) (FloatValueFloat64 $ realToFrac d)-- H.it "downgrade bigfloat to float32, since float64 is unsupported" $- QC.property $ \d -> checkFloatAdapter- [FloatTypeFloat32]- FloatTypeBigfloat FloatTypeFloat32 True- (FloatValueBigfloat d) (FloatValueFloat32 $ realToFrac d)-- H.it "bigfloat is supported and remains unchanged" $- QC.property $ \d -> checkFloatAdapter- [FloatTypeFloat32, FloatTypeBigfloat]- FloatTypeBigfloat FloatTypeBigfloat False- (FloatValueBigfloat d) (FloatValueBigfloat d)--testIntegerAdapter :: H.SpecWith ()-testIntegerAdapter = H.describe "Test integer adapter" $ do-- H.it "upgrade uint8 to uint16, not int16" $- QC.property $ \b -> checkIntegerAdapter- [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]- IntegerTypeUint8 IntegerTypeUint16 False- (IntegerValueUint8 b) (IntegerValueUint16 $ fromIntegral b)-- H.it "upgrade int8 to int16, not uint16" $- QC.property $ \b -> checkIntegerAdapter- [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]- IntegerTypeInt8 IntegerTypeInt16 False- (IntegerValueInt8 b) (IntegerValueInt16 $ fromIntegral b)-- H.it "upgrade uint8 to int16 when uint16 is not supported" $- QC.property $ \b -> checkIntegerAdapter- [IntegerTypeInt16, IntegerTypeInt32, IntegerTypeBigint]- IntegerTypeUint8 IntegerTypeInt16 False- (IntegerValueUint8 b) (IntegerValueInt16 $ fromIntegral b)-- H.it "cross-convert uint32 to int32, even when uint16 is supported" $- QC.property $ \b -> checkIntegerAdapter- [IntegerTypeUint16, IntegerTypeInt32]- IntegerTypeUint32 IntegerTypeInt32 True- (IntegerValueUint32 b) (IntegerValueInt32 $ fromIntegral b)-- H.it "downgrade bigint to int32, not uint32" $- QC.property $ \b -> checkIntegerAdapter- [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeInt32, IntegerTypeUint32]- IntegerTypeBigint IntegerTypeInt32 True- (IntegerValueBigint b) (IntegerValueInt32 $ fromIntegral b)-- H.it "upgrade uint64 to bigint when supported" $- QC.property $ \i -> checkIntegerAdapter- [IntegerTypeInt32, IntegerTypeUint32, IntegerTypeBigint]- IntegerTypeUint64 IntegerTypeBigint False- (IntegerValueUint64 i) (IntegerValueBigint $ fromIntegral i)-- H.it "downgrade uint64 to uint32 when bigint is unsupported" $- QC.property $ \i -> checkIntegerAdapter- [IntegerTypeInt32, IntegerTypeUint32]- IntegerTypeUint64 IntegerTypeUint32 True- (IntegerValueUint64 i) (IntegerValueUint32 $ fromIntegral i)--testLiteralAdapter :: H.SpecWith ()-testLiteralAdapter = H.describe "Test literal adapter" $ do-- H.it "encode binary data as strings" $- QC.property $ \b -> checkLiteralAdapter- [LiteralVariantString]- LiteralTypeBinary LiteralTypeString False- (LiteralBinary b) (LiteralString b)-- H.it "encode booleans as strings" $- QC.property $ \b -> checkLiteralAdapter- [LiteralVariantString]- LiteralTypeBoolean LiteralTypeString False- (LiteralBoolean b) (LiteralString $ if b then "true" else "false")-- H.it "encode booleans as integers" $- QC.property $ \b -> checkLiteralAdapter- [LiteralVariantInteger]- LiteralTypeBoolean (LiteralTypeInteger IntegerTypeInt16) False- (LiteralBoolean b) (LiteralInteger $ IntegerValueInt16 $ if b then 1 else 0)-- H.it "floating-point encoding is delegated to the float adapter" $- QC.property $ \f -> checkLiteralAdapter- [LiteralVariantFloat]- (LiteralTypeFloat FloatTypeBigfloat) (LiteralTypeFloat FloatTypeFloat32) True- (LiteralFloat $ FloatValueBigfloat f) (LiteralFloat $ FloatValueFloat32 $ realToFrac f)-- H.it "integer encoding is delegated to the integer adapter" $- QC.property $ \i -> checkLiteralAdapter- [LiteralVariantInteger]- (LiteralTypeInteger IntegerTypeBigint) (LiteralTypeInteger IntegerTypeInt32) True- (LiteralInteger $ IntegerValueBigint i) (LiteralInteger $ IntegerValueInt32 $ fromIntegral i)-- H.it "strings are unchanged" $- QC.property $ \s -> checkLiteralAdapter- [LiteralVariantString]- LiteralTypeString LiteralTypeString False- (LiteralString s) (LiteralString s)--spec :: H.Spec-spec = do- testFloatAdapter- testIntegerAdapter- testLiteralAdapter
− src/test/haskell/Hydra/Adapters/TermSpec.hs
@@ -1,377 +0,0 @@-module Hydra.Adapters.TermSpec where--import Hydra.Kernel-import Hydra.Adapters.Term-import Hydra.Adapters.UtilsEtc-import Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Meta-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Data.Map as M-import qualified Test.QuickCheck as QC-import qualified Data.Set as S-import qualified Data.Maybe as Y---constraintsAreAsExpected :: H.SpecWith ()-constraintsAreAsExpected = H.describe "Verify that the language constraints include/exclude the appropriate types" $ do-- H.it "int16 and int32 are supported in the test context" $ do- typeIsSupported (context [TypeVariantLiteral]) Types.int16 `H.shouldBe` True- typeIsSupported (context [TypeVariantLiteral]) Types.int32 `H.shouldBe` True-- H.it "int8 and bigint are unsupported in the test context" $ do- typeIsSupported (context [TypeVariantLiteral]) Types.int8 `H.shouldBe` False- typeIsSupported (context [TypeVariantLiteral]) Types.bigint `H.shouldBe` False-- H.it "Records are supported, but unions are not" $ do- typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) latLonType `H.shouldBe` True- typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) stringOrIntType `H.shouldBe` False-- H.it "Records are supported if and only if each of their fields are supported" $ do- typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])- (TypeRecord $ RowType (Name "Example") Nothing [Types.field "first" Types.string, Types.field "second" Types.int16])- `H.shouldBe` True- typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])- (TypeRecord $ RowType (Name "Example") Nothing [Types.field "first" Types.string, Types.field "second" Types.int8])- `H.shouldBe` False-- H.it "Lists are supported if the list element type is supported" $ do- typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfStringsType `H.shouldBe` True- typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfListsOfStringsType `H.shouldBe` True- typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfSetOfStringsType `H.shouldBe` False-- where- context = languageConstraints . adapterContextTarget . termTestContext--supportedConstructorsAreUnchanged :: H.SpecWith ()-supportedConstructorsAreUnchanged = H.describe "Verify that supported term constructors are unchanged" $ do-- H.it "Strings (and other supported literal values) pass through without change" $- QC.property $ \b -> checkDataAdapter- [TypeVariantLiteral]- Types.string- Types.string- False- (string b)- (string b)-- H.it "Lists (when supported) pass through without change" $- QC.property $ \strings -> checkDataAdapter- [TypeVariantLiteral, TypeVariantList]- listOfStringsType- listOfStringsType- False- (list $ string <$> strings)- (list $ string <$> strings)-- H.it "Maps (when supported) pass through without change" $- QC.property $ \keyvals -> checkDataAdapter- [TypeVariantLiteral, TypeVariantMap]- mapOfStringsToIntsType- mapOfStringsToIntsType- False- (makeMap keyvals)- (makeMap keyvals)-- H.it "Optionals (when supported) pass through without change" $- QC.property $ \mi -> checkDataAdapter- [TypeVariantLiteral, TypeVariantOptional]- optionalInt8Type- optionalInt16Type- False- (optional $ int8 <$> mi)- (optional $ int16 . fromIntegral <$> mi)-- H.it "Records (when supported) pass through without change" $- QC.property $ \a1 a2 -> checkDataAdapter- [TypeVariantLiteral, TypeVariantRecord]- (TypeRecord $ RowType testTypeName Nothing [Types.field "first" Types.string, Types.field "second" Types.int8])- (TypeRecord $ RowType testTypeName Nothing [Types.field "first" Types.string, Types.field "second" Types.int16])- False- (record testTypeName [field "first" $ string a1, field "second" $ int8 a2])- (record testTypeName [field "first" $ string a1, field "second" $ int16 $ fromIntegral a2])-- H.it "Unions (when supported) pass through without change" $- QC.property $ \int -> checkDataAdapter- [TypeVariantLiteral, TypeVariantUnion]- stringOrIntType- stringOrIntType- False- (variant stringOrIntName (FieldName "right") $ int32 int)- (variant stringOrIntName (FieldName "right") $ int32 int)-- H.it "Sets (when supported) pass through without change" $- QC.property $ \strings -> checkDataAdapter- [TypeVariantLiteral, TypeVariantSet]- setOfStringsType- setOfStringsType- False- (stringSet strings)- (stringSet strings)-- H.it "Element references (when supported) pass through without change" $- QC.property $ \name -> checkDataAdapter- [TypeVariantElement]- int32ElementType- int32ElementType- False- (element name)- (element name)-- H.it "CompareTo terms (when supported) pass through without change" $- QC.property $ \s -> checkDataAdapter- [TypeVariantLiteral, TypeVariantFunction]- compareStringsType- compareStringsType- False- (compareTo $ string s)- (compareTo $ string s)-- H.it "Term terms (when supported) pass through without change" $- QC.property $ \() -> checkDataAdapter- [TypeVariantLiteral, TypeVariantFunction, TypeVariantElement]- int32ElementDataType- int32ElementDataType- False- delta- delta-- H.it "Primitive function references (when supported) pass through without change" $- QC.property $ \name -> checkDataAdapter- [TypeVariantLiteral, TypeVariantFunction]- concatType- concatType- False- (primitive name)- (primitive name)-- H.it "Projections (when supported) pass through without change" $- QC.property $ \fname -> checkDataAdapter- [TypeVariantLiteral, TypeVariantFunction, TypeVariantRecord]- exampleProjectionType- exampleProjectionType- False- (projection testTypePersonName fname)- (projection testTypePersonName fname)-- H.it "Nominal types (when supported) pass through without change" $- QC.property $ \s -> checkDataAdapter- [TypeVariantLiteral, TypeVariantNominal]- stringAliasType- stringAliasType- False- (string s)- (string s)--unsupportedConstructorsAreModified :: H.SpecWith ()-unsupportedConstructorsAreModified = H.describe "Verify that unsupported term constructors are changed in the expected ways" $ do-- H.it "Sets (when unsupported) become lists" $- QC.property $ \strings -> checkDataAdapter- [TypeVariantLiteral, TypeVariantList]- setOfStringsType- listOfStringsType- False- (stringSet strings)- (stringList $ S.toList strings)-- H.it "Element references (when unsupported) become strings" $- QC.property $ \name@(Name nm) -> checkDataAdapter- [TypeVariantLiteral]- int32ElementType- Types.string- False- (element name)- (string nm) -- Note: the element name is not dereferenced-- H.it "CompareTo terms (when unsupported) become variant terms" $- QC.property $ \s -> checkDataAdapter- [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]- compareStringsType- (functionProxyType Types.string)- False- (compareTo $ string s)- (union functionProxyName $ field "compareTo" $ string s)-- H.it "Data terms (when unsupported) become variant terms" $- QC.property $ \() -> checkDataAdapter- [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]- int32ElementDataType- (functionProxyType Types.string)- False- delta- (union functionProxyName $ field "element" unit)-- H.it "Optionals (when unsupported) become lists" $- QC.property $ \ms -> checkDataAdapter- [TypeVariantLiteral, TypeVariantList]- (Types.optional Types.string)- (Types.list Types.string)- False- (optional $ string <$> ms)- (list $ Y.maybe [] (\s -> [string s]) ms)-- H.it "Primitive function references (when unsupported) become variant terms" $- QC.property $ \name -> checkDataAdapter- [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]- concatType- (functionProxyType Types.string)- False- (primitive name)- (union functionProxyName $ field "primitive" $ string $ unName name) -- Note: the function name is not dereferenced-- H.it "Projections (when unsupported) become variant terms" $- QC.property $ \fname -> checkDataAdapter- [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]- exampleProjectionType- (functionProxyType testTypePerson)- False- (projection testTypePersonName fname)- (union functionProxyName $ field "record" $ string $- show (projection testTypePersonName fname :: Term Meta)) -- Note: the field name is not dereferenced-- H.it "Nominal types (when unsupported) are dereferenced" $- QC.property $ \s -> checkDataAdapter- [TypeVariantLiteral, TypeVariantAnnotated]- stringAliasType- (TypeAnnotated $ Annotated Types.string $ Meta $- M.fromList [(metaDescription, Terms.string "An alias for the string type")])- False- (string s)- (string s)-- H.it "Unions (when unsupported) become records" $- QC.property $ \i -> checkDataAdapter- [TypeVariantLiteral, TypeVariantOptional, TypeVariantRecord]- eitherStringOrInt8Type- (TypeRecord $ RowType eitherStringOrInt8TypeName Nothing [- Types.field "left" $ Types.optional Types.string,- Types.field "right" $ Types.optional Types.int16])- False- (union eitherStringOrInt8TypeName $ field "right" $ int8 i)- (record eitherStringOrInt8TypeName [- field "left" $ optional Nothing,- field "right" $ optional $ Just $ int16 $ fromIntegral i])--termsAreAdaptedRecursively :: H.SpecWith ()-termsAreAdaptedRecursively = H.describe "Verify that the adapter descends into subterms and transforms them appropriately" $ do-- H.it "A list of int8's becomes a list of int32's" $- QC.property $ \ints -> checkDataAdapter- [TypeVariantLiteral, TypeVariantList]- listOfInt8sType- listOfInt16sType- False- (list $ int8 <$> ints)- (list $ int16 . fromIntegral <$> ints)-- H.it "A list of sets of strings becomes a list of lists of strings" $- QC.property $ \lists -> checkDataAdapter- [TypeVariantLiteral, TypeVariantList]- listOfSetOfStringsType- listOfListsOfStringsType- False- (list $ (\l -> set $ S.fromList $ string <$> l) <$> lists)- (list $ (\l -> list $ string <$> S.toList (S.fromList l)) <$> lists)-- H.it "A list of sets of element references becomes a list of lists of strings" $- QC.property $ \names -> checkDataAdapter- [TypeVariantLiteral, TypeVariantList]- listOfSetOfInt32ElementReferencesType- listOfListsOfStringsType- False- (list $ (\l -> set $ S.fromList $ element <$> l) <$> names)- (list $ (\l -> list $ string <$> S.toList (S.fromList $ unName <$> l)) <$> names)--roundTripsPreserveSelectedTypes :: H.SpecWith ()-roundTripsPreserveSelectedTypes = H.describe "Verify that the adapter is information preserving, i.e. that round-trips are no-ops" $ do-- H.it "Check strings (pass-through)" $- QC.property $ \s -> roundTripIsNoop Types.string (string s)-- H.it "Check lists (pass-through)" $- QC.property $ \strings -> roundTripIsNoop listOfStringsType (list $ string <$> strings)-- H.it "Check sets (which map to lists)" $- QC.property $ \strings -> roundTripIsNoop setOfStringsType (stringSet strings)-- H.it "Check element references (which map to strings)" $- QC.property $ \name -> roundTripIsNoop int32ElementType (element name)-- H.it "Check compareTo terms (which map to variants)" $- QC.property $ \s -> roundTripIsNoop compareStringsType (compareTo $ string s)-- H.it "Check data terms (which map to variants)" $- roundTripIsNoop int32ElementDataType delta-- H.it "Check primitive function references (which map to variants)" $- QC.property $ \name -> roundTripIsNoop concatType (primitive name)-- H.it "Check projection terms (which map to variants)" $- QC.property $ \fname -> roundTripIsNoop exampleProjectionType (projection testTypePersonName fname)-- H.it "Check nominally typed terms (which pass through as instances of the aliased type)" $- QC.property $ \s -> roundTripIsNoop stringAliasType (string s)--roundTripsPreserveArbitraryTypes :: H.SpecWith ()-roundTripsPreserveArbitraryTypes = H.describe "Verify that the adapter is information preserving for arbitrary typed terms" $ do-- H.it "Check arbitrary type/term pairs" $- QC.property $ \(TypedTerm typ term) -> roundTripIsNoop typ term--fieldAdaptersAreAsExpected :: H.SpecWith ()-fieldAdaptersAreAsExpected = H.describe "Check that field adapters are as expected" $ do-- H.it "An int8 field becomes an int16 field" $- QC.property $ \i -> checkFieldAdapter- [TypeVariantLiteral, TypeVariantRecord]- (Types.field "second" Types.int8)- (Types.field "second" Types.int16)- False- (field "second" $ int8 i)- (field "second" $ int16 $ fromIntegral i)--roundTripIsNoop :: Type Meta -> Term Meta -> H.Expectation-roundTripIsNoop typ term = shouldSucceedWith- (step coderEncode term >>= step coderDecode)- term- where- step = adapt typ-- -- Use a YAML-like language (but supporting unions) as the default target language- testLanguage = Language (LanguageName "hydra/test") $ LanguageConstraints {- languageConstraintsEliminationVariants = S.empty, -- S.fromList eliminationVariants,- languageConstraintsLiteralVariants = S.fromList [- LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],- languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],- languageConstraintsFunctionVariants = S.empty,- languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],- languageConstraintsTermVariants = S.fromList termVariants,- languageConstraintsTypeVariants = S.fromList [- TypeVariantAnnotated, TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantRecord, TypeVariantUnion],- languageConstraintsTypes = \typ -> case stripType typ of- TypeOptional (TypeOptional _) -> False- _ -> True }-- acx = AdapterContext testContext hydraCoreLanguage testLanguage-- -- Note: in a real application, you wouldn't create the adapter just to use it once;- -- it should be created once, then applied to many terms.- adapt typ dir term = do- ad <- withState acx $ termAdapter typ- dir (adapterCoder ad) term--spec :: H.Spec-spec = do- constraintsAreAsExpected- supportedConstructorsAreUnchanged- unsupportedConstructorsAreModified- termsAreAdaptedRecursively- roundTripsPreserveSelectedTypes- roundTripsPreserveArbitraryTypes- fieldAdaptersAreAsExpected
+ src/test/haskell/Hydra/AnnotationsSpec.hs view
@@ -0,0 +1,126 @@+module Hydra.AnnotationsSpec where++import Hydra.Kernel+import qualified Hydra.Dsl.Terms as Terms+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.Map as M+++checkArbitraryAnnotations :: H.SpecWith ()+checkArbitraryAnnotations = H.describe "Check getting/setting of arbitrary annotations" $ do++ H.it "Set a single key/value pair" $+ QC.property $ \k v -> H.shouldBe+ (setAnn k (Just $ Terms.int32 v) $ Terms.string "foo")+ (TermAnnotated $ AnnotatedTerm (Terms.string "foo") $ M.fromList [(k, Terms.int32 v)])++ H.it "Retrieve a single value" $+ QC.property $ \k v -> H.shouldBe+ (getAnn k $ setAnn k (Just $ Terms.string v) $ Terms.int32 42)+ (Just $ Terms.string v)++ H.it "Retrieve a null value" $+ QC.property $ \k -> H.shouldBe+ (getAnn k $ Terms.int16 42)+ Nothing++ H.it "Set multiple values" $+ QC.property $ \v1 v2 -> H.shouldBe+ (setAnn "k2" (Just $ Terms.int32 v2) $+ setAnn "k1" (Just $ Terms.string v1) $+ Terms.boolean True)+ (TermAnnotated $ AnnotatedTerm (Terms.boolean True) $ M.fromList [("k1", Terms.string v1), ("k2", Terms.int32 v2)])++ H.it "An outer annotation overrides an inner one" $+ QC.property $ \k v1 v2 -> H.shouldBe+ (setAnn k (Just $ Terms.string v2) $ setAnn k (Just $ Terms.string v1) $ Terms.string "bar")+ (TermAnnotated $ AnnotatedTerm (Terms.string "bar") $ M.fromList [(k, Terms.string v2)])++ H.it "Unset a single annotation" $+ QC.property $ \k -> H.shouldBe+ (setAnn k Nothing $ setAnn k (Just $ Terms.string "foo") $ Terms.int64 137)+ (Terms.int64 137)++ H.it "Unset one of multiple annotations" $+ QC.property $ \v1 v2 -> H.shouldBe+ (setAnn "k1" Nothing $+ setAnn "k2" (Just $ Terms.int32 v2) $+ setAnn "k1" (Just $ Terms.string v1) $+ Terms.int64 137)+ (TermAnnotated $ AnnotatedTerm (Terms.int64 137) $ M.fromList [("k2", Terms.int32 v2)])++checkDescriptions :: H.SpecWith ()+checkDescriptions = H.describe "Check getting/setting of descriptions" $ do++ H.it "Set a single description" $+ QC.property $ \d -> H.shouldBe+ (setDesc (Just d) $ Terms.string "foo")+ (TermAnnotated $ AnnotatedTerm (Terms.string "foo") $ M.fromList [("description", Terms.string d)])++ H.it "Retrieve a single description" $+ QC.property $ \d -> H.shouldBe+ (getDesc $ setDesc (Just d) $ Terms.int32 42)+ (Just d)++ H.it "Retrieve a null description" $+ QC.property $ \i -> H.shouldBe+ (getDesc $ Terms.int16 i)+ Nothing++ H.it "An outer description overrides an inner one" $+ QC.property $ \d1 d2 -> H.shouldBe+ (setDesc (Just d2) $ setDesc (Just d1) $ Terms.string "bar")+ (TermAnnotated $ AnnotatedTerm (Terms.string "bar") $ M.fromList [("description", Terms.string d2)])++ H.it "Unset a description" $+ QC.property $ \d -> H.shouldBe+ (setDesc Nothing $ setDesc (Just d) $ Terms.int64 137)+ (Terms.int64 137)++checkNoncompactAnnotations :: H.SpecWith ()+checkNoncompactAnnotations = H.describe "Check non-compact (i.e. layered) annotations" $ do++ H.it "Annotations at different levels, with different keys, are all available" $ do+ H.shouldBe+ (getTermAnnotation "one" term0)+ Nothing+ H.shouldBe+ (getTermAnnotation "one" term1)+ (Just $ Terms.int32 1)+ H.shouldBe+ (getTermAnnotation "one" term2)+ (Just $ Terms.int32 1)+ H.shouldBe+ (getTermAnnotation "two" term2)+ (Just $ Terms.int32 2)+ H.shouldBe+ (getTermAnnotation "two" term3)+ (Just $ Terms.int32 2)++ H.it "Outer annotations override inner ones" $+ H.shouldBe+ (getTermAnnotation "one" term3)+ (Just $ Terms.int32 42)++ where+ term0 = Terms.int32 42+ term1 = Terms.annot (M.fromList [("one", Terms.int32 1)]) term0+ term2 = Terms.annot (M.fromList [("two", Terms.int32 2)]) term1+ term3 = Terms.annot (M.fromList [("one", Terms.int32 42)]) term2++getAnn = getTermAnnotation++getDesc term = fromFlow (Just "no description") testGraph $ getTermDescription term++setAnn = setTermAnnotation++setDesc = setTermDescription++spec :: H.Spec+spec = do+ checkArbitraryAnnotations+ checkDescriptions+ checkNoncompactAnnotations
src/test/haskell/Hydra/ArbitraryCore.hs view
@@ -1,8 +1,10 @@++{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for QC.Arbitrary (Term) and QC.Arbitrary (Type) module Hydra.ArbitraryCore where import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types+import Hydra.Dsl.Terms+import qualified Hydra.Dsl.Types as Types import qualified Control.Monad as CM import qualified Data.List as L@@ -30,11 +32,6 @@ LiteralInteger <$> QC.arbitrary, LiteralString <$> QC.arbitrary] -instance QC.Arbitrary FieldName- where- arbitrary = FieldName <$> QC.arbitrary- shrink (FieldName n) = FieldName <$> QC.shrink n- instance QC.Arbitrary FloatType where arbitrary = QC.oneof $ pure <$> [@@ -75,15 +72,15 @@ IntegerValueUint32 <$> QC.arbitrary, IntegerValueUint64 <$> QC.arbitrary] -instance (Eq m, Ord m, Read m, Show m) => QC.Arbitrary (Term m) where- arbitrary = (\(TypedTerm _ term) -> term) <$> QC.sized arbitraryTypedTerm+instance QC.Arbitrary (Term) where+ arbitrary = (\(TypedTerm term _) -> term) <$> QC.sized arbitraryTypedTerm instance QC.Arbitrary Name where arbitrary = Name <$> QC.arbitrary shrink (Name name)= Name <$> QC.shrink name -instance QC.Arbitrary (Type m) where+instance QC.Arbitrary (Type) where arbitrary = QC.sized arbitraryType shrink typ = case typ of TypeLiteral at -> Types.literal <$> case at of@@ -92,9 +89,9 @@ _ -> [] _ -> [] -- TODO -instance (Eq m, Ord m, Read m, Show m) => QC.Arbitrary (TypedTerm m) where+instance QC.Arbitrary (TypedTerm) where arbitrary = QC.sized arbitraryTypedTerm- shrink (TypedTerm typ term) = L.concat ((\(t, m) -> TypedTerm t <$> m term) <$> shrinkers typ)+ shrink (TypedTerm term typ) = L.concat ((\(t, m) -> TypedTerm <$> m term <*> pure t) <$> shrinkers typ) arbitraryLiteral :: LiteralType -> QC.Gen Literal arbitraryLiteral at = case at of@@ -104,10 +101,10 @@ LiteralTypeInteger it -> LiteralInteger <$> arbitraryIntegerValue it LiteralTypeString -> LiteralString <$> QC.arbitrary -arbitraryField :: (Eq m, Ord m, Read m, Show m) => FieldType m -> Int -> QC.Gen (Field m)+arbitraryField :: FieldType -> Int -> QC.Gen (Field) arbitraryField (FieldType fn ft) n = Field fn <$> arbitraryTerm ft n -arbitraryFieldType :: Int -> QC.Gen (FieldType m)+arbitraryFieldType :: Int -> QC.Gen (FieldType) arbitraryFieldType n = FieldType <$> QC.arbitrary <*> arbitraryType n arbitraryFloatValue :: FloatType -> QC.Gen FloatValue@@ -117,19 +114,21 @@ FloatTypeFloat64 -> FloatValueFloat64 <$> QC.arbitrary -- Note: primitive functions and data terms are not currently generated, as they require a context.-arbitraryFunction :: (Eq m, Ord m, Read m, Show m) => FunctionType m -> Int -> QC.Gen (Function m)-arbitraryFunction (FunctionType dom cod) n = QC.oneof $ defaults ++ whenEqual ++ domainSpecific+arbitraryFunction :: FunctionType -> Int -> QC.Gen (Function)+arbitraryFunction (FunctionType dom cod) n = QC.oneof $ defaults ++ domainSpecific where n' = decr n defaults = [ -- Note: this simple lambda is a bit of a cheat. We just have to make sure we can generate at least one term -- for any supported function type.- FunctionLambda <$> (Lambda (Variable "x") <$> arbitraryTerm cod n')]+ FunctionLambda <$> (Lambda (Name "x") <$> arbitraryTerm cod n')] -- Note: two random types will rarely be equal, but it will happen occasionally with simple types- whenEqual = [FunctionCompareTo <$> arbitraryTerm dom n' | dom == cod] domainSpecific = case dom of- TypeUnion (RowType n _ sfields) -> [FunctionElimination . EliminationUnion . CaseStatement n <$> CM.mapM arbitraryCase sfields]+ TypeUnion (RowType n _ sfields) -> [cs] where+ cs = do+ afields <- CM.mapM arbitraryCase sfields+ return $ FunctionElimination $ EliminationUnion $ CaseStatement n Nothing afields arbitraryCase (FieldType fn dom') = do term <- arbitraryFunction (FunctionType dom' cod) n2 return $ Field fn $ TermFunction term@@ -173,7 +172,7 @@ where n' = div n 2 -- Note: variables and function applications are not (currently) generated-arbitraryTerm :: (Eq m, Ord m, Read m, Show m) => Type m -> Int -> QC.Gen (Term m)+arbitraryTerm :: Type -> Int -> QC.Gen (Term) arbitraryTerm typ n = case typ of TypeLiteral at -> literal <$> arbitraryLiteral at TypeFunction ft -> TermFunction <$> arbitraryFunction ft n'@@ -189,7 +188,7 @@ TypeOptional ot -> optional <$> arbitraryOptional (arbitraryTerm ot) n' TypeRecord (RowType n _ sfields) -> record n <$> arbitraryFields sfields TypeSet st -> set <$> (S.fromList <$> arbitraryList False (arbitraryTerm st) n')- TypeUnion (RowType n _ sfields) -> union n <$> do+ TypeUnion (RowType n _ sfields) -> inject n <$> do f <- QC.elements sfields let fn = fieldTypeName f ft <- arbitraryTerm (fieldTypeType f) n'@@ -203,7 +202,7 @@ n2 = div n' $ L.length sfields -- Note: nominal types and element types are not currently generated, as instantiating them requires a context-arbitraryType :: Int -> QC.Gen (Type m)+arbitraryType :: Int -> QC.Gen (Type) arbitraryType n = if n == 0 then pure Types.unit else QC.oneof [ TypeLiteral <$> QC.arbitrary, TypeFunction <$> arbitraryPair FunctionType arbitraryType n',@@ -215,11 +214,11 @@ -- TypeUnion <$> arbitraryList True arbitraryFieldType n'] -- TODO: avoid duplicate field names where n' = decr n -arbitraryTypedTerm :: (Eq m, Ord m, Read m, Show m) => Int -> QC.Gen (TypedTerm m)+arbitraryTypedTerm :: Int -> QC.Gen (TypedTerm) arbitraryTypedTerm n = do typ <- arbitraryType n' term <- arbitraryTerm typ n'- return $ TypedTerm typ term+ return $ TypedTerm term typ where n' = div n 2 -- TODO: a term is usually bigger than its type @@ -227,7 +226,7 @@ decr n = max 0 (n-1) -- Note: shrinking currently discards any metadata-shrinkers :: (Eq m, Ord m, Read m, Show m) => Type m -> [(Type m, Term m -> [Term m])]+shrinkers :: Type -> [(Type, Term -> [Term])] shrinkers typ = trivialShrinker ++ case typ of TypeLiteral at -> case at of LiteralTypeBinary -> [(Types.binary, \(TermLiteral (LiteralBinary s)) -> binary <$> QC.shrink s)]@@ -235,7 +234,6 @@ LiteralTypeFloat ft -> [] LiteralTypeInteger it -> [] LiteralTypeString -> [(Types.string, \(TermLiteral (LiteralString s)) -> string <$> QC.shrink s)]- -- TypeElement et -> -- TypeFunction ft -> TypeList lt -> dropElements : promoteType : shrinkType where@@ -253,7 +251,6 @@ where shrinkPair m (km, vm) = (\vm' -> (km, vm')) <$> m vm dropPairs = [(Types.map kt vt, \(TermMap m) -> TermMap . M.fromList <$> dropAny (M.toList m))]- -- TypeNominal name -> TypeOptional ot -> toNothing : promoteType : shrinkType where toNothing = (Types.optional ot, \(TermOptional m) -> optional <$> Y.maybe [] (const [Nothing]) m)@@ -280,7 +277,7 @@ promoteType = (st, \(TermSet els) -> S.toList els) shrinkType = (\(t, m) -> (Types.set t, \(TermSet els) -> set . S.fromList <$> CM.mapM m (S.toList els))) <$> shrinkers st TypeUnion (RowType name _ sfields) -> dropFields- ++ shrinkFieldNames (TypeUnion . RowType name Nothing) (union name . L.head) (\(TermUnion (Union _ f)) -> [f]) sfields+ ++ shrinkFieldNames (TypeUnion . RowType name Nothing) (inject name . L.head) (\(TermUnion (Injection _ f)) -> [f]) sfields ++ promoteTypes ++ shrinkTypes where dropFields = [] -- TODO
− src/test/haskell/Hydra/CommonSpec.hs
@@ -1,42 +0,0 @@-module Hydra.CommonSpec where--import Hydra.Kernel--import Hydra.TestUtils-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Char as C---checkStripTerm :: H.SpecWith ()-checkStripTerm = do- H.describe "Tests for stripping annotations from terms" $ do- H.it "Un-annotated terms are not affected" $- QC.property $ \term -> case (term :: Term ()) of- TermAnnotated _ -> True- _ -> stripTerm term == term- H.it "Terms are stripped recursively" $- QC.property $ \term -> case (term :: Term ()) of- TermAnnotated _ -> True- _ -> stripTerm (Terms.annot () (Terms.annot () term)) == term--checkStripType :: H.SpecWith ()-checkStripType = do- H.describe "Tests for stripping annotations from types" $ do- H.it "Un-annotated types are not affected" $- QC.property $ \typ -> case (typ :: Type ()) of- TypeAnnotated _ -> True- _ -> stripType typ == typ- H.it "Types are stripped recursively" $- QC.property $ \typ -> case (typ :: Type ()) of- TypeAnnotated _ -> True- _ -> stripType (Types.annot () (Types.annot () typ)) == typ--spec :: H.Spec-spec = do- checkStripTerm- checkStripType
src/test/haskell/Hydra/CoreCodersSpec.hs view
@@ -1,11 +1,8 @@ module Hydra.CoreCodersSpec where import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.CoreDecoding-import Hydra.CoreEncoding-import Hydra.Meta-import qualified Hydra.Impl.Haskell.Dsl.Types as Types+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types import Hydra.TestData import Hydra.TestUtils@@ -22,35 +19,35 @@ H.it "string literal type" $ do H.shouldBe- (strip $ encodeLiteralType LiteralTypeString :: Term Meta)+ (strip $ coreEncodeLiteralType LiteralTypeString :: Term) (strip $ unitVariant _LiteralType _LiteralType_string) H.it "string type" $ do H.shouldBe- (strip $ encodeType Types.string :: Term Meta)+ (strip $ coreEncodeType Types.string :: Term) (strip $ variant _Type _Type_literal (unitVariant _LiteralType _LiteralType_string)) H.it "int32 type" $ do H.shouldBe- (strip $ encodeType Types.int32 :: Term Meta)+ (strip $ coreEncodeType Types.int32 :: Term) (strip $ variant _Type _Type_literal (variant _LiteralType _LiteralType_integer $ unitVariant _IntegerType _IntegerType_int32)) H.it "record type" $ do H.shouldBe- (strip $ encodeType (TypeRecord $ RowType (Name "Example") Nothing- [Types.field "something" Types.string, Types.field "nothing" Types.unit]) :: Term Meta)+ (strip $ coreEncodeType (TypeRecord $ RowType (Name "Example") Nothing+ [Types.field "something" Types.string, Types.field "nothing" Types.unit]) :: Term) (strip $ variant _Type _Type_record $ record _RowType [- Field _RowType_typeName $ string "Example",+ Field _RowType_typeName $ wrap _Name $ string "Example", Field _RowType_extends $ optional Nothing, Field _RowType_fields $ list [ record _FieldType [- Field _FieldType_name $ string "something",+ Field _FieldType_name $ wrap _Name $ string "something", Field _FieldType_type $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_string], record _FieldType [- Field _FieldType_name $ string "nothing",+ Field _FieldType_name $ wrap _Name $ string "nothing", Field _FieldType_type $ variant _Type _Type_record $ record _RowType [- Field _RowType_typeName $ string "hydra/core.UnitType",+ Field _RowType_typeName $ wrap _Name $ string "hydra/core.Unit", Field _RowType_extends $ optional Nothing, Field _RowType_fields $ list []]]]]) @@ -60,30 +57,30 @@ H.it "float32 literal type" $ do shouldSucceedWith- (decodeLiteralType+ (coreDecodeLiteralType (variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32)) (LiteralTypeFloat FloatTypeFloat32) H.it "float32 type" $ do shouldSucceedWith- (decodeType+ (coreDecodeType (variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32)) Types.float32 H.it "union type" $ do shouldSucceedWith- (decodeType $+ (coreDecodeType $ variant _Type _Type_union $ record _RowType [- Field _RowType_typeName $ string (unName testTypeName),+ Field _RowType_typeName $ wrap _Name $ string (unName testTypeName), Field _RowType_extends $ optional Nothing, Field _RowType_fields $ list [ record _FieldType [- Field _FieldType_name $ string "left",+ Field _FieldType_name $ wrap _Name $ string "left", Field _FieldType_type $ variant _Type _Type_literal $ variant _LiteralType _LiteralType_integer $ unitVariant _IntegerType _IntegerType_int64], record _FieldType [- Field _FieldType_name $ string "right",+ Field _FieldType_name $ wrap _Name $ string "right", Field _FieldType_type $ variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float64]]]) (TypeUnion $ RowType testTypeName Nothing [@@ -95,10 +92,10 @@ H.describe "Decode invalid terms" $ do H.it "Try to decode a term with wrong fields for Type" $ do- shouldFail (decodeType $ variant untyped (FieldName "unknownField") $ list [])+ shouldFail (coreDecodeType $ variant untyped (Name "unknownField") $ list []) H.it "Try to decode an incomplete representation of a Type" $ do- shouldFail (decodeType $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_integer)+ shouldFail (coreDecodeType $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_integer) metadataIsPreserved :: H.SpecWith () metadataIsPreserved = do@@ -106,13 +103,13 @@ H.it "Basic metadata" $ do shouldSucceedWith- (decodeType $ encodeType annotatedStringType)+ (coreDecodeType $ coreEncodeType annotatedStringType) annotatedStringType where- annotatedStringType :: Type Meta- annotatedStringType = TypeAnnotated $ Annotated Types.string $ Meta $ M.fromList [- (metaDescription, Terms.string "The string literal type"),- (metaType, encodeType $ Types.nominal _Type)]+ annotatedStringType :: Type+ annotatedStringType = TypeAnnotated $ AnnotatedType Types.string $ M.fromList [+ (key_description, Terms.string "The string literal type"),+ (key_type, coreEncodeType $ TypeVariable _Type)] testRoundTripsFromType :: H.SpecWith () testRoundTripsFromType = do@@ -121,7 +118,7 @@ H.it "Try random types" $ QC.property $ \typ -> shouldSucceedWith- (decodeType $ encodeType typ)+ (coreDecodeType $ coreEncodeType typ) typ spec :: H.Spec
+ src/test/haskell/Hydra/Dsl/TypesSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Dsl.TypesSpec where++import Hydra.Kernel+import Hydra.Dsl.Types++import qualified Test.Hspec as H+++check :: Type -> Type -> H.Expectation+check = H.shouldBe++checkFunctionSyntax :: H.SpecWith ()+checkFunctionSyntax = do+ H.describe "Check function syntax" $ do++ H.it "Function arrows are supported" $ do+ check+ ("a" --> "b")+ (function (var "a") (var "b"))+ check+ (string --> int32)+ (function string int32)++ H.it "Function arrows are right-associative" $ do+ check+ ("a" --> "b" --> "c")+ ("a" --> ("b" --> "c"))++ H.it "Functions bind less tightly than application" $ do+ check+ ("a" @@ "b" --> "c" @@ "d")+ (("a" @@ "b") --> ("c" @@ "d"))++checkHelperFunctions :: H.SpecWith ()+checkHelperFunctions = do+ H.describe "Check helper functions" $ do++ H.it "Check n-ary functions" $ do+ check+ (functionN ["a", "b"])+ (function "a" "b")+ check+ (functionN [int32, string, boolean])+ (function int32 $ function string boolean)++spec :: H.Spec+spec = do+ checkFunctionSyntax+ checkHelperFunctions
− src/test/haskell/Hydra/Ext/Json/CoderSpec.hs
@@ -1,134 +0,0 @@-module Hydra.Ext.Json.CoderSpec where--import Hydra.Kernel-import Hydra.Lib.Literals-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Ext.Json.Coder-import qualified Hydra.Ext.Json.Model as Json-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Data.Bifunctor as BF-import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import qualified Test.QuickCheck as QC---literalTypeConstraintsAreRespected :: H.SpecWith ()-literalTypeConstraintsAreRespected = H.describe "Verify that JSON's literal type constraints are respected" $ do-- -- TODO: binary data-- H.it "Check booleans" $- QC.property $ \b -> checkJsonCoder Types.boolean (Terms.boolean b) (Json.ValueBoolean b)-- H.it "Check 32-bit floats" $- QC.property $ \f -> checkJsonCoder Types.float32 (Terms.float32 f) (jsonFloat $ realToFrac f)-- H.it "Check 64-bit floats (doubles)" $- QC.property $ \d -> checkJsonCoder Types.float64 (Terms.float64 d) (jsonFloat $ realToFrac d)-- -- TODO: bigfloat-- H.it "Check 32-bit integers" $- QC.property $ \i -> checkJsonCoder Types.int32 (Terms.int32 i) (jsonInt i)-- H.it "Check 16-bit unsigned integers" $- QC.property $ \i -> checkJsonCoder Types.uint16 (Terms.uint16 i) (jsonInt i)-- H.it "Check arbitrary-precision integers" $- QC.property $ \i -> checkJsonCoder Types.bigint (Terms.bigint i) (jsonInt i)-- H.it "Check strings" $- QC.property $ \s -> checkJsonCoder Types.string (Terms.string s) (Json.ValueString s)--supportedTypesPassThrough :: H.SpecWith ()-supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do-- H.it "Lists become JSON arrays" $- QC.property $ \strings -> checkJsonCoder listOfStringsType- (Terms.list $ Terms.string <$> strings) (Json.ValueArray $ Json.ValueString <$> strings)-- H.it "Maps become JSON objects" $- QC.property $ \keyvals -> checkJsonCoder mapOfStringsToIntsType- (makeMap keyvals) (jsonMap $ BF.bimap id jsonInt <$> keyvals)-- H.it "Optionals become JSON null or type-specific values" $- QC.property $ \ms -> checkJsonCoder optionalStringType- (Terms.optional $ Terms.string <$> ms) (Y.maybe Json.ValueNull Json.ValueString ms)-- H.it "Records become JSON objects" $- QC.property $ \lat lon -> checkJsonCoder latLonType- (latlonRecord lat lon) (jsonMap [- ("lat", jsonFloat $ realToFrac lat),- ("lon", jsonFloat $ realToFrac lon)])--unsupportedTypesAreTransformed :: H.SpecWith ()-unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do-- -- TODO: functions-- H.it "Element references become strings" $- QC.property $ \name -> checkJsonCoder int32ElementType- (Terms.element name)- (Json.ValueString $ unName name)-- H.it "Sets become arrays" $- QC.property $ \strings -> checkJsonCoder setOfStringsType- (Terms.stringSet strings)- (Json.ValueArray $ Json.ValueString <$> S.toList strings)-- H.it "Nominal types are dereferenced" $- QC.property $ \s -> checkJsonCoder stringAliasType- (Terms.string s)- (Json.ValueString s)-- H.it "Unions become JSON objects (as records)" $- QC.property $ \int -> checkJsonCoder stringOrIntType- (Terms.union stringOrIntName $ Field (FieldName "right") $ Terms.int32 int)- (jsonMap [("right", jsonInt int)])--nominalTypesAreSupported :: H.SpecWith ()-nominalTypesAreSupported = H.describe "Verify that nominal types are supported" $ do- H.it "Nominal unions become single-attribute objects" $- QC.property $ \() -> checkJsonCoder (Types.nominal testTypeFoobarValueName)- (Terms.union testTypeFoobarValueName $ Terms.field "bool" $ Terms.boolean True)- (jsonMap [("bool", jsonBool True)])-- H.it "Nominal enums become single-attribute objects with empty-object values, and type annotations are transparent" $- QC.property $ \() -> checkJsonCoder (Types.nominal testTypeComparisonName)- (Terms.union testTypeComparisonName $ Terms.field "equalTo" Terms.unit)- (jsonMap [("equalTo", jsonMap [])])--spec :: H.Spec-spec = do- literalTypeConstraintsAreRespected- supportedTypesPassThrough- unsupportedTypesAreTransformed- nominalTypesAreSupported--checkJsonCoder :: Type Meta -> Term Meta -> Json.Value -> H.Expectation-checkJsonCoder typ term node = case mstep of- Nothing -> HL.assertFailure (traceSummary trace)- Just step -> do- shouldSucceedWith (coderEncode step term) node- shouldSucceedWith (coderEncode step term >>= coderDecode step) term- where- FlowState mstep _ trace = unFlow (jsonCoder typ) testContext emptyTrace--jsonBool :: Bool -> Json.Value-jsonBool = Json.ValueBoolean--jsonFloat :: Double -> Json.Value-jsonFloat = Json.ValueNumber--jsonInt :: Integral i => i -> Json.Value-jsonInt = Json.ValueNumber . bigintToBigfloat . fromIntegral--jsonMap :: [(String, Json.Value)] -> Json.Value-jsonMap = Json.ValueObject . M.fromList
− src/test/haskell/Hydra/Ext/Yaml/CoderSpec.hs
@@ -1,123 +0,0 @@-module Hydra.Ext.Yaml.CoderSpec where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms-import Hydra.Ext.Yaml.Coder-import qualified Hydra.Ext.Yaml.Model as YM-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Data.Bifunctor as BF-import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import qualified Test.QuickCheck as QC---literalTypeConstraintsAreRespected :: H.SpecWith ()-literalTypeConstraintsAreRespected = H.describe "Verify that YAML's literal type constraints are respected" $ do-- -- TODO: binary data-- H.it "Check booleans" $- QC.property $ \b -> checkYamlCoder Types.boolean (boolean b) (yamlBool b)-- H.it "Check 32-bit floats" $- QC.property $ \f -> checkYamlCoder Types.float32 (float32 f) (yamlFloat $ realToFrac f)-- H.it "Check 64-bit floats (doubles)" $- QC.property $ \d -> checkYamlCoder Types.float64 (float64 d) (yamlFloat $ realToFrac d)-- -- TODO: bigfloat-- H.it "Check 32-bit integers" $- QC.property $ \i -> checkYamlCoder Types.int32 (int32 i) (yamlInt i)-- H.it "Check 16-bit unsigned integers" $- QC.property $ \i -> checkYamlCoder Types.uint16 (uint16 i) (yamlInt i)-- H.it "Check arbitrary-precision integers" $- QC.property $ \i -> checkYamlCoder Types.bigint (bigint i) (yamlInt i)-- H.it "Check strings" $- QC.property $ \s -> checkYamlCoder Types.string (string s) (yamlStr s)--supportedTypesPassThrough :: H.SpecWith ()-supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do-- H.it "Lists become YAML sequences" $- QC.property $ \strings -> checkYamlCoder listOfStringsType- (list $ string <$> strings) (YM.NodeSequence $ yamlStr <$> strings)-- H.it "Maps become YAML mappings" $- QC.property $ \keyvals -> checkYamlCoder mapOfStringsToIntsType- (makeMap keyvals) (yamlMap $ BF.bimap yamlStr yamlInt <$> keyvals)-- H.it "Optionals become YAML null or type-specific nodes" $- QC.property $ \ms -> checkYamlCoder optionalStringType- (optional $ string <$> ms) (YM.NodeScalar $ Y.maybe YM.ScalarNull YM.ScalarStr ms)-- H.it "Records become YAML mappings" $- QC.property $ \lat lon -> checkYamlCoder latLonType- (latlonRecord lat lon) (yamlMap [- (yamlStr "lat", yamlFloat $ realToFrac lat),- (yamlStr "lon", yamlFloat $ realToFrac lon)])--unsupportedTypesAreTransformed :: H.SpecWith ()-unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do-- -- TODO: functions-- H.it "Element references become strings" $- QC.property $ \name -> checkYamlCoder int32ElementType- (element name) (yamlStr $ unName name)-- H.it "Sets become sequences" $- QC.property $ \strings -> checkYamlCoder setOfStringsType- (stringSet strings) (YM.NodeSequence $ yamlStr <$> S.toList strings)-- H.it "Nominal types are dereferenced" $- QC.property $ \s -> checkYamlCoder stringAliasType- (string s) (yamlStr s)-- H.it "Unions become YAML mappings (as records)" $- QC.property $ \int -> checkYamlCoder stringOrIntType- (variant stringOrIntName (FieldName "right") $ int32 int)- (yamlMap [(yamlStr "right", yamlInt int)])--spec :: H.Spec-spec = do- literalTypeConstraintsAreRespected- supportedTypesPassThrough- unsupportedTypesAreTransformed--checkYamlCoder :: Type Meta -> Term Meta -> YM.Node -> H.Expectation-checkYamlCoder typ term node = case mstep of- Nothing -> HL.assertFailure (traceSummary trace)- Just step -> do- shouldSucceedWith (coderEncode step term) node- shouldSucceedWith (coderEncode step term >>= coderDecode step) term- where- FlowState mstep _ trace = unFlow (yamlCoder typ) testContext emptyTrace--yamlBool :: Bool -> YM.Node-yamlBool = YM.NodeScalar . YM.ScalarBool--yamlFloat :: Double -> YM.Node-yamlFloat = YM.NodeScalar . YM.ScalarFloat--yamlInt :: Integral i => i -> YM.Node-yamlInt = YM.NodeScalar . YM.ScalarInt . fromIntegral--yamlMap :: [(YM.Node, YM.Node)] -> YM.Node-yamlMap = YM.NodeMapping . M.fromList--yamlNull :: YM.Node-yamlNull = YM.NodeScalar YM.ScalarNull--yamlStr :: String -> YM.Node-yamlStr = YM.NodeScalar . YM.ScalarStr
+ src/test/haskell/Hydra/FlowsSpec.hs view
@@ -0,0 +1,53 @@+module Hydra.FlowsSpec where++import Hydra.Kernel+import qualified Hydra.Dsl.Terms as Terms+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.List as L+import qualified Data.Map as M+import qualified Test.Hspec as H+++checkErrorTrace :: H.SpecWith ()+checkErrorTrace = do+ H.describe "Check error traces resulting from an explicit failure" $ do++ H.it "Error traces are in the right order" $+ H.shouldBe+ (unFlow (withTrace "one" $ withTrace "two" $ if False then pure 42 else fail "oops") () emptyTrace)+ (FlowState Nothing () emptyTrace {traceMessages = ["Error: oops (one > two)"]})++checkMaxTraceDepth :: H.SpecWith ()+checkMaxTraceDepth = do+ H.describe "Check breaking out of flows with an infinite loop" $ do++ H.it "Flows with no trace are OK" $+ H.shouldBe+ (unFlow (testFlow 42 0) () emptyTrace)+ (FlowState (Just 42) () emptyTrace)++ H.it "Flows with a trace just below the maximum depth are OK" $+ H.shouldBe+ (unFlow (testFlow 42 maxTraceDepth) () emptyTrace)+ (FlowState (Just 42) () emptyTrace)++ H.it "Flows fail when their trace reaches the maximum depth" $ do+ H.shouldBe (flowStateValue overflow) Nothing+ H.shouldBe (L.length $ traceMessages $ flowStateTrace overflow) 1+ where+ overflow = unFlow (testFlow 42 (maxTraceDepth+1)) () emptyTrace++testFlow :: x -> Int -> Flow () x+testFlow seed depth = helper depth+ where+ helper d = if d == 0+ then pure seed+ else withTrace ("level " ++ show (depth-d)) $ helper (d-1)++spec :: H.Spec+spec = do+ checkErrorTrace+ checkMaxTraceDepth
− src/test/haskell/Hydra/Impl/Haskell/Dsl/TypesSpec.hs
@@ -1,51 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Impl.Haskell.Dsl.TypesSpec where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Types--import qualified Test.Hspec as H---check :: Type Meta -> Type Meta -> H.Expectation-check = H.shouldBe--checkFunctionSyntax :: H.SpecWith ()-checkFunctionSyntax = do- H.describe "Check function syntax" $ do-- H.it "Function arrows are supported" $ do- check- ("a" --> "b")- (function (variable "a") (variable "b"))- check- (string --> int32)- (function string int32)-- H.it "Function arrows are right-associative" $ do- check- ("a" --> "b" --> "c")- ("a" --> ("b" --> "c"))-- H.it "Functions bind less tightly than application" $ do- check- ("a" @@ "b" --> "c" @@ "d")- (("a" @@ "b") --> ("c" @@ "d"))--checkHelperFunctions :: H.SpecWith ()-checkHelperFunctions = do- H.describe "Check helper functions" $ do-- H.it "Check n-ary functions" $ do- check- (functionN ["a"] "b")- (function "a" "b")- check- (functionN [int32, string] boolean)- (function int32 $ function string boolean)--spec :: H.Spec-spec = do- checkFunctionSyntax- checkHelperFunctions
− src/test/haskell/Hydra/Impl/Haskell/Ext/Json/SerdeSpec.hs
@@ -1,105 +0,0 @@--- Note: these tests are dependent on Data.Aeson, both because the Serde depends on Data.Aeson--- and because of the particular serialization style.--module Hydra.Impl.Haskell.Ext.Json.SerdeSpec where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms-import Hydra.Impl.Haskell.Ext.Json.Serde-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Data.List as L-import qualified Test.QuickCheck as QC-import qualified Data.Maybe as Y---checkLiterals :: H.SpecWith ()-checkLiterals = H.describe "Test literal values" $ do-- H.it "Booleans become 'true' and 'false'" $ do- QC.property $ \b -> checkSerialization jsonSerdeStr- (TypedTerm Types.boolean $ boolean b)- (if b then "true" else "false")-- H.it "int32's become numbers, and are serialized in the obvious way" $ do- QC.property $ \i -> checkSerialization jsonSerdeStr- (TypedTerm Types.int32 $ int32 i)- (show i)-- H.it "uint8's and other finite integer types become numbers, and are serialized in the obvious way" $ do- QC.property $ \i -> checkSerialization jsonSerdeStr- (TypedTerm Types.uint8 $ uint8 i)- (show i)-- H.it "bigints become numbers" $ do- QC.property $ \i -> checkSerialization jsonSerdeStr- (TypedTerm Types.bigint $ bigint i)- (show i)--checkOptionals :: H.SpecWith ()-checkOptionals = H.describe "Test and document serialization of optionals" $ do-- H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $- QC.property $ \mi -> checkSerialization jsonSerdeStr- (TypedTerm- (Types.optional Types.int32)- (optional $ (Just . int32) =<< mi))- (Y.maybe "null" show mi)-- H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $- QC.property $ \mi -> checkSerialization jsonSerdeStr- (TypedTerm- (Types.optional $ Types.optional Types.int32)- (optional $ Just $ optional $ (Just . int32) =<< mi))- ("[" ++ Y.maybe "null" show mi ++ "]")-- H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $- QC.property $ \() -> checkSerialization jsonSerdeStr- (TypedTerm- (Types.optional $ Types.optional Types.int32)- (optional Nothing))- "[]"--checkRecordsAndUnions :: H.SpecWith ()-checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do-- H.it "Empty records become empty objects" $- QC.property $ \() -> checkSerialization jsonSerdeStr- (TypedTerm Types.unit unit)- "{}"-- H.it "Simple records become simple objects" $- QC.property $ \() -> checkSerialization jsonSerdeStr- (TypedTerm latLonType (latlonRecord 37 (negate 122)))- "{\"lat\":37,\"lon\":-122}"-- H.it "Optionals are omitted from record objects if 'nothing'" $- QC.property $ \() -> checkSerialization jsonSerdeStr- (TypedTerm- (TypeRecord $ RowType testTypeName Nothing [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32])- (record testTypeName [Field (FieldName "one") $ optional $ Just $ string "test", Field (FieldName "two") $ optional Nothing]))- "{\"one\":\"test\"}"-- H.it "Simple unions become simple objects, via records" $- QC.property $ \() -> checkSerialization jsonSerdeStr- (TypedTerm- (TypeUnion $ RowType testTypeName Nothing [Types.field "left" Types.string, Types.field "right" Types.int32])- (union testTypeName $ Field (FieldName "left") $ string "test"))- "{\"left\":\"test\"}"--jsonSerdeIsInformationPreserving :: H.SpecWith ()-jsonSerdeIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized JSON, and back again is a no-op" $ do-- H.it "Generate arbitrary type/term pairs, serialize the terms to JSON, deserialize them, and compare" $- QC.property (checkSerdeRoundTrip jsonSerde)--spec :: H.Spec-spec = do- checkLiterals- checkOptionals- checkRecordsAndUnions--- jsonSerdeIsInformationPreserving -- TODO: restore me
− src/test/haskell/Hydra/Impl/Haskell/Ext/Yaml/SerdeSpec.hs
@@ -1,110 +0,0 @@--- Note: these tests are dependent on HsYaml, both because the Serde depends on HsYaml--- and because of the particular serialization style.--module Hydra.Impl.Haskell.Ext.Yaml.SerdeSpec where--import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms-import Hydra.Impl.Haskell.Ext.Yaml.Serde-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Data.List as L-import qualified Test.QuickCheck as QC-import qualified Data.Maybe as Y---checkLiterals :: H.SpecWith ()-checkLiterals = H.describe "Test literal values" $ do-- H.it "Booleans become 'true' and 'false' (not 'y' and 'n')" $ do- QC.property $ \b -> checkSerialization yamlSerdeStr- (TypedTerm Types.boolean $ boolean b)- (if b then "true" else "false")-- H.it "int32's become ints, and are serialized in the obvious way" $ do- QC.property $ \i -> checkSerialization yamlSerdeStr- (TypedTerm Types.int32 $ int32 i)- (show i)-- H.it "uint8's and other finite integer types become ints, and are serialized in the obvious way" $ do- QC.property $ \i -> checkSerialization yamlSerdeStr- (TypedTerm Types.uint8 $ uint8 i)- (show i)-- H.it "bigints become ints" $ do- QC.property $ \i -> checkSerialization yamlSerdeStr- (TypedTerm Types.bigint $ bigint i)- (show i)-- -- TODO: examine quirks around floating-point serialization more closely. These could affect portability of the serialized YAML.-- -- TODO: binary string and character string serialization--checkOptionals :: H.SpecWith ()-checkOptionals = H.describe "Test and document serialization of optionals" $ do-- H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $- QC.property $ \mi -> checkSerialization yamlSerdeStr- (TypedTerm- (Types.optional Types.int32)- (optional $ (Just . int32) =<< mi))- (Y.maybe "null" show mi)-- H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $- QC.property $ \mi -> checkSerialization yamlSerdeStr- (TypedTerm- (Types.optional $ Types.optional Types.int32)- (optional $ Just $ optional $ (Just . int32) =<< mi))- ("- " ++ Y.maybe "null" show mi)-- H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $- QC.property $ \() -> checkSerialization yamlSerdeStr- (TypedTerm- (Types.optional $ Types.optional Types.int32)- (optional Nothing))- "[]"--checkRecordsAndUnions :: H.SpecWith ()-checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do-- H.it "Empty records become empty objects" $- QC.property $ \() -> checkSerialization yamlSerdeStr- (TypedTerm Types.unit unit)- "{}"-- H.it "Simple records become simple objects" $- QC.property $ \() -> checkSerialization yamlSerdeStr- (TypedTerm latLonType (latlonRecord 37.0 (negate 122.0)))- "lat: 37.0\nlon: -122.0"-- H.it "Optionals are omitted from record objects if 'nothing'" $- QC.property $ \() -> checkSerialization yamlSerdeStr- (TypedTerm- (TypeRecord $ RowType testTypeName Nothing [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32])- (record testTypeName [Field (FieldName "one") $ optional $ Just $ string "test", Field (FieldName "two") $ optional Nothing]))- "one: test"-- H.it "Simple unions become simple objects, via records" $- QC.property $ \() -> checkSerialization yamlSerdeStr- (TypedTerm- (TypeUnion $ RowType testTypeName Nothing [Types.field "left" Types.string, Types.field "right" Types.int32])- (union testTypeName $ Field (FieldName "left") $ string "test"))- "left: test\n"--yamlSerdeIsInformationPreserving :: H.SpecWith ()-yamlSerdeIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized YAML, and back again is a no-op" $ do-- H.it "Generate arbitrary type/term pairs, serialize the terms to YAML, deserialize them, and compare" $- QC.property (checkSerdeRoundTrip yamlSerde)--spec :: H.Spec-spec = do- checkLiterals- checkOptionals- checkRecordsAndUnions--- yamlSerdeIsInformationPreserving -- TODO: restore me
+ src/test/haskell/Hydra/InferenceSpec.hs view
@@ -0,0 +1,498 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.InferenceSpec where++import Hydra.Kernel+import Hydra.Sources.Libraries+import Hydra.Inference+import Hydra.TestUtils+import Hydra.TestData+import qualified Hydra.Dsl.Expect as Expect+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Annotations as Ann+import qualified Hydra.Dsl.Types as Types++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+import Control.Monad+++checkType :: Term -> Type -> H.Expectation+checkType term typ = typeAnn term `H.shouldBe` typ+ where+ typeAnn (TermTyped (TypedTerm _ typ)) = typ++expectMonotype :: Term -> Type -> H.Expectation+expectMonotype term = expectPolytype term []++expectPolytype :: Term-> [String] -> Type -> H.Expectation+expectPolytype term vars typ = do+ shouldSucceedWith+ (inferTypeScheme term)+ (TypeScheme (Name <$> vars) typ)++expectTypeAnnotation :: (Term -> Flow (Graph) (Term)) -> Term -> Type -> H.Expectation+expectTypeAnnotation path term etyp = shouldSucceedWith atyp etyp+ where+ atyp = do+ iterm <- annotateTypedTerms term+ selected <- path iterm+ case selected of+ TermTyped (TypedTerm _ typ) -> return typ+ _ -> fail $ "no type annotation"++checkApplicationTerms :: H.SpecWith ()+checkApplicationTerms = H.describe "Check a few hand-picked application terms" $ do++ H.it "Check lambda applications" $ do+ expectMonotype+ (apply (lambda "x" (var "x")) (string "foo"))+ Types.string++ H.it "Check mixed expressions with lambdas, constants, and primitive functions" $ do+ expectMonotype+ (lambda "x" $+ apply+ (apply (primitive _math_sub) (apply (apply (primitive _math_add) (var "x")) (var "x")))+ (int32 1))+ (Types.function Types.int32 Types.int32)++checkFunctionTerms :: H.SpecWith ()+checkFunctionTerms = H.describe "Check a few hand-picked function terms" $ do++ H.it "Check lambdas" $ do+ expectPolytype+ (lambda "x" (var "x"))+ ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))+ expectPolytype+ (lambda "x" (int16 137))+ ["t0"] (Types.function (Types.var "t0") Types.int16)++ H.it "Check list eliminations" $ do+ let fun = Terms.fold $ primitive _math_add+ expectMonotype+ fun+ (Types.functionN [Types.int32, Types.list Types.int32, Types.int32])+ expectMonotype+ (apply fun $ int32 0)+ (Types.function (Types.list Types.int32) Types.int32)+ expectMonotype+ (apply (apply fun $ int32 0) (list (int32 <$> [1, 2, 3, 4, 5])))+ Types.int32++ H.it "Check projections" $ do+ expectMonotype+ (project testTypePersonName (Name "firstName"))+ (Types.function testTypePerson Types.string)++ H.it "Check case statements" $ do+ expectMonotype+ (match testTypeFoobarValueName Nothing [+ Field (Name "bool") (lambda "x" (boolean True)),+ Field (Name "string") (lambda "x" (boolean False)),+ Field (Name "unit") (lambda "x" (boolean False))])+ (Types.function testTypeFoobarValue Types.boolean)++checkIndividualTerms :: H.SpecWith ()+checkIndividualTerms = H.describe "Check a few hand-picked terms" $ do++ H.it "Check literal values" $ do+ expectMonotype+ (int32 42)+ Types.int32+ expectMonotype+ (string "foo")+ Types.string+ expectMonotype+ (boolean False)+ Types.boolean+ expectMonotype+ (float64 42.0)+ Types.float64++ H.it "Check let terms" $ do+ expectPolytype+ (letTerm (Name "x") (float32 42.0) (lambda "y" (lambda "z" (var "x"))))+ ["t0", "t1"] (Types.function (Types.var "t0") (Types.function (Types.var "t1") Types.float32))++ H.it "Check optionals" $ do+ expectMonotype+ (optional $ Just $ int32 42)+ (Types.optional Types.int32)+ expectPolytype+ (optional Nothing)+ ["t0"] (Types.optional $ Types.var "t0")++ H.it "Check records" $ do+ expectMonotype+ (record latLonName [+ Field (Name "lat") $ float32 37.7749,+ Field (Name "lon") $ float32 $ negate 122.4194])+ (TypeRecord $ RowType latLonName Nothing [+ FieldType (Name "lat") Types.float32,+ FieldType (Name "lon") Types.float32])+ expectMonotype+ (record latLonPolyName [+ Field (Name "lat") $ float32 37.7749,+ Field (Name "lon") $ float32 $ negate 122.4194])+ (TypeRecord $ RowType latLonPolyName Nothing [+ FieldType (Name "lat") Types.float32,+ FieldType (Name "lon") Types.float32])+ expectMonotype+ (lambda "lon" (record latLonPolyName [+ Field (Name "lat") $ float32 37.7749,+ Field (Name "lon") $ var "lon"]))+ (Types.function (Types.float32)+ (TypeRecord $ RowType latLonPolyName Nothing [+ FieldType (Name "lat") $ Types.float32,+ FieldType (Name "lon") $ Types.float32]))+ expectPolytype+ (lambda "latlon" (record latLonPolyName [+ Field (Name "lat") $ var "latlon",+ Field (Name "lon") $ var "latlon"]))+ ["t0"] (Types.function (Types.var "t0")+ (TypeRecord $ RowType latLonPolyName Nothing [+ FieldType (Name "lat") $ Types.var "t0",+ FieldType (Name "lon") $ Types.var "t0"]))++ H.it "Check unions" $ do+ expectMonotype+ (inject testTypeTimestampName $ Field (Name "unixTimeMillis") $ uint64 1638200308368)+ testTypeTimestamp++ H.it "Check sets" $ do+ expectMonotype+ (set $ S.fromList [boolean True])+ (Types.set Types.boolean)+ expectPolytype+ (set $ S.fromList [set S.empty])+ ["t0"] (Types.set $ Types.set $ Types.var "t0")++ H.it "Check maps" $ do+ expectMonotype+ (mapTerm $ M.fromList [(string "firstName", string "Arthur"), (string "lastName", string "Dent")])+ (Types.map Types.string Types.string)+ expectPolytype+ (mapTerm M.empty)+ ["t0", "t1"] (Types.map (Types.var "t0") (Types.var "t1"))+ expectPolytype+ (lambda "x" (lambda "y" (mapTerm $ M.fromList+ [(var "x", float64 0.1), (var "y", float64 0.2)])))+ ["t0"] (Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.map (Types.var "t0") Types.float64)))++ -- -- TODO: add a case for a recursive nominal type -- e.g. MyList := () + (int, Mylist)+ -- H.it "Check nominal (newtype) terms" $ do+ -- expectMonotype+ -- testDataArthur+ -- (Types.wrap "Person")+ -- expectMonotype+ -- (lambda "x" (record [+ -- Field "firstName" $ var "x",+ -- Field "lastName" $ var "x",+ -- Field "age" $ int32 42]))+ -- (Types.function Types.string testTypePerson)++checkLetTerms :: H.SpecWith ()+checkLetTerms = H.describe "Check a few hand-picked let terms" $ do++ H.it "Check empty let" $ do+ expectMonotype+ ((int32 42) `with` [])+ Types.int32++ H.it "Check trivial let" $ do+ expectMonotype+ (var "foo" `with` [+ "foo">: int32 42])+ Types.int32++checkLists :: H.SpecWith ()+checkLists = H.describe "Check a few hand-picked list terms" $ do++ H.it "Check list of strings" $ do+ expectMonotype+ (list [string "foo", string "bar"])+ (Types.list Types.string)+ H.it "Check list of lists of strings" $ do+ expectMonotype+ (list [list [string "foo"], list []])+ (Types.list $ Types.list Types.string)+ H.it "Check empty list" $ do+ expectPolytype+ (list [])+ ["t0"] (Types.list $ Types.var "t0")+ H.it "Check list containing an empty list" $ do+ expectPolytype+ (list [list []])+ ["t0"] (Types.list $ Types.list $ Types.var "t0")+ H.it "Check lambda producing a list of integers" $ do+ expectMonotype+ (lambda "x" (list [var "x", int32 42]))+ (Types.function Types.int32 $ Types.list Types.int32)+ H.it "Check list with bound variables" $ do+ expectMonotype+ (lambda "x" (list [var "x", string "foo", var "x"]))+ (Types.function Types.string (Types.list Types.string))++checkLiterals :: H.SpecWith ()+checkLiterals = H.describe "Check arbitrary literals" $ do++ H.it "Verify that type inference preserves the literal to literal type mapping" $+ QC.property $ \l -> expectMonotype+ (TermLiteral l)+ (Types.literal $ literalType l)++checkWrappedTerms :: H.SpecWith ()+checkWrappedTerms = H.describe "Check nominal introductions and eliminations" $ do++ H.it "Check nominal introductions" $ do+ expectMonotype+ (wrap stringAliasTypeName $ string "foo")+ stringAliasType+ expectMonotype+ (lambda "v" $ wrap stringAliasTypeName $ var "v")+ (Types.function Types.string stringAliasType)++ H.it "Check nominal eliminations" $ do+-- expectMonotype+-- (unwrap stringAliasTypeName)+-- (Types.function stringAliasType (Ann.doc "An alias for the string type" Types.string))+ expectMonotype+ (apply (unwrap stringAliasTypeName) (wrap stringAliasTypeName $ string "foo"))+ Types.string++checkPrimitives :: H.SpecWith ()+checkPrimitives = H.describe "Check a few hand-picked terms with primitive functions" $ do++ H.it "Check monomorphic primitive functions" $ do+ expectMonotype+ (primitive $ Name "hydra/lib/strings.length")+ (Types.function Types.string Types.int32)+ expectMonotype+ (primitive _math_sub)+ (Types.function Types.int32 (Types.function Types.int32 Types.int32))++ H.it "Check polymorphic primitive functions" $ do+ expectPolytype+ (lambda "els" (apply (primitive _lists_length) (apply (primitive _lists_concat) $ var "els")))+ ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") Types.int32)++checkProducts :: H.SpecWith ()+checkProducts = H.describe "Check a few hand-picked product terms" $ do++ H.it "Check empty product" $ do+ expectMonotype+ (Terms.product [])+ (Types.product [])++ H.it "Check non-empty, monotyped products" $ do+ expectMonotype+ (Terms.product [string "foo", int32 42])+ (Types.product [Types.string, Types.int32])+ expectMonotype+ (Terms.product [string "foo", list [float32 42.0, float32 137.0]])+ (Types.product [Types.string, Types.list Types.float32])++ H.it "Check polytyped products" $ do+ expectPolytype+ (Terms.product [list [], string "foo"])+ ["t0"] (Types.product [Types.list $ Types.var "t0", Types.string])++checkSums :: H.SpecWith ()+checkSums = H.describe "Check a few hand-picked sum terms" $ do++ H.it "Check singleton sum terms" $ do+ expectMonotype+ (Terms.sum 0 1 $ string "foo")+ (Types.sum [Types.string])+ expectPolytype+ (Terms.sum 0 1 $ list [])+ ["t0"] (Types.sum [Types.list $ Types.var "t0"])++ H.it "Check non-singleton sum terms" $ do+ expectPolytype+ (Terms.sum 0 2 $ string "foo")+ ["t0"] (Types.sum [Types.string, Types.var "t0"])+ expectPolytype+ (Terms.sum 1 2 $ string "foo")+ ["t0"] (Types.sum [Types.var "t0", Types.string])++checkTypeAnnotations :: H.SpecWith ()+checkTypeAnnotations = H.describe "Check that type annotations are added to terms and subterms" $ do++ H.it "Check literals" $+ QC.property $ \l -> do+ let term = TermLiteral l+ let term1 = fromFlow (TermLiteral $ LiteralString "no term") testGraph (fst <$> inferTypeAndConstraints term)+ checkType term1 (Types.literal $ literalType l)++ H.it "Check lists of literals" $+ QC.property $ \l -> do+ let term = TermList [TermLiteral l]+ let term1 = fromFlow (TermLiteral $ LiteralString "no term") testGraph (fst <$> inferTypeAndConstraints term)+ checkType term1 (Types.list $ Types.literal $ literalType l)+ let (TermTyped (TypedTerm (TermList [term2]) _)) = term1+ checkType term2 (Types.literal $ literalType l)++checkSubtermAnnotations :: H.SpecWith ()+checkSubtermAnnotations = H.describe "Check additional subterm annotations" $ do++ H.it "Check literals" $+ expectTypeAnnotation pure+ (string "foo")+ (Types.string)++ H.describe "Check monotyped lists" $ do+ H.it "test #1" $+ expectTypeAnnotation pure+ (list [string "foo"])+ (Types.list Types.string)+ H.it "test #2" $+ expectTypeAnnotation Expect.listHead+ (list [string "foo"])+ Types.string++ H.describe "Check monotyped lists within lambdas" $ do+ H.it "test #1" $+ expectTypeAnnotation pure+ (lambda "x" $ list [var "x", string "foo"])+ (Types.function Types.string (Types.list Types.string))+ H.it "test #2" $+ expectTypeAnnotation (Expect.lambdaBody >=> Expect.listHead)+ (lambda "x" $ list [var "x", string "foo"])+ Types.string++ H.describe "Check injections" $ do+ H.it "test #1" $+ expectTypeAnnotation pure+ (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11")+ testTypeTimestamp+ H.it "test #2" $+ expectTypeAnnotation pure+ (lambda "ignored" $ (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11"))+ (Types.function (Types.var "t0") testTypeTimestamp)++ H.it "Check projections" $ do+ expectTypeAnnotation pure+ (project testTypePersonName $ Name "firstName")+ (Types.function testTypePerson Types.string)++ H.describe "Check case statements" $ do+ H.it "test #1" $ do+ expectTypeAnnotation pure+ (match testTypeNumberName (Just $ string "it's something else") [+ Field (Name "int") $ constant $ string "it's an integer"])+ (Types.function testTypeNumber Types.string)+ H.describe "test #2" $ do+ let testCase = match testTypeNumberName Nothing [+ Field (Name "int") $ constant $ string "it's an integer",+ Field (Name "float") $ constant $ string "it's a float"]+ H.it "case #1" $+ expectTypeAnnotation pure testCase+ (Types.function testTypeNumber Types.string)+ H.it "case #2" $+ expectTypeAnnotation (Expect.casesCase testTypeNumberName "int" >=> (pure . fieldTerm)) testCase+ (Types.function Types.int32 Types.string)++ H.describe "Check optional eliminations" $ do+ H.describe "test #1" $ do+ let testCase = matchOpt+ (string "nothing")+ (lambda "ignored" $ string "just")+ H.it "case #1" $+ expectTypeAnnotation pure testCase+ (Types.function (Types.optional $ Types.var "t2") Types.string)+ H.it "case #2" $+ expectTypeAnnotation Expect.optCasesNothing testCase+ Types.string+ H.it "case #3" $+ expectTypeAnnotation Expect.optCasesJust testCase+ (Types.function (Types.var "t2") Types.string)+ H.describe "test #2" $ do+ let testCase = lambda "getOpt" $ lambda "x" $+ (matchOpt+ (string "nothing")+ (lambda "t2" $ string "just")) @@ (var "getOpt" @@ var "x")+ let getOptType = (Types.function (Types.var "t1") (Types.optional $ Types.var "t4"))+ let constStringType = Types.function (Types.var "t1") Types.string+ H.it "case #1" $+ expectTypeAnnotation pure testCase+ (Types.function getOptType constStringType)+ H.it "case #2" $+ expectTypeAnnotation Expect.lambdaBody testCase+ constStringType++ H.describe "Check unannotated 'let' terms" $ do+ H.describe "test #1" $ do+ let testCase = lambda "i" $+ (Terms.primitive _strings_cat @@ list [string "foo", var "i", string "bar"])+ `with` [+ "foo">: string "FOO",+ "bar">: string "BAR"]+ H.it "case #1" $+ expectTypeAnnotation pure testCase+ (Types.function Types.string Types.string)+ H.it "case #2" $+ expectTypeAnnotation Expect.lambdaBody testCase+ Types.string+ H.describe "test #2" $ do+ let testCase = lambda "original" $+ var "alias" `with` [+ "alias">: var "original"]+ H.it "case #1" $+ expectTypeAnnotation pure testCase+ (Types.function (Types.var "t0") (Types.var "t0"))+ H.it "case #2" $+ expectTypeAnnotation Expect.lambdaBody testCase+ (Types.var "t0")+ H.it "case #3" $+ expectTypeAnnotation (Expect.lambdaBody >=> Expect.letBinding "alias") testCase+ (Types.var "t0")+ H.describe "test #3" $ do+ let testCase = lambda "fun" $ lambda "t" $+ ((var "funAlias" @@ var "t") `with` [+ "funAlias">: var "fun"])+ let funType = Types.function (Types.var "t1") (Types.var "t2")+ H.it "case #1" $+ expectTypeAnnotation pure testCase+ (Types.function funType funType)+ H.it "case #2" $+ expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody) testCase+ (Types.var "t2")+ H.it "case #3" $+ expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody >=> Expect.letBinding "funAlias") testCase+ funType++-- H.describe "Check 'let' terms with type annotations on bindings" $++ where+ tmp term = shouldSucceedWith flow ()+ where+ flow = do+ iterm <- annotateTypedTerms term+ fail $ "iterm: " ++ show iterm++--checkTypedTerms :: H.SpecWith ()+--checkTypedTerms = H.describe "Check that term/type pairs are consistent with type inference" $ do+--+-- H.it "Check arbitrary typed terms" $+-- QC.property $ \(TypedTerm term typ) -> expectMonotype term typ++spec :: H.Spec+spec = do+ checkApplicationTerms+ checkFunctionTerms+ checkIndividualTerms+ checkLetTerms+ checkLists+ checkLiterals+ checkWrappedTerms+ checkPrimitives+ checkProducts+ checkSums+ checkTypeAnnotations+ checkSubtermAnnotations+-- checkTypedTerms
+ src/test/haskell/Hydra/Langs/Json/CoderSpec.hs view
@@ -0,0 +1,130 @@+module Hydra.Langs.Json.CoderSpec where++import Hydra.Kernel+import Hydra.Lib.Literals+import Hydra.Langs.Json.Coder+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Json as Json+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.Tests++import Hydra.TestData+import Hydra.TestUtils++import qualified Data.Bifunctor as BF+import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+import qualified Test.QuickCheck as QC+++literalTypeConstraintsAreRespected :: H.SpecWith ()+literalTypeConstraintsAreRespected = H.describe "Verify that JSON's literal type constraints are respected" $ do++ -- TODO: binary data++ H.it "Check booleans" $+ QC.property $ \b -> checkJsonCoder Types.boolean (Terms.boolean b) (Json.ValueBoolean b)++ H.it "Check 32-bit floats" $+ QC.property $ \f -> checkJsonCoder Types.float32 (Terms.float32 f) (jsonFloat $ realToFrac f)++ H.it "Check 64-bit floats (doubles)" $+ QC.property $ \d -> checkJsonCoder Types.float64 (Terms.float64 d) (jsonFloat $ realToFrac d)++ -- TODO: bigfloat++ H.it "Check 32-bit integers" $+ QC.property $ \i -> checkJsonCoder Types.int32 (Terms.int32 i) (jsonInt i)++ H.it "Check 16-bit unsigned integers" $+ QC.property $ \i -> checkJsonCoder Types.uint16 (Terms.uint16 i) (jsonInt i)++ H.it "Check arbitrary-precision integers" $+ QC.property $ \i -> checkJsonCoder Types.bigint (Terms.bigint i) (jsonInt i)++ H.it "Check strings" $+ QC.property $ \s -> checkJsonCoder Types.string (Terms.string s) (Json.ValueString s)++supportedTypesPassThrough :: H.SpecWith ()+supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do++ H.it "Lists become JSON arrays" $+ QC.property $ \strings -> checkJsonCoder listOfStringsType+ (Terms.list $ Terms.string <$> strings) (Json.ValueArray $ Json.ValueString <$> strings)++ H.it "Maps become JSON objects" $+ QC.property $ \keyvals -> checkJsonCoder mapOfStringsToIntsType+ (makeMap keyvals) (jsonMap $ BF.bimap id jsonInt <$> keyvals)++ H.it "Optionals become JSON null or type-specific values" $+ QC.property $ \ms -> checkJsonCoder optionalStringType+ (Terms.optional $ Terms.string <$> ms) (Y.maybe Json.ValueNull Json.ValueString ms)++ H.it "Records become JSON objects" $+ QC.property $ \lat lon -> checkJsonCoder latLonType+ (latlonRecord lat lon) (jsonMap [+ ("lat", jsonFloat $ realToFrac lat),+ ("lon", jsonFloat $ realToFrac lon)])++unsupportedTypesAreTransformed :: H.SpecWith ()+unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do++ -- TODO: functions++ H.it "Sets become arrays" $+ QC.property $ \strings -> checkJsonCoder setOfStringsType+ (stringSet strings)+ (Json.ValueArray $ Json.ValueString <$> S.toList strings)++ H.it "Nominal types are dereferenced" $+ QC.property $ \s -> checkJsonCoder stringAliasType+ (Terms.wrap stringAliasTypeName $ Terms.string s)+ (Json.ValueString s)++ H.it "Unions become JSON objects (as records)" $+ QC.property $ \int -> checkJsonCoder stringOrIntType+ (Terms.inject stringOrIntName $ Field (Name "right") $ Terms.int32 int)+ (jsonMap [("right", jsonInt int)])++wrappedTypesAreSupported :: H.SpecWith ()+wrappedTypesAreSupported = H.describe "Verify that nominal types are supported" $ do+ H.it "Nominal unions become single-attribute objects" $+ QC.property $ \() -> checkJsonCoder (TypeVariable testTypeFoobarValueName)+ (Terms.inject testTypeFoobarValueName $ Terms.field "bool" $ Terms.boolean True)+ (jsonMap [("bool", jsonBool True)])++ H.it "Nominal enums become single-attribute objects with empty-object values, and type annotations are transparent" $+ QC.property $ \() -> checkJsonCoder (TypeVariable testTypeComparisonName)+ (Terms.inject testTypeComparisonName $ Terms.field "equalTo" Terms.unit)+ (jsonMap [("equalTo", jsonMap [])])++spec :: H.Spec+spec = do+ literalTypeConstraintsAreRespected+ supportedTypesPassThrough+ unsupportedTypesAreTransformed+ wrappedTypesAreSupported++checkJsonCoder :: Type -> Term -> Json.Value -> H.Expectation+checkJsonCoder typ term node = case mstep of+ Nothing -> HL.assertFailure (traceSummary trace)+ Just step -> do+ shouldSucceedWith (coderEncode step term) node+ shouldSucceedWith (coderEncode step term >>= coderDecode step) term+ where+ FlowState mstep _ trace = unFlow (jsonCoder typ) testGraph emptyTrace++jsonBool :: Bool -> Json.Value+jsonBool = Json.ValueBoolean++jsonFloat :: Double -> Json.Value+jsonFloat = Json.ValueNumber++jsonInt :: Integral i => i -> Json.Value+jsonInt = Json.ValueNumber . bigintToBigfloat . fromIntegral++jsonMap :: [(String, Json.Value)] -> Json.Value+jsonMap = Json.ValueObject . M.fromList
+ src/test/haskell/Hydra/Langs/Json/SerdeSpec.hs view
@@ -0,0 +1,105 @@+-- Note: these tests are dependent on Data.Aeson, both because the Serde depends on Data.Aeson+-- and because of the particular serialization style.++module Hydra.Langs.Json.SerdeSpec where++import Hydra.Kernel+import Hydra.Dsl.Terms+import Hydra.Langs.Json.Serde+import qualified Hydra.Dsl.Types as Types++import Hydra.TestData+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Data.List as L+import qualified Test.QuickCheck as QC+import qualified Data.Maybe as Y+++checkLiterals :: H.SpecWith ()+checkLiterals = H.describe "Test literal values" $ do++ H.it "Booleans become 'true' and 'false'" $ do+ QC.property $ \b -> checkSerialization jsonStringCoder+ (TypedTerm (boolean b) $ Types.boolean)+ (if b then "true" else "false")++ H.it "int32's become numbers, and are serialized in the obvious way" $ do+ QC.property $ \i -> checkSerialization jsonStringCoder+ (TypedTerm (int32 i) $ Types.int32)+ (show i)++ H.it "uint8's and other finite integer types become numbers, and are serialized in the obvious way" $ do+ QC.property $ \i -> checkSerialization jsonStringCoder+ (TypedTerm (uint8 i) $ Types.uint8)+ (show i)++ H.it "bigints become numbers" $ do+ QC.property $ \i -> checkSerialization jsonStringCoder+ (TypedTerm (bigint i) $ Types.bigint)+ (show i)++checkOptionals :: H.SpecWith ()+checkOptionals = H.describe "Test and document serialization of optionals" $ do++ H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $+ QC.property $ \mi -> checkSerialization jsonStringCoder+ (TypedTerm+ (optional $ (Just . int32) =<< mi)+ (Types.optional Types.int32))+ (Y.maybe "null" show mi)++ H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $+ QC.property $ \mi -> checkSerialization jsonStringCoder+ (TypedTerm+ (optional $ Just $ optional $ (Just . int32) =<< mi)+ (Types.optional $ Types.optional Types.int32))+ ("[" ++ Y.maybe "null" show mi ++ "]")++ H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $+ QC.property $ \() -> checkSerialization jsonStringCoder+ (TypedTerm+ (optional Nothing)+ (Types.optional $ Types.optional Types.int32))+ "[]"++checkRecordsAndUnions :: H.SpecWith ()+checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do++ H.it "Empty records become empty objects" $+ QC.property $ \() -> checkSerialization jsonStringCoder+ (TypedTerm unit Types.unit)+ "{}"++ H.it "Simple records become simple objects" $+ QC.property $ \() -> checkSerialization jsonStringCoder+ (TypedTerm (latlonRecord 37 (negate 122)) latLonType)+ "{\"lat\":37,\"lon\":-122}"++ H.it "Optionals are omitted from record objects if 'nothing'" $+ QC.property $ \() -> checkSerialization jsonStringCoder+ (TypedTerm+ (record testTypeName [Field (Name "one") $ optional $ Just $ string "test", Field (Name "two") $ optional Nothing])+ (TypeRecord $ RowType testTypeName Nothing [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32]))+ "{\"one\":\"test\"}"++ H.it "Simple unions become simple objects, via records" $+ QC.property $ \() -> checkSerialization jsonStringCoder+ (TypedTerm+ (inject testTypeName $ Field (Name "left") $ string "test")+ (TypeUnion $ RowType testTypeName Nothing [Types.field "left" Types.string, Types.field "right" Types.int32]))+ "{\"left\":\"test\"}"++jsonByteStringCoderIsInformationPreserving :: H.SpecWith ()+jsonByteStringCoderIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized JSON, and back again is a no-op" $ do++ H.it "Generate arbitrary type/term pairs, serialize the terms to JSON, deserialize them, and compare" $+ QC.property (checkSerdeRoundTrip jsonByteStringCoder)++spec :: H.Spec+spec = do+ checkLiterals+ checkOptionals+ checkRecordsAndUnions+-- jsonByteStringCoderIsInformationPreserving -- TODO: restore me
+ src/test/haskell/Hydra/Langs/Yaml/CoderSpec.hs view
@@ -0,0 +1,120 @@+module Hydra.Langs.Yaml.CoderSpec where++import Hydra.Kernel+import Hydra.Dsl.Terms+import Hydra.Langs.Yaml.Coder+import qualified Hydra.Langs.Yaml.Model as YM+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.Tests++import Hydra.TestData+import Hydra.TestUtils++import qualified Data.Bifunctor as BF+import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+import qualified Test.QuickCheck as QC+++literalTypeConstraintsAreRespected :: H.SpecWith ()+literalTypeConstraintsAreRespected = H.describe "Verify that YAML's literal type constraints are respected" $ do++ -- TODO: binary data++ H.it "Check booleans" $+ QC.property $ \b -> checkYamlCoder Types.boolean (boolean b) (yamlBool b)++ H.it "Check 32-bit floats" $+ QC.property $ \f -> checkYamlCoder Types.float32 (float32 f) (yamlFloat $ realToFrac f)++ H.it "Check 64-bit floats (doubles)" $+ QC.property $ \d -> checkYamlCoder Types.float64 (float64 d) (yamlFloat $ realToFrac d)++ -- TODO: bigfloat++ H.it "Check 32-bit integers" $+ QC.property $ \i -> checkYamlCoder Types.int32 (int32 i) (yamlInt i)++ H.it "Check 16-bit unsigned integers" $+ QC.property $ \i -> checkYamlCoder Types.uint16 (uint16 i) (yamlInt i)++ H.it "Check arbitrary-precision integers" $+ QC.property $ \i -> checkYamlCoder Types.bigint (bigint i) (yamlInt i)++ H.it "Check strings" $+ QC.property $ \s -> checkYamlCoder Types.string (string s) (yamlStr s)++supportedTypesPassThrough :: H.SpecWith ()+supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do++ H.it "Lists become YAML sequences" $+ QC.property $ \strings -> checkYamlCoder listOfStringsType+ (list $ string <$> strings) (YM.NodeSequence $ yamlStr <$> strings)++ H.it "Maps become YAML mappings" $+ QC.property $ \keyvals -> checkYamlCoder mapOfStringsToIntsType+ (makeMap keyvals) (yamlMap $ BF.bimap yamlStr yamlInt <$> keyvals)++ H.it "Optionals become YAML null or type-specific nodes" $+ QC.property $ \ms -> checkYamlCoder optionalStringType+ (optional $ string <$> ms) (YM.NodeScalar $ Y.maybe YM.ScalarNull YM.ScalarStr ms)++ H.it "Records become YAML mappings" $+ QC.property $ \lat lon -> checkYamlCoder latLonType+ (latlonRecord lat lon) (yamlMap [+ (yamlStr "lat", yamlFloat $ realToFrac lat),+ (yamlStr "lon", yamlFloat $ realToFrac lon)])++unsupportedTypesAreTransformed :: H.SpecWith ()+unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do++ -- TODO: functions++ H.it "Sets become sequences" $+ QC.property $ \strings -> checkYamlCoder setOfStringsType+ (stringSet strings) (YM.NodeSequence $ yamlStr <$> S.toList strings)++ H.it "Nominal types are dereferenced" $+ QC.property $ \s -> checkYamlCoder stringAliasType+ (wrap stringAliasTypeName $ string s) (yamlStr s)++ H.it "Unions become YAML mappings (as records)" $+ QC.property $ \int -> checkYamlCoder stringOrIntType+ (variant stringOrIntName (Name "right") $ int32 int)+ (yamlMap [(yamlStr "right", yamlInt int)])++spec :: H.Spec+spec = do+ literalTypeConstraintsAreRespected+ supportedTypesPassThrough+ unsupportedTypesAreTransformed++checkYamlCoder :: Type -> Term -> YM.Node -> H.Expectation+checkYamlCoder typ term node = case mstep of+ Nothing -> HL.assertFailure (traceSummary trace)+ Just step -> do+ shouldSucceedWith (coderEncode step term) node+ shouldSucceedWith (coderEncode step term >>= coderDecode step) term+ where+ FlowState mstep _ trace = unFlow (yamlCoder typ) testGraph emptyTrace++yamlBool :: Bool -> YM.Node+yamlBool = YM.NodeScalar . YM.ScalarBool++yamlFloat :: Double -> YM.Node+yamlFloat = YM.NodeScalar . YM.ScalarFloat++yamlInt :: Integral i => i -> YM.Node+yamlInt = YM.NodeScalar . YM.ScalarInt . fromIntegral++yamlMap :: [(YM.Node, YM.Node)] -> YM.Node+yamlMap = YM.NodeMapping . M.fromList++yamlNull :: YM.Node+yamlNull = YM.NodeScalar YM.ScalarNull++yamlStr :: String -> YM.Node+yamlStr = YM.NodeScalar . YM.ScalarStr
+ src/test/haskell/Hydra/Langs/Yaml/SerdeSpec.hs view
@@ -0,0 +1,110 @@+-- Note: these tests are dependent on HsYaml, both because the Serde depends on HsYaml+-- and because of the particular serialization style.++module Hydra.Langs.Yaml.SerdeSpec where++import Hydra.Kernel+import Hydra.Dsl.Terms+import Hydra.Langs.Yaml.Serde+import qualified Hydra.Dsl.Types as Types++import Hydra.TestData+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.List as L+import qualified Test.QuickCheck as QC+import qualified Data.Maybe as Y+++checkLiterals :: H.SpecWith ()+checkLiterals = H.describe "Test literal values" $ do++ H.it "Booleans become 'true' and 'false' (not 'y' and 'n')" $ do+ QC.property $ \b -> checkSerialization yamlStringCoder+ (TypedTerm (boolean b) Types.boolean)+ (if b then "true" else "false")++ H.it "int32's become ints, and are serialized in the obvious way" $ do+ QC.property $ \i -> checkSerialization yamlStringCoder+ (TypedTerm (int32 i) Types.int32)+ (show i)++ H.it "uint8's and other finite integer types become ints, and are serialized in the obvious way" $ do+ QC.property $ \i -> checkSerialization yamlStringCoder+ (TypedTerm (uint8 i) Types.uint8)+ (show i)++ H.it "bigints become ints" $ do+ QC.property $ \i -> checkSerialization yamlStringCoder+ (TypedTerm (bigint i) Types.bigint)+ (show i)++ -- TODO: examine quirks around floating-point serialization more closely. These could affect portability of the serialized YAML.++ -- TODO: binary string and character string serialization++checkOptionals :: H.SpecWith ()+checkOptionals = H.describe "Test and document serialization of optionals" $ do++ H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $+ QC.property $ \mi -> checkSerialization yamlStringCoder+ (TypedTerm+ (optional $ (Just . int32) =<< mi)+ (Types.optional Types.int32))+ (Y.maybe "null" show mi)++ H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $+ QC.property $ \mi -> checkSerialization yamlStringCoder+ (TypedTerm+ (optional $ Just $ optional $ (Just . int32) =<< mi)+ (Types.optional $ Types.optional Types.int32))+ ("- " ++ Y.maybe "null" show mi)++ H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $+ QC.property $ \() -> checkSerialization yamlStringCoder+ (TypedTerm+ (optional Nothing)+ (Types.optional $ Types.optional Types.int32))+ "[]"++checkRecordsAndUnions :: H.SpecWith ()+checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do++ H.it "Empty records become empty objects" $+ QC.property $ \() -> checkSerialization yamlStringCoder+ (TypedTerm unit Types.unit)+ "{}"++ H.it "Simple records become simple objects" $+ QC.property $ \() -> checkSerialization yamlStringCoder+ (TypedTerm (latlonRecord 37.0 (negate 122.0)) latLonType)+ "lat: 37.0\nlon: -122.0"++ H.it "Optionals are omitted from record objects if 'nothing'" $+ QC.property $ \() -> checkSerialization yamlStringCoder+ (TypedTerm+ (record testTypeName [Field (Name "one") $ optional $ Just $ string "test", Field (Name "two") $ optional Nothing])+ (TypeRecord $ RowType testTypeName Nothing [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32]))+ "one: test"++ H.it "Simple unions become simple objects, via records" $+ QC.property $ \() -> checkSerialization yamlStringCoder+ (TypedTerm+ (inject testTypeName $ Field (Name "left") $ string "test")+ (TypeUnion $ RowType testTypeName Nothing [Types.field "left" Types.string, Types.field "right" Types.int32]))+ "left: test\n"++yamlByteStringCoderIsInformationPreserving :: H.SpecWith ()+yamlByteStringCoderIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized YAML, and back again is a no-op" $ do++ H.it "Generate arbitrary type/term pairs, serialize the terms to YAML, deserialize them, and compare" $+ QC.property (checkSerdeRoundTrip yamlByteStringCoder)++spec :: H.Spec+spec = do+ checkLiterals+ checkOptionals+ checkRecordsAndUnions+-- yamlByteStringCoderIsInformationPreserving -- TODO: restore me
+ src/test/haskell/Hydra/LiteralAdaptersSpec.hs view
@@ -0,0 +1,126 @@+module Hydra.LiteralAdaptersSpec where++import Hydra.Kernel++import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+++testFloatAdapter :: H.SpecWith ()+testFloatAdapter = H.describe "Test floating-point adapter" $ do++ H.it "upgrade float32 to bigfloat, since float32 and float64 are unsupported" $+ QC.property $ \f -> checkFloatAdapter+ [FloatTypeBigfloat]+ FloatTypeFloat32 FloatTypeBigfloat False+ (FloatValueFloat32 f) (FloatValueBigfloat $ realToFrac f)++ H.it "downgrade bigfloat to float64" $+ QC.property $ \d -> checkFloatAdapter+ [FloatTypeFloat32, FloatTypeFloat64]+ FloatTypeBigfloat FloatTypeFloat64 True+ (FloatValueBigfloat d) (FloatValueFloat64 $ realToFrac d)++ H.it "downgrade bigfloat to float32, since float64 is unsupported" $+ QC.property $ \d -> checkFloatAdapter+ [FloatTypeFloat32]+ FloatTypeBigfloat FloatTypeFloat32 True+ (FloatValueBigfloat d) (FloatValueFloat32 $ realToFrac d)++ H.it "bigfloat is supported and remains unchanged" $+ QC.property $ \d -> checkFloatAdapter+ [FloatTypeFloat32, FloatTypeBigfloat]+ FloatTypeBigfloat FloatTypeBigfloat False+ (FloatValueBigfloat d) (FloatValueBigfloat d)++testIntegerAdapter :: H.SpecWith ()+testIntegerAdapter = H.describe "Test integer adapter" $ do++ H.it "upgrade uint8 to uint16, not int16" $+ QC.property $ \b -> checkIntegerAdapter+ [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]+ IntegerTypeUint8 IntegerTypeUint16 False+ (IntegerValueUint8 b) (IntegerValueUint16 $ fromIntegral b)++ H.it "upgrade int8 to int16, not uint16" $+ QC.property $ \b -> checkIntegerAdapter+ [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]+ IntegerTypeInt8 IntegerTypeInt16 False+ (IntegerValueInt8 b) (IntegerValueInt16 $ fromIntegral b)++ H.it "upgrade uint8 to int16 when uint16 is not supported" $+ QC.property $ \b -> checkIntegerAdapter+ [IntegerTypeInt16, IntegerTypeInt32, IntegerTypeBigint]+ IntegerTypeUint8 IntegerTypeInt16 False+ (IntegerValueUint8 b) (IntegerValueInt16 $ fromIntegral b)++ H.it "cross-convert uint32 to int32, even when uint16 is supported" $+ QC.property $ \b -> checkIntegerAdapter+ [IntegerTypeUint16, IntegerTypeInt32]+ IntegerTypeUint32 IntegerTypeInt32 True+ (IntegerValueUint32 b) (IntegerValueInt32 $ fromIntegral b)++ H.it "downgrade bigint to int32, not uint32" $+ QC.property $ \b -> checkIntegerAdapter+ [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeInt32, IntegerTypeUint32]+ IntegerTypeBigint IntegerTypeInt32 True+ (IntegerValueBigint b) (IntegerValueInt32 $ fromIntegral b)++ H.it "upgrade uint64 to bigint when supported" $+ QC.property $ \i -> checkIntegerAdapter+ [IntegerTypeInt32, IntegerTypeUint32, IntegerTypeBigint]+ IntegerTypeUint64 IntegerTypeBigint False+ (IntegerValueUint64 i) (IntegerValueBigint $ fromIntegral i)++ H.it "downgrade uint64 to uint32 when bigint is unsupported" $+ QC.property $ \i -> checkIntegerAdapter+ [IntegerTypeInt32, IntegerTypeUint32]+ IntegerTypeUint64 IntegerTypeUint32 True+ (IntegerValueUint64 i) (IntegerValueUint32 $ fromIntegral i)++testLiteralAdapter :: H.SpecWith ()+testLiteralAdapter = H.describe "Test literal adapter" $ do++ H.it "encode binary data as strings" $+ QC.property $ \b -> checkLiteralAdapter+ [LiteralVariantString]+ LiteralTypeBinary LiteralTypeString False+ (LiteralBinary b) (LiteralString b)++ H.it "encode booleans as strings" $+ QC.property $ \b -> checkLiteralAdapter+ [LiteralVariantString]+ LiteralTypeBoolean LiteralTypeString False+ (LiteralBoolean b) (LiteralString $ if b then "true" else "false")++ H.it "encode booleans as integers" $+ QC.property $ \b -> checkLiteralAdapter+ [LiteralVariantInteger]+ LiteralTypeBoolean (LiteralTypeInteger IntegerTypeInt16) False+ (LiteralBoolean b) (LiteralInteger $ IntegerValueInt16 $ if b then 1 else 0)++ H.it "floating-point encoding is delegated to the float adapter" $+ QC.property $ \f -> checkLiteralAdapter+ [LiteralVariantFloat]+ (LiteralTypeFloat FloatTypeBigfloat) (LiteralTypeFloat FloatTypeFloat32) True+ (LiteralFloat $ FloatValueBigfloat f) (LiteralFloat $ FloatValueFloat32 $ realToFrac f)++ H.it "integer encoding is delegated to the integer adapter" $+ QC.property $ \i -> checkLiteralAdapter+ [LiteralVariantInteger]+ (LiteralTypeInteger IntegerTypeBigint) (LiteralTypeInteger IntegerTypeInt32) True+ (LiteralInteger $ IntegerValueBigint i) (LiteralInteger $ IntegerValueInt32 $ fromIntegral i)++ H.it "strings are unchanged" $+ QC.property $ \s -> checkLiteralAdapter+ [LiteralVariantString]+ LiteralTypeString LiteralTypeString False+ (LiteralString s) (LiteralString s)++spec :: H.Spec+spec = do+ testFloatAdapter+ testIntegerAdapter+ testLiteralAdapter
− src/test/haskell/Hydra/MetaSpec.hs
@@ -1,97 +0,0 @@-module Hydra.MetaSpec where--import Hydra.Kernel-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import Hydra.Meta-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.Map as M---checkArbitraryAnnotations :: H.SpecWith ()-checkArbitraryAnnotations = do- H.describe "Check getting/setting of arbitrary annotations" $ do-- H.it "Set a single key/value pair" $- QC.property $ \k v -> H.shouldBe- (setAnn k (Just $ Terms.int32 v) $ Terms.string "foo")- (TermAnnotated $ Annotated (Terms.string "foo") $ Meta $ M.fromList [(k, Terms.int32 v)])-- H.it "Retrieve a single value" $- QC.property $ \k v -> H.shouldBe- (getAnn k $ setAnn k (Just $ Terms.string v) $ Terms.int32 42)- (Just $ Terms.string v)-- H.it "Retrieve a null value" $- QC.property $ \k -> H.shouldBe- (getAnn k $ Terms.int16 42)- Nothing-- H.it "Set multiple values" $- QC.property $ \v1 v2 -> H.shouldBe- (setAnn "k2" (Just $ Terms.int32 v2) $- setAnn "k1" (Just $ Terms.string v1) $- Terms.boolean True)- (TermAnnotated $ Annotated (Terms.boolean True) $ Meta $ M.fromList [("k1", Terms.string v1), ("k2", Terms.int32 v2)])-- H.it "An outer annotation overrides an inner one" $- QC.property $ \k v1 v2 -> H.shouldBe- (setAnn k (Just $ Terms.string v2) $ setAnn k (Just $ Terms.string v1) $ Terms.string "bar")- (TermAnnotated $ Annotated (Terms.string "bar") $ Meta $ M.fromList [(k, Terms.string v2)])-- H.it "Unset a single annotation" $- QC.property $ \k -> H.shouldBe- (setAnn k Nothing $ setAnn k (Just $ Terms.string "foo") $ Terms.int64 137)- (Terms.int64 137)-- H.it "Unset one of multiple annotations" $- QC.property $ \v1 v2 -> H.shouldBe- (setAnn "k1" Nothing $- setAnn "k2" (Just $ Terms.int32 v2) $- setAnn "k1" (Just $ Terms.string v1) $- Terms.int64 137)- (TermAnnotated $ Annotated (Terms.int64 137) $ Meta $ M.fromList [("k2", Terms.int32 v2)])--checkDescriptions :: H.SpecWith ()-checkDescriptions = do- H.describe "Check getting/setting of descriptions" $ do-- H.it "Set a single description" $- QC.property $ \d -> H.shouldBe- (setDesc (Just d) $ Terms.string "foo")- (TermAnnotated $ Annotated (Terms.string "foo") $ Meta $ M.fromList [("description", Terms.string d)])-- H.it "Retrieve a single description" $- QC.property $ \d -> H.shouldBe- (getDesc $ setDesc (Just d) $ Terms.int32 42)- (Just d)-- H.it "Retrieve a null description" $- QC.property $ \i -> H.shouldBe- (getDesc $ Terms.int16 i)- Nothing-- H.it "An outer description overrides an inner one" $- QC.property $ \d1 d2 -> H.shouldBe- (setDesc (Just d2) $ setDesc (Just d1) $ Terms.string "bar")- (TermAnnotated $ Annotated (Terms.string "bar") $ Meta $ M.fromList [("description", Terms.string d2)])-- H.it "Unset a description" $- QC.property $ \d -> H.shouldBe- (setDesc Nothing $ setDesc (Just d) $ Terms.int64 137)- (Terms.int64 137)--getAnn = getTermAnnotation testContext--getDesc term = fromFlow testContext $ getTermDescription term--setAnn = setTermAnnotation testContext--setDesc = setTermDescription testContext--spec :: H.Spec-spec = do- checkArbitraryAnnotations- checkDescriptions
src/test/haskell/Hydra/ReductionSpec.hs view
@@ -2,8 +2,9 @@ import Hydra.Kernel import Hydra.Reduction-import Hydra.Impl.Haskell.Dsl.Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types+import Hydra.Dsl.Terms as Terms+import Hydra.Lib.Strings+import qualified Hydra.Dsl.Types as Types import Hydra.TestUtils @@ -11,6 +12,7 @@ import qualified Test.QuickCheck as QC import qualified Data.List as L import qualified Data.Char as C+import qualified Data.Set as S checkAlphaConversion :: H.SpecWith ()@@ -18,38 +20,40 @@ H.describe "Tests for alpha conversion" $ do H.it "Variables are substituted at the top level" $ QC.property $ \v ->- alphaConvert (Variable v) (variable $ v ++ "'") (variable v) == (variable (v ++ "'") :: Term Meta)+ alphaConvert (Name v) (var $ v ++ "'") (var v) == (var (v ++ "'") :: Term) H.it "Variables are substituted within subexpressions" $ QC.property $ \v ->- alphaConvert (Variable v) (variable $ v ++ "'") (list [int32 42, variable v])- == (list [int32 42, variable (v ++ "'")] :: Term Meta)+ alphaConvert (Name v) (var $ v ++ "'") (list [int32 42, var v])+ == (list [int32 42, var (v ++ "'")] :: Term) H.it "Lambdas with unrelated variables are transparent to alpha conversion" $ QC.property $ \v ->- alphaConvert (Variable v) (variable $ v ++ "1") (lambda (v ++ "2") $ list [int32 42, variable v, variable (v ++ "2")])- == (lambda (v ++ "2") $ list [int32 42, variable (v ++ "1"), variable (v ++ "2")] :: Term Meta)+ alphaConvert (Name v) (var $ v ++ "1") (lambda (v ++ "2") $ list [int32 42, var v, var (v ++ "2")])+ == (lambda (v ++ "2") $ list [int32 42, var (v ++ "1"), var (v ++ "2")] :: Term) H.it "Lambdas of the same variable are opaque to alpha conversion" $ QC.property $ \v ->- alphaConvert (Variable v) (variable $ v ++ "1") (lambda v $ list [int32 42, variable v, variable (v ++ "2")])- == (lambda v $ list [int32 42, variable v, variable (v ++ "2")] :: Term Meta)+ alphaConvert (Name v) (var $ v ++ "1") (lambda v $ list [int32 42, var v, var (v ++ "2")])+ == (lambda v $ list [int32 42, var v, var (v ++ "2")] :: Term) checkLiterals :: H.SpecWith () checkLiterals = do H.describe "Tests for literal values" $ do H.it "Literal terms have no free variables" $- QC.property $ \av -> termIsClosed (literal av :: Term Meta)+ QC.property $ \av -> termIsClosed (literal av :: Term) H.it "Literal terms are fully reduced; check using a dedicated function" $- QC.property $ \av -> termIsValue testContext testStrategy (literal av :: Term Meta)+ QC.property $ \av -> termIsValue testGraph (literal av :: Term) H.it "Literal terms are fully reduced; check by trying to reduce them" $ QC.property $ \av -> shouldSucceedWith (eval (literal av))- (literal av :: Term Meta)+ (literal av :: Term) H.it "Literal terms cannot be applied" $- QC.property $ \av (TypedTerm _ term) -> shouldFail (eval $ apply (literal av) term)+ QC.property $ \lv -> shouldSucceedWith+ (eval $ apply (literal lv) (literal lv))+ (apply (literal lv) (literal lv)) checkMonomorphicPrimitives :: H.SpecWith () checkMonomorphicPrimitives = do@@ -57,10 +61,10 @@ H.it "Example primitives have the expected arity" $ do H.shouldBe- (primitiveFunctionArity <$> lookupPrimitiveFunction testContext _strings_toUpper)+ (primitiveArity <$> lookupPrimitive testGraph _strings_toUpper) (Just 1) H.shouldBe- (primitiveFunctionArity <$> lookupPrimitiveFunction testContext _strings_splitOn)+ (primitiveArity <$> lookupPrimitive testGraph _strings_splitOn) (Just 2) H.it "Simple applications of a unary function succeed" $@@ -81,9 +85,11 @@ (eval (apply (primitive _strings_splitOn) $ string s1)) (apply (primitive _strings_splitOn) $ string s1) - H.it "Extra arguments to a primitive function cause failure" $+ H.it "Extra arguments to a primitive function are tolerated" $ QC.property $ \s1 s2 ->- shouldFail (eval (apply (apply (primitive _strings_toUpper) $ string s1) $ string s2))+ shouldSucceedWith+ (eval (apply (apply (primitive _strings_toUpper) $ string s1) $ string s2))+ (apply (string $ toUpper s1) (string s2)) checkPolymorphicPrimitives :: H.SpecWith () checkPolymorphicPrimitives = do@@ -95,6 +101,18 @@ (eval (apply (primitive _lists_length) $ list l)) (int32 $ L.length l) +checkNullaryPrimitives :: H.SpecWith ()+checkNullaryPrimitives = do+ H.describe "Tests for nullary primitives (constants)" $ do++ H.it "Test empty set constant" $ do+ -- shouldSucceedWith+ -- (eval (apply (primitive _sets_size) (Terms.set S.empty)))+ -- (int32 0)+ shouldSucceedWith+ (eval (apply (primitive _sets_size) (primitive _sets_empty)))+ (int32 0)+ testBetaReduceTypeRecursively :: H.SpecWith () testBetaReduceTypeRecursively = do H.describe "Beta reduce types recursively" $ do@@ -131,19 +149,16 @@ -- (reduce True app5) -- (TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" $ Types.function Types.string Types.string]) where- app1 = Types.apply (Types.lambda "t" $ Types.function (Types.variable "t") (Types.variable "t")) Types.string :: Type Meta- app2 = Types.apply (Types.lambda "x" latLonType) Types.int32 :: Type Meta- app3 = Types.apply (Types.lambda "a" $ TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" $ Types.variable "a"]) Types.unit :: Type Meta+ app1 = Types.apply (Types.lambda "t" $ Types.function (Types.var "t") (Types.var "t")) Types.string :: Type+ app2 = Types.apply (Types.lambda "x" latLonType) Types.int32 :: Type+ app3 = Types.apply (Types.lambda "a" $ TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" $ Types.var "a"]) Types.unit :: Type app4 = Types.apply (Types.apply (Types.lambda "x" $ Types.lambda "y" $ TypeRecord $ RowType (Name "Example") Nothing [- Types.field "f1" $ Types.variable "x",- Types.field "f2" $ Types.variable "y"]) Types.int32) Types.int64 :: Type Meta- app5 = Types.apply (Types.lambda "a" $ TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" $ Types.variable "a"]) app1--reduce :: Type Meta -> Type Meta-reduce typ = fromFlow (schemaContext testContext) (betaReduceType typ)+ Types.field "f1" $ Types.var "x",+ Types.field "f2" $ Types.var "y"]) Types.int32) Types.int64 :: Type+ app5 = Types.apply (Types.lambda "a" $ TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" $ Types.var "a"]) app1 -eval :: Term Meta -> GraphFlow Meta (Term Meta)-eval = betaReduceTerm+reduce :: Type -> Type+reduce typ = fromFlow typ (schemaContext testGraph) (betaReduceType typ) spec :: H.Spec spec = do@@ -152,3 +167,4 @@ checkLiterals checkMonomorphicPrimitives checkPolymorphicPrimitives+ checkNullaryPrimitives
src/test/haskell/Hydra/RewritingSpec.hs view
@@ -3,13 +3,17 @@ module Hydra.RewritingSpec where import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms+import Hydra.Flows+import Hydra.Dsl.Terms as Terms+import Hydra.Lib.Io+import qualified Hydra.Dsl.Types as Types import Hydra.TestUtils import qualified Test.Hspec as H import qualified Test.QuickCheck as QC import qualified Data.List as L+import qualified Data.Map as M import qualified Data.Set as S @@ -37,53 +41,59 @@ noChange (int32 42) noChange (list ["foo", "bar"]) noChange- (apply (apply splitOn "foo") "bar")+ (splitOn @@ "foo" @@ "bar") noChange (lambda "x" $ int32 42)+ noChange+ (typed Types.int32 $ int32 42) H.it "Expand bare function terms" $ do expandsTo toLower- (lambda "v1" $ apply toLower (variable "v1"))+ (lambda "v1" $ toLower @@ var "v1") expandsTo splitOn- (lambda "v1" $ lambda "v2" $ apply (apply splitOn (variable "v1")) (variable "v2"))- expandsTo- (compareTo $ int32 42)- (lambda "v1" $ apply (compareTo $ int32 42) (variable "v1"))+ (lambda "v1" $ lambda "v2" $ splitOn @@ var "v1" @@ var "v2") expandsTo- (matchOptional (int32 42) length)+ (matchOpt (int32 42) length) -- Note two levels of lambda expansion- (lambda "v1" $ apply (matchOptional (int32 42) (lambda "v1" $ apply length $ variable "v1")) (variable "v1"))+ (lambda "v1" $ (matchOpt (int32 42) $ lambda "v1" $ length @@ var "v1") @@ var "v1") H.it "Expand subterms within applications" $ do expandsTo- (apply splitOn "bar")- (lambda "v1" $ apply (apply splitOn "bar") (variable "v1"))+ (splitOn @@ "bar")+ (lambda "v1" $ splitOn @@ "bar" @@ var "v1") expandsTo- (apply (lambda "x" $ variable "x") length)- (apply (lambda "x" $ variable "x") (lambda "v1" $ apply length $ variable "v1"))+ ((lambda "x" $ var "x") @@ length)+ ((lambda "x" $ var "x") @@ (lambda "v1" $ length @@ var "v1")) H.it "Expand arbitrary subterms" $ do expandsTo- (list [lambda "x" "foo", apply splitOn "bar"])- (list [lambda "x" "foo", lambda "v1" $ apply (apply splitOn "bar") $ variable "v1"])+ (list [lambda "x" $ list ["foo"], splitOn @@ "bar"])+ (list [lambda "x" $ list ["foo"], lambda "v1" $ splitOn @@ "bar" @@ var "v1"]) H.it "Check that lambda expansion is idempotent" $ do QC.property $ \term -> do- once <- fromFlowIo testContext $ expandLambdas term- twice <- fromFlowIo testContext $ expandLambdas once+ inf <- fromFlowIo testGraph $ annotateTypedTerms term+ let once = expandTypedLambdas term+ let twice = expandTypedLambdas once H.shouldBe once twice+ where length = primitive $ Name "hydra/lib/strings.length" splitOn = primitive $ Name "hydra/lib/strings.splitOn" toLower = primitive $ Name "hydra/lib/strings.toLower" expandsTo termBefore termAfter = do- result <- fromFlowIo testContext $ expandLambdas termBefore- H.shouldBe result termAfter+-- result <- fromFlowIo testGraph $ expandLambdas termBefore+-- H.shouldBe result termAfter+ inf <- fromFlowIo testGraph $ annotateTypedTerms termBefore+ let result = expandTypedLambdas inf+ H.shouldBe (showTerm (removeTermAnnotations result)) (showTerm termAfter) noChange term = expandsTo term term + app = lambda "a" $ project testTypePersonName (Name "firstName") @@ var "a"+ testFoldOverTerm :: H.SpecWith () testFoldOverTerm = do H.describe "Test folding over terms" $ do@@ -91,17 +101,17 @@ H.it "Try a simple fold" $ do H.shouldBe (foldOverTerm TraversalOrderPre addInt32s 0- (list [int32 42, apply (lambda "x" $ variable "x") (int32 10)] :: Term Meta))+ (list [int32 42, (lambda "x" $ var "x") @@ int32 10])) 52 H.it "Check that traversal order is respected" $ do H.shouldBe (foldOverTerm TraversalOrderPre listLengths []- (list [list [string "foo", string "bar"], apply (lambda "x" $ variable "x") (list [string "quux"])] :: Term Meta))+ (list [list [string "foo", string "bar"], (lambda "x" $ var "x") @@ (list [string "quux"])])) [1, 2, 2] H.shouldBe (foldOverTerm TraversalOrderPost listLengths []- (list [list [string "foo", string "bar"], apply (lambda "x" $ variable "x") (list [string "quux"])] :: Term Meta))+ (list [list [string "foo", string "bar"], (lambda "x" $ var "x") @@ (list [string "quux"])])) [2, 1, 2] where addInt32s sum term = case term of@@ -111,37 +121,93 @@ TermList els -> L.length els:l _ -> l +testFlattenLetTerms :: H.SpecWith ()+testFlattenLetTerms = do+ H.describe "Test flattening of 'let' terms" $ do++ H.it "Non-let terms are unaffected" $ do+ H.shouldBe+ (flattenLetTerms $ Terms.int32 42)+ (Terms.int32 42)+ H.shouldBe+ (flattenLetTerms $ Terms.list [Terms.string "foo"])+ (Terms.list [Terms.string "foo"])++ H.it "Non-nested let terms are unaffected" $+ H.shouldBe+ (flattenLetTerms letTerm1)+ (letTerm1)++ H.it "Nonrecursive, nested bindings are flattened" $+ H.shouldBe+ (flattenLetTerms letTerm2)+ (letTerm2_flattened)++ H.it "Multiple levels of nesting are flattened appropriately" $+ H.shouldBe+ (flattenLetTerms letTerm3)+ (letTerm3_flattened)+ where+ makeLet body pairs = TermLet $ Let (makeBinding <$> pairs) body+ where+ makeBinding (k, v) = LetBinding (Name k) v Nothing+ letTerm1 = makeLet (TermList [Terms.var "x", Terms.var "y"]) [+ ("x", Terms.int32 1),+ ("y", Terms.int32 2)]+ letTerm2 = makeLet (TermList [Terms.var "a", Terms.var "b"]) [+ ("a", Terms.int32 1),+ ("b", letTerm1)]+ letTerm2_flattened = makeLet (TermList [Terms.var "a", Terms.var "b"]) [+ ("a", Terms.int32 1),+ ("b", TermList [Terms.var "b_x", Terms.var "b_y"]),+ ("b_x", Terms.int32 1),+ ("b_y", Terms.int32 2)]+ letTerm3 = makeLet (TermList [Terms.var "a", Terms.var "b"]) [+ ("a", Terms.int32 1),+ ("b", makeLet (TermList [Terms.var "x", Terms.var "y"]) [+ ("x", Terms.int32 1),+ ("y", makeLet (TermList [Terms.var "a", Terms.var "q"]) [+ ("p", Terms.int32 137),+ ("q", TermList [Terms.var "x", Terms.int32 5])])])]+ letTerm3_flattened = makeLet (TermList [Terms.var "a", Terms.var "b"]) [+ ("a", Terms.int32 1),+ ("b", TermList [Terms.var "b_x", Terms.var "b_y"]),+ ("b_x", Terms.int32 1),+ ("b_y", TermList [Terms.var "a", Terms.var "b_y_q"]),+ ("b_y_p", Terms.int32 137),+ ("b_y_q", TermList [Terms.var "b_x", Terms.int32 5])]+ testFreeVariablesInTerm :: H.SpecWith () testFreeVariablesInTerm = do H.describe "Test free variables" $ do - H.it "Generated terms never have free variables" $ do- QC.property $ \(TypedTerm _ term) -> do- H.shouldBe- (freeVariablesInTerm (term :: Term ()))- S.empty+-- H.it "Generated terms never have free variables" $ do+-- QC.property $ \(TypedTerm term _) -> do+-- H.shouldBe+-- (freeVariablesInTerm (term))+-- S.empty H.it "Free variables in individual terms" $ do H.shouldBe- (freeVariablesInTerm (string "foo" :: Term ()))+ (freeVariablesInTerm (string "foo")) S.empty H.shouldBe- (freeVariablesInTerm (variable "x" :: Term ()))- (S.fromList [Variable "x"])+ (freeVariablesInTerm (var "x"))+ (S.fromList [Name "x"]) H.shouldBe- (freeVariablesInTerm (list [variable "x", apply (lambda "y" $ variable "y") (int32 42)] :: Term ()))- (S.fromList [Variable "x"])+ (freeVariablesInTerm (list [var "x", (lambda "y" $ var "y") @@ int32 42]))+ (S.fromList [Name "x"]) H.shouldBe- (freeVariablesInTerm (list [variable "x", apply (lambda "y" $ variable "y") (variable "y")] :: Term ()))- (S.fromList [Variable "x", Variable "y"])+ (freeVariablesInTerm (list [var "x", (lambda "y" $ var "y") @@ var "y"]))+ (S.fromList [Name "x", Name "y"]) ---testReplaceFreeVariableType :: H.SpecWith ()---testReplaceFreeVariableType = do+--testReplaceFreeName :: H.SpecWith ()+--testReplaceFreeName = do -- H.describe "Test replace free type variables" $ do -- -- H.it "Check that variable types are replaced" $ do -- H.shouldBe--- (replaceFreeVariableType (VariableType "v1") Types.string $ Types.variable "v")+-- (replaceFreeName (Name "v1") Types.string $ Types.var "v") -- () testReplaceTerm :: H.SpecWith ()@@ -150,32 +216,32 @@ H.it "Check that the correct subterms are replaced" $ do H.shouldBe- (rewriteTerm replaceInts keepMeta+ (rewriteTerm replaceInts keepKv (int32 42))- (int64 42 :: Term Meta)+ (int64 42) H.shouldBe- (rewriteTerm replaceInts keepMeta- (list [int32 42, apply (lambda "x" $ variable "x") (int32 137)]))- (list [int64 42, apply (lambda "x" $ variable "x") (int64 137)] :: Term Meta)+ (rewriteTerm replaceInts keepKv+ (list [int32 42, (lambda "x" $ var "x") @@ int32 137]))+ (list [int64 42, (lambda "x" $ var "x") @@ int64 137]) H.it "Check that traversal order is respected" $ do H.shouldBe- (rewriteTerm replaceListsPre keepMeta+ (rewriteTerm replaceListsPre keepKv (list [list [list []]]))- (list [list []] :: Term Meta)+ (list [list []]) H.shouldBe- (rewriteTerm replaceListsPost keepMeta+ (rewriteTerm replaceListsPost keepKv (list [list [list []]]))- (list [] :: Term Meta)+ (list []) - H.it "Check that metadata is replace recursively" $ do- H.shouldBe- (rewriteTerm keepTerm replaceMeta (list [annot 42 (string "foo")] :: Term Int))- (list [annot "42" (string "foo")])+-- H.it "Check that metadata is replace recursively" $ do+-- H.shouldBe+-- (rewriteTerm keepTerm replaceKv (list [annot 42 (string "foo")] Int))+-- (list [annot "42" (string "foo")]) where keepTerm recurse term = recurse term - keepMeta = id+ keepKv = id replaceInts recurse term = case term2 of TermLiteral (LiteralInteger (IntegerValueInt32 v)) -> int64 $ fromIntegral v@@ -193,7 +259,7 @@ replaceListsPost recurse = replaceLists . recurse - replaceMeta i = show i+ replaceKv i = show i testRewriteExampleType :: H.SpecWith () testRewriteExampleType = do@@ -213,47 +279,46 @@ H.it "Check that 'const' applications are simplified" $ do H.shouldBe- (simplifyTerm (apply (lambda "x" (string "foo")) (int32 42)))- (string "foo" :: Term Meta)+ (simplifyTerm $ (lambda "x" $ string "foo") @@ int32 42)+ (string "foo") H.shouldBe- (simplifyTerm (apply (lambda "x" $ list [variable "x", variable "x"]) (variable "y")))- (list [variable "y", variable "y"] :: Term Meta)+ (simplifyTerm ((lambda "x" $ list [var "x", var "x"]) @@ var "y"))+ (list [var "y", var "y"]) H.shouldBe- (simplifyTerm (apply (lambda "x" $ string "foo") (variable "y")))- (string "foo" :: Term Meta)+ (simplifyTerm ((lambda "x" $ string "foo") @@ var "y"))+ (string "foo") H.shouldBe- (simplifyTerm (apply (lambda "x"- (apply (lambda "a" (list [string "foo", variable "a"])) (variable "x"))) (variable "y")))- (list [string "foo", variable "y"] :: Term Meta)--testStripMeta :: H.SpecWith ()-testStripMeta = do- H.describe "Test stripping metadata from terms" $ do-- H.it "Strip type annotations" $ do- QC.property $ \(TypedTerm typ term) -> do- shouldSucceedWith- (typeOf term)- Nothing- shouldSucceedWith- (typeOf $ withType testContext typ term)- (Just typ)- shouldSucceedWith- (typeOf $ strip $ withType testContext typ term)- Nothing--typeOf term = annotationClassTermType (contextAnnotations testContext) term+ (simplifyTerm ((lambda "x"+ ((lambda "a" (list [string "foo", var "a"])) @@ var "x")) @@ var "y"))+ (list [string "foo", var "y"]) -withType :: Context m -> Type m -> Term m -> Term m-withType cx typ = annotationClassSetTermType (contextAnnotations cx) cx (Just typ)+--testStripAnnotations :: H.SpecWith ()+--testStripAnnotations = do+-- H.describe "Test stripping metadata from terms" $ do+--+-- H.it "Strip type annotations" $ do+-- QC.property $ \(TypedTerm term typ) -> do+-- shouldSucceedWith+-- (getTermType term)+-- Nothing+-- shouldSucceedWith+-- (getTermType $ withType typ term)+-- (Just typ)+-- shouldSucceedWith+-- (getTermType $ strip $ withType typ term)+-- Nothing+--+--withType :: Graph -> Type -> Term -> Term+--withType typ = setTermType $ Just typ spec :: H.Spec spec = do- testExpandLambdas+-- testExpandLambdas -- TODO: restore me testFoldOverTerm+ testFlattenLetTerms testFreeVariablesInTerm--- testReplaceFreeVariableType+-- testReplaceFreeName testReplaceTerm testRewriteExampleType testSimplifyTerm- testStripMeta+-- testStripAnnotations -- TODO: restore me
+ src/test/haskell/Hydra/StripSpec.hs view
@@ -0,0 +1,43 @@+module Hydra.StripSpec where++import Hydra.Kernel++import Hydra.TestUtils+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.Char as C+import qualified Data.List as L+import qualified Data.Map as M+++checkStripTerm :: H.SpecWith ()+checkStripTerm = do+ H.describe "Tests for stripping annotations from terms" $ do+ H.it "Un-annotated terms are not affected" $+ QC.property $ \term -> case (term :: Term) of+ TermAnnotated _ -> True+ _ -> stripTerm term == term+ H.it "Terms are stripped recursively" $+ QC.property $ \term -> case (term :: Term) of+ TermAnnotated _ -> True+ _ -> stripTerm (Terms.annot M.empty (Terms.annot M.empty term)) == term++checkStripType :: H.SpecWith ()+checkStripType = do+ H.describe "Tests for stripping annotations from types" $ do+ H.it "Un-annotated types are not affected" $+ QC.property $ \typ -> case (typ :: Type) of+ TypeAnnotated _ -> True+ _ -> stripType typ == typ+ H.it "Types are stripped recursively" $+ QC.property $ \typ -> case (typ :: Type) of+ TypeAnnotated _ -> True+ _ -> stripType (Types.annot M.empty (Types.annot M.empty typ)) == typ++spec :: H.Spec+spec = do+ checkStripTerm+ checkStripType
+ src/test/haskell/Hydra/TermAdaptersSpec.hs view
@@ -0,0 +1,294 @@+module Hydra.TermAdaptersSpec where++import Hydra.Kernel+import Hydra.TermAdapters+import Hydra.AdapterUtils+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.Tests++import Hydra.TestData+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Data.Map as M+import qualified Test.QuickCheck as QC+import qualified Data.Set as S+import qualified Data.Maybe as Y+++constraintsAreAsExpected :: H.SpecWith ()+constraintsAreAsExpected = H.describe "Verify that the language constraints include/exclude the appropriate types" $ do++ H.it "int16 and int32 are supported in the test context" $ do+ typeIsSupported (context [TypeVariantLiteral]) Types.int16 `H.shouldBe` True+ typeIsSupported (context [TypeVariantLiteral]) Types.int32 `H.shouldBe` True++ H.it "int8 and bigint are unsupported in the test context" $ do+ typeIsSupported (context [TypeVariantLiteral]) Types.int8 `H.shouldBe` False+ typeIsSupported (context [TypeVariantLiteral]) Types.bigint `H.shouldBe` False++ H.it "Records are supported, but unions are not" $ do+ typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) latLonType `H.shouldBe` True+ typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) stringOrIntType `H.shouldBe` False++ H.it "Records are supported if and only if each of their fields are supported" $ do+ typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])+ (TypeRecord $ RowType (Name "Example") Nothing [Types.field "first" Types.string, Types.field "second" Types.int16])+ `H.shouldBe` True+ typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])+ (TypeRecord $ RowType (Name "Example") Nothing [Types.field "first" Types.string, Types.field "second" Types.int8])+ `H.shouldBe` False++ H.it "Lists are supported if the list element type is supported" $ do+ typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfStringsType `H.shouldBe` True+ typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfListsOfStringsType `H.shouldBe` True+ typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfSetOfStringsType `H.shouldBe` False++ where+ context = languageConstraints . adapterContextLanguage . termTestContext++supportedConstructorsAreUnchanged :: H.SpecWith ()+supportedConstructorsAreUnchanged = H.describe "Verify that supported term constructors are unchanged" $ do++ H.it "Strings (and other supported literal values) pass through without change" $+ QC.property $ \b -> checkDataAdapter+ [TypeVariantLiteral]+ Types.string+ Types.string+ False+ (string b)+ (string b)++ H.it "Lists (when supported) pass through without change" $+ QC.property $ \strings -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantList]+ listOfStringsType+ listOfStringsType+ False+ (list $ string <$> strings)+ (list $ string <$> strings)++ H.it "Maps (when supported) pass through without change" $+ QC.property $ \keyvals -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantMap]+ mapOfStringsToIntsType+ mapOfStringsToIntsType+ False+ (makeMap keyvals)+ (makeMap keyvals)++ H.it "Optionals (when supported) pass through without change" $+ QC.property $ \mi -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantOptional]+ optionalInt8Type+ optionalInt16Type+ False+ (optional $ int8 <$> mi)+ (optional $ int16 . fromIntegral <$> mi)++ H.it "Records (when supported) pass through without change" $+ QC.property $ \a1 a2 -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantRecord]+ (TypeRecord $ RowType testTypeName Nothing [Types.field "first" Types.string, Types.field "second" Types.int8])+ (TypeRecord $ RowType testTypeName Nothing [Types.field "first" Types.string, Types.field "second" Types.int16])+ False+ (record testTypeName [field "first" $ string a1, field "second" $ int8 a2])+ (record testTypeName [field "first" $ string a1, field "second" $ int16 $ fromIntegral a2])++ H.it "Unions (when supported) pass through without change" $+ QC.property $ \int -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantUnion]+ stringOrIntType+ stringOrIntType+ False+ (variant stringOrIntName (Name "right") $ int32 int)+ (variant stringOrIntName (Name "right") $ int32 int)++ H.it "Sets (when supported) pass through without change" $+ QC.property $ \strings -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantSet]+ setOfStringsType+ setOfStringsType+ False+ (stringSet strings)+ (stringSet strings)++ H.it "Primitive function references (when supported) pass through without change" $+ QC.property $ \name -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantFunction]+ concatType+ concatType+ False+ (primitive name)+ (primitive name)++ H.it "Projections (when supported) pass through without change" $+ QC.property $ \fname -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantFunction, TypeVariantRecord]+ exampleProjectionType+ exampleProjectionType+ False+ (project testTypePersonName fname)+ (project testTypePersonName fname)++unsupportedConstructorsAreModified :: H.SpecWith ()+unsupportedConstructorsAreModified = H.describe "Verify that unsupported term constructors are changed in the expected ways" $ do++ H.it "Sets (when unsupported) become lists" $+ QC.property $ \strings -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantList]+ setOfStringsType+ listOfStringsType+ False+ (stringSet strings)+ (stringList $ S.toList strings)++ H.it "Optionals (when unsupported) become lists" $+ QC.property $ \ms -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantList]+ (Types.optional Types.string)+ (Types.list Types.string)+ False+ (optional $ string <$> ms)+ (list $ Y.maybe [] (\s -> [string s]) ms)++ H.it "Primitive function references (when unsupported) become variant terms" $+ QC.property $ \name -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]+ concatType+ (functionProxyType Types.string)+ False+ (primitive name)+ (inject functionProxyName $ field "primitive" $ string $ unName name) -- Note: the function name is not dereferenced++ H.it "Projections (when unsupported) become variant terms" $+ QC.property $ \fname -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]+ exampleProjectionType+ (functionProxyType testTypePerson)+ False+ (project testTypePersonName fname)+ (inject functionProxyName $ field "record" $ string $+ show (project testTypePersonName fname :: Term)) -- Note: the field name is not dereferenced++-- H.it "Nominal types (when unsupported) are dereferenced" $+-- QC.property $ \s -> checkDataAdapter+-- [TypeVariantLiteral, TypeVariantAnnotated]+-- stringAliasType+-- (TypeAnnotated $ Annotated Types.string $ Kv $+-- M.fromList [(key_description, Terms.string "An alias for the string type")])+-- False+-- (string s)+-- (string s)++ H.it "Unions (when unsupported) become records" $+ QC.property $ \i -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantOptional, TypeVariantRecord]+ eitherStringOrInt8Type+ (TypeRecord $ RowType eitherStringOrInt8TypeName Nothing [+ Types.field "left" $ Types.optional Types.string,+ Types.field "right" $ Types.optional Types.int16])+ False+ (inject eitherStringOrInt8TypeName $ field "right" $ int8 i)+ (record eitherStringOrInt8TypeName [+ field "left" $ optional Nothing,+ field "right" $ optional $ Just $ int16 $ fromIntegral i])++termsAreAdaptedRecursively :: H.SpecWith ()+termsAreAdaptedRecursively = H.describe "Verify that the adapter descends into subterms and transforms them appropriately" $ do++ H.it "A list of int8's becomes a list of int32's" $+ QC.property $ \ints -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantList]+ listOfInt8sType+ listOfInt16sType+ False+ (list $ int8 <$> ints)+ (list $ int16 . fromIntegral <$> ints)++ H.it "A list of sets of strings becomes a list of lists of strings" $+ QC.property $ \lists -> checkDataAdapter+ [TypeVariantLiteral, TypeVariantList]+ listOfSetOfStringsType+ listOfListsOfStringsType+ False+ (list $ (\l -> set $ S.fromList $ string <$> l) <$> lists)+ (list $ (\l -> list $ string <$> S.toList (S.fromList l)) <$> lists)++roundTripsPreserveSelectedTypes :: H.SpecWith ()+roundTripsPreserveSelectedTypes = H.describe "Verify that the adapter is information preserving, i.e. that round-trips are no-ops" $ do++ H.it "Check strings (pass-through)" $+ QC.property $ \s -> roundTripIsNoop Types.string (string s)++ H.it "Check lists (pass-through)" $+ QC.property $ \strings -> roundTripIsNoop listOfStringsType (list $ string <$> strings)++ H.it "Check sets (which map to lists)" $+ QC.property $ \strings -> roundTripIsNoop setOfStringsType (stringSet strings)++ H.it "Check primitive function references (which map to variants)" $+ QC.property $ \name -> roundTripIsNoop concatType (primitive name)++ H.it "Check projection terms (which map to variants)" $+ QC.property $ \fname -> roundTripIsNoop exampleProjectionType (project testTypePersonName fname)++ H.it "Check nominally typed terms (which pass through as instances of the aliased type)" $+ QC.property $ \s -> roundTripIsNoop stringAliasType (wrap stringAliasTypeName $ string s)++--roundTripsPreserveArbitraryTypes :: H.SpecWith ()+--roundTripsPreserveArbitraryTypes = H.describe "Verify that the adapter is information preserving for arbitrary typed terms" $ do+--+-- H.it "Check arbitrary type/term pairs" $+-- QC.property $ \(TypedTerm term typ) -> roundTripIsNoop typ term++fieldAdaptersAreAsExpected :: H.SpecWith ()+fieldAdaptersAreAsExpected = H.describe "Check that field adapters are as expected" $ do++ H.it "An int8 field becomes an int16 field" $+ QC.property $ \i -> checkFieldAdapter+ [TypeVariantLiteral, TypeVariantRecord]+ (Types.field "second" Types.int8)+ (Types.field "second" Types.int16)+ False+ (field "second" $ int8 i)+ (field "second" $ int16 $ fromIntegral i)++roundTripIsNoop :: Type -> Term -> H.Expectation+roundTripIsNoop typ term = shouldSucceedWith+ (step coderEncode term >>= step coderDecode)+ term+ where+ step = adapt typ++ -- Use a YAML-like language (but supporting unions) as the default target language+ testLanguage = Language (LanguageName "hydra/test") $ LanguageConstraints {+ languageConstraintsEliminationVariants = S.empty, -- S.fromList eliminationVariants,+ languageConstraintsLiteralVariants = S.fromList [+ LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],+ languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],+ languageConstraintsFunctionVariants = S.empty,+ languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],+ languageConstraintsTermVariants = S.fromList termVariants,+ languageConstraintsTypeVariants = S.fromList [+ TypeVariantAnnotated, TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantRecord, TypeVariantUnion],+ languageConstraintsTypes = \typ -> case stripType typ of+ TypeOptional (TypeOptional _) -> False+ _ -> True }++ -- Note: in a real application, you wouldn't create the adapter just to use it once;+ -- it should be created once, then applied to many terms.+ adapt typ dir term = do+ adapter <- languageAdapter testLanguage typ+ dir (adapterCoder adapter) term++spec :: H.Spec+spec = do+ constraintsAreAsExpected+ supportedConstructorsAreUnchanged+ unsupportedConstructorsAreModified+ termsAreAdaptedRecursively+ roundTripsPreserveSelectedTypes+-- roundTripsPreserveArbitraryTypes -- TODO: restore me+ fieldAdaptersAreAsExpected
src/test/haskell/Hydra/TestData.hs view
@@ -1,80 +1,68 @@ module Hydra.TestData where import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Terms+import Hydra.Dsl.Terms import Hydra.TestGraph-import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms-import qualified Hydra.Impl.Haskell.Dsl.Types as Types+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types import qualified Data.Map as M -concatType :: Type m+concatType :: Type concatType = Types.function Types.string $ Types.function Types.string Types.string -compareStringsType :: Type m+compareStringsType :: Type compareStringsType = Types.function Types.string Types.string -eitherStringOrInt8Type :: Type m+eitherStringOrInt8Type :: Type eitherStringOrInt8Type = TypeUnion $ RowType eitherStringOrInt8TypeName Nothing [Types.field "left" Types.string, Types.field "right" Types.int8] eitherStringOrInt8TypeName :: Name-eitherStringOrInt8TypeName = fromQname testNamespace "EitherStringOrInt8"+eitherStringOrInt8TypeName = unqualifyName $ QualifiedName (Just testNamespace) "EitherStringOrInt8" -exampleProjectionType :: Type Meta+exampleProjectionType :: Type exampleProjectionType = Types.function testTypePerson Types.string -int32ElementType :: Type m-int32ElementType = Types.element Types.int32--int32ElementDataType :: Type m-int32ElementDataType = Types.function int32ElementType Types.int32--listOfInt8sType :: Type m+listOfInt8sType :: Type listOfInt8sType = Types.list Types.int8 -listOfInt16sType :: Type m+listOfInt16sType :: Type listOfInt16sType = Types.list Types.int16 -listOfListsOfStringsType :: Type m+listOfListsOfStringsType :: Type listOfListsOfStringsType = Types.list $ Types.list Types.string -listOfSetOfInt32ElementReferencesType :: Type m-listOfSetOfInt32ElementReferencesType = Types.list $ Types.set $ Types.element Types.int32--listOfSetOfStringsType :: Type m+listOfSetOfStringsType :: Type listOfSetOfStringsType = Types.list $ Types.set Types.string -listOfStringsType :: Type m+listOfStringsType :: Type listOfStringsType = Types.list Types.string -makeMap :: (Eq a, Ord a, Read a, Show a) => [(String, Int)] -> Term a+makeMap :: [(String, Int)] -> Term makeMap keyvals = Terms.map $ M.fromList $ ((\(k, v) -> (string k, int32 v)) <$> keyvals) -mapOfStringsToIntsType :: Type m+mapOfStringsToIntsType :: Type mapOfStringsToIntsType = Types.map Types.string Types.int32 -optionalInt8Type :: Type m+optionalInt8Type :: Type optionalInt8Type = Types.optional Types.int8 -optionalInt16Type :: Type m+optionalInt16Type :: Type optionalInt16Type = Types.optional Types.int16 -optionalStringType :: Type m+optionalStringType :: Type optionalStringType = Types.optional Types.string -setOfStringsType :: Type m+setOfStringsType :: Type setOfStringsType = Types.set Types.string -stringAliasType :: Type m-stringAliasType = Types.nominal $ Name "StringTypeAlias"- stringOrIntName :: Name stringOrIntName = Name "StringOrInt" -stringOrIntType :: Type m+stringOrIntType :: Type stringOrIntType = TypeUnion $ RowType stringOrIntName Nothing [Types.field "left" Types.string, Types.field "right" Types.int32] testTypeName :: Name-testTypeName = fromQname testNamespace "TestType"+testTypeName = unqualifyName $ QualifiedName (Just testNamespace) "TestType"
src/test/haskell/Hydra/TestGraph.hs view
@@ -1,62 +1,67 @@ module Hydra.TestGraph ( module Hydra.TestGraph,- module Hydra.Impl.Haskell.Sources.Libraries,+ module Hydra.Sources.Libraries, ) where import Hydra.Kernel-import Hydra.Impl.Haskell.Dsl.Standard as Standard-import Hydra.Impl.Haskell.Sources.Core-import Hydra.Impl.Haskell.Sources.Libraries-import Hydra.CoreEncoding-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Terms+import Hydra.Sources.Libraries+import Hydra.Dsl.Terms+import Hydra.Sources.Core+import Hydra.Dsl.Annotations as Ann+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Types as Types import qualified Data.Map as M import qualified Data.Set as S+import qualified Hydra.Dsl.Terms as Terms latLonName :: Name latLonName = Name "LatLon" -latlonRecord :: Float -> Float -> Term m-latlonRecord lat lon = record latLonName [Field (FieldName "lat") $ float32 lat, Field (FieldName "lon") $ float32 lon]+latLonPolyName :: Name+latLonPolyName = Name "LatLonPoly" -latLonType :: Type m+latlonRecord :: Float -> Float -> Term+latlonRecord lat lon = record latLonName [Field (Name "lat") $ float32 lat, Field (Name "lon") $ float32 lon]++latLonType :: Type latLonType = TypeRecord $ RowType latLonName Nothing [Types.field "lat" Types.float32, Types.field "lon" Types.float32] -testContext :: Context Meta-testContext = coreContext {- contextGraph = testGraph,- contextStrategy = EvaluationStrategy {- evaluationStrategyOpaqueTermVariants = S.fromList [ -- TODO: revisit this list- TermVariantLiteral,- TermVariantElement,- TermVariantFunction]}}+latLonPolyType :: Type+latLonPolyType = TypeLambda $ LambdaType (Name "a") $+ TypeRecord $ RowType latLonPolyName Nothing [Types.field "lat" $ Types.var "a", Types.field "lon" $ Types.var "a"] -testElementArthur :: Element Meta+stringAliasType :: Type+stringAliasType = TypeWrap $ WrappedType stringAliasTypeName Types.string++stringAliasTypeName :: Name+stringAliasTypeName = Name "StringTypeAlias"++testElementArthur :: Element testElementArthur = Element { elementName = Name "ArthurDent",- elementSchema = element $ Name "Person", elementData = testDataArthur} -testElementFirstName :: Element Meta+testElementFirstName :: Element testElementFirstName = Element { elementName = Name "firstName",- elementSchema = encodeType (Types.function (Types.nominal testTypePersonName) Types.string),- elementData = projection testTypePersonName $ FieldName "firstName"}+ elementData = project testTypePersonName $ Name "firstName"} -testGraph :: Graph Meta-testGraph = elementsToGraph (Just testSchemaGraph) [testElementArthur, testElementFirstName]+testGraph :: Graph+testGraph = elementsToGraph hydraCore (Just testSchemaGraph) [testElementArthur, testElementFirstName] testNamespace :: Namespace testNamespace = Namespace "testGraph" -testSchemaGraph :: Graph Meta-testSchemaGraph = standardGraph [- def (Name "StringTypeAlias") $ Standard.doc "An alias for the string type" Types.string,+testSchemaGraph :: Graph+testSchemaGraph = elementsToGraph hydraCore (Just hydraCore) [+ def stringAliasTypeName $ Ann.doc "An alias for the string type" stringAliasType, def testTypeFoobarValueName testTypeFoobarValue,+ def testTypeNumberName testTypeNumber, def testTypeComparisonName testTypeComparison, def latLonName latLonType,+ def latLonPolyName latLonPolyType, def testTypePersonName testTypePerson, def testTypePersonOrSomethingName testTypePersonOrSomething, def testTypeTimestampName testTypeTimestamp]@@ -66,16 +71,13 @@ testSchemaNamespace :: Namespace testSchemaNamespace = Namespace "testSchemaGraph" -testStrategy :: EvaluationStrategy-testStrategy = contextStrategy testContext--testDataArthur :: Term Meta+testDataArthur :: Term testDataArthur = record testTypePersonName [- Field (FieldName "firstName") $ string "Arthur",- Field (FieldName "lastName") $ string "Dent",- Field (FieldName "age") $ int32 42]+ Field (Name "firstName") $ string "Arthur",+ Field (Name "lastName") $ string "Dent",+ Field (Name "age") $ int32 42] -testTypeComparison :: Type m+testTypeComparison :: Type testTypeComparison = TypeUnion $ RowType testTypeComparisonName Nothing [ Types.field "lessThan" Types.unit, Types.field "equalTo" Types.unit,@@ -84,7 +86,7 @@ testTypeComparisonName :: Name testTypeComparisonName = Name "Comparison" -testTypeFoobarValue :: Type m+testTypeFoobarValue :: Type testTypeFoobarValue = TypeUnion $ RowType testTypeFoobarValueName Nothing [ Types.field "bool" Types.boolean, Types.field "string" Types.string,@@ -93,7 +95,15 @@ testTypeFoobarValueName :: Name testTypeFoobarValueName = Name "FoobarValue" -testTypePerson :: Type Meta+testTypeNumber :: Type+testTypeNumber = TypeUnion $ RowType testTypeNumberName Nothing [+ Types.field "int" Types.int32,+ Types.field "float" Types.float32]++testTypeNumberName :: Name+testTypeNumberName = Name "Number"++testTypePerson :: Type testTypePerson = TypeRecord $ RowType testTypePersonName Nothing [ Types.field "firstName" Types.string, Types.field "lastName" Types.string,@@ -102,18 +112,18 @@ testTypePersonName :: Name testTypePersonName = Name "Person" -testTypePersonOrSomething :: Type Meta+testTypePersonOrSomething :: Type testTypePersonOrSomething = Types.lambda "a" $ TypeUnion $ RowType testTypePersonOrSomethingName Nothing [ Types.field "person" testTypePerson,- Types.field "other" $ Types.variable "a"]+ Types.field "other" $ Types.var "a"] testTypePersonOrSomethingName :: Name testTypePersonOrSomethingName = Name "PersonOrSomething" -testTypeTimestamp :: Type Meta+testTypeTimestamp :: Type testTypeTimestamp = TypeUnion $ RowType testTypeTimestampName Nothing [- FieldType (FieldName "unixTimeMillis") Types.uint64,- FieldType (FieldName "date") Types.string]+ FieldType (Name "unixTimeMillis") Types.uint64,+ FieldType (Name "date") Types.string] testTypeTimestampName :: Name testTypeTimestampName = Name "Timestamp"
+ src/test/haskell/Hydra/TestSuiteSpec.hs view
@@ -0,0 +1,44 @@+module Hydra.TestSuiteSpec where++import Hydra.Kernel+import qualified Hydra.Dsl.Terms as Terms+import Hydra.TestUtils+import Hydra.Testing++import Hydra.Test.TestSuite++import qualified Control.Monad as CM+import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Maybe as Y+++runTestSuite :: H.SpecWith ()+runTestSuite = do+ runTestGroup allTests++runTestCase :: Int -> TestCase -> H.SpecWith ()+runTestCase idx tc = H.it desc $+ shouldSucceedWith+ (eval $ testCaseInput tc)+ (testCaseOutput tc)+ where+ desc = Y.fromMaybe ("test #" ++ show idx) $ testCaseDescription tc++runTestGroup :: TestGroup -> H.SpecWith ()+runTestGroup tg = do+ H.describe desc $ do+ CM.sequence (L.zipWith runTestCase [1..] (testGroupCases tg))+ + CM.sequence (runTestGroup <$> (testGroupSubgroups tg))+ return ()+ where+ desc = testGroupName tg ++ case testGroupDescription tg of+ Nothing -> ""+ Just d -> " (" ++ d ++ ")"++spec :: H.Spec+spec = do+ runTestSuite
src/test/haskell/Hydra/TestUtils.hs view
@@ -6,6 +6,7 @@ checkDataAdapter, checkSerdeRoundTrip, checkSerialization,+ eval, shouldFail, shouldSucceedWith, strip,@@ -13,47 +14,51 @@ module Hydra.TestGraph, ) where -import Hydra.ArbitraryCore()- import Hydra.Kernel+import Hydra.LiteralAdapters+import Hydra.TermAdapters+import Hydra.AdapterUtils+ import Hydra.TestGraph-import Hydra.Adapters.Literal-import Hydra.Adapters.Term-import Hydra.Adapters.UtilsEtc+import Hydra.ArbitraryCore() import qualified Test.Hspec as H import qualified Test.HUnit.Lang as HL 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 qualified Data.ByteString.Lazy as BS -baseLanguage :: Language m+baseLanguage :: Language baseLanguage = hydraCoreLanguage -baseContext :: AdapterContext Meta-baseContext = AdapterContext testContext baseLanguage baseLanguage+baseContext :: AdapterContext+baseContext = AdapterContext testGraph baseLanguage M.empty checkAdapter :: (Eq t, Eq v, Show t, Show v) => (v -> v)- -> (t -> Flow (AdapterContext Meta) (SymmetricAdapter (Context Meta) t v))- -> ([r] -> AdapterContext Meta)+ -> (t -> Flow AdapterContext (SymmetricAdapter AdapterContext t v))+ -> ([r] -> AdapterContext) -> [r] -> t -> t -> Bool -> v -> v -> H.Expectation checkAdapter normalize mkAdapter mkContext variants source target lossy vs vt = do- let acx = mkContext variants :: AdapterContext Meta- let cx = adapterContextEvaluation acx- let FlowState adapter' _ trace = unFlow (mkAdapter source) acx emptyTrace+ let cx0 = mkContext variants :: AdapterContext+ let g = adapterContextGraph cx0+ let FlowState adapter' cx trace = unFlow (mkAdapter source) cx0 emptyTrace if Y.isNothing adapter' then HL.assertFailure (traceSummary trace) else pure () let adapter = Y.fromJust adapter'- let step = adapterCoder adapter+ let step = Coder encode decode+ where+ encode = withState cx . coderEncode (adapterCoder adapter)+ decode = withState cx . coderDecode (adapterCoder adapter) adapterSource adapter `H.shouldBe` source adapterTarget adapter `H.shouldBe` target adapterIsLossy adapter `H.shouldBe` lossy- fromFlow cx (normalize <$> coderEncode step vs) `H.shouldBe` (normalize vt)+ fromFlow vt g (normalize <$> coderEncode step vs) `H.shouldBe` (normalize vt) if lossy then True `H.shouldBe` True- else fromFlow cx (coderEncode step vs >>= coderDecode step) `H.shouldBe` vs+ else fromFlow vs g (coderEncode step vs >>= coderDecode step) `H.shouldBe` vs checkLiteralAdapter :: [LiteralVariant] -> LiteralType -> LiteralType -> Bool -> Literal -> Literal -> H.Expectation checkLiteralAdapter = checkAdapter id literalAdapter context@@ -66,7 +71,7 @@ floatVars = S.fromList [FloatTypeFloat32] integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32] -checkFieldAdapter :: [TypeVariant] -> FieldType Meta -> FieldType Meta -> Bool -> Field Meta -> Field Meta -> H.Expectation+checkFieldAdapter :: [TypeVariant] -> FieldType -> FieldType -> Bool -> Field -> Field -> H.Expectation checkFieldAdapter = checkAdapter id fieldAdapter termTestContext checkFloatAdapter :: [FloatType] -> FloatType -> FloatType -> Bool -> FloatValue -> FloatValue -> H.Expectation@@ -81,23 +86,23 @@ context variants = withConstraints $ (languageConstraints baseLanguage) { languageConstraintsIntegerTypes = S.fromList variants } -checkDataAdapter :: [TypeVariant] -> Type Meta -> Type Meta -> Bool -> Term Meta -> Term Meta -> H.Expectation+checkDataAdapter :: [TypeVariant] -> Type -> Type -> Bool -> Term -> Term -> H.Expectation checkDataAdapter = checkAdapter stripTerm termAdapter termTestContext -checkSerdeRoundTrip :: (Type Meta -> GraphFlow Meta (Coder (Context Meta) (Context Meta) (Term Meta) BS.ByteString))- -> TypedTerm Meta -> H.Expectation-checkSerdeRoundTrip mkSerde (TypedTerm typ term) = do+checkSerdeRoundTrip :: (Type -> Flow Graph (Coder Graph Graph Term BS.ByteString))+ -> TypedTerm -> H.Expectation+checkSerdeRoundTrip mkSerde (TypedTerm term typ) = do case mserde of Nothing -> HL.assertFailure (traceSummary trace) Just serde -> shouldSucceedWith (stripTerm <$> (coderEncode serde term >>= coderDecode serde)) (stripTerm term) where- FlowState mserde _ trace = unFlow (mkSerde typ) testContext emptyTrace+ FlowState mserde _ trace = unFlow (mkSerde typ) testGraph emptyTrace -checkSerialization :: (Type Meta -> GraphFlow Meta (Coder (Context Meta) (Context Meta) (Term Meta) String))- -> TypedTerm Meta -> String -> H.Expectation-checkSerialization mkSerdeStr (TypedTerm typ term) expected = do+checkSerialization :: (Type -> Flow Graph (Coder Graph Graph Term String))+ -> TypedTerm -> String -> H.Expectation+checkSerialization mkSerdeStr (TypedTerm term typ) expected = do case mserde of Nothing -> HL.assertFailure (traceSummary trace) Just serde -> shouldSucceedWith@@ -105,29 +110,32 @@ (normalize expected) where normalize = unlines . L.filter (not . L.null) . lines- FlowState mserde _ trace = unFlow (mkSerdeStr typ) testContext emptyTrace+ FlowState mserde _ trace = unFlow (mkSerdeStr typ) testGraph emptyTrace -shouldFail :: GraphFlow Meta a -> H.Expectation-shouldFail f = H.shouldBe True (Y.isNothing $ flowStateValue $ unFlow f testContext emptyTrace)+eval :: Term -> Flow Graph Term+eval = reduceTerm True M.empty -shouldSucceed :: GraphFlow Meta a -> H.Expectation+shouldFail :: Flow Graph a -> H.Expectation+shouldFail f = H.shouldBe True (Y.isNothing $ flowStateValue $ unFlow f testGraph emptyTrace)++shouldSucceed :: Flow Graph a -> H.Expectation shouldSucceed f = case my of Nothing -> HL.assertFailure (traceSummary trace) Just y -> True `H.shouldBe` True where- FlowState my _ trace = unFlow f testContext emptyTrace+ FlowState my _ trace = unFlow f testGraph emptyTrace -shouldSucceedWith :: (Eq a, Show a) => GraphFlow Meta a -> a -> H.Expectation+shouldSucceedWith :: (Eq a, Show a) => Flow Graph a -> a -> H.Expectation shouldSucceedWith f x = case my of Nothing -> HL.assertFailure (traceSummary trace) Just y -> y `H.shouldBe` x where- FlowState my _ trace = unFlow f testContext emptyTrace+ FlowState my _ trace = unFlow f testGraph emptyTrace -strip :: Ord m => Term m -> Term m+strip :: Term -> Term strip = stripTerm -termTestContext :: [TypeVariant] -> AdapterContext Meta+termTestContext :: [TypeVariant] -> AdapterContext termTestContext variants = withConstraints $ (languageConstraints baseLanguage) { languageConstraintsTypeVariants = S.fromList variants, languageConstraintsLiteralVariants = literalVars,@@ -138,5 +146,5 @@ floatVars = S.fromList [FloatTypeFloat32] integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32] -withConstraints :: LanguageConstraints Meta -> AdapterContext Meta-withConstraints c = baseContext { adapterContextTarget = baseLanguage { languageConstraints = c }}+withConstraints :: LanguageConstraints -> AdapterContext+withConstraints c = baseContext { adapterContextLanguage = baseLanguage { languageConstraints = c }}
+ src/test/haskell/Hydra/Tools/SerializationSpec.hs view
@@ -0,0 +1,113 @@+module Hydra.Tools.SerializationSpec where++import qualified Test.Hspec as H++import Hydra.Ast+import Hydra.Tools.Serialization+import Hydra.Langs.Haskell.Operators+++check :: Expr -> String -> H.Expectation+check expr printed = printExpr (parenthesize expr) `H.shouldBe` printed++cases :: Expr -> [(Expr, Expr)] -> Expr+cases cond cases = ifx ofOp lhs rhs+ where+ lhs = spaceSep [cst "case", cond]+ rhs = newlineSep (uncurry (ifx caseOp) <$> cases)+ ofOp = Op (Symbol "of") (Padding WsSpace $ WsBreakAndIndent " ") (Precedence 0) AssociativityNone++lam :: [String] -> Expr -> Expr+lam vars = ifx lambdaOp $ cst $ "\\" ++ unwords vars++checkAssociativity :: H.SpecWith ()+checkAssociativity = do+ H.describe "Unit tests to verify that associativity is respected" $ do++ H.it "Right-associative operator" $ do+ check+ (ifx arrowOp (ifx arrowOp (cst "a") (cst "b")) (ifx arrowOp (cst "c") (cst "d")))+ "(a -> b) -> c -> d"++checkCaseStatements :: H.SpecWith ()+checkCaseStatements = do+ H.describe "Unit tests for case statements" $ do++ H.it "Simple case statement" $ do+ check+ (cases (ifx gtOp (cst "x") (num 42)) [(cst "False", cst "Big"), (cst "True", cst "Small")])+ ( "case x > 42 of\n"+ ++ " False -> Big\n"+ ++ " True -> Small")++ H.it "Nested case statement" $ do+ check+ (cases (ifx gtOp (cst "x") (num 42)) [+ (cst "True", cases (ifx gtOp (cst "x") (num 100)) [(cst "True", cst "ReallyBig"), (cst "False", cst "Big")]),+ (cst "False", cst "Small")])+ ( "case x > 42 of\n"+ ++ " True -> case x > 100 of\n"+ ++ " True -> ReallyBig\n"+ ++ " False -> Big\n"+ ++ " False -> Small")++checkLambdas :: H.SpecWith ()+checkLambdas = do+ H.describe "Unit tests for lambda expressions" $ do++ H.it "Simple lambda" $ do+ check+ (lam ["x", "y"] (ifx plusOp (cst "x") (cst "y")))+ "\\x y -> x + y"++checkLists :: H.SpecWith ()+checkLists = do+ H.describe "Unit tests for list expressions" $ do++ H.it "Empty list" $ do+ check+ (bracketList inlineStyle [])+ "[]"++ H.it "Simple non-empty list" $ do+ check+ (bracketList inlineStyle [num 1, num 2, num 3])+ "[1, 2, 3]"++ H.it "Nested list" $ do+ check+ (bracketList inlineStyle [bracketList inlineStyle [num 1, num 3], num 2])+ "[[1, 3], 2]"++ H.it "List with parenthesized expression inside" $ do+ check+ (bracketList inlineStyle [bracketList inlineStyle [num 1, ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10))], num 2])+ "[[1, (2 + 3) * (1 + 10)], 2]"++checkPrecedence :: H.SpecWith ()+checkPrecedence = do+ H.describe "Unit tests to verify that operator precedence is respected" $ do++ H.it "Check expressions with operators of different precedence" $ do+ check+ (ifx plusOp (ifx multOp (num 2) (num 3)) (ifx multOp (num 1) (num 10)))+ "2 * 3 + 1 * 10"+ check+ (ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10)))+ "(2 + 3) * (1 + 10)"++ H.it "Check an operator which is both left- and right-associative" $ do+ check+ (ifx multOp (cst "x") (ifx multOp (cst "y") (cst "z")))+ "x * y * z"+ check+ (ifx multOp (ifx multOp (cst "x") (cst "y")) (cst "z"))+ "x * y * z"++spec :: H.Spec+spec = do+ checkAssociativity+ checkCaseStatements+ checkLambdas+ checkLists+ checkPrecedence
+ src/test/haskell/Hydra/Tools/SortingSpec.hs view
@@ -0,0 +1,145 @@+module Hydra.Tools.SortingSpec where++import qualified Test.Hspec as H++import Hydra.Tools.Sorting+++checkSort :: (Ord a, Show a) => [(a, [a])] -> Either [[a]] [a] -> H.Expectation+checkSort adj exp = H.shouldBe (topologicalSort adj) exp++checkSortSCC :: (Ord a, Show a) => [(a, [a])] -> [[a]] -> H.Expectation+checkSortSCC adj exp = H.shouldBe (topologicalSortComponents adj) exp++checkSortDiscreteSet :: H.SpecWith ()+checkSortDiscreteSet = H.describe "Check sorting of discrete sets (no dependencies)" $ do++ H.it "Empty set" $+ checkSort [] (Right [] :: Either [[Int]] [Int])++ H.it "Singleton set" $+ checkSort [(1, [])]+ (Right [1])++ H.it "Discrete set with multiple elements" $+ checkSort [(3, []), (1, []), (2, [])]+ (Right [3, 2, 1])++checkSortTreesAndDags :: H.SpecWith ()+checkSortTreesAndDags = H.describe "Check sorting of trees and DAGs" $ do++ H.it "Linked list" $+ checkSort [(3, [1]), (2, [3]), (1, [])]+ (Right [1, 3, 2])++ H.it "Binary tree" $+ checkSort [(3, [1, 4]), (4, [6, 2]), (1, [5]), (2, []), (6, []), (5, [])]+ (Right [6, 5, 2, 4, 1, 3])++ H.it "Two trees" $+ checkSort [(3, [1, 4]), (5, [6, 2]), (2, [7]), (1, []), (4, []), (6, []), (7, [])]+ (Right [7, 6, 4, 2, 5, 1, 3])++ H.it "Diamond (DAG)" $+ checkSort [(1, [3, 4]), (3, [2]), (4, [2]), (2, [5]), (5, [])]+ (Right [5, 2, 3, 4, 1])++checkSortCycles :: H.SpecWith ()+checkSortCycles = H.describe "Check that sorting of graphs with cycles fails" $ do++ H.it "Two-node cycle" $+ checkSort [(1, [2]), (2, [1])]+ (Left [[1, 2]])++ H.it "Cycle with incoming and outgoing edges" $+ checkSort [(1, [3]), (3, [2]), (2, [3, 4]), (4, [5]), (5, [])]+ (Left [[2, 3]])++checkSortSCCDiscreteSet :: H.SpecWith ()+checkSortSCCDiscreteSet = H.describe "Check sorting of discrete sets (no dependencies)" $ do++ H.it "Empty set" $+ checkSortSCC []+ ([] :: [[Int]])++ H.it "Singleton set" $+ checkSortSCC [(1, [])]+ [[1]]++ H.it "Discrete set with multiple elements" $+ checkSortSCC [(3, []), (1, []), (2, [])]+ [[3],[2],[1]]++checkSortSCCWeaklyConnectedComponents :: H.SpecWith ()+checkSortSCCWeaklyConnectedComponents = H.describe "Check weakly-connected components" $ do++ H.describe "Single, two-element component" $ do+ H.it "test #1" $+ checkSortSCC [(1, [2]), (2, [])]+ [[2], [1]]+ H.it "test #2" $+ checkSortSCC [(2, [1]), (1, [])]+ [[1], [2]]++ H.it "Multiple-element component" $ do+ checkSortSCC [(2, [1, 3]), (1, [3]), (3, [])]+ [[3], [1], [2]]++checkSortSCCStronglyConnectedComponents :: H.SpecWith ()+checkSortSCCStronglyConnectedComponents = H.describe "Check strongly-connected components" $ do++ H.describe "Cycle of two nodes" $ do+ H.it "test #1" $+ checkSortSCC [(1, [2]), (2, [1])]+ [[1, 2]]+ H.it "test #2" $+ checkSortSCC [(2, [1]), (1, [2])]+ [[1, 2]]++ H.describe "Cycle of three nodes, ordered naturally" $ do++ H.it "test #1" $+ checkSortSCC [(1, [2]), (2, [3]), (3, [1])]+ [[1, 2, 3]]+ H.it "test #2" $+ checkSortSCC [(2, [1]), (3, [2]), (1, [3])]+ [[1, 2, 3]]++ H.it "Multiple, disconnected cycles, each ordered naturally" $ do+ checkSortSCC+ ([(200, [])] ++ [(100, [])] ++ [(300, [])] ++ [(10, [20]), (20, [10])] ++ [(1, [2]), (2, [3]), (3, [1])])+ [[300], [200], [100], [10, 20], [1, 2, 3]]++ H.it "Complex cycles" $ do+ checkSortSCC [(1, [2, 3]), (2, [3]), (3, [1])]+ [[1, 2, 3]]++checkSortSCCMixed :: H.SpecWith ()+checkSortSCCMixed = H.describe "Check graphs which are a mix of weakly- and strongly-connected components" $ do++ H.it "Chain of three SCCs" $+ checkSortSCC+ [(1, [2, 10]), (2, [3]), (3, [1]), (10, [20]), (20, [100, 10]), (100, [])]+ [[100], [10, 20], [1, 2, 3]]++ H.it "SCCs with dependencies to/from non-SCC nodes" $+ checkSortSCC+ [(1, [2, 3, 10]), (2, [3]), (3, [1]),+ (10, [20, 30]), (20, [30]), (30, []),+ (100, [200, 2]), (200, []), (300, [100]),+ (1000, []),+ (2000, [])]+ [[2000], [1000], [200], [30], [20], [10], [1, 2, 3], [100], [300]]++spec :: H.Spec+spec = do+ H.describe "Check topological sort (without cycles)" $ do+ checkSortDiscreteSet+ checkSortTreesAndDags+ checkSortCycles++ H.describe "Check sorting of strongly connected components" $ do+ checkSortSCCDiscreteSet+ checkSortSCCWeaklyConnectedComponents+ checkSortSCCStronglyConnectedComponents+ checkSortSCCMixed
− src/test/haskell/Hydra/Types/InferenceSpec.hs
@@ -1,353 +0,0 @@-module Hydra.Types.InferenceSpec where--import Hydra.Kernel-import Hydra.Impl.Haskell.Sources.Libraries-import Hydra.Types.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Impl.Haskell.Dsl.Standard as Standard-import qualified Hydra.Impl.Haskell.Dsl.Types as Types-import Hydra.Impl.Haskell.Dsl.Terms as Terms--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.Map as M-import qualified Data.Set as S---checkType :: Term (Meta, Type Meta, [Constraint Meta]) -> Type Meta -> H.Expectation-checkType term typ = typeAnn term `H.shouldBe` typ- where- typeAnn (TermAnnotated (Annotated _ (_, typ, _))) = typ--expectMonotype :: Term Meta -> Type Meta -> H.Expectation-expectMonotype term = expectPolytype term []--expectPolytype :: Term Meta-> [String] -> Type Meta -> H.Expectation-expectPolytype term vars typ = do- shouldSucceedWith- (snd <$> inferType term)- (TypeScheme (VariableType <$> vars) typ)--checkApplicationTerms :: H.SpecWith ()-checkApplicationTerms = do- H.describe "Check a few hand-picked application terms" $ do-- H.it "Check lambda applications" $ do- expectMonotype- (apply (lambda "x" (variable "x")) (string "foo"))- Types.string-- H.it "Check data (delta) applications" $ do- expectMonotype- (apply delta (element $ Name "ArthurDent"))- testTypePerson--- expectMonotype--- (apply termExpr describeType)--- (Types.function (Types.nominal _Type) Types.string)-- H.it "Check mixed expressions with lambdas, constants, and primitive functions" $ do- expectMonotype- (lambda "x" $- apply- (apply (primitive _math_sub) (apply (apply (primitive _math_add) (variable "x")) (variable "x")))- (int32 1))- (Types.function Types.int32 Types.int32)--checkFunctionTerms :: H.SpecWith ()-checkFunctionTerms = do- H.describe "Check a few hand-picked function terms" $ do-- H.it "Check lambdas" $ do- expectPolytype- (lambda "x" (variable "x"))- ["v1"] (Types.function (Types.variable "v1") (Types.variable "v1"))- expectPolytype- (lambda "x" (int16 137))- ["v1"] (Types.function (Types.variable "v1") Types.int16)-- H.it "Check 'compareTo' terms" $ do- expectMonotype- (compareTo $ optional (Just $ string "Betelgeuse"))- (Types.function (Types.optional Types.string) Types.int8)- expectPolytype- (lambda "x" $ compareTo (variable "x"))- ["v1"] (Types.function (Types.variable "v1") (Types.function (Types.variable "v1") Types.int8))-- H.it "Check list eliminations" $ do- let fun = Terms.fold $ primitive _math_add- expectMonotype- fun- (Types.functionN [Types.int32, Types.list Types.int32] Types.int32)- expectMonotype- (apply fun $ int32 0)- (Types.function (Types.list Types.int32) Types.int32)- expectMonotype- (apply (apply fun $ int32 0) (list (int32 <$> [1, 2, 3, 4, 5])))- Types.int32-- H.it "Check projections" $ do- expectMonotype- (projection testTypePersonName (FieldName "firstName"))- (Types.function testTypePerson Types.string)-- H.it "Check case statements" $ do- expectMonotype- (cases testTypeFoobarValueName [- Field (FieldName "bool") (lambda "x" (boolean True)),- Field (FieldName "string") (lambda "x" (boolean False)),- Field (FieldName "unit") (lambda "x" (boolean False))])- (Types.function testTypeFoobarValue Types.boolean)- expectPolytype- (cases testTypePersonOrSomethingName [- Field (FieldName "person") (apply delta (element $ Name "firstName")),- Field (FieldName "other") (lambda "x" (string "NONE"))])- ["v1"] (Types.function- (TypeUnion $ RowType testTypePersonOrSomethingName Nothing [- Types.field "person" $ TypeRecord $ RowType testTypePersonName Nothing [- Types.field "firstName" Types.string,- Types.field "lastName" Types.string,- Types.field "age" Types.int32],- Types.field "other" $ Types.variable "v1"])- Types.string)--checkIndividualTerms :: H.SpecWith ()-checkIndividualTerms = do- H.describe "Check a few hand-picked terms" $ do-- H.it "Check literal values" $ do- expectMonotype- (int32 42)- Types.int32- expectMonotype- (string "foo")- Types.string- expectMonotype- (boolean False)- Types.boolean- expectMonotype- (float64 42.0)- Types.float64-- H.it "Check let terms" $ do- expectPolytype- (letTerm (Variable "x") (float32 42.0) (lambda "y" (lambda "z" (variable "x"))))- ["v1", "v2"] (Types.function (Types.variable "v1") (Types.function (Types.variable "v2") Types.float32))-- H.it "Check elements" $ do- expectMonotype- (element $ Name "ArthurDent")- (Types.element testTypePerson) -- Note: the resolved element type is the raw record type associated with "Person", not the nominal type "Person".- expectMonotype- (element $ Name "firstName")- (Types.element (Types.function (Types.nominal $ Name "Person") Types.string))-- H.it "Check optionals" $ do- expectMonotype- (optional $ Just $ int32 42)- (Types.optional Types.int32)- expectPolytype- (optional Nothing)- ["v1"] (Types.optional $ Types.variable "v1")-- H.it "Check records" $ do- expectMonotype- (record latLonName [Field (FieldName "lat") $ float32 37.7749, Field (FieldName "lon") $ float32 $ negate 122.4194])- (TypeRecord $ RowType latLonName Nothing [FieldType (FieldName "lat") Types.float32, FieldType (FieldName "lon") Types.float32])--- expectPolytype--- (lambda "lon" (record latLonName [Field (FieldName "lat") $ float32 37.7749, Field (FieldName "lon") $ variable "lon"]))--- ["v1"] (Types.function (Types.variable "v1")--- (TypeRecord $ RowType latLonName Nothing [FieldType (FieldName "lat") Types.float32, FieldType (FieldName "lon") $ Types.variable "v1"]))-- H.it "Check unions" $ do- expectMonotype- (union testTypeTimestampName $ Field (FieldName "unixTimeMillis") $ uint64 1638200308368)- testTypeTimestamp-- H.it "Check sets" $ do- expectMonotype- (set $ S.fromList [boolean True])- (Types.set Types.boolean)- expectPolytype- (set $ S.fromList [set S.empty])- ["v1"] (Types.set $ Types.set $ Types.variable "v1")-- H.it "Check maps" $ do- expectMonotype- (mapTerm $ M.fromList [(string "firstName", string "Arthur"), (string "lastName", string "Dent")])- (Types.map Types.string Types.string)- expectPolytype- (mapTerm M.empty)- ["v1", "v2"] (Types.map (Types.variable "v1") (Types.variable "v2"))- expectPolytype- (lambda "x" (lambda "y" (mapTerm $ M.fromList- [(variable "x", float64 0.1), (variable "y", float64 0.2)])))- ["v1"] (Types.function (Types.variable "v1") (Types.function (Types.variable "v1") (Types.map (Types.variable "v1") Types.float64)))-- -- TODO: restore me, and add a case for a recursive nominal type -- e.g. MyList := () + (int, Mylist)--- H.it "Check nominal (newtype) terms" $ do--- expectMonotype--- testDataArthur--- (Types.nominal "Person")--- expectMonotype--- (lambda "x" (record [--- Field "firstName" $ variable "x",--- Field "lastName" $ variable "x",--- Field "age" $ int32 42]))--- (Types.function Types.string testTypePerson)--checkLists :: H.SpecWith ()-checkLists = do- H.describe "Check a few hand-picked list terms" $ do-- H.it "Check list of strings" $ do- expectMonotype- (list [string "foo", string "bar"])- (Types.list Types.string)- H.it "Check list of lists of strings" $ do- expectMonotype- (list [list [string "foo"], list []])- (Types.list $ Types.list Types.string)- H.it "Check empty list" $ do- expectPolytype- (list [])- ["v1"] (Types.list $ Types.variable "v1")- H.it "Check list containing an empty list" $ do- expectPolytype- (list [list []])- ["v1"] (Types.list $ Types.list $ Types.variable "v1")- H.it "Check lambda producing a list of integers" $ do- expectMonotype- (lambda "x" (list [variable "x", int32 42]))- (Types.function Types.int32 $ Types.list Types.int32)- H.it "Check list with bound variables" $ do- expectMonotype- (lambda "x" (list [variable "x", string "foo", variable "x"]))- (Types.function Types.string (Types.list Types.string))--checkLiterals :: H.SpecWith ()-checkLiterals = do- H.describe "Check arbitrary literals" $ do-- H.it "Verify that type inference preserves the literal to literal type mapping" $- QC.property $ \l -> expectMonotype- (TermLiteral l)- (Types.literal $ literalType l)--checkNominalTerms :: H.SpecWith ()-checkNominalTerms = do- H.describe "Check nominal introductions and eliminations" $ do-- H.it "Check nominal introductions" $ do- expectMonotype- (nominal (Name "StringTypeAlias") $ string "foo")- stringAliasType- expectMonotype- (lambda "v" $ nominal (Name "StringTypeAlias") $ variable "v")- (Types.function Types.string stringAliasType)-- H.it "Check nominal eliminations" $ do- expectMonotype- (eliminateNominal $ Name "StringTypeAlias")- (Types.function stringAliasType (Standard.doc "An alias for the string type" Types.string))- expectMonotype- (apply (eliminateNominal $ Name "StringTypeAlias") (nominal (Name "StringTypeAlias") $ string "foo"))- Types.string--checkPrimitiveFunctions :: H.SpecWith ()-checkPrimitiveFunctions = do- H.describe "Check a few hand-picked terms with primitive functions" $ do-- H.it "Check monomorphic primitive functions" $ do- expectMonotype- (primitive $ Name "hydra/lib/strings.length")- (Types.function Types.string Types.int32)- expectMonotype- (primitive _math_sub)- (Types.function Types.int32 (Types.function Types.int32 Types.int32))-- H.it "Check polymorphic primitive functions" $ do- expectPolytype- (lambda "els" (apply (primitive _lists_length) (apply (primitive _lists_concat) $ variable "els")))- ["v1"] (Types.function (Types.list $ Types.list $ Types.variable "v1") Types.int32)--checkProducts :: H.SpecWith ()-checkProducts = do- H.describe "Check a few hand-picked product terms" $ do-- H.it "Check empty product" $ do- expectMonotype- (Terms.product [])- (Types.product [])-- H.it "Check non-empty, monotyped products" $ do- expectMonotype- (Terms.product [string "foo", int32 42])- (Types.product [Types.string, Types.int32])- expectMonotype- (Terms.product [string "foo", list [float32 42.0, float32 137.0]])- (Types.product [Types.string, Types.list Types.float32])-- H.it "Check polytyped products" $ do- expectPolytype- (Terms.product [list [], string "foo"])- ["v1"] (Types.product [Types.list $ Types.variable "v1", Types.string])--checkSums :: H.SpecWith ()-checkSums = do- H.describe "Check a few hand-picked sum terms" $ do-- H.it "Check singleton sum terms" $ do- expectMonotype- (Terms.sum 0 1 $ string "foo")- (Types.sum [Types.string])- expectPolytype- (Terms.sum 0 1 $ list [])- ["v1"] (Types.sum [Types.list $ Types.variable "v1"])-- H.it "Check non-singleton sum terms" $ do- expectPolytype- (Terms.sum 0 2 $ string "foo")- ["v1"] (Types.sum [Types.string, Types.variable "v1"])- expectPolytype- (Terms.sum 1 2 $ string "foo")- ["v1"] (Types.sum [Types.variable "v1", Types.string])--checkTypeAnnotations :: H.SpecWith ()-checkTypeAnnotations = do- H.describe "Check that type annotations are added to terms and subterms" $ do-- H.it "Check literals" $- QC.property $ \l -> do- let term = TermLiteral l- let term1 = fromFlow testContext (fst <$> inferType term)- checkType term1 (Types.literal $ literalType l)-- H.it "Check lists of literals" $- QC.property $ \l -> do- let term = TermList [TermLiteral l]- let term1 = fromFlow testContext (fst <$> inferType term)- checkType term1 (Types.list $ Types.literal $ literalType l)- let (TermAnnotated (Annotated (TermList [term2]) _)) = term1- checkType term2 (Types.literal $ literalType l)--checkTypedTerms :: H.SpecWith ()-checkTypedTerms = do- H.describe "Check that term/type pairs are consistent with type inference" $ do-- H.it "Check arbitrary typed terms" $- QC.property $ \(TypedTerm typ term) -> expectMonotype term typ--spec :: H.Spec-spec = do- checkApplicationTerms- checkFunctionTerms- checkIndividualTerms- checkLists- checkLiterals- checkNominalTerms- checkPrimitiveFunctions- checkProducts- checkSums- checkTypeAnnotations--- checkTypedTerms
− src/test/haskell/Hydra/Types/UnificationSpec.hs
@@ -1,36 +0,0 @@-module Hydra.Types.UnificationSpec where--import Hydra.Kernel-import Hydra.Types.Unification-import Hydra.TestUtils-import qualified Hydra.Impl.Haskell.Dsl.Types as Types--import qualified Test.Hspec as H-import qualified Data.Map as M---expectUnified :: [Constraint Meta] -> [(VariableType, Type Meta)] -> H.Expectation-expectUnified constraints subst = shouldSucceedWith- (solveConstraints constraints)- (M.fromList subst)--checkIndividualConstraints :: H.SpecWith ()-checkIndividualConstraints = do- H.describe "Check a few hand-crafted constraints" $ do-- H.it "Unify nothing" $- expectUnified [] []-- H.it "Unify variable with variable" $- expectUnified- [(Types.variable "a", Types.variable "b")]- [(VariableType "a", Types.variable "b")]-- H.it "Unify variable with literal type" $- expectUnified- [(Types.variable "a" :: Type Meta, Types.string)]- [(VariableType "a", Types.string)]--spec :: H.Spec-spec = do- checkIndividualConstraints
+ src/test/haskell/Hydra/UnificationSpec.hs view
@@ -0,0 +1,36 @@+module Hydra.UnificationSpec where++import Hydra.Kernel+import Hydra.Unification+import Hydra.TestUtils+import qualified Hydra.Dsl.Types as Types++import qualified Test.Hspec as H+import qualified Data.Map as M+++expectUnified :: [Constraint] -> [(Name, Type)] -> H.Expectation+expectUnified constraints subst = shouldSucceedWith+ (solveConstraints constraints)+ (M.fromList subst)++checkIndividualConstraints :: H.SpecWith ()+checkIndividualConstraints = do+ H.describe "Check a few hand-crafted constraints" $ do++ H.it "Unify nothing" $+ expectUnified [] []++ H.it "Unify variable with variable" $+ expectUnified+ [(Types.var "a", Types.var "b")]+ [(Name "b", Types.var "a")]++ H.it "Unify variable with literal type" $+ expectUnified+ [(Types.var "a" :: Type, Types.string)]+ [(Name "a", Types.string)]++spec :: H.Spec+spec = do+ checkIndividualConstraints
− src/test/haskell/Hydra/Util/Codetree/PrintSpec.hs
@@ -1,113 +0,0 @@-module Hydra.Util.Codetree.PrintSpec where--import qualified Test.Hspec as H--import Hydra.Util.Codetree.Ast-import Hydra.Util.Codetree.Script-import Hydra.Ext.Haskell.Operators---check :: Expr -> String -> H.Expectation-check expr printed = printExpr (parenthesize expr) `H.shouldBe` printed--caseStatement :: Expr -> [(Expr, Expr)] -> Expr-caseStatement cond cases = ifx ofOp lhs rhs- where- lhs = spaceSep [cst "case", cond]- rhs = newlineSep (uncurry (ifx caseOp) <$> cases)- ofOp = Op (Symbol "of") (Padding WsSpace WsBreakAndIndent) (Precedence 0) AssociativityNone--lam :: [String] -> Expr -> Expr-lam vars = ifx lambdaOp $ cst $ "\\" ++ unwords vars--checkAssociativity :: H.SpecWith ()-checkAssociativity = do- H.describe "Unit tests to verify that associativity is respected" $ do-- H.it "Right-associative operator" $ do- check- (ifx arrowOp (ifx arrowOp (cst "a") (cst "b")) (ifx arrowOp (cst "c") (cst "d")))- "(a -> b) -> c -> d"--checkCaseStatements :: H.SpecWith ()-checkCaseStatements = do- H.describe "Unit tests for case statements" $ do-- H.it "Simple case statement" $ do- check- (caseStatement (ifx gtOp (cst "x") (num 42)) [(cst "False", cst "Big"), (cst "True", cst "Small")])- ( "case x > 42 of\n"- ++ " False -> Big\n"- ++ " True -> Small")-- H.it "Nested case statement" $ do- check- (caseStatement (ifx gtOp (cst "x") (num 42)) [- (cst "True", caseStatement (ifx gtOp (cst "x") (num 100)) [(cst "True", cst "ReallyBig"), (cst "False", cst "Big")]),- (cst "False", cst "Small")])- ( "case x > 42 of\n"- ++ " True -> case x > 100 of\n"- ++ " True -> ReallyBig\n"- ++ " False -> Big\n"- ++ " False -> Small")--checkLambdas :: H.SpecWith ()-checkLambdas = do- H.describe "Unit tests for lambda expressions" $ do-- H.it "Simple lambda" $ do- check- (lam ["x", "y"] (ifx plusOp (cst "x") (cst "y")))- "\\x y -> x + y"--checkLists :: H.SpecWith ()-checkLists = do- H.describe "Unit tests for list expressions" $ do-- H.it "Empty list" $ do- check- (bracketList inlineStyle [])- "[]"-- H.it "Simple non-empty list" $ do- check- (bracketList inlineStyle [num 1, num 2, num 3])- "[1, 2, 3]"-- H.it "Nested list" $ do- check- (bracketList inlineStyle [bracketList inlineStyle [num 1, num 3], num 2])- "[[1, 3], 2]"-- H.it "List with parenthesized expression inside" $ do- check- (bracketList inlineStyle [bracketList inlineStyle [num 1, ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10))], num 2])- "[[1, (2 + 3) * (1 + 10)], 2]"--checkPrecedence :: H.SpecWith ()-checkPrecedence = do- H.describe "Unit tests to verify that operator precedence is respected" $ do-- H.it "Check expressions with operators of different precedence" $ do- check- (ifx plusOp (ifx multOp (num 2) (num 3)) (ifx multOp (num 1) (num 10)))- "2 * 3 + 1 * 10"- check- (ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10)))- "(2 + 3) * (1 + 10)"-- H.it "Check an operator which is both left- and right-associative" $ do- check- (ifx multOp (cst "x") (ifx multOp (cst "y") (cst "z")))- "x * y * z"- check- (ifx multOp (ifx multOp (cst "x") (cst "y")) (cst "z"))- "x * y * z"--spec :: H.Spec-spec = do- checkAssociativity- checkCaseStatements- checkLambdas- checkLists- checkPrecedence