hydra (empty) → 0.1.0
raw patch · 162 files changed
+36696/−0 lines, 162 filesdep +HUnitdep +HsYAMLdep +QuickCheck
Dependencies added: HUnit, HsYAML, QuickCheck, aeson, aeson-pretty, base, bytestring, containers, directory, filepath, hspec, hspec-discover, hydra, scientific, split, text, unordered-containers, vector
Files
- CHANGELOG.md +16/−0
- LICENSE +201/−0
- README.md +153/−0
- hydra.cabal +234/−0
- src/gen-main/haskell/Hydra/Adapters/Utils.hs +88/−0
- src/gen-main/haskell/Hydra/Basics.hs +246/−0
- src/gen-main/haskell/Hydra/Compute.hs +277/−0
- src/gen-main/haskell/Hydra/Core.hs +652/−0
- src/gen-main/haskell/Hydra/Ext/Avro/Schema.hs +221/−0
- src/gen-main/haskell/Hydra/Ext/Graphql/Syntax.hs +1413/−0
- src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs +892/−0
- src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs +3280/−0
- src/gen-main/haskell/Hydra/Ext/Json/Model.hs +32/−0
- src/gen-main/haskell/Hydra/Ext/Owl/Syntax.hs +1211/−0
- src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs +267/−0
- src/gen-main/haskell/Hydra/Ext/Rdf/Syntax.hs +185/−0
- src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs +2264/−0
- src/gen-main/haskell/Hydra/Ext/Shacl/Model.hs +357/−0
- src/gen-main/haskell/Hydra/Ext/Shex/Syntax.hs +1818/−0
- src/gen-main/haskell/Hydra/Ext/Tinkerpop/Features.hs +321/−0
- src/gen-main/haskell/Hydra/Ext/Tinkerpop/Typed.hs +220/−0
- src/gen-main/haskell/Hydra/Ext/Tinkerpop/V3.hs +111/−0
- src/gen-main/haskell/Hydra/Ext/Xml/Schema.hs +464/−0
- src/gen-main/haskell/Hydra/Ext/Yaml/Model.hs +53/−0
- src/gen-main/haskell/Hydra/Grammar.hs +105/−0
- src/gen-main/haskell/Hydra/Mantle.hs +269/−0
- src/gen-main/haskell/Hydra/Module.hs +48/−0
- src/gen-main/haskell/Hydra/Phantoms.hs +48/−0
- src/gen-main/haskell/Hydra/Util/Codetree/Ast.hs +173/−0
- src/main/haskell/Hydra/Adapters/Coders.hs +45/−0
- src/main/haskell/Hydra/Adapters/Literal.hs +142/−0
- src/main/haskell/Hydra/Adapters/Term.hs +363/−0
- src/main/haskell/Hydra/Adapters/UtilsEtc.hs +125/−0
- src/main/haskell/Hydra/All.hs +51/−0
- src/main/haskell/Hydra/Common.hs +128/−0
- src/main/haskell/Hydra/CoreDecoding.hs +236/−0
- src/main/haskell/Hydra/CoreEncoding.hs +193/−0
- src/main/haskell/Hydra/CoreLanguage.hs +18/−0
- src/main/haskell/Hydra/Ext/Avro/Coder.hs +352/−0
- src/main/haskell/Hydra/Ext/Avro/Language.hs +32/−0
- src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs +165/−0
- src/main/haskell/Hydra/Ext/Graphql/Coder.hs +176/−0
- src/main/haskell/Hydra/Ext/Graphql/Language.hs +38/−0
- src/main/haskell/Hydra/Ext/Graphql/Serde.hs +13/−0
- src/main/haskell/Hydra/Ext/Haskell/Coder.hs +327/−0
- src/main/haskell/Hydra/Ext/Haskell/Language.hs +70/−0
- src/main/haskell/Hydra/Ext/Haskell/Operators.hs +110/−0
- src/main/haskell/Hydra/Ext/Haskell/Serde.hs +213/−0
- src/main/haskell/Hydra/Ext/Haskell/Settings.hs +7/−0
- src/main/haskell/Hydra/Ext/Haskell/Utils.hs +96/−0
- src/main/haskell/Hydra/Ext/Java/Coder.hs +710/−0
- src/main/haskell/Hydra/Ext/Java/Language.hs +96/−0
- src/main/haskell/Hydra/Ext/Java/Serde.hs +918/−0
- src/main/haskell/Hydra/Ext/Java/Settings.hs +4/−0
- src/main/haskell/Hydra/Ext/Java/Utils.hs +495/−0
- src/main/haskell/Hydra/Ext/Json/Coder.hs +113/−0
- src/main/haskell/Hydra/Ext/Json/Eliminate.hs +54/−0
- src/main/haskell/Hydra/Ext/Json/Language.hs +30/−0
- src/main/haskell/Hydra/Ext/Pegasus/Coder.hs +182/−0
- src/main/haskell/Hydra/Ext/Pegasus/Language.hs +42/−0
- src/main/haskell/Hydra/Ext/Pegasus/Serde.hs +81/−0
- src/main/haskell/Hydra/Ext/Rdf/Serde.hs +81/−0
- src/main/haskell/Hydra/Ext/Scala/Coder.hs +241/−0
- src/main/haskell/Hydra/Ext/Scala/Language.hs +73/−0
- src/main/haskell/Hydra/Ext/Scala/Prepare.hs +65/−0
- src/main/haskell/Hydra/Ext/Scala/Serde.hs +140/−0
- src/main/haskell/Hydra/Ext/Scala/Utils.hs +68/−0
- src/main/haskell/Hydra/Ext/Shacl/Coder.hs +273/−0
- src/main/haskell/Hydra/Ext/Shacl/Language.hs +36/−0
- src/main/haskell/Hydra/Ext/Tinkerpop/Language.hs +100/−0
- src/main/haskell/Hydra/Ext/Yaml/Coder.hs +117/−0
- src/main/haskell/Hydra/Ext/Yaml/Language.hs +26/−0
- src/main/haskell/Hydra/Ext/Yaml/Modules.hs +40/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Base.hs +168/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Bootstrap.hs +54/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Grammars.hs +48/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Lists.hs +27/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Literals.hs +12/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Math.hs +27/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Sets.hs +20/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Lib/Strings.hs +21/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Literals.hs +92/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/PhantomLiterals.hs +75/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Prims.hs +101/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Standard.hs +78/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Terms.hs +264/−0
- src/main/haskell/Hydra/Impl/Haskell/Dsl/Types.hs +140/−0
- src/main/haskell/Hydra/Impl/Haskell/Ext/Bytestrings.hs +12/−0
- src/main/haskell/Hydra/Impl/Haskell/Ext/Json/Serde.hs +77/−0
- src/main/haskell/Hydra/Impl/Haskell/Ext/Yaml/Serde.hs +80/−0
- src/main/haskell/Hydra/Impl/Haskell/GraphIO.hs +169/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Adapters/Utils.hs +95/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Basics.hs +318/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Compute.hs +153/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Core.hs +374/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/CoreLang.hs +51/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Avro/Schema.hs +140/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Graphql/Syntax.hs +340/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Haskell/Ast.hs +422/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Java/Syntax.hs +1743/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Json/Model.hs +28/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Owl/Syntax.hs +601/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Pegasus/Pdl.hs +130/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Rdf/Syntax.hs +103/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Scala/Meta.hs +1373/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Shacl/Model.hs +274/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Shex/Syntax.hs +526/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/Features.hs +160/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/Typed.hs +114/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Tinkerpop/V3.hs +72/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Xml/Schema.hs +118/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Ext/Yaml/Model.hs +77/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Grammar.hs +50/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Libraries.hs +264/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Mantle.hs +131/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Module.hs +42/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Phantoms.hs +38/−0
- src/main/haskell/Hydra/Impl/Haskell/Sources/Util/Codetree/Ast.hs +81/−0
- src/main/haskell/Hydra/Lexical.hs +71/−0
- src/main/haskell/Hydra/Lib/Flows.hs +16/−0
- src/main/haskell/Hydra/Lib/Io.hs +49/−0
- src/main/haskell/Hydra/Lib/Lists.hs +34/−0
- src/main/haskell/Hydra/Lib/Literals.hs +16/−0
- src/main/haskell/Hydra/Lib/Maps.hs +10/−0
- src/main/haskell/Hydra/Lib/Math.hs +23/−0
- src/main/haskell/Hydra/Lib/Optionals.hs +16/−0
- src/main/haskell/Hydra/Lib/Sets.hs +32/−0
- src/main/haskell/Hydra/Lib/Strings.hs +21/−0
- src/main/haskell/Hydra/Meta.hs +119/−0
- src/main/haskell/Hydra/Monads.hs +116/−0
- src/main/haskell/Hydra/Reduction.hs +236/−0
- src/main/haskell/Hydra/Rewriting.hs +306/−0
- src/main/haskell/Hydra/Sorting.hs +17/−0
- src/main/haskell/Hydra/Types/Inference.hs +353/−0
- src/main/haskell/Hydra/Types/Substitution.hs +76/−0
- src/main/haskell/Hydra/Types/Unification.hs +79/−0
- src/main/haskell/Hydra/Util/Codetree/Script.hs +204/−0
- src/main/haskell/Hydra/Util/Context.hs +27/−0
- src/main/haskell/Hydra/Util/Debug.hs +10/−0
- src/main/haskell/Hydra/Util/Formatting.hs +112/−0
- src/main/haskell/Hydra/Util/GrammarToModule.hs +98/−0
- src/test/haskell/Hydra/Adapters/LiteralSpec.hs +126/−0
- src/test/haskell/Hydra/Adapters/TermSpec.hs +377/−0
- src/test/haskell/Hydra/ArbitraryCore.hs +307/−0
- src/test/haskell/Hydra/CommonSpec.hs +42/−0
- src/test/haskell/Hydra/CoreCodersSpec.hs +133/−0
- src/test/haskell/Hydra/Ext/Json/CoderSpec.hs +134/−0
- src/test/haskell/Hydra/Ext/Yaml/CoderSpec.hs +123/−0
- src/test/haskell/Hydra/Impl/Haskell/Dsl/TypesSpec.hs +51/−0
- src/test/haskell/Hydra/Impl/Haskell/Ext/Json/SerdeSpec.hs +105/−0
- src/test/haskell/Hydra/Impl/Haskell/Ext/Yaml/SerdeSpec.hs +110/−0
- src/test/haskell/Hydra/MetaSpec.hs +97/−0
- src/test/haskell/Hydra/ReductionSpec.hs +154/−0
- src/test/haskell/Hydra/RewritingSpec.hs +259/−0
- src/test/haskell/Hydra/TestData.hs +80/−0
- src/test/haskell/Hydra/TestGraph.hs +119/−0
- src/test/haskell/Hydra/TestUtils.hs +142/−0
- src/test/haskell/Hydra/Types/InferenceSpec.hs +353/−0
- src/test/haskell/Hydra/Types/UnificationSpec.hs +36/−0
- src/test/haskell/Hydra/Util/Codetree/PrintSpec.hs +113/−0
- src/test/haskell/Spec.hs +1/−0
- stack.yaml +6/−0
+ CHANGELOG.md view
@@ -0,0 +1,16 @@+Note: this change log tracks hydra-haskell changes only, exlusive of hydra-java, hydra-scala, and hydra-extensions++# 0.1.0++This is the first packaged release of Hydra. It contains everything developed so far, including:+* Hydra's core type and data languages+* Core models for graphs and modules, computation, BNF grammars, phantom types, and basic operations on types and terms+* Hindley-Milner style type inference+* Hydra's adapter (type/type rewriting) system+* Haskell and Java coders for both types and terms+* Partial Scala coder for terms+* Type and term DSLs+* Additional coders for Avro, JSON, PDL, RDF+SHACL, and YAML+* Models for GraphQL, OWL, ShEx, and TinkerPop-style property graphs+* QuickCheck tests+
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed 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.
+ README.md view
@@ -0,0 +1,153 @@+# Hydra-Haskell++Hydra is a type-aware data transformation toolkit which aims to be highly flexible and portable.+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.++## 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.+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:++```bash+stack ghci+```++To run tests, use:++```bash+stack test+```++## Code generation++One of the main objectives for Hydra is for the framework to generate its own source code into various languages,+producing nearly-complete Hydra implementations in those languages.+At this time, Haskell is fully supported as a target language, while Java is supported for schemas only (i.e. Hydra type definitions map to Java classes),+and Scala is supported for data only (i.e. constants and functions are mapped, but types are not yet).++You can generate Hydra's sources by first entering the GHCi REPL as above, then:++```bash+writeHaskell allModules "/path/to/CategoricalData/hydra/hydra-haskell/src/gen-main/haskell"+```++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.+For individual modules, use Haskell list syntax, e.g.++```bash+writeHaskell [rdfSyntaxModule, shaclModelModule] "/path/to/CategoricalData/hydra/hydra-haskell/src/gen-main/haskell"+```++The commands for Scala and Java generation are similar, e.g.++```bash+writeScala allModules "/path/to/CategoricalData/hydra/hydra-scala/src/gen-main/scala"+```++and++```bash+writeJava allModules "/path/to/CategoricalData/hydra/hydra-java/src/gen-main/java"+```++There is also schema-only support for PDL:++```bash+writePdl allModules "/tmp/pdl"+```++For languages other than Haskell and Java, you can expect error messages from Hydra where a given coder encounters language features which are not yet fully implemented.++## Haskell API++### Structures++The most important structural types in Hydra are `Type` and `Term` (provided in the generated [Hydra.Core](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/gen-main/haskell/Hydra/Core.hs) module in Haskell), and `Graph` and `Element` (provided in the generated [Hydra.Graph](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/gen-main/haskell/Hydra/Graph.hs) module).+`Type` provides a datatype, and a `Term` is an instance of a known `Type`.+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.+"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.+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,+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 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:++```haskell+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`,+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.++```haskell+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.+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.+As a trivial example, consider this coder which serializes integers to strings using Haskell's built-in `show` function, then reads the strings back to integers using `read`:++```haskell+intStringCoder :: Coder () () Int String+intStringCoder = Coder {+ coderEncode = pure . show,+ coderDecode = pure . read}+```++The `()`'s indicate that this coder is stateless in both directions, which makes the use of `Coder` overkill in this case.+For a more realistic, but still simple example, see the [JSON coder](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Ext/Json/Coder.hs), which makes use of state for error propagation.+For a more sophisticated example, see the [Haskell coder](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Ext/Haskell/Coder.hs)+or the [Java coder](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Ext/Java/Coder.hs);+these make use of all of the facilities of a graph flow, including lexical lookups, type decoding, annotations, etc.++### DSLs++Constructing types and terms directly from the `Type` and `Term` APIs mentioned above is perfectly correct, but not very convenient.+For example, the type of all lists of strings may be expressed as `TypeList $ TypeLiteral LiteralTypeString`,+and a specific instance of that type (a term) may be expressed as `TermList [TermLiteral $ LiteralString "foo", TermLiteral $ LiteralString "bar"]`.++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;+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++A minority of Hydra's primary sources, rather than providing models (type definitions), provide collections of functions.+For example, look at [Basics.hs](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Sources/Basics.hs)+or [Utils.hs](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Sources/Adapters/Utils.hs).+There are not many of these files because the syntax for constructing transformations natively in Hydra DSLs is still in flux,+but you will notice that the type signatures in these modules look very different.+For example, you will see signatures like `Definition (Precision -> String)` which appear to use native Haskell types such as `String`,+or generated types like `Precision`, rather than Hydra's low-level constructs (`Type`, `Term`, etc.).+This is a convenience for the programmer which will will be expanded upon as more of Hydra's kernel (indispensable code which is needed in each host language)+is pulled out of raw Haskell and into the DSLs.+If you are curious how these types work, see the [Phantoms](https://github.com/CategoricalData/hydra/blob/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Sources/Phantoms.hs) model+and [these slides](https://www.slideshare.net/joshsh/transpilers-gone-wild-introducing-hydra/34).+Phantom types are available both in Haskell and Java.
+ hydra.cabal view
@@ -0,0 +1,234 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: hydra+version: 0.1.0+synopsis: Type-aware transformations for data and functional 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+homepage: https://github.com/CategoricalData/hydra#readme+bug-reports: https://github.com/CategoricalData/hydra/issues+author: Joshua Shinavier <josh@fortytwo.net>+maintainer: Joshua Shinavier <josh@fortytwo.net>+license: Apache-2.0+license-file: LICENSE+build-type: Simple+extra-source-files:+ CHANGELOG.md+ LICENSE+ README.md+ stack.yaml++source-repository head+ type: git+ location: https://github.com/CategoricalData/hydra++library+ exposed-modules:+ Hydra.Adapters.Coders+ Hydra.Adapters.Literal+ Hydra.Adapters.Term+ Hydra.Adapters.UtilsEtc+ Hydra.All+ Hydra.Common+ 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.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.GraphIO+ 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.Lexical+ Hydra.Lib.Flows+ Hydra.Lib.Io+ Hydra.Lib.Lists+ Hydra.Lib.Literals+ Hydra.Lib.Maps+ Hydra.Lib.Math+ Hydra.Lib.Optionals+ Hydra.Lib.Sets+ Hydra.Lib.Strings+ Hydra.Meta+ Hydra.Monads+ Hydra.Reduction+ Hydra.Rewriting+ Hydra.Sorting+ Hydra.Types.Inference+ Hydra.Types.Substitution+ Hydra.Types.Unification+ Hydra.Util.Codetree.Script+ Hydra.Util.Context+ Hydra.Util.Debug+ Hydra.Util.Formatting+ Hydra.Util.GrammarToModule+ Hydra.Adapters.Utils+ Hydra.Basics+ Hydra.Compute+ 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.Grammar+ Hydra.Mantle+ Hydra.Module+ Hydra.Phantoms+ Hydra.Util.Codetree.Ast+ other-modules:+ Paths_hydra+ hs-source-dirs:+ src/main/haskell+ src/gen-main/haskell+ build-depends:+ HsYAML >=0.2.1 && <0.3+ , aeson >=2.0.0 && <2.2+ , aeson-pretty >=0.8.9 && <0.9+ , base >=4.16.3 && <4.17+ , bytestring >=0.11.3 && <0.12+ , containers >=0.6.5 && <0.7+ , directory >=1.3.6 && <1.4+ , filepath >=1.4.2 && <1.5+ , scientific >=0.3.7 && <0.4+ , split >=0.2.3 && <0.3+ , text >=1.2.5 && <1.3+ , unordered-containers >=0.2.19 && <0.3+ , vector >=0.12.0 && <0.14+ default-language: Haskell2010++test-suite hydra-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Hydra.Adapters.LiteralSpec+ Hydra.Adapters.TermSpec+ 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.ReductionSpec+ Hydra.RewritingSpec+ Hydra.TestData+ Hydra.TestGraph+ Hydra.TestUtils+ Hydra.Types.InferenceSpec+ Hydra.Types.UnificationSpec+ Hydra.Util.Codetree.PrintSpec+ Paths_hydra+ hs-source-dirs:+ src/test/haskell+ build-depends:+ HUnit+ , HsYAML >=0.2.1 && <0.3+ , QuickCheck+ , aeson >=2.0.0 && <2.2+ , aeson-pretty >=0.8.9 && <0.9+ , base >=4.16.3 && <4.17+ , bytestring >=0.11.3 && <0.12+ , containers >=0.6.5 && <0.7+ , directory >=1.3.6 && <1.4+ , filepath >=1.4.2 && <1.5+ , hspec+ , hspec-discover+ , hydra+ , scientific >=0.3.7 && <0.4+ , split >=0.2.3 && <0.3+ , text >=1.2.5 && <1.3+ , unordered-containers >=0.2.19 && <0.3+ , vector >=0.12.0 && <0.14+ default-language: Haskell2010
+ src/gen-main/haskell/Hydra/Adapters/Utils.hs view
@@ -0,0 +1,88 @@+-- | 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/Basics.hs view
@@ -0,0 +1,246 @@+-- | Basic functions for working with types and terms++module Hydra.Basics where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+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++-- | Find the elimination variant (constructor) for a given elimination term+eliminationVariant :: (Core.Elimination m -> Mantle.EliminationVariant)+eliminationVariant x = case x of+ Core.EliminationElement -> Mantle.EliminationVariantElement+ Core.EliminationList _ -> Mantle.EliminationVariantList+ Core.EliminationNominal _ -> Mantle.EliminationVariantNominal+ Core.EliminationOptional _ -> Mantle.EliminationVariantOptional+ Core.EliminationRecord _ -> Mantle.EliminationVariantRecord+ Core.EliminationUnion _ -> Mantle.EliminationVariantUnion++-- | All elimination variants (constructors), in a canonical order+eliminationVariants :: [Mantle.EliminationVariant]+eliminationVariants = [+ Mantle.EliminationVariantElement,+ Mantle.EliminationVariantList,+ Mantle.EliminationVariantNominal,+ Mantle.EliminationVariantOptional,+ Mantle.EliminationVariantRecord,+ Mantle.EliminationVariantUnion]++-- | Find the precision of a given floating-point type+floatTypePrecision :: (Core.FloatType -> Mantle.Precision)+floatTypePrecision x = case x of+ Core.FloatTypeBigfloat -> Mantle.PrecisionArbitrary+ Core.FloatTypeFloat32 -> (Mantle.PrecisionBits 32)+ Core.FloatTypeFloat64 -> (Mantle.PrecisionBits 64)++-- | All floating-point types in a canonical order+floatTypes :: [Core.FloatType]+floatTypes = [+ Core.FloatTypeBigfloat,+ Core.FloatTypeFloat32,+ Core.FloatTypeFloat64]++-- | Find the float type for a given floating-point value+floatValueType :: (Core.FloatValue -> Core.FloatType)+floatValueType x = case x of+ Core.FloatValueBigfloat _ -> Core.FloatTypeBigfloat+ Core.FloatValueFloat32 _ -> Core.FloatTypeFloat32+ Core.FloatValueFloat64 _ -> Core.FloatTypeFloat64++-- | Find the function variant (constructor) for a given function+functionVariant :: (Core.Function m -> Mantle.FunctionVariant)+functionVariant x = case x of+ Core.FunctionCompareTo _ -> Mantle.FunctionVariantCompareTo+ Core.FunctionElimination _ -> Mantle.FunctionVariantElimination+ Core.FunctionLambda _ -> Mantle.FunctionVariantLambda+ Core.FunctionPrimitive _ -> Mantle.FunctionVariantPrimitive++-- | All function variants (constructors), in a canonical order+functionVariants :: [Mantle.FunctionVariant]+functionVariants = [+ Mantle.FunctionVariantCompareTo,+ Mantle.FunctionVariantElimination,+ Mantle.FunctionVariantLambda,+ Mantle.FunctionVariantPrimitive]++-- | Find whether a given integer type is signed (true) or unsigned (false)+integerTypeIsSigned :: (Core.IntegerType -> Bool)+integerTypeIsSigned x = case x of+ Core.IntegerTypeBigint -> True+ Core.IntegerTypeInt8 -> True+ Core.IntegerTypeInt16 -> True+ Core.IntegerTypeInt32 -> True+ Core.IntegerTypeInt64 -> True+ Core.IntegerTypeUint8 -> False+ Core.IntegerTypeUint16 -> False+ Core.IntegerTypeUint32 -> False+ Core.IntegerTypeUint64 -> False++-- | Find the precision of a given integer type+integerTypePrecision :: (Core.IntegerType -> Mantle.Precision)+integerTypePrecision x = case x of+ Core.IntegerTypeBigint -> Mantle.PrecisionArbitrary+ Core.IntegerTypeInt8 -> (Mantle.PrecisionBits 8)+ Core.IntegerTypeInt16 -> (Mantle.PrecisionBits 16)+ Core.IntegerTypeInt32 -> (Mantle.PrecisionBits 32)+ Core.IntegerTypeInt64 -> (Mantle.PrecisionBits 64)+ Core.IntegerTypeUint8 -> (Mantle.PrecisionBits 8)+ Core.IntegerTypeUint16 -> (Mantle.PrecisionBits 16)+ Core.IntegerTypeUint32 -> (Mantle.PrecisionBits 32)+ Core.IntegerTypeUint64 -> (Mantle.PrecisionBits 64)++-- | All integer types, in a canonical order+integerTypes :: [Core.IntegerType]+integerTypes = [+ Core.IntegerTypeBigint,+ Core.IntegerTypeInt8,+ Core.IntegerTypeInt16,+ Core.IntegerTypeInt32,+ Core.IntegerTypeInt64,+ Core.IntegerTypeUint8,+ Core.IntegerTypeUint16,+ Core.IntegerTypeUint32,+ Core.IntegerTypeUint64]++-- | Find the integer type for a given integer value+integerValueType :: (Core.IntegerValue -> Core.IntegerType)+integerValueType x = case x of+ Core.IntegerValueBigint _ -> Core.IntegerTypeBigint+ Core.IntegerValueInt8 _ -> Core.IntegerTypeInt8+ Core.IntegerValueInt16 _ -> Core.IntegerTypeInt16+ Core.IntegerValueInt32 _ -> Core.IntegerTypeInt32+ Core.IntegerValueInt64 _ -> Core.IntegerTypeInt64+ Core.IntegerValueUint8 _ -> Core.IntegerTypeUint8+ Core.IntegerValueUint16 _ -> Core.IntegerTypeUint16+ Core.IntegerValueUint32 _ -> Core.IntegerTypeUint32+ Core.IntegerValueUint64 _ -> Core.IntegerTypeUint64++-- | Find the literal type for a given literal value+literalType :: (Core.Literal -> Core.LiteralType)+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.LiteralString _ -> Core.LiteralTypeString++-- | Find the literal type variant (constructor) for a given literal value+literalTypeVariant :: (Core.LiteralType -> Mantle.LiteralVariant)+literalTypeVariant x = case x of+ Core.LiteralTypeBinary -> Mantle.LiteralVariantBinary+ Core.LiteralTypeBoolean -> Mantle.LiteralVariantBoolean+ Core.LiteralTypeFloat _ -> Mantle.LiteralVariantFloat+ Core.LiteralTypeInteger _ -> Mantle.LiteralVariantInteger+ Core.LiteralTypeString -> Mantle.LiteralVariantString++-- | Find the literal variant (constructor) for a given literal value+literalVariant :: (Core.Literal -> Mantle.LiteralVariant)+literalVariant x1 = (literalTypeVariant (literalType x1))++-- | All literal variants, in a canonical order+literalVariants :: [Mantle.LiteralVariant]+literalVariants = [+ Mantle.LiteralVariantBinary,+ Mantle.LiteralVariantBoolean,+ Mantle.LiteralVariantFloat,+ 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+ 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.TermUnion _ -> Mantle.TermVariantUnion+ Core.TermVariable _ -> Mantle.TermVariantVariable) term)++-- | All term (expression) variants, in a canonical order+termVariants :: [Mantle.TermVariant]+termVariants = [+ 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.TermVariantUnion,+ Mantle.TermVariantVariable]++-- | TODO: temporary. Just a token polymorphic function for testing+testLists :: ([[a]] -> Int)+testLists els = (Lists.length (Lists.concat els))++-- | Find the type variant (constructor) for a given type+typeVariant :: (Core.Type m -> Mantle.TypeVariant)+typeVariant typ = ((\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)++-- | 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.TypeVariantOptional,+ Mantle.TypeVariantProduct,+ Mantle.TypeVariantRecord,+ Mantle.TypeVariantSet,+ Mantle.TypeVariantStream,+ Mantle.TypeVariantSum,+ Mantle.TypeVariantUnion,+ Mantle.TypeVariantVariable]
+ src/gen-main/haskell/Hydra/Compute.hs view
@@ -0,0 +1,277 @@+-- | Abstractions for evaluation and 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++data Adapter s1 s2 t1 t2 v1 v2 = + Adapter {+ adapterIsLossy :: Bool,+ adapterSource :: t1,+ adapterTarget :: t2,+ adapterCoder :: (Coder s1 s2 v1 v2)}++_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")++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")++_AnnotationClass_termDescription = (Core.FieldName "termDescription")++_AnnotationClass_typeDescription = (Core.FieldName "typeDescription")++_AnnotationClass_termType = (Core.FieldName "termType")++_AnnotationClass_setTermDescription = (Core.FieldName "setTermDescription")++_AnnotationClass_setTermType = (Core.FieldName "setTermType")++_AnnotationClass_typeOf = (Core.FieldName "typeOf")++_AnnotationClass_setTypeOf = (Core.FieldName "setTypeOf")++-- | An encoder and decoder; a bidirectional flow between two types+data Coder s1 s2 v1 v2 = + Coder {+ coderEncode :: (v1 -> Flow s1 v2),+ coderDecode :: (v2 -> Flow s2 v1)}++_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")++_EvaluationStrategy_opaqueTermVariants = (Core.FieldName "opaqueTermVariants")++-- | A variant of the State monad with built-in logging and error handling+newtype Flow s a = + Flow {+ unFlow :: (s -> Trace -> FlowState s a)}++_Flow = (Core.Name "hydra/compute.Flow")++data FlowState s a = + FlowState {+ flowStateValue :: (Maybe a),+ 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")++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")++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")++newtype LanguageName = + LanguageName {+ 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")++_TermCoder_type = (Core.FieldName "type")++_TermCoder_coder = (Core.FieldName "coder")++-- | A container for logging and error information+data Trace = + Trace {+ traceStack :: [String],+ traceMessages :: [String],+ -- | A map of string keys to arbitrary terms as values, for application-specific use+ traceOther :: (Map String (Core.Term Meta))}+ 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")++data TraversalOrder = + -- | Pre-order traversal+ TraversalOrderPre |+ -- | Post-order traversal+ TraversalOrderPost + deriving (Eq, Ord, Read, Show)++_TraversalOrder = (Core.Name "hydra/compute.TraversalOrder")++_TraversalOrder_pre = (Core.FieldName "pre")++_TraversalOrder_post = (Core.FieldName "post")
+ src/gen-main/haskell/Hydra/Core.hs view
@@ -0,0 +1,652 @@+-- | Hydra's core data model, defining types, terms, and their dependencies++module Hydra.Core where++import Data.List+import Data.Map+import Data.Set++data Annotated a m = + Annotated {+ annotatedSubject :: a,+ annotatedAnnotation :: m}+ deriving (Eq, Ord, Read, Show)++_Annotated = (Name "hydra/core.Annotated")++_Annotated_subject = (FieldName "subject")++_Annotated_annotation = (FieldName "annotation")++-- | A term which applies a function to an argument+data Application m = + Application {+ -- | The left-hand side of the application+ applicationFunction :: (Term m),+ -- | The right-hand side of the application+ applicationArgument :: (Term m)}+ deriving (Eq, Ord, Read, Show)++_Application = (Name "hydra/core.Application")++_Application_function = (FieldName "function")++_Application_argument = (FieldName "argument")++-- | The type-level analog of an application term+data ApplicationType m = + ApplicationType {+ -- | The left-hand side of the application+ applicationTypeFunction :: (Type m),+ -- | The right-hand side of the application+ applicationTypeArgument :: (Type m)}+ deriving (Eq, Ord, Read, Show)++_ApplicationType = (Name "hydra/core.ApplicationType")++_ApplicationType_function = (FieldName "function")++_ApplicationType_argument = (FieldName "argument")++data CaseStatement m = + CaseStatement {+ caseStatementTypeName :: Name,+ caseStatementCases :: [Field m]}+ deriving (Eq, Ord, Read, Show)++_CaseStatement = (Name "hydra/core.CaseStatement")++_CaseStatement_typeName = (FieldName "typeName")++_CaseStatement_cases = (FieldName "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 |+ -- | 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 |+ -- | Eliminates an optional term by matching over the two possible cases+ EliminationOptional (OptionalCases m) |+ -- | 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)+ deriving (Eq, Ord, Read, Show)++_Elimination = (Name "hydra/core.Elimination")++_Elimination_element = (FieldName "element")++_Elimination_list = (FieldName "list")++_Elimination_nominal = (FieldName "nominal")++_Elimination_optional = (FieldName "optional")++_Elimination_record = (FieldName "record")++_Elimination_union = (FieldName "union")++-- | A labeled term+data Field m = + Field {+ fieldName :: FieldName,+ fieldTerm :: (Term m)}+ deriving (Eq, Ord, Read, Show)++_Field = (Name "hydra/core.Field")++_Field_name = (FieldName "name")++_Field_term = (FieldName "term")++-- | The name of a field+newtype FieldName = + FieldName {+ -- | The name of a field+ unFieldName :: String}+ deriving (Eq, Ord, Read, Show)++_FieldName = (Name "hydra/core.FieldName")++-- | The name and type of a field+data FieldType m = + FieldType {+ fieldTypeName :: FieldName,+ fieldTypeType :: (Type m)}+ deriving (Eq, Ord, Read, Show)++_FieldType = (Name "hydra/core.FieldType")++_FieldType_name = (FieldName "name")++_FieldType_type = (FieldName "type")++-- | A floating-point type+data FloatType = + FloatTypeBigfloat |+ FloatTypeFloat32 |+ FloatTypeFloat64 + deriving (Eq, Ord, Read, Show)++_FloatType = (Name "hydra/core.FloatType")++_FloatType_bigfloat = (FieldName "bigfloat")++_FloatType_float32 = (FieldName "float32")++_FloatType_float64 = (FieldName "float64")++-- | A floating-point literal value+data FloatValue = + -- | An arbitrary-precision floating-point value+ FloatValueBigfloat Double |+ -- | A 32-bit floating-point value+ FloatValueFloat32 Float |+ -- | A 64-bit floating-point value+ FloatValueFloat64 Double+ deriving (Eq, Ord, Read, Show)++_FloatValue = (Name "hydra/core.FloatValue")++_FloatValue_bigfloat = (FieldName "bigfloat")++_FloatValue_float32 = (FieldName "float32")++_FloatValue_float64 = (FieldName "float64")++-- | A function+data Function m = + -- | Compares a term with a given term of the same type, producing a Comparison+ FunctionCompareTo (Term m) |+ -- | An elimination for any of a few term variants+ FunctionElimination (Elimination m) |+ -- | A function abstraction (lambda)+ FunctionLambda (Lambda m) |+ -- | 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_lambda = (FieldName "lambda")++_Function_primitive = (FieldName "primitive")++-- | A function type, also known as an arrow type+data FunctionType m = + FunctionType {+ functionTypeDomain :: (Type m),+ functionTypeCodomain :: (Type m)}+ deriving (Eq, Ord, Read, Show)++_FunctionType = (Name "hydra/core.FunctionType")++_FunctionType_domain = (FieldName "domain")++_FunctionType_codomain = (FieldName "codomain")++-- | An integer type+data IntegerType = + IntegerTypeBigint |+ IntegerTypeInt8 |+ IntegerTypeInt16 |+ IntegerTypeInt32 |+ IntegerTypeInt64 |+ IntegerTypeUint8 |+ IntegerTypeUint16 |+ IntegerTypeUint32 |+ IntegerTypeUint64 + deriving (Eq, Ord, Read, Show)++_IntegerType = (Name "hydra/core.IntegerType")++_IntegerType_bigint = (FieldName "bigint")++_IntegerType_int8 = (FieldName "int8")++_IntegerType_int16 = (FieldName "int16")++_IntegerType_int32 = (FieldName "int32")++_IntegerType_int64 = (FieldName "int64")++_IntegerType_uint8 = (FieldName "uint8")++_IntegerType_uint16 = (FieldName "uint16")++_IntegerType_uint32 = (FieldName "uint32")++_IntegerType_uint64 = (FieldName "uint64")++-- | An integer literal value+data IntegerValue = + -- | An arbitrary-precision integer value+ IntegerValueBigint Integer |+ -- | An 8-bit signed integer value+ IntegerValueInt8 Int |+ -- | A 16-bit signed integer value (short value)+ IntegerValueInt16 Int |+ -- | A 32-bit signed integer value (int value)+ IntegerValueInt32 Int |+ -- | A 64-bit signed integer value (long value)+ IntegerValueInt64 Integer |+ -- | An 8-bit unsigned integer value (byte)+ IntegerValueUint8 Int |+ -- | A 16-bit unsigned integer value+ IntegerValueUint16 Int |+ -- | A 32-bit unsigned integer value (unsigned int)+ IntegerValueUint32 Integer |+ -- | 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_int8 = (FieldName "int8")++_IntegerValue_int16 = (FieldName "int16")++_IntegerValue_int32 = (FieldName "int32")++_IntegerValue_int64 = (FieldName "int64")++_IntegerValue_uint8 = (FieldName "uint8")++_IntegerValue_uint16 = (FieldName "uint16")++_IntegerValue_uint32 = (FieldName "uint32")++_IntegerValue_uint64 = (FieldName "uint64")++-- | A function abstraction (lambda)+data Lambda m = + Lambda {+ -- | The parameter of the lambda+ lambdaParameter :: Variable,+ -- | The body of the lambda+ lambdaBody :: (Term m)}+ deriving (Eq, Ord, Read, Show)++_Lambda = (Name "hydra/core.Lambda")++_Lambda_parameter = (FieldName "parameter")++_Lambda_body = (FieldName "body")++-- | A type abstraction; the type-level analog of a lambda term+data LambdaType m = + LambdaType {+ -- | The parameter of the lambda+ lambdaTypeParameter :: VariableType,+ -- | The body of the lambda+ lambdaTypeBody :: (Type m)}+ deriving (Eq, Ord, Read, Show)++_LambdaType = (Name "hydra/core.LambdaType")++_LambdaType_parameter = (FieldName "parameter")++_LambdaType_body = (FieldName "body")++-- | A 'let' binding+data Let m = + Let {+ letKey :: Variable,+ letValue :: (Term m),+ letEnvironment :: (Term m)}+ deriving (Eq, Ord, Read, Show)++_Let = (Name "hydra/core.Let")++_Let_key = (FieldName "key")++_Let_value = (FieldName "value")++_Let_environment = (FieldName "environment")++-- | A term constant; an instance of a literal type+data Literal = + -- | A binary literal+ LiteralBinary String |+ -- | A boolean literal+ LiteralBoolean Bool |+ -- | A floating-point literal+ LiteralFloat FloatValue |+ -- | An integer literal+ LiteralInteger IntegerValue |+ -- | A string literal+ LiteralString String+ deriving (Eq, Ord, Read, Show)++_Literal = (Name "hydra/core.Literal")++_Literal_binary = (FieldName "binary")++_Literal_boolean = (FieldName "boolean")++_Literal_float = (FieldName "float")++_Literal_integer = (FieldName "integer")++_Literal_string = (FieldName "string")++-- | Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants+data LiteralType = + LiteralTypeBinary |+ LiteralTypeBoolean |+ LiteralTypeFloat FloatType |+ LiteralTypeInteger IntegerType |+ LiteralTypeString + deriving (Eq, Ord, Read, Show)++_LiteralType = (Name "hydra/core.LiteralType")++_LiteralType_binary = (FieldName "binary")++_LiteralType_boolean = (FieldName "boolean")++_LiteralType_float = (FieldName "float")++_LiteralType_integer = (FieldName "integer")++_LiteralType_string = (FieldName "string")++-- | A map type+data MapType m = + MapType {+ mapTypeKeys :: (Type m),+ mapTypeValues :: (Type m)}+ deriving (Eq, Ord, Read, Show)++_MapType = (Name "hydra/core.MapType")++_MapType_keys = (FieldName "keys")++_MapType_values = (FieldName "values")++-- | A unique element name+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)}+ deriving (Eq, Ord, Read, Show)++_Named = (Name "hydra/core.Named")++_Named_typeName = (FieldName "typeName")++_Named_term = (FieldName "term")++-- | A case statement for matching optional terms+data OptionalCases m = + 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)}+ deriving (Eq, Ord, Read, Show)++_OptionalCases = (Name "hydra/core.OptionalCases")++_OptionalCases_nothing = (FieldName "nothing")++_OptionalCases_just = (FieldName "just")++data Projection = + Projection {+ projectionTypeName :: Name,+ projectionField :: FieldName}+ deriving (Eq, Ord, Read, Show)++_Projection = (Name "hydra/core.Projection")++_Projection_typeName = (FieldName "typeName")++_Projection_field = (FieldName "field")++-- | A record, or labeled tuple; a map of field names to terms+data Record m = + Record {+ recordTypeName :: Name,+ recordFields :: [Field m]}+ deriving (Eq, Ord, Read, Show)++_Record = (Name "hydra/core.Record")++_Record_typeName = (FieldName "typeName")++_Record_fields = (FieldName "fields")++-- | A labeled record or union type+data RowType m = + 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.+ rowTypeExtends :: (Maybe Name),+ -- | The fields of this row type, excluding any inherited fields+ rowTypeFields :: [FieldType m]}+ 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")++_Stream_first = (FieldName "first")++_Stream_rest = (FieldName "rest")++-- | The unlabeled equivalent of a Union term+data Sum m = + Sum {+ sumIndex :: Int,+ sumSize :: Int,+ sumTerm :: (Term m)}+ deriving (Eq, Ord, Read, Show)++_Sum = (Name "hydra/core.Sum")++_Sum_index = (FieldName "index")++_Sum_size = (FieldName "size")++_Sum_term = (FieldName "term")++-- | A data term+data Term m = + -- | A term annotated with metadata+ TermAnnotated (Annotated (Term m) m) |+ -- | A function application+ TermApplication (Application m) |+ -- | An element reference+ TermElement Name |+ -- | A function term+ TermFunction (Function m) |+ TermLet (Let m) |+ -- | A list+ TermList [Term m] |+ -- | A literal value+ TermLiteral Literal |+ -- | A map of keys to values+ TermMap (Map (Term m) (Term m)) |+ TermNominal (Named m) |+ -- | An optional value+ TermOptional (Maybe (Term m)) |+ -- | A tuple+ TermProduct [Term m] |+ -- | A record term+ TermRecord (Record m) |+ -- | A set of values+ TermSet (Set (Term m)) |+ -- | An infinite stream of terms+ TermStream (Stream m) |+ -- | A variant tuple+ TermSum (Sum m) |+ -- | A union term+ TermUnion (Union m) |+ -- | A variable reference+ TermVariable Variable+ deriving (Eq, Ord, Read, Show)++_Term = (Name "hydra/core.Term")++_Term_annotated = (FieldName "annotated")++_Term_application = (FieldName "application")++_Term_element = (FieldName "element")++_Term_function = (FieldName "function")++_Term_let = (FieldName "let")++_Term_list = (FieldName "list")++_Term_literal = (FieldName "literal")++_Term_map = (FieldName "map")++_Term_nominal = (FieldName "nominal")++_Term_optional = (FieldName "optional")++_Term_product = (FieldName "product")++_Term_record = (FieldName "record")++_Term_set = (FieldName "set")++_Term_stream = (FieldName "stream")++_Term_sum = (FieldName "sum")++_Term_union = (FieldName "union")++_Term_variable = (FieldName "variable")++-- | 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) |+ 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+ deriving (Eq, Ord, Read, Show)++_Type = (Name "hydra/core.Type")++_Type_annotated = (FieldName "annotated")++_Type_application = (FieldName "application")++_Type_element = (FieldName "element")++_Type_function = (FieldName "function")++_Type_lambda = (FieldName "lambda")++_Type_list = (FieldName "list")++_Type_literal = (FieldName "literal")++_Type_map = (FieldName "map")++_Type_nominal = (FieldName "nominal")++_Type_optional = (FieldName "optional")++_Type_product = (FieldName "product")++_Type_record = (FieldName "record")++_Type_set = (FieldName "set")++_Type_stream = (FieldName "stream")++_Type_sum = (FieldName "sum")++_Type_union = (FieldName "union")++_Type_variable = (FieldName "variable")++-- | A symbol which stands in for a term+newtype Variable = + Variable {+ -- | A symbol which stands in for a term+ unVariable :: String}+ deriving (Eq, Ord, Read, Show)++_Variable = (Name "hydra/core.Variable")++-- | 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)++_VariableType = (Name "hydra/core.VariableType")++-- | 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)}+ deriving (Eq, Ord, Read, Show)++_Union = (Name "hydra/core.Union")++_Union_typeName = (FieldName "typeName")++_Union_field = (FieldName "field")++data UnitType = + UnitType {}+ deriving (Eq, Ord, Read, Show)++_UnitType = (Name "hydra/core.UnitType")
+ src/gen-main/haskell/Hydra/Ext/Avro/Schema.hs view
@@ -0,0 +1,221 @@+-- | 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 view
@@ -0,0 +1,1413 @@+-- | 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 view
@@ -0,0 +1,892 @@+-- | 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 view
@@ -0,0 +1,3280 @@+-- | 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 view
@@ -0,0 +1,32 @@+-- | 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 view
@@ -0,0 +1,1211 @@+-- | 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 view
@@ -0,0 +1,267 @@+-- | 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 view
@@ -0,0 +1,185 @@+-- | 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 view
@@ -0,0 +1,2264 @@+-- | 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 view
@@ -0,0 +1,357 @@+-- | 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 view
@@ -0,0 +1,1818 @@+-- | 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 view
@@ -0,0 +1,321 @@+-- | 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 view
@@ -0,0 +1,220 @@+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 view
@@ -0,0 +1,111 @@+-- | 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 view
@@ -0,0 +1,464 @@+-- | 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 view
@@ -0,0 +1,53 @@+-- | 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/Grammar.hs view
@@ -0,0 +1,105 @@+-- | A common API for BNF-based grammars++module Hydra.Grammar where++import qualified Hydra.Core as Core+import Data.List+import Data.Map+import Data.Set++newtype Constant = + Constant {+ unConstant :: String}+ deriving (Eq, Ord, Read, Show)++_Constant = (Core.Name "hydra/grammar.Constant")++newtype Grammar = + Grammar {+ unGrammar :: [Production]}+ deriving (Eq, Ord, Read, Show)++_Grammar = (Core.Name "hydra/grammar.Grammar")++newtype Label = + Label {+ unLabel :: String}+ deriving (Eq, Ord, Read, Show)++_Label = (Core.Name "hydra/grammar.Label")++data LabeledPattern = + LabeledPattern {+ labeledPatternLabel :: Label,+ labeledPatternPattern :: Pattern}+ deriving (Eq, Ord, Read, Show)++_LabeledPattern = (Core.Name "hydra/grammar.LabeledPattern")++_LabeledPattern_label = (Core.FieldName "label")++_LabeledPattern_pattern = (Core.FieldName "pattern")++data Pattern = + PatternNil |+ PatternIgnored Pattern |+ PatternLabeled LabeledPattern |+ PatternConstant Constant |+ PatternRegex Regex |+ PatternNonterminal Symbol |+ PatternSequence [Pattern] |+ PatternAlternatives [Pattern] |+ PatternOption Pattern |+ PatternStar Pattern |+ PatternPlus Pattern+ deriving (Eq, Ord, Read, Show)++_Pattern = (Core.Name "hydra/grammar.Pattern")++_Pattern_nil = (Core.FieldName "nil")++_Pattern_ignored = (Core.FieldName "ignored")++_Pattern_labeled = (Core.FieldName "labeled")++_Pattern_constant = (Core.FieldName "constant")++_Pattern_regex = (Core.FieldName "regex")++_Pattern_nonterminal = (Core.FieldName "nonterminal")++_Pattern_sequence = (Core.FieldName "sequence")++_Pattern_alternatives = (Core.FieldName "alternatives")++_Pattern_option = (Core.FieldName "option")++_Pattern_star = (Core.FieldName "star")++_Pattern_plus = (Core.FieldName "plus")++data Production = + Production {+ productionSymbol :: Symbol,+ productionPattern :: Pattern}+ deriving (Eq, Ord, Read, Show)++_Production = (Core.Name "hydra/grammar.Production")++_Production_symbol = (Core.FieldName "symbol")++_Production_pattern = (Core.FieldName "pattern")++newtype Regex = + Regex {+ unRegex :: String}+ deriving (Eq, Ord, Read, Show)++_Regex = (Core.Name "hydra/grammar.Regex")++newtype Symbol = + Symbol {+ unSymbol :: String}+ deriving (Eq, Ord, Read, Show)++_Symbol = (Core.Name "hydra/grammar.Symbol")
+ src/gen-main/haskell/Hydra/Mantle.hs view
@@ -0,0 +1,269 @@+-- | A set of types which supplement hydra/core with type variants, graphs, and elements++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")++-- | 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)}+ deriving (Eq, Ord, Read, Show)++_Element = (Core.Name "hydra/mantle.Element")++_Element_name = (Core.FieldName "name")++_Element_schema = (Core.FieldName "schema")++_Element_data = (Core.FieldName "data")++-- | The identifier of an elimination constructor+data EliminationVariant = + EliminationVariantElement |+ EliminationVariantList |+ EliminationVariantNominal |+ EliminationVariantOptional |+ EliminationVariantRecord |+ EliminationVariantUnion + deriving (Eq, Ord, Read, Show)++_EliminationVariant = (Core.Name "hydra/mantle.EliminationVariant")++_EliminationVariant_element = (Core.FieldName "element")++_EliminationVariant_list = (Core.FieldName "list")++_EliminationVariant_nominal = (Core.FieldName "nominal")++_EliminationVariant_optional = (Core.FieldName "optional")++_EliminationVariant_record = (Core.FieldName "record")++_EliminationVariant_union = (Core.FieldName "union")++-- | The identifier of a function constructor+data FunctionVariant = + FunctionVariantCompareTo |+ FunctionVariantElimination |+ FunctionVariantLambda |+ FunctionVariantPrimitive + deriving (Eq, Ord, Read, Show)++_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")++_Graph_elements = (Core.FieldName "elements")++_Graph_schema = (Core.FieldName "schema")++-- | The identifier of a literal constructor+data LiteralVariant = + LiteralVariantBinary |+ LiteralVariantBoolean |+ LiteralVariantFloat |+ LiteralVariantInteger |+ LiteralVariantString + deriving (Eq, Ord, Read, Show)++_LiteralVariant = (Core.Name "hydra/mantle.LiteralVariant")++_LiteralVariant_binary = (Core.FieldName "binary")++_LiteralVariant_boolean = (Core.FieldName "boolean")++_LiteralVariant_float = (Core.FieldName "float")++_LiteralVariant_integer = (Core.FieldName "integer")++_LiteralVariant_string = (Core.FieldName "string")++-- | Numeric precision: arbitrary precision, or precision to a specified number of bits+data Precision = + PrecisionArbitrary |+ PrecisionBits Int+ deriving (Eq, Ord, Read, Show)++_Precision = (Core.Name "hydra/mantle.Precision")++_Precision_arbitrary = (Core.FieldName "arbitrary")++_Precision_bits = (Core.FieldName "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 |+ TermVariantUnion |+ TermVariantVariable + 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_literal = (Core.FieldName "literal")++_TermVariant_map = (Core.FieldName "map")++_TermVariant_nominal = (Core.FieldName "nominal")++_TermVariant_optional = (Core.FieldName "optional")++_TermVariant_product = (Core.FieldName "product")++_TermVariant_record = (Core.FieldName "record")++_TermVariant_set = (Core.FieldName "set")++_TermVariant_stream = (Core.FieldName "stream")++_TermVariant_sum = (Core.FieldName "sum")++_TermVariant_union = (Core.FieldName "union")++_TermVariant_variable = (Core.FieldName "variable")++-- | 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)++_TypeScheme = (Core.Name "hydra/mantle.TypeScheme")++_TypeScheme_variables = (Core.FieldName "variables")++_TypeScheme_type = (Core.FieldName "type")++-- | 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 + 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_map = (Core.FieldName "map")++_TypeVariant_nominal = (Core.FieldName "nominal")++_TypeVariant_optional = (Core.FieldName "optional")++_TypeVariant_product = (Core.FieldName "product")++_TypeVariant_record = (Core.FieldName "record")++_TypeVariant_set = (Core.FieldName "set")++_TypeVariant_stream = (Core.FieldName "stream")++_TypeVariant_sum = (Core.FieldName "sum")++_TypeVariant_union = (Core.FieldName "union")++_TypeVariant_variable = (Core.FieldName "variable")++-- | 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)++_TypedTerm = (Core.Name "hydra/mantle.TypedTerm")++_TypedTerm_type = (Core.FieldName "type")++_TypedTerm_term = (Core.FieldName "term")
+ src/gen-main/haskell/Hydra/Module.hs view
@@ -0,0 +1,48 @@+-- | A model for Hydra namespaces and modules (collections of elements in the same namespace)++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++newtype FileExtension = + FileExtension {+ unFileExtension :: String}+ deriving (Eq, Ord, Read, Show)++_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 = + 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],+ -- | 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_elements = (Core.FieldName "elements")++_Module_dependencies = (Core.FieldName "dependencies")++_Module_description = (Core.FieldName "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")
+ src/gen-main/haskell/Hydra/Phantoms.hs view
@@ -0,0 +1,48 @@+-- | Phantom types for use in model definitions++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++newtype Case a = + Case {+ unCase :: Core.FieldName}+ deriving (Eq, Ord, Read, Show)++_Case = (Core.Name "hydra/phantoms.Case")++newtype Datum a = + Datum {+ unDatum :: (Core.Term Compute.Meta)}+ deriving (Eq, Ord, Read, Show)++_Datum = (Core.Name "hydra/phantoms.Datum")++data Definition a = + Definition {+ definitionName :: Core.Name,+ definitionDatum :: (Datum a)}+ deriving (Eq, Ord, Read, Show)++_Definition = (Core.Name "hydra/phantoms.Definition")++_Definition_name = (Core.FieldName "name")++_Definition_datum = (Core.FieldName "datum")++newtype Fld a = + Fld {+ unFld :: (Core.Field Compute.Meta)}+ deriving (Eq, Ord, Read, Show)++_Fld = (Core.Name "hydra/phantoms.Fld")++data Reference a = + Reference {}+ deriving (Eq, Ord, Read, Show)++_Reference = (Core.Name "hydra/phantoms.Reference")
+ src/gen-main/haskell/Hydra/Util/Codetree/Ast.hs view
@@ -0,0 +1,173 @@+-- | 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/main/haskell/Hydra/Adapters/Coders.hs view
@@ -0,0 +1,45 @@+module Hydra.Adapters.Coders where++import Hydra.All+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 view
@@ -0,0 +1,142 @@+module Hydra.Adapters.Literal (+ literalAdapter,+ floatAdapter,+ integerAdapter,+) where++import Hydra.All+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 view
@@ -0,0 +1,363 @@+module Hydra.Adapters.Term (+ fieldAdapter,+ functionProxyName,+ functionProxyType,+ termAdapter,+) where++import Hydra.All+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 (TermUnion (Union _ dfield)) -> do+ 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 view
@@ -0,0 +1,125 @@+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.Util.Context+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/All.hs view
@@ -0,0 +1,51 @@+-- | Provides in Haskell all modules which are either generated and/or are in the top-level Hydra.* namespace.+-- Additionally, some Hydra.Util.* modules are included.+-- Hydra.CoreDecoding and Hydra.CoreEncoding, Hydra.Meta, and Hydra.Reduction are excluded due to their dependencies on the Hydra DSLs++module Hydra.All (+ module Hydra.Adapters.Utils,+ module Hydra.Basics,+ module Hydra.Common,+ module Hydra.Compute,+ module Hydra.Core,+-- module Hydra.CoreDecoding,+-- module Hydra.CoreEncoding,+ module Hydra.CoreLanguage,+ module Hydra.Grammar,+ module Hydra.Lexical,+ module Hydra.Mantle,+-- module Hydra.Meta,+ module Hydra.Module,+ module Hydra.Monads,+ module Hydra.Phantoms,+-- module Hydra.Reduction,+ module Hydra.Rewriting,+ module Hydra.Sorting,+ module Hydra.Util.Formatting,+-- module Hydra.Util.Context,+ module Hydra.Util.Debug,+-- module Hydra.Util.GrammarToModule,+) where++import Hydra.Adapters.Utils+import Hydra.Basics+import Hydra.Common+import Hydra.Compute+import Hydra.Core+--import Hydra.CoreDecoding+--import Hydra.CoreEncoding+import Hydra.CoreLanguage+import Hydra.Grammar+import Hydra.Lexical+import Hydra.Mantle+--import Hydra.Meta+import Hydra.Module+import Hydra.Monads+import Hydra.Phantoms+--import Hydra.Reduction+import Hydra.Rewriting+import Hydra.Sorting+import Hydra.Util.Formatting+--import Hydra.Util.Context+import Hydra.Util.Debug+--import Hydra.Util.GrammarToModule
+ src/main/haskell/Hydra/Common.hs view
@@ -0,0 +1,128 @@+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
@@ -0,0 +1,236 @@+module Hydra.CoreDecoding (+ decodeLiteralType,+ decodeFieldType,+ decodeFieldTypes,+ decodeFloatType,+ decodeFunctionType,+ decodeIntegerType,+ decodeMapType,+ decodeRowType,+ decodeString,+ decodeType,+ decodeLambdaType,+ elementAsTypedTerm,+ fieldTypes,+ requireRecordType,+ requireType,+ requireUnionType,+ typeDependencies,+ typeDependencyNames,+ ) where++import Hydra.Common+import Hydra.Core+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 qualified Control.Monad as CM+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+++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++decodeFieldType :: Show m => Term m -> GraphFlow m (FieldType m)+decodeFieldType = matchRecord $ \m -> FieldType+ <$> (FieldName <$> getField m _FieldType_name decodeString)+ <*> getField m _FieldType_type decodeType++decodeFieldTypes :: Show m => Term m -> GraphFlow m [FieldType m]+decodeFieldTypes term = case stripTerm term of+ TermList els -> CM.mapM decodeFieldType els+ _ -> unexpected "list" term++decodeFloatType :: Show m => Term m -> GraphFlow m FloatType+decodeFloatType = matchEnum [+ (_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++decodeIntegerType :: Show m => Term m -> GraphFlow m IntegerType+decodeIntegerType = matchEnum [+ (_IntegerType_bigint, IntegerTypeBigint),+ (_IntegerType_int8, IntegerTypeInt8),+ (_IntegerType_int16, IntegerTypeInt16),+ (_IntegerType_int32, IntegerTypeInt32),+ (_IntegerType_int64, IntegerTypeInt64),+ (_IntegerType_uint8, IntegerTypeUint8),+ (_IntegerType_uint16, IntegerTypeUint16),+ (_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++decodeLiteralType :: Show m => Term m -> GraphFlow m LiteralType+decodeLiteralType = matchUnion [+ matchUnitField _LiteralType_binary LiteralTypeBinary,+ matchUnitField _LiteralType_boolean LiteralTypeBoolean,+ (_LiteralType_float, fmap LiteralTypeFloat . decodeFloatType),+ (_LiteralType_integer, fmap LiteralTypeInteger . decodeIntegerType),+ 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++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++decodeString :: Show m => Term m -> GraphFlow m String+decodeString = Terms.expectString . stripTerm++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++elementAsTypedTerm :: (Show m) => Element m -> GraphFlow m (TypedTerm m)+elementAsTypedTerm el = TypedTerm <$> decodeType (elementSchema el) <*> pure (elementData el)++fieldTypes :: Show m => Type m -> GraphFlow m (M.Map FieldName (Type m))+fieldTypes t = case stripType t of+ TypeRecord rt -> pure $ toMap $ rowTypeFields rt+ TypeUnion rt -> pure $ toMap $ rowTypeFields rt+ TypeElement et -> fieldTypes et+ TypeNominal 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+ 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 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)++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++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+ Nothing -> fail $ "no matching case for field " ++ show fname+ Just f -> f val+ _ -> unexpected ("union with one of {" ++ L.intercalate ", " (unFieldName . fst <$> pairs) ++ "}") term+ where+ mapping = M.fromList pairs++matchUnitField :: FieldName -> b -> (FieldName, a -> GraphFlow m b)+matchUnitField fname x = (fname, \_ -> pure x)++requireRecordType :: Show m => Bool -> Name -> GraphFlow m (RowType m)+requireRecordType infer = requireRowType "record" 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 label infer getter name = do+ t <- withSchemaContext $ requireType name+ case getter (rawType t) of+ Just rt -> if infer+ then case rowTypeExtends rt of+ Nothing -> return rt+ Just name' -> do+ rt' <- requireRowType label True getter name'+ return $ RowType name Nothing (rowTypeFields rt' ++ rowTypeFields rt)+ else return rt+ Nothing -> fail $ show name ++ " does not resolve to a " ++ label ++ " type: " ++ show t+ where+ rawType t = case t of+ TypeAnnotated (Annotated 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++requireUnionType :: Show m => Bool -> Name -> GraphFlow m (RowType m)+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))+typeDependencies name = deps (S.fromList [name]) M.empty+ where+ deps seeds names = if S.null seeds+ then return names+ else do+ pairs <- CM.mapM toPair $ S.toList seeds+ let newNames = M.union names (M.fromList pairs)+ let refs = L.foldl S.union S.empty (typeDependencyNames <$> (snd <$> pairs))+ let visited = S.fromList $ M.keys names+ let newSeeds = S.difference refs visited+ deps newSeeds newNames+ where+ toPair name = do+ typ <- requireType name+ return (name, typ)++ requireType name = do+ withTrace ("type dependencies of " ++ unName name) $ do+ el <- requireElement name+ 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
+ src/main/haskell/Hydra/CoreEncoding.hs view
@@ -0,0 +1,193 @@+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 view
@@ -0,0 +1,18 @@+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/Ext/Avro/Coder.hs view
@@ -0,0 +1,352 @@+module Hydra.Ext.Avro.Coder where++import Hydra.All+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 view
@@ -0,0 +1,32 @@+module Hydra.Ext.Avro.Language where++import Hydra.All++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 view
@@ -0,0 +1,165 @@+module Hydra.Ext.Avro.SchemaJson where++import Hydra.All+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 view
@@ -0,0 +1,176 @@+module Hydra.Ext.Graphql.Coder where -- (printGraph) where++import Hydra.All+--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 view
@@ -0,0 +1,38 @@+module Hydra.Ext.Graphql.Language where++import Hydra.All++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 view
@@ -0,0 +1,13 @@+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 view
@@ -0,0 +1,327 @@+module Hydra.Ext.Haskell.Coder (printModule) where++import Hydra.All+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 view
@@ -0,0 +1,70 @@+module Hydra.Ext.Haskell.Language where++import Hydra.All++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 view
@@ -0,0 +1,110 @@+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 view
@@ -0,0 +1,213 @@+-- | 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 view
@@ -0,0 +1,7 @@+module Hydra.Ext.Haskell.Settings where++newtypesNotTypedefs :: Bool+newtypesNotTypedefs = True++useCoreImport :: Bool+useCoreImport = True
+ src/main/haskell/Hydra/Ext/Haskell/Utils.hs view
@@ -0,0 +1,96 @@+module Hydra.Ext.Haskell.Utils where++import Hydra.All+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 view
@@ -0,0 +1,710 @@+module Hydra.Ext.Java.Coder (printModule) where++import Hydra.All+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.Util.Context++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 view
@@ -0,0 +1,96 @@+module Hydra.Ext.Java.Language where++import Hydra.All++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 view
@@ -0,0 +1,918 @@+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 view
@@ -0,0 +1,4 @@+module Hydra.Ext.Java.Settings where++listsAsArrays :: Bool+listsAsArrays = False
+ src/main/haskell/Hydra/Ext/Java/Utils.hs view
@@ -0,0 +1,495 @@+module Hydra.Ext.Java.Utils where++import Hydra.All+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 view
@@ -0,0 +1,113 @@+module Hydra.Ext.Json.Coder (jsonCoder) where++import Hydra.All+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 view
@@ -0,0 +1,54 @@+module Hydra.Ext.Json.Eliminate where++import Hydra.All+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 view
@@ -0,0 +1,30 @@+module Hydra.Ext.Json.Language where++import Hydra.All++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 view
@@ -0,0 +1,182 @@+module Hydra.Ext.Pegasus.Coder (printModule) where++import Hydra.All+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 view
@@ -0,0 +1,42 @@+module Hydra.Ext.Pegasus.Language where++import Hydra.All++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 view
@@ -0,0 +1,81 @@+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 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.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 view
@@ -0,0 +1,241 @@+module Hydra.Ext.Scala.Coder (printModule) where++import Hydra.All+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) = 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 n fields) -> do+ sn <- schemaName+ case sn of+ Nothing -> fail $ "unexpected anonymous record: " ++ show term+ Just name -> 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 n (Field fn ft)) -> do+ sn <- schemaName+ let lhs = sname $ qualifyUnionFieldName "UNION." 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+ where+ schemaName = do+ cx <- getState+ r <- annotationClassTermType (contextAnnotations cx) term+ pure $ r >>= nameOfType cx++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 view
@@ -0,0 +1,73 @@+module Hydra.Ext.Scala.Language where++import Hydra.All++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 view
@@ -0,0 +1,65 @@+module Hydra.Ext.Scala.Prepare (+ prepareType,+) where++import Hydra.All+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 view
@@ -0,0 +1,140 @@+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 view
@@ -0,0 +1,68 @@+module Hydra.Ext.Scala.Utils where++import Hydra.All+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 view
@@ -0,0 +1,273 @@+module Hydra.Ext.Shacl.Coder where++import Hydra.All+import Hydra.CoreDecoding+import Hydra.Util.Context+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 view
@@ -0,0 +1,36 @@+module Hydra.Ext.Shacl.Language where++import Hydra.All++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 view
@@ -0,0 +1,100 @@+module Hydra.Ext.Tinkerpop.Language where++import Hydra.All+import Hydra.Ext.Tinkerpop.Features++import qualified Data.Set as S+import qualified Data.Maybe as Y+++-- Populate language constraints based on TinkerPop Graph.Features.+-- Note: although Graph.Features is phrased such that it defaults to supporting features not explicitly mentioned,+-- for Hydra we cannot support a term or type pattern unless it is provably safe in the target environment.+-- Otherwise, generated expressions could cause failure during runtime operations.+-- Also note that extra features are required on top of Graph.Features, again for reasons of completeness.+tinkerpopLanguage :: LanguageName -> Features -> ExtraFeatures m -> Language m+tinkerpopLanguage 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 view
@@ -0,0 +1,117 @@+module Hydra.Ext.Yaml.Coder (yamlCoder) where++import Hydra.All+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 view
@@ -0,0 +1,26 @@+module Hydra.Ext.Yaml.Language where++import Hydra.All++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 view
@@ -0,0 +1,40 @@+module Hydra.Ext.Yaml.Modules (printModule) where++import Hydra.All+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/Impl/Haskell/Dsl/Base.hs view
@@ -0,0 +1,168 @@+module Hydra.Impl.Haskell.Dsl.Base (+ module Hydra.Impl.Haskell.Dsl.Base,+ module Hydra.Impl.Haskell.Dsl.PhantomLiterals,+ Standard.coreContext,+) where++import Hydra.All+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 view
@@ -0,0 +1,54 @@+module Hydra.Impl.Haskell.Dsl.Bootstrap where++import Hydra.All+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 view
@@ -0,0 +1,48 @@+module Hydra.Impl.Haskell.Dsl.Grammars where++import Hydra.All+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 view
@@ -0,0 +1,27 @@+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 view
@@ -0,0 +1,12 @@+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 view
@@ -0,0 +1,27 @@+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 view
@@ -0,0 +1,20 @@+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 view
@@ -0,0 +1,21 @@+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 view
@@ -0,0 +1,92 @@+module Hydra.Impl.Haskell.Dsl.Literals where++import Hydra.All++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 view
@@ -0,0 +1,75 @@+module Hydra.Impl.Haskell.Dsl.PhantomLiterals where++import Hydra.All+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 view
@@ -0,0 +1,101 @@+module Hydra.Impl.Haskell.Dsl.Prims where++import Hydra.All+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 view
@@ -0,0 +1,78 @@+module Hydra.Impl.Haskell.Dsl.Standard (+ module Hydra.Impl.Haskell.Dsl.Standard,+ module Hydra.Impl.Haskell.Dsl.Bootstrap+) where++import Hydra.All+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 view
@@ -0,0 +1,264 @@+module Hydra.Impl.Haskell.Dsl.Terms where++import Hydra.All+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 view
@@ -0,0 +1,140 @@+module Hydra.Impl.Haskell.Dsl.Types where++import Hydra.All++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 view
@@ -0,0 +1,12 @@+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 view
@@ -0,0 +1,77 @@+module Hydra.Impl.Haskell.Ext.Json.Serde where++import Hydra.All+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 view
@@ -0,0 +1,80 @@+module Hydra.Impl.Haskell.Ext.Yaml.Serde where++import Hydra.All+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/GraphIO.hs view
@@ -0,0 +1,169 @@+module Hydra.Impl.Haskell.GraphIO where++import Hydra.All+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 ++ 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 = [+ adapterUtilsModule,+ codetreeAstModule,+ haskellAstModule,+ hydraBasicsModule,+ hydraCoreModule,+ hydraComputeModule,+ hydraMantleModule,+ hydraModuleModule,+ hydraGrammarModule,+-- hydraMonadsModule,+ hydraPhantomsModule,+ jsonModelModule]++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/Sources/Adapters/Utils.hs view
@@ -0,0 +1,95 @@+module Hydra.Impl.Haskell.Sources.Adapters.Utils where++import Hydra.All+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 view
@@ -0,0 +1,318 @@+module Hydra.Impl.Haskell.Sources.Basics where++import Hydra.All+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 view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Compute where++import Hydra.All+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" $+ 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" $+ 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" $+ lambda "s" $ lambda "a" $ record [+ "value">: optional "a",+ "state">: "s",+ "trace">: compute "Trace"],++ def "Language" $+ lambda "m" $ record [+ "name">: compute "LanguageName",+ "constraints">: apply (compute "LanguageConstraints") (variable "m")],++ def "LanguageConstraints" $+ 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" 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" $+ union [+ "pre">: doc "Pre-order traversal" unit,+ "post">: doc "Post-order traversal" unit]]
+ src/main/haskell/Hydra/Impl/Haskell/Sources/Core.hs view
@@ -0,0 +1,374 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Core where++import Hydra.All+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" $+ 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" $+ 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"+ 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" $+ 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" $ record []]
+ src/main/haskell/Hydra/Impl/Haskell/Sources/CoreLang.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.CoreLang where++import Hydra.All+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 view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Ext.Avro.Schema where++import Hydra.All+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 view
@@ -0,0 +1,340 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Ext.Graphql.Syntax where++import Hydra.All+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 view
@@ -0,0 +1,422 @@+module Hydra.Impl.Haskell.Sources.Ext.Haskell.Ast where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,1743 @@+module Hydra.Impl.Haskell.Sources.Ext.Java.Syntax where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,28 @@+module Hydra.Impl.Haskell.Sources.Ext.Json.Model where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,601 @@+module Hydra.Impl.Haskell.Sources.Ext.Owl.Syntax where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,130 @@+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.All+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 view
@@ -0,0 +1,103 @@+module Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,1373 @@+module Hydra.Impl.Haskell.Sources.Ext.Scala.Meta where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,274 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Ext.Shacl.Model where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,526 @@+{-# 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 view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Features where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,114 @@+module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Typed where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.V3 where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,118 @@+module Hydra.Impl.Haskell.Sources.Ext.Xml.Schema where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,77 @@+module Hydra.Impl.Haskell.Sources.Ext.Yaml.Model where++import Hydra.Impl.Haskell.Sources.Core++import Hydra.All+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 view
@@ -0,0 +1,50 @@+-- | A model for Hydra labeled-BNF grammars++module Hydra.Impl.Haskell.Sources.Grammar where++import Hydra.All+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"+ where+ ns = Namespace "hydra/grammar"+ grammar = nsref ns+ def = datatype ns++ elements = [++ def "Constant" string,++ def "Grammar" $ list $ grammar "Production",++ def "Label" string,++ def "LabeledPattern" $ record [+ "label">: grammar "Label",+ "pattern">: grammar "Pattern"],++ def "Pattern" $ 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" $ record [+ "symbol">: grammar "Symbol",+ "pattern">: grammar "Pattern"],++ def "Regex" string,++ def "Symbol" string]
+ src/main/haskell/Hydra/Impl/Haskell/Sources/Libraries.hs view
@@ -0,0 +1,264 @@+module Hydra.Impl.Haskell.Sources.Libraries where++import Hydra.All+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 view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Mantle where++import Hydra.All+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 view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Module where++import Hydra.All+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 view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Sources.Phantoms where++import Hydra.All+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" $+ lambda "a" $ core "FieldName",++ def "Datum" $+ lambda "a" $ (core "Term") @@ (evaluation "Meta"),++ def "Definition" $+ lambda "a" $ record [+ "name">: core "Name",+ "datum">: phantoms "Datum" @@ "a"],++ def "Fld" $+ lambda "a" $ (core "Field") @@ (evaluation "Meta"),++ def "Reference" $+ lambda "a" $ unit]
+ src/main/haskell/Hydra/Impl/Haskell/Sources/Util/Codetree/Ast.hs view
@@ -0,0 +1,81 @@+module Hydra.Impl.Haskell.Sources.Util.Codetree.Ast where++import Hydra.All+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/Lexical.hs view
@@ -0,0 +1,71 @@+module Hydra.Lexical (+ module Hydra.Lexical,+ module Hydra.Common,+ ) where++import Hydra.Common+import Hydra.Core+import Hydra.Module+import Hydra.Compute+import Hydra.Mantle+import Hydra.Monads++import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Maybe as Y+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++requireElement :: Name -> GraphFlow m (Element m)+requireElement name = do+ cx <- getState+ Y.maybe (err cx) pure $ M.lookup name $ graphElements $ contextGraph cx+ where+ err cx = fail $ "no such element: " ++ unName name+ ++ ". Available elements: {" ++ L.intercalate ", " (ellipsis (unName . elementName <$> M.elems (graphElements $ contextGraph cx))) ++ "}"+ where+ ellipsis strings = if L.length strings > 3+-- ellipsis strings = if L.length strings < 0+ then L.take 3 strings ++ ["..."]+ else strings++requirePrimitiveFunction :: Name -> GraphFlow m (PrimitiveFunction m)+requirePrimitiveFunction fn = do+ cx <- getState+ Y.maybe err pure $ lookupPrimitiveFunction 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}++withSchemaContext :: GraphFlow m a -> GraphFlow m a+withSchemaContext f = do+ cx <- getState+ withState (schemaContext cx) f
+ src/main/haskell/Hydra/Lib/Flows.hs view
@@ -0,0 +1,16 @@+module Hydra.Lib.Flows where++import Hydra.All+++apply :: Flow s (a -> b) -> Flow s a -> Flow s b+apply = (<*>)++bind :: Flow s a -> (a -> Flow s b) -> Flow s b+bind = (>>=)++map :: (a -> b) -> Flow s a -> Flow s b+map = fmap++pure :: a -> Flow s a+pure = return
+ src/main/haskell/Hydra/Lib/Io.hs view
@@ -0,0 +1,49 @@+module Hydra.Lib.Io (+ showTerm,+ showType,+ coreContext,+) where++import Hydra.All+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.CoreEncoding++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++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+ where+ mout term = valueToString <$> coderEncode termJsonCoder term+ min s = case stringToValue 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++typeJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Json.Value+typeJsonCoder = fromFlow coreContext $ jsonCoder $ Types.nominal _Type++typeStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String+typeStringCoder = Coder mout min+ where+ mout term = valueToString <$> coderEncode typeJsonCoder term+ min s = case stringToValue 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
@@ -0,0 +1,34 @@+module Hydra.Lib.Lists where++import qualified Data.List as L+++apply :: [a -> b] -> [a] -> [b]+apply = (<*>)++bind :: [a] -> (a -> [b]) -> [b]+bind = (>>=)++concat :: [[a]] -> [a]+concat = L.concat++head :: [a] -> a+head = L.head++intercalate :: [a] -> [[a]] -> [a]+intercalate = L.intercalate++intersperse :: a -> [a] -> [a]+intersperse = L.intersperse++last :: [a] -> a+last = L.last++length :: [a] -> Int+length = L.length++map :: (a -> b) -> [a] -> [b]+map = fmap++pure :: a -> [a]+pure x = [x]
+ src/main/haskell/Hydra/Lib/Literals.hs view
@@ -0,0 +1,16 @@+module Hydra.Lib.Literals where+++-- TODO: expose as a primitive+bigfloatToBigint :: Double -> Integer+bigfloatToBigint = round++-- TODO: expose as a primitive+bigintToBigfloat :: Integer -> Double+bigintToBigfloat = fromIntegral++showInt32 :: Int -> String+showInt32 = show++showString :: String -> String+showString = show
+ src/main/haskell/Hydra/Lib/Maps.hs view
@@ -0,0 +1,10 @@+module Hydra.Lib.Maps where++import qualified Data.Map as M+++map :: (v1 -> v2) -> M.Map k v1 -> M.Map k v2+map = fmap++size :: M.Map k v -> Int+size = M.size
+ src/main/haskell/Hydra/Lib/Math.hs view
@@ -0,0 +1,23 @@+module Hydra.Lib.Math where+++neg :: Int -> Int+neg = negate++add :: Int -> Int -> Int+add x y = x + y++sub :: Int -> Int -> Int+sub x y = x - y++mul :: Int -> Int -> Int+mul x y = x * y++div :: Int -> Int -> Int+div = Prelude.div++mod :: Int -> Int -> Int+mod = Prelude.mod++rem :: Int -> Int -> Int+rem = Prelude.rem
+ src/main/haskell/Hydra/Lib/Optionals.hs view
@@ -0,0 +1,16 @@+module Hydra.Lib.Optionals where++import qualified Data.Maybe as Y+++apply :: Y.Maybe (a -> b) -> Y.Maybe a -> Y.Maybe b+apply = (<*>)++bind :: Y.Maybe a -> (a -> Y.Maybe b) -> Y.Maybe b+bind = (>>=)++map :: (a -> b) -> Y.Maybe a -> Y.Maybe b+map = fmap++pure :: a -> Y.Maybe a+pure = Just
+ src/main/haskell/Hydra/Lib/Sets.hs view
@@ -0,0 +1,32 @@+module Hydra.Lib.Sets where++import qualified Data.Set as S+++contains :: Ord a => a -> S.Set a -> Bool+contains = S.member++fromList :: Ord a => [a] -> S.Set a+fromList = S.fromList++insert :: Ord a => a -> S.Set a -> S.Set a+insert = S.insert++isEmpty :: S.Set a -> 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 f = S.fromList . fmap f . S.toList++remove :: Ord a => a -> S.Set a -> S.Set a+remove = S.delete++singleton :: a -> S.Set a+singleton = S.singleton++size :: S.Set a -> Int+size = S.size++toList :: Ord a => S.Set a -> [a]+toList = S.toList
+ src/main/haskell/Hydra/Lib/Strings.hs view
@@ -0,0 +1,21 @@+module Hydra.Lib.Strings where++import qualified Data.Char as C+import qualified Data.List as L+import qualified Data.List.Split as LS+++cat :: [String] -> String+cat = L.concat++length :: String -> Int+length = L.length++splitOn :: String -> String -> [String]+splitOn = LS.splitOn++toLower :: String -> String+toLower = fmap C.toLower++toUpper :: String -> String+toUpper = fmap C.toUpper
+ src/main/haskell/Hydra/Meta.hs view
@@ -0,0 +1,119 @@+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 Hydra.Impl.Haskell.Dsl.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++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"++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 (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 (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 (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 view
@@ -0,0 +1,116 @@+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
@@ -0,0 +1,236 @@+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.CoreDecoding+import Hydra.Util.Context++import qualified Control.Monad as CM+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+++alphaConvert :: Ord m => Variable -> Term m -> Term m -> Term m+alphaConvert vold tnew = rewriteTerm rewrite id+ where+ rewrite recurse term = case term of+ TermFunction (FunctionLambda (Lambda v body)) -> if v == vold+ then term+ else recurse term+ TermVariable v -> if v == vold then tnew else TermVariable v+ _ -> recurse term++-- For demo purposes. This should be generalized to enable additional side effects of interest.+countPrimitiveFunctionInvocations :: Bool+countPrimitiveFunctionInvocations = 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+ 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++ 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++ -- TODO: FunctionCompareTo++ 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++ FunctionLambda (Lambda v body) -> reduce (M.insert v (L.head args) bindings) body+ >>= reduceApplication bindings (L.tail args)++ -- TODO: FunctionProjection++ _ -> fail $ "unsupported function variant: " ++ show (functionVariant f)++ _ -> fail $ "tried to apply a non-function: " ++ show (termVariant f)++-- 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 typ = do+ cx <- getState :: GraphFlow m (Context m)+ return $ rewriteType (mapExpr cx) id typ+ where+ mapExpr cx rec t = case rec t of+ TypeApplication a -> reduceApp a+ t' -> 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+ -- nominal types are transparent+ TypeNominal name -> fromFlow cx $ betaReduceType $ TypeApplication $ ApplicationType t' rhs+ where+ t' = fromFlow cx $ requireType name++-- | 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 = rewriteTerm rewrite id+ where+ rewrite recurse term = case rec of+ TermApplication (Application lhs rhs) -> case stripTerm lhs of+ TermFunction (FunctionLambda (Lambda v body)) -> if isFreeIn v body+ then body+ else alphaConvert v rhs body+ _ -> rec+ _ -> rec+ where+ rec = recurse term++-- Note: unused / untested+etaReduceTerm :: Term m -> Term m+etaReduceTerm term = case term of+ TermAnnotated (Annotated term1 ann) -> TermAnnotated (Annotated (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)+ TermApplication a -> reduceApplication a+ where+ reduceApplication (Application lhs rhs) = case etaReduceTerm rhs of+ TermAnnotated (Annotated rhs1 ann) -> reduceApplication (Application lhs rhs1)+ TermVariable v1 -> if v == v1 && isFreeIn v lhs+ then etaReduceTerm lhs+ else noChange+ _ -> noChange+ _ -> noChange+ noChange = term++-- | Whether a term is closed, i.e. represents a complete program+termIsClosed :: Term m -> 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+ 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)+ True $ M.toList map+ TermOptional m -> case m of+ Nothing -> True+ Just term -> termIsValue cx strategy term+ TermRecord (Record _ fields) -> checkFields fields+ TermSet els -> forList $ S.toList els+ TermUnion (Union _ field) -> checkField field+ TermVariable _ -> False+ where+ forList els = L.foldl (\b t -> b && termIsValue cx strategy t) True els+ checkField = termIsValue cx strategy . 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+ EliminationRecord _ -> True+ EliminationUnion (CaseStatement _ cases) -> checkFields cases+ FunctionLambda (Lambda _ body) -> termIsValue cx strategy body+ FunctionPrimitive _ -> True
+ src/main/haskell/Hydra/Rewriting.hs view
@@ -0,0 +1,306 @@+module Hydra.Rewriting where++import Hydra.Core+import Hydra.Monads+import Hydra.Module+import Hydra.Lexical+import Hydra.Compute+--import Hydra.CoreDecoding+import Hydra.Mantle+import Hydra.Sorting++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+++-- | 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)+ 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++ pad args arity term = L.foldl lam (L.foldl app term args') $ L.reverse variables+ where+ variables = L.take (max 0 (arity - L.length args)) ((\i -> Variable $ "v" ++ show i) <$> [1..])+ args' = args ++ (TermVariable <$> variables)++ app lhs rhs = TermApplication $ Application lhs rhs+ lam body v = TermFunction $ FunctionLambda $ Lambda v body++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++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+ where+ children = subtypes typ++freeVariablesInScheme :: Show m => TypeScheme m -> S.Set VariableType+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+ 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)++isFreeIn :: Variable -> Term m -> 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 = rewriteTerm remove id+ where+ remove recurse term = case term of+ TermAnnotated (Annotated term' _) -> remove recurse term'+ _ -> recurse term++-- | Recursively remove type annotations, including within subtypes+removeTypeAnnotations :: Ord m => Type m -> Type m+removeTypeAnnotations = rewriteType remove id+ where+ remove recurse typ = case recurse typ of+ TypeAnnotated (Annotated typ' _) -> remove recurse typ'+ _ -> recurse typ++replaceFreeVariableType :: Ord m => VariableType -> Type m -> Type m -> Type m+replaceFreeVariableType v rep = rewriteType mapExpr id+ where+ mapExpr recurse t = case t of+ TypeLambda (LambdaType v' body) -> if v == v'+ then t+ else TypeLambda $ LambdaType v' $ recurse body+ TypeVariable v' -> if v == v' then rep else t+ _ -> recurse t++rewrite :: ((a -> b) -> a -> b) -> ((a -> b) -> a -> b) -> a -> b+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 f mf = rewrite fsub f+ where+ fsub recurse term = case term of+ TermAnnotated (Annotated ex ann) -> TermAnnotated $ Annotated (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+ EliminationOptional (OptionalCases nothing just) -> EliminationOptional+ (OptionalCases (recurse nothing) (recurse just))+ EliminationRecord p -> EliminationRecord p+ EliminationUnion (CaseStatement n cases) -> EliminationUnion $ CaseStatement n (forField <$> cases)+ 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)+ 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)+ 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+ 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 f mf = rewrite fsub f+ where+ fsub recurse term = case term of+ TermAnnotated (Annotated ex ma) -> TermAnnotated <$> (Annotated <$> 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+ EliminationOptional (OptionalCases nothing just) -> EliminationOptional <$>+ (OptionalCases <$> recurse nothing <*> recurse just)+ EliminationRecord p -> pure $ EliminationRecord p+ EliminationUnion (CaseStatement n cases) -> EliminationUnion <$> (CaseStatement n <$> (CM.mapM forField cases))+ 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)+ TermList els -> TermList <$> (CM.mapM recurse els)+ TermLiteral v -> pure $ TermLiteral v+ TermMap m -> TermMap <$> (M.fromList <$> CM.mapM forPair (M.toList m))+ where+ forPair (k, v) = do+ 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)+ TermVariable v -> pure $ TermVariable v+ where+ forField f = do+ t <- recurse (fieldTerm f)+ return f {fieldTerm = t}++rewriteTermMeta :: Ord b => (a -> b) -> Term a -> Term b+rewriteTermMeta = rewriteTerm mapExpr+ where+ mapExpr recurse term = recurse term++rewriteType :: ((Type a -> Type b) -> Type a -> Type b) -> (a -> b) -> Type a -> Type b+rewriteType f mf = rewrite fsub f+ where+ fsub recurse typ = case typ of+ TypeAnnotated (Annotated t ann) -> TypeAnnotated $ Annotated (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)+ TypeSet t -> TypeSet $ recurse t+ TypeSum types -> TypeSum (recurse <$> types)+ TypeUnion (RowType name extends fields) -> TypeUnion $ RowType name extends (forfield <$> fields)+ TypeVariable v -> TypeVariable v+ where+ forfield f = f {fieldTypeType = recurse (fieldTypeType f)}++rewriteTypeMeta :: (a -> b) -> Type a -> Type b+rewriteTypeMeta = rewriteType mapExpr+ where+ mapExpr recurse term = recurse term++simplifyTerm :: Ord m => Term m -> Term m+simplifyTerm = rewriteTerm simplify id+ where+ simplify recurse term = recurse $ case stripTerm term of+ TermApplication (Application lhs rhs) -> case stripTerm lhs of+ TermFunction (FunctionLambda (Lambda var body)) ->+ if S.member var (freeVariablesInTerm body)+ then case stripTerm rhs of+ TermVariable v -> simplifyTerm $ substituteVariable var v body+ _ -> term+ else simplifyTerm body+ _ -> term+ _ -> term++substituteVariable :: Ord m => Variable -> Variable -> Term m -> Term m+substituteVariable from to = rewriteTerm replace id+ where+ replace recurse term = case term of+ TermVariable x -> recurse $ (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 _ -> []++termDependencyNames :: Bool -> Bool -> Bool -> Term m -> S.Set Name+termDependencyNames withEls 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++topologicalSortElements :: [Element m] -> Maybe [Name]+topologicalSortElements els = topologicalSort $ adjlist <$> els+ where+ adjlist e = (elementName e, S.toList $ termDependencyNames True True True $ elementData e)
+ src/main/haskell/Hydra/Sorting.hs view
@@ -0,0 +1,17 @@+module Hydra.Sorting where++import qualified Data.List as L+import qualified Data.Bifunctor as BF+++-- Note: requires 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/main/haskell/Hydra/Types/Inference.hs view
@@ -0,0 +1,353 @@+module Hydra.Types.Inference (+ annotateElementWithTypes,+ annotateTermWithTypes,+ inferType,+ Constraint,+) where++import Hydra.All+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 toplevel 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+-- withTrace ("infer type of " ++ show term) $ do+ cx <- getState+ withState (startContext cx) $ do+ term1 <- infer term+ withTrace ("original term (without annotations): " ++ show (removeTermAnnotations term) ++ " ### inferred term: " ++ show term1) $ do+ 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 view
@@ -0,0 +1,76 @@+module Hydra.Types.Substitution where++import Hydra.All+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 view
@@ -0,0 +1,79 @@+module Hydra.Types.Unification (+ Constraint,+ solveConstraints,+) where++import Hydra.All+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/Util/Codetree/Script.hs view
@@ -0,0 +1,204 @@+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/Context.hs view
@@ -0,0 +1,27 @@+module Hydra.Util.Context where++import Hydra.All+import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms++import qualified Data.Map as M+import qualified Data.Maybe as Y+++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++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})
+ src/main/haskell/Hydra/Util/Debug.hs view
@@ -0,0 +1,10 @@+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 view
@@ -0,0 +1,112 @@+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 view
@@ -0,0 +1,98 @@+module Hydra.Util.GrammarToModule where++import Hydra.All+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/test/haskell/Hydra/Adapters/LiteralSpec.hs view
@@ -0,0 +1,126 @@+module Hydra.Adapters.LiteralSpec where++import Hydra.All++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 view
@@ -0,0 +1,377 @@+module Hydra.Adapters.TermSpec where++import Hydra.All+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/ArbitraryCore.hs view
@@ -0,0 +1,307 @@+module Hydra.ArbitraryCore where++import Hydra.All+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 Data.Maybe as Y+import qualified Test.QuickCheck as QC+++instance QC.Arbitrary LiteralType+ where+ arbitrary = QC.oneof [+ pure LiteralTypeBinary,+ pure LiteralTypeBoolean,+ LiteralTypeFloat <$> QC.arbitrary,+ LiteralTypeInteger <$> QC.arbitrary,+ pure LiteralTypeString]++instance QC.Arbitrary Literal+ where+ arbitrary = QC.oneof [+ LiteralBinary <$> QC.arbitrary,+ LiteralBoolean <$> QC.arbitrary,+ LiteralFloat <$> QC.arbitrary,+ 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 <$> [+ FloatTypeBigfloat,+ FloatTypeFloat32,+ FloatTypeFloat64]++instance QC.Arbitrary FloatValue+ where+ arbitrary = QC.oneof [+ FloatValueBigfloat <$> QC.arbitrary,+ FloatValueFloat32 <$> QC.arbitrary,+ FloatValueFloat64 <$> QC.arbitrary]++instance QC.Arbitrary IntegerType+ where+ arbitrary = QC.oneof $ pure <$> [+ IntegerTypeBigint,+ IntegerTypeInt8,+ IntegerTypeInt16,+ IntegerTypeInt32,+ IntegerTypeInt64,+ IntegerTypeUint8,+ IntegerTypeUint16,+ IntegerTypeUint32,+ IntegerTypeUint64]++instance QC.Arbitrary IntegerValue+ where+ arbitrary = QC.oneof [+ IntegerValueBigint <$> QC.arbitrary,+ IntegerValueInt8 <$> QC.arbitrary,+ IntegerValueInt16 <$> QC.arbitrary,+ IntegerValueInt32 <$> QC.arbitrary,+ IntegerValueInt64 <$> QC.arbitrary,+ IntegerValueUint8 <$> QC.arbitrary,+ IntegerValueUint16 <$> QC.arbitrary,+ 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 Name+ where+ arbitrary = Name <$> QC.arbitrary+ shrink (Name name)= Name <$> QC.shrink name++instance QC.Arbitrary (Type m) where+ arbitrary = QC.sized arbitraryType+ shrink typ = case typ of+ TypeLiteral at -> Types.literal <$> case at of+ LiteralTypeInteger _ -> [LiteralTypeBoolean]+ LiteralTypeFloat _ -> [LiteralTypeBoolean]+ _ -> []+ _ -> [] -- TODO++instance (Eq m, Ord m, Read m, Show m) => QC.Arbitrary (TypedTerm m) where+ arbitrary = QC.sized arbitraryTypedTerm+ shrink (TypedTerm typ term) = L.concat ((\(t, m) -> TypedTerm t <$> m term) <$> shrinkers typ)++arbitraryLiteral :: LiteralType -> QC.Gen Literal+arbitraryLiteral at = case at of+ LiteralTypeBinary -> LiteralBinary <$> QC.arbitrary+ LiteralTypeBoolean -> LiteralBoolean <$> QC.arbitrary+ LiteralTypeFloat ft -> LiteralFloat <$> arbitraryFloatValue ft+ 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 fn ft) n = Field fn <$> arbitraryTerm ft n++arbitraryFieldType :: Int -> QC.Gen (FieldType m)+arbitraryFieldType n = FieldType <$> QC.arbitrary <*> arbitraryType n++arbitraryFloatValue :: FloatType -> QC.Gen FloatValue+arbitraryFloatValue ft = case ft of+ FloatTypeBigfloat -> FloatValueBigfloat <$> QC.arbitrary+ FloatTypeFloat32 -> FloatValueFloat32 <$> QC.arbitrary+ 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+ 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')]+ -- 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]+ where+ arbitraryCase (FieldType fn dom') = do+ term <- arbitraryFunction (FunctionType dom' cod) n2+ return $ Field fn $ TermFunction term+ n2 = div n' $ L.length sfields+ -- Note: projections now require nominally-typed records+-- TypeRecord sfields -> [FunctionProjection <$> (fieldTypeName <$> QC.elements sfields) | not (L.null sfields)]+-- TypeOptional ot -> [FunctionOptionalCases <$> (+-- OptionalCases <$> arbitraryTerm cod n'+-- <*> (TermFunction+-- <$> arbitraryFunction (FunctionType ot cod) n'))]+ _ -> []++arbitraryIntegerValue :: IntegerType -> QC.Gen IntegerValue+arbitraryIntegerValue it = case it of+ IntegerTypeBigint -> IntegerValueBigint <$> QC.arbitrary+ IntegerTypeInt8 -> IntegerValueInt8 <$> QC.arbitrary+ IntegerTypeInt16 -> IntegerValueInt16 <$> QC.arbitrary+ IntegerTypeInt32 -> IntegerValueInt32 <$> QC.arbitrary+ IntegerTypeInt64 -> IntegerValueInt64 <$> QC.arbitrary+ IntegerTypeUint8 -> IntegerValueUint8 <$> QC.arbitrary+ IntegerTypeUint16 -> IntegerValueUint16 <$> QC.arbitrary+ IntegerTypeUint32 -> IntegerValueUint32 <$> QC.arbitrary+ IntegerTypeUint64 -> IntegerValueUint64 <$> QC.arbitrary++arbitraryList :: Bool -> (Int -> QC.Gen a) -> Int -> QC.Gen [a]+arbitraryList nonempty g n = do+ l <- QC.choose (0, div n 2)+ if nonempty && l == 0+ then do+ x <- g (decr n)+ return [x]+ else QC.vectorOf l (g (div n l))++arbitraryOptional :: (Int -> QC.Gen a) -> Int -> QC.Gen (Maybe a)+arbitraryOptional gen n = do+ b <- QC.arbitrary+ if b || n == 0 then pure Nothing else Just <$> gen (decr n)++arbitraryPair :: (a -> a -> b) -> (Int -> QC.Gen a) -> Int -> QC.Gen b+arbitraryPair c g n = c <$> g n' <*> g n'+ 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 typ n = case typ of+ TypeLiteral at -> literal <$> arbitraryLiteral at+ TypeFunction ft -> TermFunction <$> arbitraryFunction ft n'+ TypeList lt -> list <$> arbitraryList False (arbitraryTerm lt) n'+ TypeMap (MapType kt vt) -> TermMap <$> (M.fromList <$> arbitraryList False arbPair n')+ where+ arbPair n = do+ k <- arbitraryTerm kt n'+ v <- arbitraryTerm vt n'+ return (k, v)+ where+ n' = div n 2+ 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+ f <- QC.elements sfields+ let fn = fieldTypeName f+ ft <- arbitraryTerm (fieldTypeType f) n'+ return $ Field fn ft+ where+ n' = decr n+ arbitraryFields sfields = if L.null sfields+ then pure []+ else CM.mapM (`arbitraryField` n2) sfields+ where+ 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 n = if n == 0 then pure Types.unit else QC.oneof [+ TypeLiteral <$> QC.arbitrary,+ TypeFunction <$> arbitraryPair FunctionType arbitraryType n',+ TypeList <$> arbitraryType n',+ TypeMap <$> arbitraryPair MapType arbitraryType n',+ TypeOptional <$> arbitraryType n',+-- TypeRecord <$> arbitraryList False arbitraryFieldType n', -- TODO: avoid duplicate field names+ TypeSet <$> arbitraryType n']+-- 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 n = do+ typ <- arbitraryType n'+ term <- arbitraryTerm typ n'+ return $ TypedTerm typ term+ where+ n' = div n 2 -- TODO: a term is usually bigger than its type++decr :: Int -> Int+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 typ = trivialShrinker ++ case typ of+ TypeLiteral at -> case at of+ LiteralTypeBinary -> [(Types.binary, \(TermLiteral (LiteralBinary s)) -> binary <$> QC.shrink s)]+ LiteralTypeBoolean -> []+ LiteralTypeFloat ft -> []+ LiteralTypeInteger it -> []+ LiteralTypeString -> [(Types.string, \(TermLiteral (LiteralString s)) -> string <$> QC.shrink s)]+ -- TypeElement et ->+ -- TypeFunction ft ->+ TypeList lt -> dropElements : promoteType : shrinkType+ where+ dropElements = (Types.list lt, \(TermList els) -> list <$> dropAny els)+ promoteType = (lt, \(TermList els) -> els)+ shrinkType = (\(t, m) -> (Types.list t, \(TermList els) -> list <$> CM.mapM m els)) <$> shrinkers lt+ TypeMap (MapType kt vt) -> shrinkKeys ++ shrinkValues ++ dropPairs+ where+ shrinkKeys = (\(t, m) -> (Types.map t vt,+ \(TermMap mp) -> TermMap . M.fromList <$> (shrinkPair m <$> M.toList mp))) <$> shrinkers kt+ where+ shrinkPair m (km, vm) = (\km' -> (km', vm)) <$> m km+ shrinkValues = (\(t, m) -> (Types.map kt t,+ \(TermMap mp) -> TermMap . M.fromList <$> (shrinkPair m <$> M.toList mp))) <$> shrinkers vt+ 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)+ promoteType = (ot, \(TermOptional m) -> Y.maybeToList m)+ shrinkType = (\(t, m) -> (Types.optional t,+ \(TermOptional mb) -> Y.maybe [] (fmap (optional . Just) . m) mb)) <$> shrinkers ot+ TypeRecord (RowType name _ sfields) -> dropFields+ ++ shrinkFieldNames (TypeRecord . RowType name Nothing) (record name) (\(TermRecord (Record _ dfields)) -> dfields) sfields+ ++ promoteTypes ++ shrinkTypes+ where+ dropFields = dropField <$> indices+ where+ dropField i = (TypeRecord $ RowType name Nothing $ dropIth i sfields, \(TermRecord (Record _ dfields))+ -> [record name $ dropIth i dfields])+ promoteTypes = promoteField <$> indices+ where+ promoteField i = (fieldTypeType $ sfields !! i, \(TermRecord (Record _ dfields))+ -> [fieldTerm $ dfields !! i])+ shrinkTypes = [] -- TODO+ indices = [0..(L.length sfields - 1)]+ TypeSet st -> dropElements : promoteType : shrinkType+ where+ dropElements = (Types.set st, \(TermSet els) -> set . S.fromList <$> dropAny (S.toList els))+ 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+ ++ promoteTypes ++ shrinkTypes+ where+ dropFields = [] -- TODO+ promoteTypes = [] -- TODO+ shrinkTypes = [] -- TODO+ _ -> []+ where+ dropAny l = case l of+ [] -> []+ (h:r) -> [r] ++ ((h :) <$> dropAny r)+ dropIth i l = L.take i l ++ L.drop (i+1) l+ nodupes l = L.length (L.nub l) == L.length l+ trivialShrinker = [(Types.unit, const [unit]) | typ /= Types.unit]+ shrinkFieldNames toType toTerm fromTerm sfields = forNames <$> altNames+ where+ forNames names = (toType $ withFieldTypeNames names sfields,+ \term -> [toTerm $ withFieldNames names $ fromTerm term])+ altNames = L.filter nodupes $ CM.mapM QC.shrink (fieldTypeName <$> sfields)+ withFieldTypeNames = L.zipWith (\n f -> FieldType n $ fieldTypeType f)+ withFieldNames = L.zipWith (\n f -> Field n $ fieldTerm f)++-- | A placeholder for a type name. Use in tests only, where a union term is needed but no type name is known.+untyped :: Name+untyped = Name "Unknown"
+ src/test/haskell/Hydra/CommonSpec.hs view
@@ -0,0 +1,42 @@+module Hydra.CommonSpec where++import Hydra.All++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
@@ -0,0 +1,133 @@+module Hydra.CoreCodersSpec where++import Hydra.All+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.TestData+import Hydra.TestUtils+import Hydra.ArbitraryCore (untyped)++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.Map as M+++individualEncoderTestCases :: H.SpecWith ()+individualEncoderTestCases = do+ H.describe "Individual encoder test cases" $ do++ H.it "string literal type" $ do+ H.shouldBe+ (strip $ encodeLiteralType LiteralTypeString :: Term Meta)+ (strip $ unitVariant _LiteralType _LiteralType_string)++ H.it "string type" $ do+ H.shouldBe+ (strip $ encodeType Types.string :: Term Meta)+ (strip $ variant _Type _Type_literal (unitVariant _LiteralType _LiteralType_string))++ H.it "int32 type" $ do+ H.shouldBe+ (strip $ encodeType Types.int32 :: Term Meta)+ (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 $ variant _Type _Type_record $+ record _RowType [+ Field _RowType_typeName $ string "Example",+ Field _RowType_extends $ optional Nothing,+ Field _RowType_fields $ list [+ record _FieldType [+ Field _FieldType_name $ string "something",+ Field _FieldType_type $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_string],+ record _FieldType [+ Field _FieldType_name $ string "nothing",+ Field _FieldType_type $ variant _Type _Type_record $ record _RowType [+ Field _RowType_typeName $ string "hydra/core.UnitType",+ Field _RowType_extends $ optional Nothing,+ Field _RowType_fields $ list []]]]])++individualDecoderTestCases :: H.SpecWith ()+individualDecoderTestCases = do+ H.describe "Individual decoder test cases" $ do++ H.it "float32 literal type" $ do+ shouldSucceedWith+ (decodeLiteralType+ (variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32))+ (LiteralTypeFloat FloatTypeFloat32)++ H.it "float32 type" $ do+ shouldSucceedWith+ (decodeType+ (variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32))+ Types.float32++ H.it "union type" $ do+ shouldSucceedWith+ (decodeType $+ variant _Type _Type_union $ record _RowType [+ Field _RowType_typeName $ string (unName testTypeName),+ Field _RowType_extends $ optional Nothing,+ Field _RowType_fields $+ list [+ record _FieldType [+ Field _FieldType_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_type $ variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $+ unitVariant _FloatType _FloatType_float64]]])+ (TypeUnion $ RowType testTypeName Nothing [+ Types.field "left" Types.int64,+ Types.field "right" Types.float64])++decodeInvalidTerms :: H.SpecWith ()+decodeInvalidTerms = do+ 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 [])++ H.it "Try to decode an incomplete representation of a Type" $ do+ shouldFail (decodeType $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_integer)++metadataIsPreserved :: H.SpecWith ()+metadataIsPreserved = do+ H.describe "Check that metadata is preserved through a type-encoding round trip" $ do++ H.it "Basic metadata" $ do+ shouldSucceedWith+ (decodeType $ encodeType 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)]++testRoundTripsFromType :: H.SpecWith ()+testRoundTripsFromType = do+ H.describe "Check that encoding, then decoding random types is a no-op" $ do++ H.it "Try random types" $+ QC.property $ \typ ->+ shouldSucceedWith+ (decodeType $ encodeType typ)+ typ++spec :: H.Spec+spec = do+ individualEncoderTestCases+ individualDecoderTestCases+ decodeInvalidTerms+ metadataIsPreserved+ testRoundTripsFromType
+ src/test/haskell/Hydra/Ext/Json/CoderSpec.hs view
@@ -0,0 +1,134 @@+module Hydra.Ext.Json.CoderSpec where++import Hydra.All+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 view
@@ -0,0 +1,123 @@+module Hydra.Ext.Yaml.CoderSpec where++import Hydra.All+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/Impl/Haskell/Dsl/TypesSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Impl.Haskell.Dsl.TypesSpec where++import Hydra.All+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 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.Impl.Haskell.Ext.Json.SerdeSpec where++import Hydra.All+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 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.Impl.Haskell.Ext.Yaml.SerdeSpec where++import Hydra.All+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/MetaSpec.hs view
@@ -0,0 +1,97 @@+module Hydra.MetaSpec where++import Hydra.All+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
@@ -0,0 +1,154 @@+module Hydra.ReductionSpec where++import Hydra.All+import Hydra.Reduction+import Hydra.Impl.Haskell.Dsl.Terms+import qualified Hydra.Impl.Haskell.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.Char as C+++checkAlphaConversion :: H.SpecWith ()+checkAlphaConversion = do+ 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)+ 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)+ 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)+ 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)++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)++ H.it "Literal terms are fully reduced; check using a dedicated function" $+ QC.property $ \av -> termIsValue testContext testStrategy (literal av :: Term Meta)++ H.it "Literal terms are fully reduced; check by trying to reduce them" $+ QC.property $ \av ->+ shouldSucceedWith+ (eval (literal av))+ (literal av :: Term Meta)++ H.it "Literal terms cannot be applied" $+ QC.property $ \av (TypedTerm _ term) -> shouldFail (eval $ apply (literal av) term)++checkMonomorphicPrimitives :: H.SpecWith ()+checkMonomorphicPrimitives = do+ H.describe "Tests for monomorphic primitive functions" $ do++ H.it "Example primitives have the expected arity" $ do+ H.shouldBe+ (primitiveFunctionArity <$> lookupPrimitiveFunction testContext _strings_toUpper)+ (Just 1)+ H.shouldBe+ (primitiveFunctionArity <$> lookupPrimitiveFunction testContext _strings_splitOn)+ (Just 2)++ H.it "Simple applications of a unary function succeed" $+ QC.property $ \s ->+ shouldSucceedWith+ (eval (apply (primitive _strings_toUpper) $ string s))+ (string $ fmap C.toUpper s)++ H.it "Simple applications of a binary function succeed" $+ QC.property $ \i1 i2 ->+ shouldSucceedWith+ (eval (apply (apply (primitive _math_add) $ int32 i1) $ int32 i2))+ (int32 $ i1 + i2)++ H.it "Incomplete application of a primitive function leaves the term unchanged" $+ QC.property $ \s1 ->+ shouldSucceedWith+ (eval (apply (primitive _strings_splitOn) $ string s1))+ (apply (primitive _strings_splitOn) $ string s1)++ H.it "Extra arguments to a primitive function cause failure" $+ QC.property $ \s1 s2 ->+ shouldFail (eval (apply (apply (primitive _strings_toUpper) $ string s1) $ string s2))++checkPolymorphicPrimitives :: H.SpecWith ()+checkPolymorphicPrimitives = do+ H.describe "Tests for polymorphic primitive functions" $ do++ H.it "Test polymorphic list length" $ do+ QC.property $ \l ->+ shouldSucceedWith+ (eval (apply (primitive _lists_length) $ list l))+ (int32 $ L.length l)++testBetaReduceTypeRecursively :: H.SpecWith ()+testBetaReduceTypeRecursively = do+ H.describe "Beta reduce types recursively" $ do++ H.it "Try non-application types" $ do+ H.shouldBe+ (reduce Types.unit)+ Types.unit+ H.shouldBe+ (reduce latLonType)+ latLonType++ H.it "Try simple application types" $ do+ H.shouldBe+ (reduce app1)+ (Types.function Types.string Types.string)+ H.shouldBe+ (reduce app2)+ latLonType+ H.shouldBe+ (reduce app3)+ (TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" Types.unit])++ H.it "Try recursive application types" $ do+ H.shouldBe+ (reduce app4)+ (TypeRecord $ RowType (Name "Example") Nothing [Types.field "f1" Types.int32, Types.field "f2" Types.int64])++-- H.it "Distinguish between eager and lazy evaluation" $ do+-- H.shouldBe+-- (reduce False app5)+-- (TypeRecord $ RowType (Name "Example") Nothing [Types.field "foo" app1])+-- H.shouldBe+-- (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+ 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)++eval :: Term Meta -> GraphFlow Meta (Term Meta)+eval = betaReduceTerm++spec :: H.Spec+spec = do+ checkAlphaConversion+ testBetaReduceTypeRecursively+ checkLiterals+ checkMonomorphicPrimitives+ checkPolymorphicPrimitives
+ src/test/haskell/Hydra/RewritingSpec.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.RewritingSpec where++import Hydra.All+import Hydra.Impl.Haskell.Dsl.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.Set as S+++data Quux a = QuuxUnit | QuuxValue a | QuuxPair (Quux a) (Quux a) deriving (Eq, Ord, Show)++fsubQuux :: (a -> b) -> (Quux a -> Quux b) -> Quux a -> Quux b+fsubQuux mf recurse q = case q of+ QuuxUnit -> QuuxUnit+ QuuxValue x -> QuuxValue $ mf x+ QuuxPair left right -> QuuxPair (recurse left) (recurse right)++rewriteQuux :: (a -> b) -> ((Quux a -> Quux b) -> Quux a -> Quux b) -> Quux a -> Quux b+rewriteQuux mf f = rewrite (fsubQuux mf) f++myQuuxRewriter :: Quux String -> Quux Int+myQuuxRewriter = rewriteQuux L.length $ \fsub q -> fsub $ case q of+ QuuxPair left right -> QuuxPair QuuxUnit right+ _ -> q++testExpandLambdas :: H.SpecWith ()+testExpandLambdas = do+ H.describe "Test expanding to lambda terms" $ do++ H.it "Try some terms which do not expand" $ do+ noChange (int32 42)+ noChange (list ["foo", "bar"])+ noChange+ (apply (apply splitOn "foo") "bar")+ noChange+ (lambda "x" $ int32 42)++ H.it "Expand bare function terms" $ do+ expandsTo+ toLower+ (lambda "v1" $ apply toLower (variable "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"))+ expandsTo+ (matchOptional (int32 42) length)+ -- Note two levels of lambda expansion+ (lambda "v1" $ apply (matchOptional (int32 42) (lambda "v1" $ apply length $ variable "v1")) (variable "v1"))++ H.it "Expand subterms within applications" $ do+ expandsTo+ (apply splitOn "bar")+ (lambda "v1" $ apply (apply splitOn "bar") (variable "v1"))+ expandsTo+ (apply (lambda "x" $ variable "x") length)+ (apply (lambda "x" $ variable "x") (lambda "v1" $ apply length $ variable "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"])++ H.it "Check that lambda expansion is idempotent" $ do+ QC.property $ \term -> do+ once <- fromFlowIo testContext $ expandLambdas term+ twice <- fromFlowIo testContext $ expandLambdas 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++ noChange term = expandsTo term term++testFoldOverTerm :: H.SpecWith ()+testFoldOverTerm = do+ H.describe "Test folding over terms" $ do++ 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))+ 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))+ [1, 2, 2]+ H.shouldBe+ (foldOverTerm TraversalOrderPost listLengths []+ (list [list [string "foo", string "bar"], apply (lambda "x" $ variable "x") (list [string "quux"])] :: Term Meta))+ [2, 1, 2]+ where+ addInt32s sum term = case term of+ TermLiteral (LiteralInteger (IntegerValueInt32 i)) -> sum + i+ _ -> sum+ listLengths l term = case term of+ TermList els -> L.length els:l+ _ -> l++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 "Free variables in individual terms" $ do+ H.shouldBe+ (freeVariablesInTerm (string "foo" :: Term ()))+ S.empty+ H.shouldBe+ (freeVariablesInTerm (variable "x" :: Term ()))+ (S.fromList [Variable "x"])+ H.shouldBe+ (freeVariablesInTerm (list [variable "x", apply (lambda "y" $ variable "y") (int32 42)] :: Term ()))+ (S.fromList [Variable "x"])+ H.shouldBe+ (freeVariablesInTerm (list [variable "x", apply (lambda "y" $ variable "y") (variable "y")] :: Term ()))+ (S.fromList [Variable "x", Variable "y"])++--testReplaceFreeVariableType :: H.SpecWith ()+--testReplaceFreeVariableType = 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")+-- ()++testReplaceTerm :: H.SpecWith ()+testReplaceTerm = do+ H.describe "Test term replacement" $ do++ H.it "Check that the correct subterms are replaced" $ do+ H.shouldBe+ (rewriteTerm replaceInts keepMeta+ (int32 42))+ (int64 42 :: Term Meta)+ 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)++ H.it "Check that traversal order is respected" $ do+ H.shouldBe+ (rewriteTerm replaceListsPre keepMeta+ (list [list [list []]]))+ (list [list []] :: Term Meta)+ H.shouldBe+ (rewriteTerm replaceListsPost keepMeta+ (list [list [list []]]))+ (list [] :: Term Meta)++ 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")])+ where+ keepTerm recurse term = recurse term++ keepMeta = id++ replaceInts recurse term = case term2 of+ TermLiteral (LiteralInteger (IntegerValueInt32 v)) -> int64 $ fromIntegral v+ _ -> term2+ where+ term2 = recurse term++ replaceLists term = case term of+ TermList (h:_) -> case h of+ TermList [] -> list []+ _ -> term+ _ -> term++ replaceListsPre recurse = recurse . replaceLists++ replaceListsPost recurse = replaceLists . recurse++ replaceMeta i = show i++testRewriteExampleType :: H.SpecWith ()+testRewriteExampleType = do+ H.describe "Test rewriting of a made-up recursive type" $ do++ H.it "Rewrite a hand-picked expression" $ do+ H.shouldBe+ quux2+ (myQuuxRewriter quux1)+ where+ quux1 = QuuxPair QuuxUnit (QuuxPair (QuuxValue "abc") (QuuxValue "12345"))+ quux2 = QuuxPair QuuxUnit (QuuxPair QuuxUnit (QuuxValue 5))++testSimplifyTerm :: H.SpecWith ()+testSimplifyTerm = do+ H.describe "Test term simplifation (optimization)" $ do++ H.it "Check that 'const' applications are simplified" $ do+ H.shouldBe+ (simplifyTerm (apply (lambda "x" (string "foo")) (int32 42)))+ (string "foo" :: Term Meta)+ H.shouldBe+ (simplifyTerm (apply (lambda "x" $ list [variable "x", variable "x"]) (variable "y")))+ (list [variable "y", variable "y"] :: Term Meta)+ H.shouldBe+ (simplifyTerm (apply (lambda "x" $ string "foo") (variable "y")))+ (string "foo" :: Term Meta)+ 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++withType :: Context m -> Type m -> Term m -> Term m+withType cx typ = annotationClassSetTermType (contextAnnotations cx) cx (Just typ)++spec :: H.Spec+spec = do+ testExpandLambdas+ testFoldOverTerm+ testFreeVariablesInTerm+-- testReplaceFreeVariableType+ testReplaceTerm+ testRewriteExampleType+ testSimplifyTerm+ testStripMeta
+ src/test/haskell/Hydra/TestData.hs view
@@ -0,0 +1,80 @@+module Hydra.TestData where++import Hydra.All+import Hydra.Impl.Haskell.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 Data.Map as M+++concatType :: Type m+concatType = Types.function Types.string $ Types.function Types.string Types.string++compareStringsType :: Type m+compareStringsType = Types.function Types.string Types.string++eitherStringOrInt8Type :: Type m+eitherStringOrInt8Type = TypeUnion $ RowType eitherStringOrInt8TypeName Nothing+ [Types.field "left" Types.string, Types.field "right" Types.int8]++eitherStringOrInt8TypeName :: Name+eitherStringOrInt8TypeName = fromQname testNamespace "EitherStringOrInt8"++exampleProjectionType :: Type Meta+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 = Types.list Types.int8++listOfInt16sType :: Type m+listOfInt16sType = Types.list Types.int16++listOfListsOfStringsType :: Type m+listOfListsOfStringsType = Types.list $ Types.list Types.string++listOfSetOfInt32ElementReferencesType :: Type m+listOfSetOfInt32ElementReferencesType = Types.list $ Types.set $ Types.element Types.int32++listOfSetOfStringsType :: Type m+listOfSetOfStringsType = Types.list $ Types.set Types.string++listOfStringsType :: Type m+listOfStringsType = Types.list Types.string++makeMap :: (Eq a, Ord a, Read a, Show a) => [(String, Int)] -> Term a+makeMap keyvals = Terms.map $ M.fromList $ ((\(k, v) -> (string k, int32 v)) <$> keyvals)++mapOfStringsToIntsType :: Type m+mapOfStringsToIntsType = Types.map Types.string Types.int32++optionalInt8Type :: Type m+optionalInt8Type = Types.optional Types.int8++optionalInt16Type :: Type m+optionalInt16Type = Types.optional Types.int16++optionalStringType :: Type m+optionalStringType = Types.optional Types.string++setOfStringsType :: Type m+setOfStringsType = Types.set Types.string++stringAliasType :: Type m+stringAliasType = Types.nominal $ Name "StringTypeAlias"++stringOrIntName :: Name+stringOrIntName = Name "StringOrInt"++stringOrIntType :: Type m+stringOrIntType = TypeUnion $ RowType stringOrIntName Nothing [Types.field "left" Types.string, Types.field "right" Types.int32]++testTypeName :: Name+testTypeName = fromQname testNamespace "TestType"
+ src/test/haskell/Hydra/TestGraph.hs view
@@ -0,0 +1,119 @@+module Hydra.TestGraph (+ module Hydra.TestGraph,+ module Hydra.Impl.Haskell.Sources.Libraries,+) where++import Hydra.All+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 qualified Data.Map as M+import qualified Data.Set as S+++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]++latLonType :: Type m+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]}}++testElementArthur :: Element Meta+testElementArthur = Element {+ elementName = Name "ArthurDent",+ elementSchema = element $ Name "Person",+ elementData = testDataArthur}++testElementFirstName :: Element Meta+testElementFirstName = Element {+ elementName = Name "firstName",+ elementSchema = encodeType (Types.function (Types.nominal testTypePersonName) Types.string),+ elementData = projection testTypePersonName $ FieldName "firstName"}++testGraph :: Graph Meta+testGraph = elementsToGraph (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,+ def testTypeFoobarValueName testTypeFoobarValue,+ def testTypeComparisonName testTypeComparison,+ def latLonName latLonType,+ def testTypePersonName testTypePerson,+ def testTypePersonOrSomethingName testTypePersonOrSomething,+ def testTypeTimestampName testTypeTimestamp]+ where+ def = typeElement++testSchemaNamespace :: Namespace+testSchemaNamespace = Namespace "testSchemaGraph"++testStrategy :: EvaluationStrategy+testStrategy = contextStrategy testContext++testDataArthur :: Term Meta+testDataArthur = record testTypePersonName [+ Field (FieldName "firstName") $ string "Arthur",+ Field (FieldName "lastName") $ string "Dent",+ Field (FieldName "age") $ int32 42]++testTypeComparison :: Type m+testTypeComparison = TypeUnion $ RowType testTypeComparisonName Nothing [+ Types.field "lessThan" Types.unit,+ Types.field "equalTo" Types.unit,+ Types.field "greaterThan" Types.unit]++testTypeComparisonName :: Name+testTypeComparisonName = Name "Comparison"++testTypeFoobarValue :: Type m+testTypeFoobarValue = TypeUnion $ RowType testTypeFoobarValueName Nothing [+ Types.field "bool" Types.boolean,+ Types.field "string" Types.string,+ Types.field "unit" Types.unit]++testTypeFoobarValueName :: Name+testTypeFoobarValueName = Name "FoobarValue"++testTypePerson :: Type Meta+testTypePerson = TypeRecord $ RowType testTypePersonName Nothing [+ Types.field "firstName" Types.string,+ Types.field "lastName" Types.string,+ Types.field "age" Types.int32]++testTypePersonName :: Name+testTypePersonName = Name "Person"++testTypePersonOrSomething :: Type Meta+testTypePersonOrSomething = Types.lambda "a" $ TypeUnion $ RowType testTypePersonOrSomethingName Nothing [+ Types.field "person" testTypePerson,+ Types.field "other" $ Types.variable "a"]++testTypePersonOrSomethingName :: Name+testTypePersonOrSomethingName = Name "PersonOrSomething"++testTypeTimestamp :: Type Meta+testTypeTimestamp = TypeUnion $ RowType testTypeTimestampName Nothing [+ FieldType (FieldName "unixTimeMillis") Types.uint64,+ FieldType (FieldName "date") Types.string]++testTypeTimestampName :: Name+testTypeTimestampName = Name "Timestamp"
+ src/test/haskell/Hydra/TestUtils.hs view
@@ -0,0 +1,142 @@+module Hydra.TestUtils (+ checkLiteralAdapter,+ checkFieldAdapter,+ checkFloatAdapter,+ checkIntegerAdapter,+ checkDataAdapter,+ checkSerdeRoundTrip,+ checkSerialization,+ shouldFail,+ shouldSucceedWith,+ strip,+ termTestContext,+ module Hydra.TestGraph,+) where++import Hydra.ArbitraryCore()++import Hydra.All+import Hydra.TestGraph+import Hydra.Adapters.Literal+import Hydra.Adapters.Term+import Hydra.Adapters.UtilsEtc++import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.List as L+import qualified Data.Set as S+import qualified Data.Maybe as Y+import qualified Data.ByteString.Lazy as BS+++baseLanguage :: Language m+baseLanguage = hydraCoreLanguage++baseContext :: AdapterContext Meta+baseContext = AdapterContext testContext baseLanguage baseLanguage++checkAdapter :: (Eq t, Eq v, Show t, Show v)+ => (v -> v)+ -> (t -> Flow (AdapterContext Meta) (SymmetricAdapter (Context Meta) t v))+ -> ([r] -> AdapterContext Meta)+ -> [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+ if Y.isNothing adapter' then HL.assertFailure (traceSummary trace) else pure ()+ let adapter = Y.fromJust adapter'+ let step = 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)+ if lossy+ then True `H.shouldBe` True+ else fromFlow cx (coderEncode step vs >>= coderDecode step) `H.shouldBe` vs++checkLiteralAdapter :: [LiteralVariant] -> LiteralType -> LiteralType -> Bool -> Literal -> Literal -> H.Expectation+checkLiteralAdapter = checkAdapter id literalAdapter context+ where+ context variants = withConstraints $ (languageConstraints baseLanguage) {+ languageConstraintsLiteralVariants = S.fromList variants,+ languageConstraintsFloatTypes = floatVars,+ languageConstraintsIntegerTypes = integerVars }+ where+ floatVars = S.fromList [FloatTypeFloat32]+ integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32]++checkFieldAdapter :: [TypeVariant] -> FieldType Meta -> FieldType Meta -> Bool -> Field Meta -> Field Meta -> H.Expectation+checkFieldAdapter = checkAdapter id fieldAdapter termTestContext++checkFloatAdapter :: [FloatType] -> FloatType -> FloatType -> Bool -> FloatValue -> FloatValue -> H.Expectation+checkFloatAdapter = checkAdapter id floatAdapter context+ where+ context variants = withConstraints $ (languageConstraints baseLanguage) {+ languageConstraintsFloatTypes = S.fromList variants }++checkIntegerAdapter :: [IntegerType] -> IntegerType -> IntegerType -> Bool -> IntegerValue -> IntegerValue -> H.Expectation+checkIntegerAdapter = checkAdapter id integerAdapter context+ where+ context variants = withConstraints $ (languageConstraints baseLanguage) {+ languageConstraintsIntegerTypes = S.fromList variants }++checkDataAdapter :: [TypeVariant] -> Type Meta -> Type Meta -> Bool -> Term Meta -> Term Meta -> 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+ 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++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+ case mserde of+ Nothing -> HL.assertFailure (traceSummary trace)+ Just serde -> shouldSucceedWith+ (normalize <$> coderEncode serde term)+ (normalize expected)+ where+ normalize = unlines . L.filter (not . L.null) . lines+ FlowState mserde _ trace = unFlow (mkSerdeStr typ) testContext emptyTrace++shouldFail :: GraphFlow Meta a -> H.Expectation+shouldFail f = H.shouldBe True (Y.isNothing $ flowStateValue $ unFlow f testContext emptyTrace)++shouldSucceed :: GraphFlow Meta 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++shouldSucceedWith :: (Eq a, Show a) => GraphFlow Meta 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++strip :: Ord m => Term m -> Term m+strip = stripTerm++termTestContext :: [TypeVariant] -> AdapterContext Meta+termTestContext variants = withConstraints $ (languageConstraints baseLanguage) {+ languageConstraintsTypeVariants = S.fromList variants,+ languageConstraintsLiteralVariants = literalVars,+ languageConstraintsFloatTypes = floatVars,+ languageConstraintsIntegerTypes = integerVars }+ where+ literalVars = S.fromList [LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString]+ floatVars = S.fromList [FloatTypeFloat32]+ integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32]++withConstraints :: LanguageConstraints Meta -> AdapterContext Meta+withConstraints c = baseContext { adapterContextTarget = baseLanguage { languageConstraints = c }}
+ src/test/haskell/Hydra/Types/InferenceSpec.hs view
@@ -0,0 +1,353 @@+module Hydra.Types.InferenceSpec where++import Hydra.All+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 view
@@ -0,0 +1,36 @@+module Hydra.Types.UnificationSpec where++import Hydra.All+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/Util/Codetree/PrintSpec.hs view
@@ -0,0 +1,113 @@+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 for 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/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ stack.yaml view
@@ -0,0 +1,6 @@+resolver: lts-20.1++packages:+ - .++extra-deps: